From 0f545b7e57d2564e351d907befd2ce26900c5521 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 24 Jul 2021 02:14:12 -0400
Subject: Now packaging JVM programs as "fat" jars in new JVM compiler.

---
 stdlib/source/test/lux.lux | 132 +++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 127 insertions(+), 5 deletions(-)

(limited to 'stdlib/source/test/lux.lux')

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
           )))
-- 
cgit v1.2.3