diff options
Diffstat (limited to 'stdlib/source/test')
| -rw-r--r-- | stdlib/source/test/lux.lux | 132 |
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 ))) |