De-sigil-ification: ^

1 files changed, 98 insertions, 0 deletions

diff --git a/stdlib/source/test/lux/macro/pattern.lux b/stdlib/source/test/lux/macro/pattern.lux
new file mode 100644
index 000000000..d5b7b9dcb
--- /dev/null
+++ b/stdlib/source/test/lux/macro/pattern.lux
@@ -0,0 +1,98 @@
+(.using
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   [abstract
+    [monad {"+" do}]]
+   [data
+    ["[0]" bit ("[1]#[0]" equivalence)]]
+   [macro
+    ["[0]" code]]
+   [math
+    ["[0]" random {"+" Random}]
+    [number
+     ["n" nat]
+     ["i" int]
+     ["f" frac]]]]]
+ [\\library
+  ["[0]" /]])
+
+(type: (Pair l r)
+  (Record
+   [#left l
+    #right r]))
+
+(template: (!pair <left> <right>)
+  [[..#left <left>
+    ..#right <right>]])
+
+(def: .public test
+  Test
+  (<| (_.covering /._)
+      (do [! random.monad]
+        [expected_nat (# ! each (n.% 1) random.nat)
+         expected_int (# ! each (i.% +1) random.int)
+         expected_rev (random.either (in .5)
+                                     (in .25))
+         expected_frac (random.either (in +0.5)
+                                      (in +1.25))
+         expected_text (random.either (in "+0.5")
+                                      (in "+1.25"))]
+        ($_ _.and
+            (do [! random.monad]
+              [sample (# ! each (n.% 5) random.nat)]
+              (_.cover [/.template]
+                       (case sample
+                         (/.template [<case>]
+                           [<case> true])
+                         ([0] [1] [2] [3] [4])
+
+                         _
+                         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 [/.let]
+                     (let [expected_pair (: (Pair Nat Int)
+                                            [..#left expected_nat ..#right expected_int])]
+                       (/.case expected_pair
+                         (/.let actual_pair (/.pattern (!pair actual_left 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])]
+                       (and (/.case expected_pair
+                              (/.multi (/.pattern (!pair 0 actual_right))
+                                       [actual_right
+                                        +0])
+                              true
+
+                              _
+                              false)
+                            (/.case expected_pair
+                              (/.multi (/.pattern (!pair 0 actual_right))
+                                       (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 [/.`]
+                     (case (code.text expected_text)
+                       (/.` "+0.5") true
+                       (/.` "+1.25") true
+                       _ false))
+            ))))