aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/aedifex/artifact.lux3
-rw-r--r--stdlib/source/test/aedifex/artifact/time_stamp.lux33
-rw-r--r--stdlib/source/test/lux/control/pipe.lux3
-rw-r--r--stdlib/source/test/lux/data/product.lux4
-rw-r--r--stdlib/source/test/lux/data/sum.lux6
-rw-r--r--stdlib/source/test/lux/data/text.lux4
-rw-r--r--stdlib/source/test/lux/data/text/format.lux2
-rw-r--r--stdlib/source/test/lux/extension.lux3
-rw-r--r--stdlib/source/test/lux/macro/syntax.lux180
-rw-r--r--stdlib/source/test/lux/macro/syntax/annotations.lux4
-rw-r--r--stdlib/source/test/lux/macro/syntax/check.lux6
-rw-r--r--stdlib/source/test/lux/macro/syntax/declaration.lux4
-rw-r--r--stdlib/source/test/lux/macro/syntax/definition.lux8
-rw-r--r--stdlib/source/test/lux/macro/syntax/export.lux4
-rw-r--r--stdlib/source/test/lux/meta.lux415
15 files changed, 470 insertions, 209 deletions
diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux
index 60619f78b..dc2de91f7 100644
--- a/stdlib/source/test/aedifex/artifact.lux
+++ b/stdlib/source/test/aedifex/artifact.lux
@@ -21,7 +21,7 @@
["." / #_
["#." type]
["#." extension]
- ["#." time_stamp #_
+ ["#." time_stamp
["#/." date]
["#/." time]]]
{#program
@@ -45,6 +45,7 @@
/type.test
/extension.test
+ /time_stamp.test
/time_stamp/date.test
/time_stamp/time.test
))))
diff --git a/stdlib/source/test/aedifex/artifact/time_stamp.lux b/stdlib/source/test/aedifex/artifact/time_stamp.lux
new file mode 100644
index 000000000..7dea57392
--- /dev/null
+++ b/stdlib/source/test/aedifex/artifact/time_stamp.lux
@@ -0,0 +1,33 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try ("#\." functor)]
+ [parser
+ ["<.>" text]]]
+ [math
+ ["." random (#+ Random)]
+ [number
+ ["n" nat]
+ ["i" int]]]
+ [time
+ ["." instant]]]
+ {#program
+ ["." /]})
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Time_Stamp])
+ ($_ _.and
+ (do random.monad
+ [expected random.instant]
+ (_.cover [/.format /.parser]
+ (|> expected
+ /.format
+ (<text>.run /.parser)
+ (try\map (\ instant.equivalence = expected))
+ (try.default false))))
+ )))
diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux
index cd57863b7..a9adcbf2e 100644
--- a/stdlib/source/test/lux/control/pipe.lux
+++ b/stdlib/source/test/lux/control/pipe.lux
@@ -1,6 +1,7 @@
(.module:
[lux #*
["_" test (#+ Test)]
+ ["." debug]
[abstract
[monad (#+ do)]]
[data
@@ -70,7 +71,7 @@
(_.cover [/.exec>]
(n.= (n.* 10 sample)
(|> sample
- (/.exec> [%.nat (format "sample = ") log!])
+ (/.exec> [%.nat (format "sample = ") debug.log!])
(n.* 10))))
(_.cover [/.tuple>]
(let [[left middle right] (|> sample
diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux
index c33e60dd1..c20e7f5e9 100644
--- a/stdlib/source/test/lux/data/product.lux
+++ b/stdlib/source/test/lux/data/product.lux
@@ -62,8 +62,8 @@
(<| (_.cover [/.curry])
(n.= (n.+ left right)
((/.curry (/.uncurry n.+)) left right)))
- (<| (_.cover [/.both])
- (let [[left' right'] (/.both (n.+ shift) (n.- shift) [left right])]
+ (<| (_.cover [/.apply])
+ (let [[left' right'] (/.apply (n.+ shift) (n.- shift) [left right])]
(and (n.= (n.+ shift left) left')
(n.= (n.- shift right) right'))))))
))))
diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux
index da108ede8..3b37382ae 100644
--- a/stdlib/source/test/lux/data/sum.lux
+++ b/stdlib/source/test/lux/data/sum.lux
@@ -60,14 +60,14 @@
(: (| Nat Nat))
(/.either (n.+ shift) (n.- shift))
(n.= (n.- shift expected)))))
- (_.cover [/.each]
+ (_.cover [/.apply]
(and (|> (/.left expected)
(: (| Nat Nat))
- (/.each (n.+ shift) (n.- shift))
+ (/.apply (n.+ shift) (n.- shift))
(case> (0 #0 actual) (n.= (n.+ shift expected) actual) _ false))
(|> (/.right expected)
(: (| Nat Nat))
- (/.each (n.+ shift) (n.- shift))
+ (/.apply (n.+ shift) (n.- shift))
(case> (0 #1 actual) (n.= (n.- shift expected) actual) _ false))))
(do !
[size (\ ! map (n.% 5) random.nat)
diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux
index 4308f8e95..a5d11685f 100644
--- a/stdlib/source/test/lux/data/text.lux
+++ b/stdlib/source/test/lux/data/text.lux
@@ -69,8 +69,8 @@
(let [value (/.enclose [left right] inner)]
(and (/.starts_with? left value)
(/.ends_with? right value))))
- (_.cover [/.encode]
- (let [sample (/.encode inner)]
+ (_.cover [/.format]
+ (let [sample (/.format inner)]
(and (/.encloses? /.double_quote sample)
(/.contains? inner sample))))
))))
diff --git a/stdlib/source/test/lux/data/text/format.lux b/stdlib/source/test/lux/data/text/format.lux
index 2aa33d2d4..0f61caa1f 100644
--- a/stdlib/source/test/lux/data/text/format.lux
+++ b/stdlib/source/test/lux/data/text/format.lux
@@ -134,7 +134,7 @@
(text\= (<alias> sample)
(<format> sample))))]
- [/.text text.encode (random.unicode 5)]
+ [/.text text.format (random.unicode 5)]
[/.code code.format $///code.random]
[/.type type.format $///type.random]
[/.location location.format
diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux
index 9e8699c55..855c6e8bb 100644
--- a/stdlib/source/test/lux/extension.lux
+++ b/stdlib/source/test/lux/extension.lux
@@ -1,5 +1,6 @@
(.module:
[lux #*
+ ["." debug]
["@" target
["." jvm]
["." js]]
@@ -85,7 +86,7 @@
## Directive
(directive: (..my_directive self phase archive {parameters (<>.some <c>.any)})
(do phase.monad
- [#let [_ (log! (format "Successfully installed directive " (%.text self) "!"))]]
+ [#let [_ (debug.log! (format "Successfully installed directive " (%.text self) "!"))]]
(wrap directive.no_requirements)))
(`` ((~~ (static ..my_directive))))
diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux
index c2a1e63a5..f2fbe2010 100644
--- a/stdlib/source/test/lux/macro/syntax.lux
+++ b/stdlib/source/test/lux/macro/syntax.lux
@@ -1,158 +1,44 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
- [abstract/monad (#+ do)]
["_" test (#+ Test)]
[abstract
- [equivalence (#+ Equivalence)]]
- [control
- ["." try (#+ Try)]
- ["p" parser
- ["s" code (#+ Parser)]]]
- [data
- ["." bit]
- ["." name]
- ["." text]]
- [macro
- ["." code]]
+ [monad (#+ do)]]
[math
- [random (#+ Random)]
+ ["." random]
[number
- ["." nat]
- ["." int]
- ["." rev]
- ["." frac]]]]
+ ["n" nat]]]]
{1
- ["." / (#+ syntax:)]})
-
-(def: (enforced? parser input)
- (-> (Parser []) (List Code) Bit)
- (case (p.run parser input)
- (#.Right [_ []])
- #1
-
- _
- #0))
-
-(def: (found? parser input)
- (-> (Parser Bit) (List Code) Bit)
- (case (p.run parser input)
- (#.Right [_ #1])
- #1
-
- _
- #0))
-
-(def: (equals? Equivalence<a> reference parser input)
- (All [a] (-> (Equivalence a) a (Parser a) (List Code) Bit))
- (case (p.run parser input)
- (#.Right [_ output])
- (\ Equivalence<a> = reference output)
-
- _
- #0))
-
-(def: (fails? input)
- (All [a] (-> (Try a) Bit))
- (case input
- (#.Left _)
- #1
-
- _
- #0))
-
-(syntax: (match pattern input)
- (wrap (list (` (case (~ input)
- (^ (#.Right [(~' _) (~ pattern)]))
- #1
-
- (~' _)
- #0)))))
-
-(def: simple_values
- Test
- (`` ($_ _.and
- (~~ (template [<assertion> <value> <ctor> <Equivalence> <get>]
- [(_.test <assertion>
- (and (equals? <Equivalence> <value> <get> (list (<ctor> <value>)))
- (found? (p.parses? (s.this! (<ctor> <value>))) (list (<ctor> <value>)))
- (enforced? (s.this! (<ctor> <value>)) (list (<ctor> <value>)))))]
-
- ["Can parse Bit syntax." #1 code.bit bit.equivalence s.bit]
- ["Can parse Nat syntax." 123 code.nat nat.equivalence s.nat]
- ["Can parse Int syntax." +123 code.int int.equivalence s.int]
- ["Can parse Rev syntax." .123 code.rev rev.equivalence s.rev]
- ["Can parse Frac syntax." +123.0 code.frac frac.equivalence s.frac]
- ["Can parse Text syntax." text.new_line code.text text.equivalence s.text]
- ["Can parse Identifier syntax." ["yolo" "lol"] code.identifier name.equivalence s.identifier]
- ["Can parse Tag syntax." ["yolo" "lol"] code.tag name.equivalence s.tag]
- ))
- (_.test "Can parse identifiers belonging to the current namespace."
- (and (match "yolo"
- (p.run s.local_identifier
- (list (code.local_identifier "yolo"))))
- (fails? (p.run s.local_identifier
- (list (code.identifier ["yolo" "lol"]))))))
- (_.test "Can parse tags belonging to the current namespace."
- (and (match "yolo"
- (p.run s.local_tag
- (list (code.local_tag "yolo"))))
- (fails? (p.run s.local_tag
- (list (code.tag ["yolo" "lol"]))))))
- )))
-
-(def: complex_values
- Test
- (`` ($_ _.and
- (~~ (template [<type> <parser> <ctor>]
- [(_.test (format "Can parse " <type> " syntax.")
- (and (match [#1 +123]
- (p.run (<parser> (p.and s.bit s.int))
- (list (<ctor> (list (code.bit #1) (code.int +123))))))
- (match #1
- (p.run (<parser> s.bit)
- (list (<ctor> (list (code.bit #1))))))
- (fails? (p.run (<parser> s.bit)
- (list (<ctor> (list (code.bit #1) (code.int +123))))))
- (match (#.Left #1)
- (p.run (<parser> (p.or s.bit s.int))
- (list (<ctor> (list (code.bit #1))))))
- (match (#.Right +123)
- (p.run (<parser> (p.or s.bit s.int))
- (list (<ctor> (list (code.int +123))))))
- (fails? (p.run (<parser> (p.or s.bit s.int))
- (list (<ctor> (list (code.frac +123.0))))))))]
-
- ["form" s.form code.form]
- ["tuple" s.tuple code.tuple]))
- (_.test "Can parse record syntax."
- (match [#1 +123]
- (p.run (s.record (p.and s.bit s.int))
- (list (code.record (list [(code.bit #1) (code.int +123)]))))))
- )))
+ ["." /]}
+ ["." / #_
+ ["#." annotations]
+ ["#." check]
+ ["#." declaration]
+ ["#." definition]
+ ["#." export]
+ ["#." input]
+ ["#." type #_
+ ["#/." variable]]])
+
+(/.syntax: (+/3 a b c)
+ (wrap (list (` ($_ n.+ (~ a) (~ b) (~ c))))))
(def: #export test
Test
- (<| (_.context (name.module (name_of /._)))
+ (<| (_.covering /._)
($_ _.and
- ..simple_values
- ..complex_values
- ($_ _.and
- (_.test "Can parse any Code."
- (match [_ (#.Bit #1)]
- (p.run s.any
- (list (code.bit #1) (code.int +123)))))
- (_.test "Can check whether the end has been reached."
- (and (match #1
- (p.run s.end?
- (list)))
- (match #0
- (p.run s.end?
- (list (code.bit #1))))))
- (_.test "Can ensure the end has been reached."
- (and (match []
- (p.run s.end!
- (list)))
- (fails? (p.run s.end!
- (list (code.bit #1))))))
- ))))
+ (do random.monad
+ [x random.nat
+ y random.nat
+ z random.nat]
+ (_.cover [/.syntax:]
+ (n.= ($_ n.+ x y z)
+ (+/3 x y z))))
+
+ /annotations.test
+ /check.test
+ /declaration.test
+ /definition.test
+ /export.test
+ /input.test
+ /type/variable.test
+ )))
diff --git a/stdlib/source/test/lux/macro/syntax/annotations.lux b/stdlib/source/test/lux/macro/syntax/annotations.lux
index 564af4ea1..dac3c1e16 100644
--- a/stdlib/source/test/lux/macro/syntax/annotations.lux
+++ b/stdlib/source/test/lux/macro/syntax/annotations.lux
@@ -42,9 +42,9 @@
(list.empty? /.empty))
(do random.monad
[expected ..random]
- (_.cover [/.write /.parser]
+ (_.cover [/.format /.parser]
(case (<code>.run /.parser
- (list (/.write expected)))
+ (list (/.format expected)))
(#try.Failure _)
false
diff --git a/stdlib/source/test/lux/macro/syntax/check.lux b/stdlib/source/test/lux/macro/syntax/check.lux
index 898ad8abb..d5036d9b2 100644
--- a/stdlib/source/test/lux/macro/syntax/check.lux
+++ b/stdlib/source/test/lux/macro/syntax/check.lux
@@ -36,10 +36,10 @@
(do random.monad
[[type value] ..random]
- (_.cover [/.write /.parser]
+ (_.cover [/.format /.parser]
(case (<code>.run /.parser
- (list (/.write {#/.type type
- #/.value value})))
+ (list (/.format {#/.type type
+ #/.value value})))
(#try.Failure _)
false
diff --git a/stdlib/source/test/lux/macro/syntax/declaration.lux b/stdlib/source/test/lux/macro/syntax/declaration.lux
index a9bc23296..2cb737caf 100644
--- a/stdlib/source/test/lux/macro/syntax/declaration.lux
+++ b/stdlib/source/test/lux/macro/syntax/declaration.lux
@@ -37,9 +37,9 @@
(do random.monad
[expected ..random]
- (_.cover [/.write /.parser]
+ (_.cover [/.format /.parser]
(case (<code>.run /.parser
- (list (/.write expected)))
+ (list (/.format expected)))
(#try.Failure _)
false
diff --git a/stdlib/source/test/lux/macro/syntax/definition.lux b/stdlib/source/test/lux/macro/syntax/definition.lux
index d6b101894..be6f05449 100644
--- a/stdlib/source/test/lux/macro/syntax/definition.lux
+++ b/stdlib/source/test/lux/macro/syntax/definition.lux
@@ -67,9 +67,9 @@
type $///code.random
untyped_value $///code.random]
($_ _.and
- (_.cover [/.write /.parser]
+ (_.cover [/.format /.parser]
(case (<code>.run (/.parser compiler)
- (list (/.write expected)))
+ (list (/.format expected)))
(#try.Failure error)
false
@@ -78,7 +78,7 @@
(_.cover [/.typed]
(let [expected (set@ #/.value (#.Left [type untyped_value]) expected)]
(case (<code>.run (/.typed compiler)
- (list (/.write expected)))
+ (list (/.format expected)))
(#try.Failure error)
false
@@ -87,7 +87,7 @@
(_.cover [/.lacks_type!]
(let [expected (set@ #/.value (#.Right untyped_value) expected)]
(case (<code>.run (/.typed compiler)
- (list (/.write expected)))
+ (list (/.format expected)))
(#try.Failure error)
(exception.match? /.lacks_type! error)
diff --git a/stdlib/source/test/lux/macro/syntax/export.lux b/stdlib/source/test/lux/macro/syntax/export.lux
index 59b72eb0f..34c19a11f 100644
--- a/stdlib/source/test/lux/macro/syntax/export.lux
+++ b/stdlib/source/test/lux/macro/syntax/export.lux
@@ -19,9 +19,9 @@
(<| (_.covering /._)
(do random.monad
[expected random.bit]
- (_.cover [/.write /.parser]
+ (_.cover [/.format /.parser]
(case (<code>.run /.parser
- (/.write expected))
+ (/.format expected))
(#try.Failure _)
false
diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux
index 2315165ef..c1972a991 100644
--- a/stdlib/source/test/lux/meta.lux
+++ b/stdlib/source/test/lux/meta.lux
@@ -11,8 +11,11 @@
[control
["." try]]
[data
+ ["." bit ("#\." equivalence)]
["." text ("#\." equivalence)
- ["%" format (#+ format)]]]
+ ["%" format (#+ format)]]
+ [collection
+ ["." list]]]
[meta
["." location]]
[math
@@ -41,10 +44,6 @@
expected_seed random.nat
expected random.nat
dummy (random.filter (|>> (n.= expected) not) random.nat)
- expected_error (random.ascii/upper_alpha 1)
- expected_short (random.ascii/upper_alpha 1)
- dummy_module (random.filter (|>> (text\= expected_current_module) not)
- (random.ascii/upper_alpha 1))
expected_gensym (random.ascii/upper_alpha 1)
#let [expected_lux {#.info {#.target target
#.version version
@@ -166,17 +165,26 @@
expected_seed random.nat
expected random.nat
dummy (random.filter (|>> (n.= expected) not) random.nat)
- expected_error (random.ascii/upper_alpha 1)
expected_short (random.ascii/upper_alpha 1)
dummy_module (random.filter (|>> (text\= expected_current_module) not)
(random.ascii/upper_alpha 1))
- #let [expected_lux {#.info {#.target target
+ #let [expected_module {#.module_hash 0
+ #.module_aliases (list)
+ #.definitions (list)
+ #.imports (list)
+ #.tags (list)
+ #.types (list)
+ #.module_annotations #.None
+ #.module_state #.Active}
+ expected_modules (list [expected_current_module
+ expected_module])
+ expected_lux {#.info {#.target target
#.version version
#.mode #.Build}
#.source [location.dummy 0 source_code]
#.location location.dummy
#.current_module (#.Some expected_current_module)
- #.modules (list)
+ #.modules expected_modules
#.scopes (list)
#.type_context {#.ex_counter 0
#.var_counter 0
@@ -192,6 +200,28 @@
(/.run expected_lux)
(!expect (^multi (#try.Success actual_current_module)
(text\= expected_current_module actual_current_module)))))
+ (_.cover [/.current_module]
+ (|> /.current_module
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_module)
+ (is? expected_module actual_module)))))
+ (_.cover [/.find_module]
+ (|> (/.find_module expected_current_module)
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_module)
+ (is? expected_module actual_module)))))
+ (_.cover [/.module_exists?]
+ (and (|> (/.module_exists? expected_current_module)
+ (/.run expected_lux)
+ (!expect (#try.Success #1)))
+ (|> (/.module_exists? dummy_module)
+ (/.run expected_lux)
+ (!expect (#try.Success #0)))))
+ (_.cover [/.modules]
+ (|> /.modules
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_modules)
+ (is? expected_modules actual_modules)))))
(_.cover [/.normalize]
(and (|> (/.normalize ["" expected_short])
(/.run expected_lux)
@@ -212,6 +242,342 @@
random.nat
random.nat))
+(def: context_related
+ (do {! random.monad}
+ [target (random.ascii/upper_alpha 1)
+ version (random.ascii/upper_alpha 1)
+ source_code (random.ascii/upper_alpha 1)
+ expected_current_module (random.ascii/upper_alpha 1)
+ expected_type (\ ! map (function (_ name)
+ (#.Primitive name (list)))
+ (random.ascii/upper_alpha 1))
+ expected_seed random.nat
+ expected random.nat
+ dummy (random.filter (|>> (n.= expected) not) random.nat)
+ expected_gensym (random.ascii/upper_alpha 1)
+ expected_location ..random_location
+ #let [expected_lux {#.info {#.target target
+ #.version version
+ #.mode #.Build}
+ #.source [location.dummy 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 []
+ #.host []}]]
+ ($_ _.and
+ (_.cover [/.count]
+ (|> (do /.monad
+ [pre /.count
+ post /.count]
+ (wrap [pre post]))
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success [actual_pre actual_post])
+ (and (n.= expected_seed actual_pre)
+ (n.= (inc expected_seed) actual_post))))))
+ (_.cover [/.gensym]
+ (|> (/.gensym expected_gensym)
+ (\ /.monad map %.code)
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_gensym)
+ (and (text.contains? expected_gensym actual_gensym)
+ (text.contains? (%.nat expected_seed) actual_gensym))))))
+ (_.cover [/.location]
+ (|> /.location
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_location)
+ (is? expected_location actual_location)))))
+ (_.cover [/.expected_type]
+ (|> /.expected_type
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_type)
+ (is? expected_type actual_type)))))
+ )))
+
+(def: definition_related
+ Test
+ (do {! random.monad}
+ [expected_current_module (random.ascii/upper_alpha 1)
+ expected_macro_module (random.filter (|>> (text\= expected_current_module) not)
+ (random.ascii/upper_alpha 1))
+ expected_short (random.ascii/upper_alpha 1)
+ expected_type (\ ! map (function (_ name)
+ (#.Primitive name (list)))
+ (random.ascii/upper_alpha 1))
+ expected_value (random.either (wrap .def:)
+ (wrap .macro:))
+ #let [expected_lux
+ (: (-> Bit (Maybe Type)
+ [(List [Text .Global])
+ (List [Text .Global])
+ Lux])
+ (function (_ exported? def_type)
+ (let [current_globals (: (List [Text .Global])
+ (list [expected_short
+ (#.Alias [expected_macro_module expected_short])]))
+ macro_globals (: (List [Text .Global])
+ (case def_type
+ (#.Some def_type)
+ (list [expected_short
+ (#.Definition [exported? def_type (' []) expected_value])])
+
+ #.None
+ (list)))]
+ [current_globals
+ macro_globals
+ {#.info {#.target ""
+ #.version ""
+ #.mode #.Build}
+ #.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)
+ #.tags (list)
+ #.types (list)
+ #.module_annotations #.None
+ #.module_state #.Active}]
+ [expected_macro_module
+ {#.module_hash 0
+ #.module_aliases (list)
+ #.definitions macro_globals
+ #.imports (list)
+ #.tags (list)
+ #.types (list)
+ #.module_annotations #.None
+ #.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 []
+ #.host []}])))]]
+ ($_ _.and
+ (_.cover [/.globals]
+ (let [[current_globals macro_globals expected_lux]
+ (expected_lux true (#.Some .Macro))
+
+ current_globals!
+ (|> (/.globals expected_current_module)
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_globals)
+ (is? current_globals actual_globals))))
+
+ macro_globals!
+ (|> (/.globals expected_macro_module)
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_globals)
+ (is? macro_globals actual_globals))))]
+ (and current_globals!
+ macro_globals!)))
+ (_.cover [/.definitions]
+ (let [[current_globals macro_globals expected_lux]
+ (expected_lux true (#.Some .Macro))]
+ (and (|> (/.definitions expected_current_module)
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_definitions)
+ (n.= 0 (list.size actual_definitions)))))
+ (|> (/.definitions expected_macro_module)
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_definitions)
+ (n.= 1 (list.size actual_definitions)))))
+ )))
+ (_.cover [/.exports]
+ (and (let [[current_globals macro_globals expected_lux]
+ (expected_lux true (#.Some .Macro))]
+ (and (|> (/.exports expected_current_module)
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_definitions)
+ (n.= 0 (list.size actual_definitions)))))
+ (|> (/.exports expected_macro_module)
+ (/.run 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)
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_definitions)
+ (n.= 0 (list.size actual_definitions)))))
+ (|> (/.exports expected_macro_module)
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_definitions)
+ (n.= 0 (list.size actual_definitions)))))
+ ))))
+ )))
+
+(def: search_related
+ Test
+ (do {! random.monad}
+ [expected_exported? random.bit
+ expected_current_module (random.ascii/upper_alpha 1)
+ expected_macro_module (random.filter (|>> (text\= expected_current_module) not)
+ (random.ascii/upper_alpha 1))
+ expected_short (random.ascii/upper_alpha 1)
+ expected_type (\ ! map (function (_ name)
+ (#.Primitive name (list)))
+ (random.ascii/upper_alpha 1))
+ #let [expected_annotations (' [])]
+ expected_value (random.either (wrap .def:)
+ (wrap .macro:))
+ #let [expected_lux
+ (: (-> Bit (Maybe Type)
+ [(List [Text .Global])
+ (List [Text .Global])
+ Lux])
+ (function (_ exported? def_type)
+ (let [current_globals (: (List [Text .Global])
+ (list [expected_short
+ (#.Alias [expected_macro_module expected_short])]))
+ macro_globals (: (List [Text .Global])
+ (case def_type
+ (#.Some def_type)
+ (list [expected_short
+ (#.Definition [exported? def_type expected_annotations expected_value])])
+
+ #.None
+ (list)))]
+ [current_globals
+ macro_globals
+ {#.info {#.target ""
+ #.version ""
+ #.mode #.Build}
+ #.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)
+ #.tags (list)
+ #.types (list)
+ #.module_annotations #.None
+ #.module_state #.Active}]
+ [expected_macro_module
+ {#.module_hash 0
+ #.module_aliases (list)
+ #.definitions macro_globals
+ #.imports (list)
+ #.tags (list)
+ #.types (list)
+ #.module_annotations #.None
+ #.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 []
+ #.host []}])))]]
+ ($_ _.and
+ (_.cover [/.find_macro]
+ (let [same_module!
+ (let [[current_globals macro_globals expected_lux]
+ (expected_lux true (#.Some .Macro))]
+ (|> (/.find_macro [expected_macro_module expected_short])
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success (#.Some actual_value))
+ (is? expected_value actual_value)))))
+
+ not_macro!
+ (let [[current_globals macro_globals expected_lux]
+ (expected_lux true (#.Some expected_type))]
+ (|> (/.find_macro [expected_macro_module expected_short])
+ (/.run expected_lux)
+ (!expect (#try.Success #.None))))
+
+ not_found!
+ (let [[current_globals macro_globals expected_lux]
+ (expected_lux true #.None)]
+ (|> (/.find_macro [expected_macro_module expected_short])
+ (/.run expected_lux)
+ (!expect (#try.Success #.None))))
+
+ aliasing!
+ (let [[current_globals macro_globals expected_lux]
+ (expected_lux true (#.Some .Macro))]
+ (|> (/.find_macro [expected_current_module expected_short])
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success (#.Some actual_value))
+ (is? expected_value actual_value)))))]
+ (and same_module!
+ not_macro!
+ not_found!
+ aliasing!)))
+ (_.cover [/.find_def]
+ (let [[current_globals macro_globals expected_lux]
+ (expected_lux expected_exported? (#.Some expected_type))
+
+ definition!
+ (|> (/.find_def [expected_macro_module expected_short])
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success (#.Definition [actual_exported? actual_type actual_annotations actual_value]))
+ (and (bit\= expected_exported? actual_exported?)
+ (is? expected_type actual_type)
+ (is? expected_annotations actual_annotations)
+ (is? (:coerce Any expected_value) actual_value)))))
+
+ alias!
+ (|> (/.find_def [expected_current_module expected_short])
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success (#.Alias [actual_module actual_short]))
+ (and (is? expected_macro_module actual_module)
+ (is? expected_short actual_short)))))]
+ (and definition!
+ alias!)))
+ (_.cover [/.find_def_type]
+ (let [[current_globals macro_globals expected_lux]
+ (expected_lux expected_exported? (#.Some expected_type))
+
+ definition!
+ (|> (/.find_def_type [expected_macro_module expected_short])
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_type)
+ (is? expected_type actual_type))))
+
+ alias!
+ (|> (/.find_def_type [expected_current_module expected_short])
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_type)
+ (is? expected_type actual_type))))]
+ (and definition!
+ alias!)))
+ (_.cover [/.find_type_def]
+ (let [[current_globals macro_globals expected_lux]
+ (expected_lux expected_exported? (#.Some .Type))
+
+ definition!
+ (|> (/.find_type_def [expected_macro_module expected_short])
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_value)
+ (is? (:coerce .Type expected_value) actual_value))))
+
+ alias!
+ (|> (/.find_type_def [expected_current_module expected_short])
+ (/.run expected_lux)
+ (!expect (^multi (#try.Success actual_value)
+ (is? (:coerce .Type expected_value) actual_value))))]
+ (and definition!
+ alias!)))
+ )))
+
(def: injection
(Injection Meta)
(\ /.monad wrap))
@@ -242,10 +608,6 @@
expected_seed random.nat
expected random.nat
dummy (random.filter (|>> (n.= expected) not) random.nat)
- expected_error (random.ascii/upper_alpha 1)
- expected_short (random.ascii/upper_alpha 1)
- dummy_module (random.filter (|>> (text\= expected_current_module) not)
- (random.ascii/upper_alpha 1))
expected_gensym (random.ascii/upper_alpha 1)
expected_location ..random_location
#let [expected_lux {#.info {#.target target
@@ -275,32 +637,9 @@
..compiler_related
..error_handling
..module_related
- (_.cover [/.count]
- (|> (do /.monad
- [pre /.count
- post /.count]
- (wrap [pre post]))
- (/.run expected_lux)
- (!expect (^multi (#try.Success [actual_pre actual_post])
- (and (n.= expected_seed actual_pre)
- (n.= (inc expected_seed) actual_post))))))
- (_.cover [/.gensym]
- (|> (/.gensym expected_gensym)
- (\ /.monad map %.code)
- (/.run expected_lux)
- (!expect (^multi (#try.Success actual_gensym)
- (and (text.contains? expected_gensym actual_gensym)
- (text.contains? (%.nat expected_seed) actual_gensym))))))
- (_.cover [/.location]
- (|> /.location
- (/.run expected_lux)
- (!expect (^multi (#try.Success actual_location)
- (is? expected_location actual_location)))))
- (_.cover [/.expected_type]
- (|> /.expected_type
- (/.run expected_lux)
- (!expect (^multi (#try.Success actual_type)
- (is? expected_type actual_type)))))
+ ..context_related
+ ..definition_related
+ ..search_related
))
/annotation.test
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 16:05:22 +0000