aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test/lux.lux')
-rw-r--r--stdlib/source/test/lux.lux296
1 files changed, 178 insertions, 118 deletions
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 34d3b4cc1..cf45f0ca5 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -12,18 +12,25 @@
[monad (#+ do)]]
[control
["." io]
+ ["." maybe ("#\." functor)]
[concurrency
- ["." atom (#+ Atom)]]]
+ ["." atom (#+ Atom)]]
+ [parser
+ ["<.>" code]]]
[data
+ ["." product]
["." bit ("#\." equivalence)]
["." text ("#\." equivalence)
["%" format (#+ format)]]
[collection
- ["." list]
- ["." set (#+ Set)]]]
+ ["." list ("#\." functor)]
+ ["." set (#+ Set) ("#\." equivalence)]
+ [dictionary
+ ["." plist]]]]
["." macro
[syntax (#+ syntax:)]
- ["." code ("#\." equivalence)]]
+ ["." code ("#\." equivalence)]
+ ["." template]]
["." math
["." random ("#\." functor)]
[number
@@ -440,15 +447,15 @@
(_.cover [/.Macro']
(|> macro
(: /.Macro')
- (is? macro)))
+ (same? macro)))
(_.cover [/.Macro]
(|> macro
"lux macro"
(: /.Macro)
(: Any)
- (is? (: Any macro))))
+ (same? (: Any macro))))
(_.cover [/.macro:]
- (is? expected (..identity_macro expected)))
+ (same? expected (..identity_macro expected)))
<found_crosshair?>
))))))
@@ -480,61 +487,61 @@
(_.cover [/.:]
(|> expected
(/.: Any)
- (is? (/.: Any expected))))
+ (same? (/.: Any expected))))
(_.cover [/.:as]
(|> expected
(/.: Any)
(/.:as /.Nat)
- (is? expected)))
- (_.cover [/.:assume]
+ (same? expected)))
+ (_.cover [/.:expected]
(|> expected
(/.: Any)
- /.:assume
+ /.:expected
(/.: /.Nat)
- (is? expected)))
+ (same? expected)))
(_.cover [/.:let]
(let [[actual_left actual_right]
(: (/.:let [side /.Nat]
[side side])
[expected_left expected_right])]
- (and (is? expected_left actual_left)
- (is? expected_right actual_right))))
+ (and (same? expected_left actual_left)
+ (same? expected_right actual_right))))
(_.cover [/.:of]
- (is? /.Nat (/.:of expected)))
+ (same? /.Nat (/.:of expected)))
(_.cover [/.primitive]
(case (/.primitive "foo" [expected/0 expected/1])
(^ (#.Primitive "foo" (list actual/0 actual/1)))
- (and (is? expected/0 actual/0)
- (is? expected/1 actual/1))
+ (and (same? expected/0 actual/0)
+ (same? expected/1 actual/1))
_
false))
(_.cover [/.type]
(and (case (/.type [expected/0 expected/1])
(#.Product actual/0 actual/1)
- (and (is? expected/0 actual/0)
- (is? expected/1 actual/1))
+ (and (same? expected/0 actual/0)
+ (same? expected/1 actual/1))
_
false)
(case (/.type (/.Or expected/0 expected/1))
(#.Sum actual/0 actual/1)
- (and (is? expected/0 actual/0)
- (is? expected/1 actual/1))
+ (and (same? expected/0 actual/0)
+ (same? expected/1 actual/1))
_
false)
(case (/.type (-> expected/0 expected/1))
(#.Function actual/0 actual/1)
- (and (is? expected/0 actual/0)
- (is? expected/1 actual/1))
+ (and (same? expected/0 actual/0)
+ (same? expected/1 actual/1))
_
false)
(case (/.type (expected/0 expected/1))
(#.Apply actual/1 actual/0)
- (and (is? expected/0 actual/0)
- (is? expected/1 actual/1))
+ (and (same? expected/0 actual/0)
+ (same? expected/1 actual/1))
_
false)))
@@ -552,17 +559,17 @@
[expected random.i64]
($_ _.and
(_.cover [/.i64]
- (is? (: Any expected)
- (: Any (/.i64 expected))))
+ (same? (: Any expected)
+ (: Any (/.i64 expected))))
(_.cover [/.nat]
- (is? (: Any expected)
- (: Any (/.nat expected))))
+ (same? (: Any expected)
+ (: Any (/.nat expected))))
(_.cover [/.int]
- (is? (: Any expected)
- (: Any (/.int expected))))
+ (same? (: Any expected)
+ (: Any (/.int expected))))
(_.cover [/.rev]
- (is? (: Any expected)
- (: Any (/.rev expected))))
+ (same? (: Any expected)
+ (: Any (/.rev expected))))
(_.cover [/.inc]
(n.= 1 (n.- expected
(/.inc expected))))
@@ -667,41 +674,41 @@
(_.cover [/.get@]
(and (and (|> sample
(/.get@ #big_left)
- (is? start/b))
+ (same? start/b))
(|> sample
((/.get@ #big_left))
- (is? start/b)))
+ (same? start/b)))
(and (|> sample
(/.get@ [#big_right #small_left])
- (is? start/s))
+ (same? start/s))
(|> sample
((/.get@ [#big_right #small_left]))
- (is? start/s)))))
+ (same? start/s)))))
(_.cover [/.set@]
(and (and (|> sample
(/.set@ #big_left shift/b)
(/.get@ #big_left)
- (is? shift/b))
+ (same? shift/b))
(|> sample
((/.set@ #big_left shift/b))
(/.get@ #big_left)
- (is? shift/b))
+ (same? shift/b))
(|> sample
((/.set@ #big_left) shift/b)
(/.get@ #big_left)
- (is? shift/b)))
+ (same? shift/b)))
(and (|> sample
(/.set@ [#big_right #small_left] shift/s)
(/.get@ [#big_right #small_left])
- (is? shift/s))
+ (same? shift/s))
(|> sample
((/.set@ [#big_right #small_left] shift/s))
(/.get@ [#big_right #small_left])
- (is? shift/s))
+ (same? shift/s))
(|> sample
((/.set@ [#big_right #small_left]) shift/s)
(/.get@ [#big_right #small_left])
- (is? shift/s)))))
+ (same? shift/s)))))
(_.cover [/.update@]
(and (and (|> sample
(/.update@ #big_left (n.+ shift/b))
@@ -852,11 +859,11 @@
(: /.Any
(hide left))
true)))
- (_.cover [/.is?]
+ (_.cover [/.same?]
(let [not_left (|> left inc dec)]
- (and (/.is? left left)
+ (and (/.same? left left)
(and (n.= not_left left)
- (not (/.is? not_left left))))))
+ (not (/.same? not_left left))))))
(_.cover [/.Rec]
(let [list (: (/.Rec NList
(Maybe [Nat NList]))
@@ -866,9 +873,9 @@
#.None])])]))]
(case list
(#.Some [actual/0 (#.Some [actual/1 (#.Some [actual/2 #.None])])])
- (and (is? item/0 actual/0)
- (is? item/1 actual/1)
- (is? item/2 actual/2))
+ (and (same? item/0 actual/0)
+ (same? item/1 actual/1)
+ (same? item/2 actual/2))
_
false)))
@@ -939,8 +946,8 @@
(_.cover [/.^slots]
(/.case {#left expected_nat #right expected_int}
(/.^slots [#left #right])
- (and (/.is? expected_nat left)
- (/.is? expected_int right))))
+ (and (/.same? expected_nat left)
+ (/.same? expected_int right))))
(_.cover [/.^]
(/.case {#left expected_nat #right expected_int}
(/.^ (!pair 0 +0)) true
@@ -950,9 +957,9 @@
{#left expected_nat #right expected_int})]
(/.case expected_pair
(/.^@ actual_pair (/.^ (!pair actual_left actual_right)))
- (and (/.is? expected_pair actual_pair)
- (/.is? expected_nat actual_left)
- (/.is? expected_int actual_right)))))
+ (and (/.same? expected_pair actual_pair)
+ (/.same? expected_nat actual_left)
+ (/.same? expected_int actual_right)))))
(_.cover [/.^multi]
(let [expected_pair (: (Pair Nat Int)
{#left expected_nat #right expected_int})]
@@ -982,10 +989,10 @@
_ false))
(_.cover [/.let]
(and (/.let [actual_nat expected_nat]
- (/.is? expected_nat actual_nat))
+ (/.same? expected_nat actual_nat))
(/.let [[actual_left actual_right] {#left expected_nat #right expected_int}]
- (and (/.is? expected_nat actual_left)
- (/.is? expected_int actual_right)))))
+ (and (/.same? expected_nat actual_left)
+ (/.same? expected_int actual_right)))))
)))
(def: for_control_flow
@@ -1007,10 +1014,10 @@
post (random.only (|>> (n.= pre) not) random.nat)
.let [box (atom.atom pre)]]
(_.cover [/.exec]
- (and (is? pre (io.run! (atom.read! box)))
+ (and (same? pre (io.run! (atom.read! box)))
(/.exec
(io.run! (atom.write! post box))
- (is? post (io.run! (atom.read! box)))))))
+ (same? post (io.run! (atom.read! box)))))))
))
(def: identity/constant
@@ -1027,38 +1034,8 @@
(do random.monad
[expected random.nat]
(_.cover [/.def:]
- (and (is? expected (identity/constant expected))
- (is? expected (identity/function expected))))))
-
-(.refer "library/lux/target" #*)
-(.refer "library/lux/macro" #all)
-(.refer "library/lux/math/number/nat" #_)
-(.refer "library/lux/math/number/int" #nothing)
-(.refer "library/lux/math/number/rev" (#+ /4096))
-(.refer "library/lux/math/number/frac" (#only positive_infinity))
-(.refer "library/lux/math/number/i8" (#- equivalence width i8 i64))
-(.refer "library/lux/math/number/i16" (#exclude equivalence width i16 i64))
-
-(def: for_import
- Test
- (let [can_access? (: (All [a] (-> a a Bit))
- (function (_ global local)
- (is? global local)))]
- ($_ _.and
- (_.cover [/.refer]
- (and (can_access? library/lux/target.jvm
- jvm)
- (can_access? library/lux/macro.single_expansion
- single_expansion)
- (can_access? library/lux/math/number/rev./4096
- /4096)
- (can_access? library/lux/math/number/frac.positive_infinity
- positive_infinity)
- (can_access? library/lux/math/number/i8.I8
- I8)
- (can_access? library/lux/math/number/i16.I16
- I16)))
- )))
+ (and (same? expected (identity/constant expected))
+ (same? expected (identity/function expected))))))
(def: possible_targets
(Set @.Target)
@@ -1110,36 +1087,119 @@
(bit\= /.private /.local)))
))
+(for {@.old (as_is)}
+ (as_is (syntax: (for_bindings|test [fn/0 <code>.local_identifier
+ var/0 <code>.local_identifier
+ let/0 <code>.local_identifier
+
+ fn/1 <code>.local_identifier
+ var/1 <code>.local_identifier
+ let/1 <code>.local_identifier
+
+ fn/2 <code>.local_identifier
+ var/2 <code>.local_identifier
+ let/2 <code>.local_identifier
+
+ let/3 <code>.local_identifier])
+ (in (list (code.bit (case (get@ #.scopes *lux*)
+ (^ (list& scope/2 _))
+ (let [locals/2 (get@ #.locals scope/2)
+ expected_locals/2 (set.of_list text.hash (list fn/2 var/2 let/2
+ let/3))
+ actual_locals/2 (|> locals/2
+ (get@ #.mappings)
+ (list\map product.left)
+ (set.of_list text.hash))
+
+ correct_locals!
+ (and (n.= 4 (get@ #.counter locals/2))
+ (set\= expected_locals/2
+ actual_locals/2))
+
+ captured/2 (get@ #.captured scope/2)
+
+ local? (: (-> Ref Bit)
+ (function (_ ref)
+ (case ref
+ (#.Local _) true
+ (#.Captured _) false)))
+ captured? (: (-> Ref Bit)
+ (|>> local? not))
+ binding? (: (-> (-> Ref Bit) Text Bit)
+ (function (_ is? name)
+ (|> captured/2
+ (get@ #.mappings)
+ (plist.value name)
+ (maybe\map (|>> product.right is?))
+ (maybe.else false))))
+
+ correct_closure!
+ (and (n.= 6 (get@ #.counter captured/2))
+ (binding? local? fn/1)
+ (binding? local? var/1)
+ (binding? local? let/1)
+ (binding? captured? fn/0)
+ (binding? captured? var/0)
+ (binding? captured? let/0))]
+ (and correct_locals!
+ correct_closure!))
+
+ _
+ false)))))
+
+ (def: for_bindings
+ Test
+ ((<| (template.with_locals [fn/0 var/0 let/0
+ fn/1 var/1 let/1
+ fn/2 var/2 let/2
+ let/3])
+ (function (fn/0 var/0)) (let [let/0 123])
+ (function (fn/1 var/1)) (let [let/1 456])
+ (function (fn/2 var/2)) (let [let/2 789])
+ (let [let/3 [fn/0 var/0 let/0
+ fn/1 var/1 let/1
+ fn/2 var/2 let/2]
+ verdict (for_bindings|test fn/0 var/0 let/0
+ fn/1 var/1 let/1
+ fn/2 var/2 let/2
+ let/3)]
+ (_.cover [/.Bindings /.Ref]
+ verdict)))
+ 0 1 2))))
+
(def: test
Test
(<| (_.covering /._)
- ($_ _.and
- ..for_bit
- ..for_try
- ..for_list
- ..for_interface
- ..for_module
- ..for_pipe
- ..for_code
- ..for_macro
- ..for_type
- ..for_i64
- ..for_function
- ..for_template
- ..for_static
- ..for_slot
- ..for_associative
- ..for_expansion
- ..for_value
- ..for_case
- ..for_control_flow
- ..for_def:
- ..for_import
- ..for_meta
- ..for_export
-
- ..sub_tests
- )))
+ (with_expansions
+ [<for_bindings> (for {@.old (~~ (as_is))}
+ (~~ (as_is ..for_bindings)))]
+ (`` ($_ _.and
+ ..for_bit
+ ..for_try
+ ..for_list
+ ..for_interface
+ ..for_module
+ ..for_pipe
+ ..for_code
+ ..for_macro
+ ..for_type
+ ..for_i64
+ ..for_function
+ ..for_template
+ ..for_static
+ ..for_slot
+ ..for_associative
+ ..for_expansion
+ ..for_value
+ ..for_case
+ ..for_control_flow
+ ..for_def:
+ ..for_meta
+ ..for_export
+ <for_bindings>
+
+ ..sub_tests
+ )))))
(program: args
(let [times (for {@.old 100
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-03 03:45:38 +0000