aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/lux.lux132
1 files changed, 127 insertions, 5 deletions
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index fcf33fa79..d482d75d5 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -510,11 +510,16 @@
[expected_left random.nat
expected_right random.nat]
(_.cover [/.-> /.function]
- (let [actual (: (/.-> Nat Nat Nat)
- (/.function (_ actual_left actual_right)
- (n.* (inc actual_left) (dec actual_right))))]
- (n.= (n.* (inc expected_left) (dec expected_right))
- (actual expected_left expected_right))))))
+ (and (let [actual (: (/.-> Nat Nat Nat)
+ (/.function (_ actual_left actual_right)
+ (n.* (inc actual_left) (dec actual_right))))]
+ (n.= (n.* (inc expected_left) (dec expected_right))
+ (actual expected_left expected_right)))
+ (let [actual (: (/.-> [Nat Nat] Nat)
+ (/.function (_ [actual_left actual_right])
+ (n.* (inc actual_left) (dec actual_right))))]
+ (n.= (n.* (inc expected_left) (dec expected_right))
+ (actual [expected_left expected_right])))))))
(/.template: (!n/+ <left> <right>)
(n.+ <left> <right>))
@@ -783,6 +788,122 @@
(not (/.is? not_left left))))))
)))
+(type: (Pair l r)
+ {#left l
+ #right r})
+
+(template: (!pair <left> <right>)
+ [{#left <left>
+ #right <right>}])
+
+(def: for_case
+ Test
+ (do {! random.monad}
+ [expected_nat (\ ! map (n.% 1) random.nat)
+ expected_int (\ ! map (i.% +1) random.int)
+ expected_rev (random.either (wrap .5)
+ (wrap .25))
+ expected_frac (random.either (wrap +0.5)
+ (wrap +1.25))
+ expected_text (random.either (wrap "+0.5")
+ (wrap "+1.25"))]
+ ($_ _.and
+ (_.cover [/.case]
+ (and (/.case expected_nat
+ 0 true
+ _ false)
+ (/.case expected_int
+ +0 true
+ _ false)
+ (/.case expected_rev
+ .5 true
+ .25 true
+ _ false)
+ (/.case expected_frac
+ +0.5 true
+ +1.25 true
+ _ false)
+ (/.case expected_text
+ "+0.5" true
+ "+1.25" true
+ _ false)
+ (/.case [expected_nat expected_int]
+ [0 +0] true
+ _ false)
+ (/.case {#left expected_nat #right expected_int}
+ {#left 0 #right +0} true
+ _ false)
+ (/.case (: (Either Nat Int) (#.Left expected_nat))
+ (#.Left 0) true
+ _ false)
+ (/.case (: (Either Nat Int) (#.Right expected_int))
+ (#.Right +0) true
+ _ false)
+ ))
+ (_.cover [/.^or]
+ (and (/.case expected_rev
+ (/.^or .5 .25) true
+ _ false)
+ (/.case expected_frac
+ (/.^or +0.5 +1.25) true
+ _ false)
+ (/.case expected_text
+ (/.^or "+0.5" "+1.25") true
+ _ false)))
+ (_.cover [/.^slots]
+ (/.case {#left expected_nat #right expected_int}
+ (/.^slots [#left #right])
+ (and (/.is? expected_nat left)
+ (/.is? expected_int right))))
+ (_.cover [/.^]
+ (/.case {#left expected_nat #right expected_int}
+ (/.^ (!pair 0 +0)) true
+ _ false))
+ (_.cover [/.^@]
+ (let [expected_pair (: (Pair Nat Int)
+ {#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)))))
+ (_.cover [/.^multi]
+ (let [expected_pair (: (Pair Nat Int)
+ {#left expected_nat #right expected_int})]
+ (and (/.case expected_pair
+ (/.^multi (/.^ (!pair actual_left actual_right))
+ [actual_left 0]
+ [actual_right +0])
+ true
+
+ _
+ false)
+ (/.case expected_pair
+ (/.^multi (/.^ (!pair actual_left actual_right))
+ (n.= 0 actual_left)
+ (i.= +0 actual_right))
+ true
+
+ _
+ false))))
+ (_.cover [/.^|>]
+ (case expected_frac
+ (/.^|> actual_frac [(f.* +2.0) (f.* +2.0)])
+ (f.= (f.* +4.0 expected_frac)
+ actual_frac)))
+ (_.cover [/.^code]
+ (case (code.text expected_text)
+ (/.^code "+0.5") true
+ (/.^code "+1.25") true
+ _ false))
+ (_.cover [/.let]
+ (and (/.let [actual_nat expected_nat]
+ (/.is? 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)))))
+ )))
+
(def: test
Test
(<| (_.covering /._)
@@ -807,6 +928,7 @@
..for_associative
..for_expansion
..for_value
+ ..for_case
..sub_tests
)))