(.using [library [lux "*" ["_" test {"+" Test}] [abstract [monad {"+" do}]] [control ["[0]" try ("[1]#[0]" functor)] [parser ["<[0]>" code]]] [data ["[0]" bit ("[1]#[0]" equivalence)] ["[0]" text ["%" format {"+" format}]] [collection ["[0]" list]]] [math ["[0]" random {"+" Random}] [number ["[0]" nat]]] ["[0]" meta ["[0]" location] ["[0]" symbol]]]] [\\library ["[0]" / [syntax {"+" syntax:}] ["[0]" code ("[1]#[0]" equivalence)] ["[0]" template]]] ["[0]" / "_" ["[1][0]" code] ["[1][0]" local] ["[1][0]" syntax] ["[1][0]" template]]) (template: (!expect ) [(case true _ false)]) (template: (!global ) [(: [Text .Global] [(template.text []) {.#Definition [true .Macro ]}])]) (syntax: (pow/2 [number .any]) (in (list (` (nat.* (~ number) (~ number)))))) (syntax: (pow/4 [number .any]) (in (list (` (..pow/2 (..pow/2 (~ number))))))) (syntax: (repeated [times .nat token .any]) (in (list.repeated times token))) (syntax: (fresh_symbol []) (do meta.monad [g!fresh (/.symbol "fresh")] (in (list g!fresh)))) (def: random_lux (Random [Nat Text .Lux]) (do [! random.monad] [seed random.nat symbol_prefix (random.ascii/upper 1) .let [macro_module (symbol.module (symbol /._)) current_module (symbol.module (symbol .._))]] (in [seed symbol_prefix [.#info [.#target "" .#version "" .#mode {.#Build}] .#source [location.dummy 0 ""] .#location location.dummy .#current_module {.#Some current_module} .#modules (list [macro_module [.#module_hash 0 .#module_aliases (list) .#definitions (: (List [Text .Global]) (list (!global /.log_single_expansion!) (!global /.log_expansion!) (!global /.log_full_expansion!))) .#imports (list) .#module_state {.#Active}]] [current_module [.#module_hash 0 .#module_aliases (list) .#definitions (: (List [Text .Global]) (list (!global ..pow/2) (!global ..pow/4) (!global ..repeated))) .#imports (list) .#module_state {.#Active}]]) .#scopes (list) .#type_context [.#ex_counter 0 .#var_counter 0 .#var_bindings (list)] .#expected {.#None} .#seed seed .#scope_type_vars (list) .#extensions [] .#eval (:as (-> Type Code (Meta Any)) []) .#host []]]))) (def: expander Test (do [! random.monad] [[seed symbol_prefix lux] ..random_lux pow/1 (# ! each code.nat random.nat) repetitions (# ! each (nat.% 10) random.nat) .let [single_expansion (` (..pow/2 (..pow/2 (~ pow/1)))) expansion (` (nat.* (..pow/2 (~ pow/1)) (..pow/2 (~ pow/1)))) full_expansion (` (nat.* (nat.* (~ pow/1) (~ pow/1)) (nat.* (~ pow/1) (~ pow/1))))]] (`` ($_ _.and (~~ (template [ ] [(_.cover [] (|> ( (` (..pow/4 (~ pow/1)))) (meta.result lux) (try#each (# (list.equivalence code.equivalence) = (list ))) (try.else false))) (_.cover [] (and (|> (/.single_expansion (` ( "omit" (..pow/4 (~ pow/1))))) (meta.result lux) (try#each (# (list.equivalence code.equivalence) = (list))) (try.else false)) (|> (/.single_expansion (` ( (..pow/4 (~ pow/1))))) (meta.result lux) (try#each (# (list.equivalence code.equivalence) = (list ))) (try.else false))))] [/.single_expansion /.log_single_expansion! single_expansion] [/.expansion /.log_expansion! expansion] [/.full_expansion /.log_full_expansion! full_expansion] )) (_.cover [/.one_expansion] (bit#= (not (nat.= 1 repetitions)) (|> (/.one_expansion (` (..repeated (~ (code.nat repetitions)) (~ pow/1)))) (meta.result lux) (!expect {try.#Failure _})))) )))) (def: .public test Test (<| (_.covering /._) ($_ _.and (do [! random.monad] [[seed symbol_prefix lux] ..random_lux] ($_ _.and (_.cover [/.symbol] (|> (/.symbol symbol_prefix) (# meta.monad each %.code) (meta.result lux) (!expect (^multi {try.#Success actual_symbol} (and (text.contains? symbol_prefix actual_symbol) (text.contains? (%.nat seed) actual_symbol)))))) (_.cover [/.wrong_syntax_error] (|> (/.single_expansion (` (/.log_single_expansion!))) (meta.result lux) (!expect (^multi {try.#Failure error} (text.contains? (/.wrong_syntax_error (symbol /.log_single_expansion!)) error))))) (_.cover [/.with_symbols] (with_expansions [ (fresh_symbol)] (|> (/.with_symbols [] (# meta.monad in )) (meta.result lux) (!expect (^multi {try.#Success [_ {.#Symbol ["" actual]}]} (text.contains? (template.text []) actual)))))) )) ..expander /code.test /local.test /syntax.test /template.test )))