diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/lux/meta.lux | 1094 | ||||
| -rw-r--r-- | stdlib/source/test/lux/meta/compiler.lux | 21 |
2 files changed, 571 insertions, 544 deletions
diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 2a2787429..75cb0d09b 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -37,7 +37,7 @@ ["[0]" / (.only) ["[0]" type (.use "[1]#[0]" equivalence)]]] ["[0]" / - ... ["[1][0]" code] + ["[1][0]" code] ... ["[1][0]" location] ... ["[1][0]" symbol] ... ["[1][0]" configuration] @@ -55,479 +55,480 @@ ... "Python" (.,, (.these ["[1]/[0]" python])) ... "Ruby" (.,, (.these ["[1]/[0]" ruby])) ... (.,, (.these))))] - ... ["[1][0]/" compiler - ... ["[1][0]" arity] - ... ["[1][0]" version] - ... ["[1][0]" reference] - ... ["[1][0]" phase] - ... [language - ... [lux - ... ... ["[1][0]" syntax] - ... ["[1][0]" analysis] - ... ["[1][0]" synthesis] - ... ["[1][0]" phase - ... ["[1]/[0]" extension] - ... ["[1]/[0]" analysis] - ... ... ["[1]/[0]" synthesis] - ... ]]] - ... ["[1][0]" meta - ... ["[1]/[0]" archive] - ... ["[1]/[0]" cli] - ... ["[1]/[0]" export] - ... ["[1]/[0]" import] - ... ["[1]/[0]" context] - ... ["[1]/[0]" cache]]] + ["[1][0]" compiler + ... ["[1]/[0]" arity] + ... ["[1]/[0]" version] + ... ["[1]/[0]" reference] + ... ["[1]/[0]" phase] + ... [language + ... [lux + ... ... ["[1]/[0]" syntax] + ... ["[1]/[0]" analysis] + ... ["[1]/[0]" synthesis] + ... ["[1]/[0]" phase + ... ["[1]/[0]" extension] + ... ["[1]/[0]" analysis] + ... ... ["[1]/[0]" synthesis] + ... ]]] + ... ["[1]/[0]" meta + ... ["[1]/[0]" archive] + ... ["[1]/[0]" cli] + ... ["[1]/[0]" export] + ... ["[1]/[0]" import] + ... ["[1]/[0]" context] + ... ["[1]/[0]" cache]] + ] ]))) -... (def !expect -... (template (_ <pattern> <value>) -... [(when <value> -... <pattern> true -... _ false)])) +(def !expect + (template (_ <pattern> <value>) + [(when <value> + <pattern> true + _ false)])) -... (def compiler_related -... Test -... (do random.monad -... [target (random.upper_cased 1) -... version (random.upper_cased 1) -... source_code (random.upper_cased 1) -... expected_current_module (random.upper_cased 1) -... nominal_type (random.upper_cased 1) -... expected_seed random.nat -... expected random.nat -... dummy (random.only (|>> (n.= expected) not) random.nat) -... configuration_feature (random.upper_cased 1) -... configuration_value (random.upper_cased 1) -... .let [configuration (list [configuration_feature configuration_value]) -... expected_lux [.#info [.#target target -... .#version version -... .#mode {.#Build} -... .#configuration configuration] -... .#source [location.dummy 0 source_code] -... .#location location.dummy -... .#current_module {.#Some expected_current_module} -... .#modules (list) -... .#scopes (list) -... .#type_context [.#ex_counter 0 -... .#var_counter 0 -... .#var_bindings (list)] -... .#expected {.#Some {.#Nominal nominal_type (list)}} -... .#seed expected_seed -... .#scope_type_vars (list) -... .#extensions [] -... .#eval (as (-> Type Code (Meta Any)) []) -... .#host []]]] -... (all _.and -... (_.coverage [/.result] -... (|> (of /.monad in expected) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual} -... (n.= expected actual))))) -... (_.coverage [/.result'] -... (|> (of /.monad in expected) -... (/.result' expected_lux) -... (!expect (^.multi {try.#Success [actual_lux actual]} -... (and (same? expected_lux actual_lux) -... (n.= expected actual)))))) -... (_.coverage [/.compiler_state] -... (|> /.compiler_state -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_lux} -... (same? expected_lux actual_lux))))) -... (_.coverage [/.version] -... (|> /.version -... (/.result expected_lux) -... (!expect (^.multi {try.#Success it} -... (same? version it))))) -... (_.coverage [/.configuration] -... (|> /.configuration -... (/.result expected_lux) -... (!expect (^.multi {try.#Success it} -... (same? configuration it))))) -... ))) +(def compiler_related + Test + (do random.monad + [target (random.upper_cased 1) + version (random.upper_cased 1) + source_code (random.upper_cased 1) + expected_current_module (random.upper_cased 1) + nominal_type (random.upper_cased 1) + expected_seed random.nat + expected random.nat + dummy (random.only (|>> (n.= expected) not) random.nat) + configuration_feature (random.upper_cased 1) + configuration_value (random.upper_cased 1) + .let [configuration (list [configuration_feature configuration_value]) + expected_lux [.#info [.#target target + .#version version + .#mode {.#Build} + .#configuration configuration] + .#source [location.dummy 0 source_code] + .#location location.dummy + .#current_module {.#Some expected_current_module} + .#modules (list) + .#scopes (list) + .#type_context [.#ex_counter 0 + .#var_counter 0 + .#var_bindings (list)] + .#expected {.#Some {.#Nominal nominal_type (list)}} + .#seed expected_seed + .#scope_type_vars (list) + .#extensions [] + .#eval (as (-> Type Code (Meta Any)) []) + .#host []]]] + (all _.and + (_.coverage [/.result] + (|> (of /.monad in expected) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual} + (n.= expected actual))))) + (_.coverage [/.result'] + (|> (of /.monad in expected) + (/.result' expected_lux) + (!expect (^.multi {try.#Success [actual_lux actual]} + (and (same? expected_lux actual_lux) + (n.= expected actual)))))) + (_.coverage [/.compiler_state] + (|> /.compiler_state + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_lux} + (same? expected_lux actual_lux))))) + (_.coverage [/.version] + (|> /.version + (/.result expected_lux) + (!expect (^.multi {try.#Success it} + (same? version it))))) + (_.coverage [/.configuration] + (|> /.configuration + (/.result expected_lux) + (!expect (^.multi {try.#Success it} + (same? configuration it))))) + ))) -... (def error_handling -... Test -... (do random.monad -... [target (random.upper_cased 1) -... version (random.upper_cased 1) -... source_code (random.upper_cased 1) -... expected_current_module (random.upper_cased 1) -... nominal_type (random.upper_cased 1) -... expected_seed random.nat -... expected random.nat -... dummy (random.only (|>> (n.= expected) not) random.nat) -... expected_error (random.upper_cased 1) -... .let [expected_lux [.#info [.#target target -... .#version version -... .#mode {.#Build} -... .#configuration (list)] -... .#source [location.dummy 0 source_code] -... .#location location.dummy -... .#current_module {.#Some expected_current_module} -... .#modules (list) -... .#scopes (list) -... .#type_context [.#ex_counter 0 -... .#var_counter 0 -... .#var_bindings (list)] -... .#expected {.#Some {.#Nominal nominal_type (list)}} -... .#seed expected_seed -... .#scope_type_vars (list) -... .#extensions [] -... .#eval (as (-> Type Code (Meta Any)) []) -... .#host []]]] -... (all _.and -... (_.coverage [/.failure] -... (|> (/.failure expected_error) -... (is (Meta Any)) -... (/.result expected_lux) -... (!expect (^.multi {try.#Failure actual_error} -... (text#= (location.with location.dummy expected_error) -... actual_error))))) -... (_.coverage [/.assertion] -... (and (|> (/.assertion expected_error true) -... (is (Meta Any)) -... (/.result expected_lux) -... (!expect {try.#Success []})) -... (|> (/.assertion expected_error false) -... (/.result expected_lux) -... (!expect (^.multi {try.#Failure actual_error} -... (text#= expected_error actual_error)))))) -... (_.coverage [/.either] -... (and (|> (/.either (of /.monad in expected) -... (is (Meta Nat) -... (/.failure expected_error))) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual} -... (n.= expected actual)))) -... (|> (/.either (is (Meta Nat) -... (/.failure expected_error)) -... (of /.monad in expected)) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual} -... (n.= expected actual)))) -... (|> (/.either (is (Meta Nat) -... (/.failure expected_error)) -... (is (Meta Nat) -... (/.failure expected_error))) -... (/.result expected_lux) -... (!expect (^.multi {try.#Failure actual_error} -... (text#= (location.with location.dummy expected_error) -... actual_error)))) -... (|> (/.either (of /.monad in expected) -... (of /.monad in dummy)) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual} -... (n.= expected actual)))) -... )) -... (_.coverage [/.try] -... (and (|> (/.try (/.failure expected_error)) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success {try.#Failure actual_error}} -... (text#= (location.with location.dummy expected_error) -... actual_error)))) -... (|> (/.try (of /.monad in expected)) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success {try.#Success actual}} -... (same? expected actual)))))) -... ))) +(def error_handling + Test + (do random.monad + [target (random.upper_cased 1) + version (random.upper_cased 1) + source_code (random.upper_cased 1) + expected_current_module (random.upper_cased 1) + nominal_type (random.upper_cased 1) + expected_seed random.nat + expected random.nat + dummy (random.only (|>> (n.= expected) not) random.nat) + expected_error (random.upper_cased 1) + .let [expected_lux [.#info [.#target target + .#version version + .#mode {.#Build} + .#configuration (list)] + .#source [location.dummy 0 source_code] + .#location location.dummy + .#current_module {.#Some expected_current_module} + .#modules (list) + .#scopes (list) + .#type_context [.#ex_counter 0 + .#var_counter 0 + .#var_bindings (list)] + .#expected {.#Some {.#Nominal nominal_type (list)}} + .#seed expected_seed + .#scope_type_vars (list) + .#extensions [] + .#eval (as (-> Type Code (Meta Any)) []) + .#host []]]] + (all _.and + (_.coverage [/.failure] + (|> (/.failure expected_error) + (is (Meta Any)) + (/.result expected_lux) + (!expect (^.multi {try.#Failure actual_error} + (text#= (location.with location.dummy expected_error) + actual_error))))) + (_.coverage [/.assertion] + (and (|> (/.assertion expected_error true) + (is (Meta Any)) + (/.result expected_lux) + (!expect {try.#Success []})) + (|> (/.assertion expected_error false) + (/.result expected_lux) + (!expect (^.multi {try.#Failure actual_error} + (text#= expected_error actual_error)))))) + (_.coverage [/.either] + (and (|> (/.either (of /.monad in expected) + (is (Meta Nat) + (/.failure expected_error))) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual} + (n.= expected actual)))) + (|> (/.either (is (Meta Nat) + (/.failure expected_error)) + (of /.monad in expected)) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual} + (n.= expected actual)))) + (|> (/.either (is (Meta Nat) + (/.failure expected_error)) + (is (Meta Nat) + (/.failure expected_error))) + (/.result expected_lux) + (!expect (^.multi {try.#Failure actual_error} + (text#= (location.with location.dummy expected_error) + actual_error)))) + (|> (/.either (of /.monad in expected) + (of /.monad in dummy)) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual} + (n.= expected actual)))) + )) + (_.coverage [/.try] + (and (|> (/.try (/.failure expected_error)) + (/.result expected_lux) + (!expect (^.multi {try.#Success {try.#Failure actual_error}} + (text#= (location.with location.dummy expected_error) + actual_error)))) + (|> (/.try (of /.monad in expected)) + (/.result expected_lux) + (!expect (^.multi {try.#Success {try.#Success actual}} + (same? expected actual)))))) + ))) -... (def module_related -... Test -... (do random.monad -... [target (random.upper_cased 1) -... version (random.upper_cased 1) -... source_code (random.upper_cased 1) -... expected_current_module (random.upper_cased 1) -... imported_module_name (random.only (|>> (text#= expected_current_module) not) -... (random.upper_cased 1)) -... nominal_type (random.upper_cased 1) -... expected_seed random.nat -... expected random.nat -... dummy (random.only (|>> (n.= expected) not) random.nat) -... expected_short (random.upper_cased 1) -... dummy_module (random.only (function (_ module) -... (not (or (text#= expected_current_module module) -... (text#= imported_module_name module)))) -... (random.upper_cased 1)) -... .let [imported_module [.#module_hash 0 -... .#module_aliases (list) -... .#definitions (list) -... .#imports (list) -... .#module_state {.#Active}] -... expected_module [.#module_hash 0 -... .#module_aliases (list) -... .#definitions (list) -... .#imports (list imported_module_name) -... .#module_state {.#Active}] -... expected_modules (list [expected_current_module -... expected_module] -... [imported_module_name -... imported_module]) -... expected_lux [.#info [.#target target -... .#version version -... .#mode {.#Build} -... .#configuration (list)] -... .#source [location.dummy 0 source_code] -... .#location location.dummy -... .#current_module {.#Some expected_current_module} -... .#modules expected_modules -... .#scopes (list) -... .#type_context [.#ex_counter 0 -... .#var_counter 0 -... .#var_bindings (list)] -... .#expected {.#Some {.#Nominal nominal_type (list)}} -... .#seed expected_seed -... .#scope_type_vars (list) -... .#extensions [] -... .#eval (as (-> Type Code (Meta Any)) []) -... .#host []]]] -... (<| (_.for [.Module]) -... (all _.and -... (_.coverage [/.current_module_name] -... (|> /.current_module_name -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_current_module} -... (text#= expected_current_module actual_current_module))))) -... (_.coverage [/.current_module] -... (|> /.current_module -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_module} -... (same? expected_module actual_module))))) -... (_.coverage [/.module] -... (|> (/.module expected_current_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_module} -... (same? expected_module actual_module))))) -... (_.coverage [/.module_exists?] -... (and (|> (/.module_exists? expected_current_module) -... (/.result expected_lux) -... (!expect {try.#Success .true})) -... (|> (/.module_exists? dummy_module) -... (/.result expected_lux) -... (!expect {try.#Success .false})))) -... (_.coverage [/.modules] -... (|> /.modules -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_modules} -... (same? expected_modules actual_modules))))) -... (_.coverage [/.imported_modules] -... (and (|> (/.imported_modules expected_current_module) -... (/.result expected_lux) -... (try#each (of (list.equivalence text.equivalence) = -... (list imported_module_name))) -... (try.else false)) -... (|> (/.imported_modules imported_module_name) -... (/.result expected_lux) -... (try#each (of (list.equivalence text.equivalence) = -... (list))) -... (try.else false)))) -... (_.coverage [/.imported_by?] -... (|> (/.imported_by? imported_module_name expected_current_module) -... (/.result expected_lux) -... (try.else false))) -... (_.coverage [/.imported?] -... (|> (/.imported? imported_module_name) -... (/.result expected_lux) -... (try.else false))) -... (_.coverage [/.normal] -... (and (|> (/.normal ["" expected_short]) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success [actual_module actual_short]} -... (and (text#= expected_current_module actual_module) -... (same? expected_short actual_short))))) -... (|> (/.normal [dummy_module expected_short]) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success [actual_module actual_short]} -... (and (text#= dummy_module actual_module) -... (same? expected_short actual_short))))))) -... )))) +(def module_related + Test + (do random.monad + [target (random.upper_cased 1) + version (random.upper_cased 1) + source_code (random.upper_cased 1) + expected_current_module (random.upper_cased 1) + imported_module_name (random.only (|>> (text#= expected_current_module) not) + (random.upper_cased 1)) + nominal_type (random.upper_cased 1) + expected_seed random.nat + expected random.nat + dummy (random.only (|>> (n.= expected) not) random.nat) + expected_short (random.upper_cased 1) + dummy_module (random.only (function (_ module) + (not (or (text#= expected_current_module module) + (text#= imported_module_name module)))) + (random.upper_cased 1)) + .let [imported_module [.#module_hash 0 + .#module_aliases (list) + .#definitions (list) + .#imports (list) + .#module_state {.#Active}] + expected_module [.#module_hash 0 + .#module_aliases (list) + .#definitions (list) + .#imports (list imported_module_name) + .#module_state {.#Active}] + expected_modules (list [expected_current_module + expected_module] + [imported_module_name + imported_module]) + expected_lux [.#info [.#target target + .#version version + .#mode {.#Build} + .#configuration (list)] + .#source [location.dummy 0 source_code] + .#location location.dummy + .#current_module {.#Some expected_current_module} + .#modules expected_modules + .#scopes (list) + .#type_context [.#ex_counter 0 + .#var_counter 0 + .#var_bindings (list)] + .#expected {.#Some {.#Nominal nominal_type (list)}} + .#seed expected_seed + .#scope_type_vars (list) + .#extensions [] + .#eval (as (-> Type Code (Meta Any)) []) + .#host []]]] + (<| (_.for [.Module]) + (all _.and + (_.coverage [/.current_module_name] + (|> /.current_module_name + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_current_module} + (text#= expected_current_module actual_current_module))))) + (_.coverage [/.current_module] + (|> /.current_module + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_module} + (same? expected_module actual_module))))) + (_.coverage [/.module] + (|> (/.module expected_current_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_module} + (same? expected_module actual_module))))) + (_.coverage [/.module_exists?] + (and (|> (/.module_exists? expected_current_module) + (/.result expected_lux) + (!expect {try.#Success .true})) + (|> (/.module_exists? dummy_module) + (/.result expected_lux) + (!expect {try.#Success .false})))) + (_.coverage [/.modules] + (|> /.modules + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_modules} + (same? expected_modules actual_modules))))) + (_.coverage [/.imported_modules] + (and (|> (/.imported_modules expected_current_module) + (/.result expected_lux) + (try#each (of (list.equivalence text.equivalence) = + (list imported_module_name))) + (try.else false)) + (|> (/.imported_modules imported_module_name) + (/.result expected_lux) + (try#each (of (list.equivalence text.equivalence) = + (list))) + (try.else false)))) + (_.coverage [/.imported_by?] + (|> (/.imported_by? imported_module_name expected_current_module) + (/.result expected_lux) + (try.else false))) + (_.coverage [/.imported?] + (|> (/.imported? imported_module_name) + (/.result expected_lux) + (try.else false))) + (_.coverage [/.normal] + (and (|> (/.normal ["" expected_short]) + (/.result expected_lux) + (!expect (^.multi {try.#Success [actual_module actual_short]} + (and (text#= expected_current_module actual_module) + (same? expected_short actual_short))))) + (|> (/.normal [dummy_module expected_short]) + (/.result expected_lux) + (!expect (^.multi {try.#Success [actual_module actual_short]} + (and (text#= dummy_module actual_module) + (same? expected_short actual_short))))))) + )))) -... (def random_location -... (Random Location) -... (all random.and -... (random.upper_cased 1) -... random.nat -... random.nat)) +(def random_location + (Random Location) + (all random.and + (random.upper_cased 1) + random.nat + random.nat)) -... (def context_related -... (do [! random.monad] -... [target (random.upper_cased 1) -... version (random.upper_cased 1) -... source_code (random.upper_cased 1) -... expected_current_module (random.upper_cased 1) -... expected_type (of ! each (function (_ name) -... {.#Nominal name (list)}) -... (random.upper_cased 1)) -... expected_seed random.nat -... expected random.nat -... dummy (random.only (|>> (n.= expected) not) random.nat) -... expected_location ..random_location -... .let [type_context [.#ex_counter 0 -... .#var_counter 0 -... .#var_bindings (list)] -... expected_lux [.#info [.#target target -... .#version version -... .#mode {.#Build} -... .#configuration (list)] -... .#source [location.dummy 0 source_code] -... .#location expected_location -... .#current_module {.#Some expected_current_module} -... .#modules (list) -... .#scopes (list) -... .#type_context type_context -... .#expected {.#Some expected_type} -... .#seed expected_seed -... .#scope_type_vars (list) -... .#extensions [] -... .#eval (as (-> Type Code (Meta Any)) []) -... .#host []]]] -... (all _.and -... (_.coverage [/.target] -... (|> /.target -... (/.result expected_lux) -... (try#each (same? target)) -... (try.else false))) -... (_.coverage [/.seed] -... (|> (do /.monad -... [pre /.seed -... post /.seed] -... (in [pre post])) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success [actual_pre actual_post]} -... (and (n.= expected_seed actual_pre) -... (n.= (++ expected_seed) actual_post)))))) -... (_.coverage [/.location] -... (|> /.location -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_location} -... (same? expected_location actual_location))))) -... (_.coverage [/.expected_type] -... (|> /.expected_type -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_type} -... (same? expected_type actual_type))))) -... (_.coverage [.Type_Context /.type_context] -... (|> /.type_context -... (/.result expected_lux) -... (try#each (same? type_context)) -... (try.else false))) -... ))) +(def context_related + (do [! random.monad] + [target (random.upper_cased 1) + version (random.upper_cased 1) + source_code (random.upper_cased 1) + expected_current_module (random.upper_cased 1) + expected_type (of ! each (function (_ name) + {.#Nominal name (list)}) + (random.upper_cased 1)) + expected_seed random.nat + expected random.nat + dummy (random.only (|>> (n.= expected) not) random.nat) + expected_location ..random_location + .let [type_context [.#ex_counter 0 + .#var_counter 0 + .#var_bindings (list)] + expected_lux [.#info [.#target target + .#version version + .#mode {.#Build} + .#configuration (list)] + .#source [location.dummy 0 source_code] + .#location expected_location + .#current_module {.#Some expected_current_module} + .#modules (list) + .#scopes (list) + .#type_context type_context + .#expected {.#Some expected_type} + .#seed expected_seed + .#scope_type_vars (list) + .#extensions [] + .#eval (as (-> Type Code (Meta Any)) []) + .#host []]]] + (all _.and + (_.coverage [/.target] + (|> /.target + (/.result expected_lux) + (try#each (same? target)) + (try.else false))) + (_.coverage [/.seed] + (|> (do /.monad + [pre /.seed + post /.seed] + (in [pre post])) + (/.result expected_lux) + (!expect (^.multi {try.#Success [actual_pre actual_post]} + (and (n.= expected_seed actual_pre) + (n.= (++ expected_seed) actual_post)))))) + (_.coverage [/.location] + (|> /.location + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_location} + (same? expected_location actual_location))))) + (_.coverage [/.expected_type] + (|> /.expected_type + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_type} + (same? expected_type actual_type))))) + (_.coverage [.Type_Context /.type_context] + (|> /.type_context + (/.result expected_lux) + (try#each (same? type_context)) + (try.else false))) + ))) -... (def definition_related -... Test -... (do [! random.monad] -... [expected_current_module (random.upper_cased 1) -... expected_macro_module (random.only (|>> (text#= expected_current_module) not) -... (random.upper_cased 1)) -... expected_short (random.upper_cased 1) -... expected_type (of ! each (function (_ name) -... {.#Nominal name (list)}) -... (random.upper_cased 1)) -... expected_value (random.either (in .def) -... (in .macro)) -... .let [expected_lux -... (is (-> Bit (Maybe Type) -... [(List [Text .Global]) -... (List [Text .Global]) -... Lux]) -... (function (_ exported? def_type) -... (let [current_globals (is (List [Text .Global]) -... (list [expected_short -... {.#Alias [expected_macro_module expected_short]}])) -... macro_globals (is (List [Text .Global]) -... (when def_type -... {.#Some def_type} -... (list [expected_short -... {.#Definition [exported? def_type expected_value]}]) +(def definition_related + Test + (do [! random.monad] + [expected_current_module (random.upper_cased 1) + expected_macro_module (random.only (|>> (text#= expected_current_module) not) + (random.upper_cased 1)) + expected_short (random.upper_cased 1) + expected_type (of ! each (function (_ name) + {.#Nominal name (list)}) + (random.upper_cased 1)) + expected_value (random.either (in .def) + (in .macro)) + .let [expected_lux + (is (-> Bit (Maybe Type) + [(List [Text [Bit .Global]]) + (List [Text [Bit .Global]]) + Lux]) + (function (_ exported? def_type) + (let [current_globals (is (List [Text [Bit .Global]]) + (list [expected_short + [false {.#Alias [expected_macro_module expected_short]}]])) + macro_globals (is (List [Text [Bit .Global]]) + (when def_type + {.#Some def_type} + (list [expected_short + [exported? {.#Definition [def_type expected_value]}]]) -... {.#None} -... (list)))] -... [current_globals -... macro_globals -... [.#info [.#target "" -... .#version "" -... .#mode {.#Build} -... .#configuration (list)] -... .#source [location.dummy 0 ""] -... .#location location.dummy -... .#current_module {.#Some expected_current_module} -... .#modules (list [expected_current_module -... [.#module_hash 0 -... .#module_aliases (list) -... .#definitions current_globals -... .#imports (list) -... .#module_state {.#Active}]] -... [expected_macro_module -... [.#module_hash 0 -... .#module_aliases (list) -... .#definitions macro_globals -... .#imports (list) -... .#module_state {.#Active}]]) -... .#scopes (list) -... .#type_context [.#ex_counter 0 -... .#var_counter 0 -... .#var_bindings (list)] -... .#expected {.#None} -... .#seed 0 -... .#scope_type_vars (list) -... .#extensions [] -... .#eval (as (-> Type Code (Meta Any)) []) -... .#host []]])))]] -... (all _.and -... (_.coverage [.Global .Alias /.globals] -... (let [[current_globals macro_globals expected_lux] -... (expected_lux true {.#Some .Macro}) + {.#None} + (list)))] + [current_globals + macro_globals + [.#info [.#target "" + .#version "" + .#mode {.#Build} + .#configuration (list)] + .#source [location.dummy 0 ""] + .#location location.dummy + .#current_module {.#Some expected_current_module} + .#modules (list [expected_current_module + [.#module_hash 0 + .#module_aliases (list) + .#definitions current_globals + .#imports (list) + .#module_state {.#Active}]] + [expected_macro_module + [.#module_hash 0 + .#module_aliases (list) + .#definitions macro_globals + .#imports (list) + .#module_state {.#Active}]]) + .#scopes (list) + .#type_context [.#ex_counter 0 + .#var_counter 0 + .#var_bindings (list)] + .#expected {.#None} + .#seed 0 + .#scope_type_vars (list) + .#extensions [] + .#eval (as (-> Type Code (Meta Any)) []) + .#host []]])))]] + (all _.and + (_.coverage [.Global .Alias /.globals] + (let [[current_globals macro_globals expected_lux] + (expected_lux true {.#Some .Macro}) -... current_globals! -... (|> (/.globals expected_current_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_globals} -... (same? current_globals actual_globals)))) + current_globals! + (|> (/.globals expected_current_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_globals} + (same? current_globals actual_globals)))) -... macro_globals! -... (|> (/.globals expected_macro_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_globals} -... (same? macro_globals actual_globals))))] -... (and current_globals! -... macro_globals!))) -... (_.coverage [.Definition /.definitions] -... (let [[current_globals macro_globals expected_lux] -... (expected_lux true {.#Some .Macro})] -... (and (|> (/.definitions expected_current_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_definitions} -... (n.= 0 (list.size actual_definitions))))) -... (|> (/.definitions expected_macro_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_definitions} -... (n.= 1 (list.size actual_definitions))))) -... ))) -... (_.coverage [/.exports] -... (and (let [[current_globals macro_globals expected_lux] -... (expected_lux true {.#Some .Macro})] -... (and (|> (/.exports expected_current_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_definitions} -... (n.= 0 (list.size actual_definitions))))) -... (|> (/.exports expected_macro_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_definitions} -... (n.= 1 (list.size actual_definitions))))) -... )) -... (let [[current_globals macro_globals expected_lux] -... (expected_lux false {.#Some .Macro})] -... (and (|> (/.exports expected_current_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_definitions} -... (n.= 0 (list.size actual_definitions))))) -... (|> (/.exports expected_macro_module) -... (/.result expected_lux) -... (!expect (^.multi {try.#Success actual_definitions} -... (n.= 0 (list.size actual_definitions))))) -... )))) -... ))) + macro_globals! + (|> (/.globals expected_macro_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_globals} + (same? macro_globals actual_globals))))] + (and current_globals! + macro_globals!))) + (_.coverage [.Definition /.definitions] + (let [[current_globals macro_globals expected_lux] + (expected_lux true {.#Some .Macro})] + (and (|> (/.definitions expected_current_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 0 (list.size actual_definitions))))) + (|> (/.definitions expected_macro_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 1 (list.size actual_definitions))))) + ))) + (_.coverage [/.exports] + (and (let [[current_globals macro_globals expected_lux] + (expected_lux true {.#Some .Macro})] + (and (|> (/.exports expected_current_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 0 (list.size actual_definitions))))) + (|> (/.exports expected_macro_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 1 (list.size actual_definitions))))) + )) + (let [[current_globals macro_globals expected_lux] + (expected_lux false {.#Some .Macro})] + (and (|> (/.exports expected_current_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 0 (list.size actual_definitions))))) + (|> (/.exports expected_macro_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 0 (list.size actual_definitions))))) + )))) + ))) ... (def search_related ... Test @@ -968,96 +969,100 @@ ... (try.else false)))) ... ))) -... (def injection -... (Injection Meta) -... (of /.monad in)) +(def injection + (Injection Meta) + (of /.monad in)) -... (def (comparison init) -... (-> Lux (Comparison Meta)) -... (function (_ == left right) -... (when [(/.result init left) -... (/.result init right)] -... [{try.#Success left} {try.#Success right}] -... (== left right) +(def (comparison init) + (-> Lux (Comparison Meta)) + (function (_ == left right) + (when [(/.result init left) + (/.result init right)] + [{try.#Success left} {try.#Success right}] + (== left right) -... _ -... false))) + _ + false))) (`` (`` (def .public test Test (<| (_.covering /._) - (_.for [.Meta .Lux]) + (_.for [.Meta .Lux + .#info .#source .#location .#current_module + .#modules .#scopes .#type_context .#expected + .#seed .#scope_type_vars .#extensions .#eval + .#host]) (all _.and - ... (do [! random.monad] - ... [target (random.upper_cased 1) - ... version (random.upper_cased 1) - ... source_code (random.upper_cased 1) - ... expected_current_module (random.upper_cased 1) - ... expected_type (of ! each (function (_ name) - ... {.#Nominal name (list)}) - ... (random.upper_cased 1)) - ... expected_seed random.nat - ... expected random.nat - ... dummy (random.only (|>> (n.= expected) not) random.nat) - ... expected_location ..random_location - ... .let [expected_lux [.#info [.#target target - ... .#version version - ... .#mode {.#Build} - ... .#configuration (list)] - ... .#source [expected_location 0 source_code] - ... .#location expected_location - ... .#current_module {.#Some expected_current_module} - ... .#modules (list) - ... .#scopes (list) - ... .#type_context [.#ex_counter 0 - ... .#var_counter 0 - ... .#var_bindings (list)] - ... .#expected {.#Some expected_type} - ... .#seed expected_seed - ... .#scope_type_vars (list) - ... .#extensions [] - ... .#eval (as (-> Type Code (Meta Any)) []) - ... .#host []]]] - ... (all _.and - ... (_.for [/.functor] - ... (functorT.spec ..injection (..comparison expected_lux) /.functor)) - ... (_.for [/.apply] - ... (applyT.spec ..injection (..comparison expected_lux) /.apply)) - ... (_.for [/.monad] - ... ($monad.spec ..injection (..comparison expected_lux) /.monad)) + (do [! random.monad] + [target (random.upper_cased 1) + version (random.upper_cased 1) + source_code (random.upper_cased 1) + expected_current_module (random.upper_cased 1) + expected_type (of ! each (function (_ name) + {.#Nominal name (list)}) + (random.upper_cased 1)) + expected_seed random.nat + expected random.nat + dummy (random.only (|>> (n.= expected) not) random.nat) + expected_location ..random_location + .let [expected_lux [.#info [.#target target + .#version version + .#mode {.#Build} + .#configuration (list)] + .#source [expected_location 0 source_code] + .#location expected_location + .#current_module {.#Some expected_current_module} + .#modules (list) + .#scopes (list) + .#type_context [.#ex_counter 0 + .#var_counter 0 + .#var_bindings (list)] + .#expected {.#Some expected_type} + .#seed expected_seed + .#scope_type_vars (list) + .#extensions [] + .#eval (as (-> Type Code (Meta Any)) []) + .#host []]]] + (all _.and + (_.for [/.functor] + (functorT.spec ..injection (..comparison expected_lux) /.functor)) + (_.for [/.apply] + (applyT.spec ..injection (..comparison expected_lux) /.apply)) + (_.for [/.monad] + ($monad.spec ..injection (..comparison expected_lux) /.monad)) - ... (do random.monad - ... [expected_value random.nat - ... expected_error (random.upper_cased 1)] - ... (_.coverage [/.of_try] - ... (and (|> expected_error - ... {try.#Failure} - ... (is (Try Nat)) - ... /.of_try - ... (/.result expected_lux) - ... (!expect (^.multi {try.#Failure actual} - ... (text#= (location.with expected_location expected_error) - ... actual)))) - ... (|> expected_value - ... {try.#Success} - ... (is (Try Nat)) - ... /.of_try - ... (/.result expected_lux) - ... (!expect (^.multi {try.#Success actual} - ... (same? expected_value actual))))))) - - ... ..compiler_related - ... ..error_handling - ... ..module_related - ... ..context_related - ... ..definition_related - ... ..search_related - ... ..locals_related - ... (_.for [.Label] - ... ..label_related) - ... )) + (do random.monad + [expected_value random.nat + expected_error (random.upper_cased 1)] + (_.coverage [/.of_try] + (and (|> expected_error + {try.#Failure} + (is (Try Nat)) + /.of_try + (/.result expected_lux) + (!expect (^.multi {try.#Failure actual} + (text#= (location.with expected_location expected_error) + actual)))) + (|> expected_value + {try.#Success} + (is (Try Nat)) + /.of_try + (/.result expected_lux) + (!expect (^.multi {try.#Success actual} + (same? expected_value actual))))))) + + ..compiler_related + ..error_handling + ..module_related + ..context_related + ..definition_related + ... ..search_related + ... ..locals_related + ... (_.for [.Label] + ... ..label_related) + )) - ... /code.test + /code.test ... /location.test ... /symbol.test ... /configuration.test @@ -1076,6 +1081,7 @@ (,, (these /extension.test)))) /global.test + /compiler.test ... /compiler/arity.test ... /compiler/version.test ... /compiler/reference.test diff --git a/stdlib/source/test/lux/meta/compiler.lux b/stdlib/source/test/lux/meta/compiler.lux new file mode 100644 index 000000000..6e56ccfac --- /dev/null +++ b/stdlib/source/test/lux/meta/compiler.lux @@ -0,0 +1,21 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [math + ["[0]" random (.only Random)]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + []) + (all _.and + (_.coverage [/.Code /.Parameter /.Input] + true) + ))) |