From 0f996f63bad02778d6dd3de767151f524a79df22 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 19 Mar 2020 21:20:08 -0400
Subject: Test for predicates + adjustments to code-generation code.

---
 stdlib/source/test/lux/abstract.lux           |  7 +++-
 stdlib/source/test/lux/abstract/order.lux     |  2 +-
 stdlib/source/test/lux/abstract/predicate.lux | 59 +++++++++++++++++++++++++++
 3 files changed, 65 insertions(+), 3 deletions(-)
 create mode 100644 stdlib/source/test/lux/abstract/predicate.lux

(limited to 'stdlib/source/test')

diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux
index c0ad0b823..d927dcd3e 100644
--- a/stdlib/source/test/lux/abstract.lux
+++ b/stdlib/source/test/lux/abstract.lux
@@ -6,7 +6,8 @@
    ["#." enum]
    ["#." equivalence]
    ["#." interval]
-   ["#." order]])
+   ["#." order]
+   ["#." predicate]])
 
 (def: #export test
   Test
@@ -15,4 +16,6 @@
       /enum.test
       /equivalence.test
       /interval.test
-      /order.test))
+      /order.test
+      /predicate.test
+      ))
diff --git a/stdlib/source/test/lux/abstract/order.lux b/stdlib/source/test/lux/abstract/order.lux
index a4bff03e9..ed64b5d46 100644
--- a/stdlib/source/test/lux/abstract/order.lux
+++ b/stdlib/source/test/lux/abstract/order.lux
@@ -14,7 +14,7 @@
 
 (def: #export test
   Test
-  (<| (_.context (%.name (name-of /.Codec)))
+  (<| (_.context (%.name (name-of /.Order)))
       (do r.monad
         [left r.nat
          right (|> r.nat (r.filter (|>> (n.= left) not)))])
diff --git a/stdlib/source/test/lux/abstract/predicate.lux b/stdlib/source/test/lux/abstract/predicate.lux
new file mode 100644
index 000000000..946d8371e
--- /dev/null
+++ b/stdlib/source/test/lux/abstract/predicate.lux
@@ -0,0 +1,59 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [equivalence (#+ Equivalence)]
+    [monad (#+ do)]]
+   [data
+    ["." bit ("#@." equivalence)]
+    [text
+     ["%" format (#+ format)]]
+    [number
+     ["n" nat]]]
+   [math
+    ["r" random (#+ Random)]]]
+  ["." // #_
+   ["#." monoid]]
+  {1
+   ["." / (#+ Predicate)]})
+
+(def: #export test
+  Test
+  (let [/2? (: (/.Predicate Nat)
+               (|>> (n.% 2) (n.= 0)))
+        /3? (: (/.Predicate Nat)
+               (|>> (n.% 3) (n.= 0)))]
+    (<| (_.context (%.name (name-of /.Predicate)))
+        (do r.monad
+          [sample r.nat])
+        ($_ _.and
+            (_.test (%.name (name-of /.none))
+                    (bit@= false (/.none sample)))
+            (_.test (%.name (name-of /.all))
+                    (bit@= true (/.all sample)))
+            (_.test (%.name (name-of /.unite))
+                    (bit@= (/.all sample)
+                           ((/.unite /.none /.all) sample)))
+            (_.test (%.name (name-of /.intersect))
+                    (bit@= (/.none sample)
+                           ((/.intersect /.none /.all) sample)))
+            (_.test (%.name (name-of /.complement))
+                    (and (not (bit@= (/.none sample)
+                                     ((/.complement /.none) sample)))
+                         (not (bit@= (/.all sample)
+                                     ((/.complement /.all) sample)))))
+            (_.test (%.name (name-of /.difference))
+                    (bit@= (and (/2? sample)
+                                (not (/3? sample)))
+                           ((/.difference /3? /2?) sample)))
+            (let [equivalence (: (Equivalence (/.Predicate Nat))
+                                 (structure
+                                  (def: (= left right)
+                                    (bit@= (left sample)
+                                           (right sample)))))
+                  generator (: (Random (/.Predicate Nat))
+                               (wrap /2?))]
+              ($_ _.and
+                  (//monoid.spec equivalence /.union generator)
+                  (//monoid.spec equivalence /.intersection generator)))
+            ))))
-- 
cgit v1.2.3