From b135e487e8f705a5fea7b9ef785310572642063a Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 30 Aug 2022 13:33:55 -0400
Subject: Added support for predicate-based polymorphism.

---
 stdlib/source/test/lux.lux                         |  4 +-
 stdlib/source/test/lux/control/function.lux        |  4 +-
 .../control/function/polymorphism/predicate.lux    | 41 ++++++++++++++
 stdlib/source/test/lux/test.lux                    | 15 +++++
 stdlib/source/test/lux/test/coverage.lux           | 65 ++++++++++++++++++++++
 5 files changed, 126 insertions(+), 3 deletions(-)
 create mode 100644 stdlib/source/test/lux/control/function/polymorphism/predicate.lux
 create mode 100644 stdlib/source/test/lux/test.lux
 create mode 100644 stdlib/source/test/lux/test/coverage.lux

(limited to 'stdlib/source/test')

diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index fb2df3a0c..f970099ec 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -52,7 +52,7 @@
   
   ["[1][0]" meta]
   ["[1][0]" program]
-  ["[1][0]" test/property]
+  ["[1][0]" test]
   
   ["[1][0]" world]
 
@@ -1254,7 +1254,7 @@
 
              /meta.test
              /program.test
-             /test/property.test
+             /test.test
 
              /world.test
 
diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux
index d87f6f3cd..f4333d520 100644
--- a/stdlib/source/test/lux/control/function.lux
+++ b/stdlib/source/test/lux/control/function.lux
@@ -25,7 +25,8 @@
   ["[1][0]" named]
   ["[1][0]" trampoline]
   ["[1][0]" polymorphism
-   ["[1]/[0]" type]]])
+   ["[1]/[0]" type]
+   ["[1]/[0]" predicate]]])
 
 (def .public test
   Test
@@ -76,4 +77,5 @@
              /named.test
              /trampoline.test
              /polymorphism/type.test
+             /polymorphism/predicate.test
              ))))
diff --git a/stdlib/source/test/lux/control/function/polymorphism/predicate.lux b/stdlib/source/test/lux/control/function/polymorphism/predicate.lux
new file mode 100644
index 000000000..10f608094
--- /dev/null
+++ b/stdlib/source/test/lux/control/function/polymorphism/predicate.lux
@@ -0,0 +1,41 @@
+(.require
+ [library
+  [lux (.except)
+   [abstract
+    [monad (.only do)]]
+   [math
+    ["[0]" random (.only Random)]
+    [number
+     ["i" int]]]
+   [test
+    ["_" property (.only Test)]]]]
+ [\\library
+  ["[0]" /]])
+
+(/.def .public (any _ choice positive negative zero)
+  [(All (_ value))] [Int value value value] value
+  zero
+
+  (/.method (any next choice positive negative zero)
+    (i.> +0 choice)
+    positive)
+
+  (/.method (any next choice positive negative zero)
+    (i.< +0 choice)
+    negative)
+  )
+
+(def .public test
+  Test
+  (<| (_.covering /._)
+      (do [! random.monad]
+        [positive random.nat
+         negative random.nat
+         zero random.nat])
+      (all _.and
+           (_.coverage [/.def]
+             (same? zero (any +0 positive negative zero)))
+           (_.coverage [/.method]
+             (and (same? positive (any +1 positive negative zero))
+                  (same? negative (any -1 positive negative zero))))
+           )))
diff --git a/stdlib/source/test/lux/test.lux b/stdlib/source/test/lux/test.lux
new file mode 100644
index 000000000..2ba71ac51
--- /dev/null
+++ b/stdlib/source/test/lux/test.lux
@@ -0,0 +1,15 @@
+(.require
+ [library
+  [lux (.except)
+   [test
+    ["_" property (.only Test)]]]]
+ ["[0]" /
+  ["[1][0]" coverage]
+  ["[1][0]" property]])
+
+(def .public test
+  Test
+  (all _.and
+       /coverage.test
+       /property.test
+       ))
diff --git a/stdlib/source/test/lux/test/coverage.lux b/stdlib/source/test/lux/test/coverage.lux
new file mode 100644
index 000000000..a7407ee6c
--- /dev/null
+++ b/stdlib/source/test/lux/test/coverage.lux
@@ -0,0 +1,65 @@
+(.require
+ [library
+  [lux (.except)
+   [abstract
+    [monad (.only do)]]
+   [control
+    ["[0]" try]]
+   [data
+    [collection
+     ["[0]" set]]]
+   [math
+    ["[0]" random (.only Random)]]
+   [meta
+    ["[0]" symbol (.use "[1]#[0]" equivalence)]
+    ["[0]" static]
+    ["[0]" code (.only)
+     ["<[1]>" \\parser]]
+    [macro
+     [syntax (.only syntax)]
+     ["[0]" template]
+     ["[0]" expansion]]]
+   [test
+    ["_" property (.only Test)]]]]
+ [\\library
+  ["[0]" /]])
+
+(def macro_error
+  (syntax (_ [macro <code>.any])
+    (function (_ compiler)
+      (when ((expansion.complete macro) compiler)
+        {try.#Failure error}
+        {try.#Success [compiler (list (code.text error))]}
+        
+        {try.#Success _}
+        {try.#Failure "OOPS!"}))))
+
+(template.with_locals [g!defined g!un_defined]
+  (these (def .public g!defined
+           Nat
+           (static.random_nat))
+         
+         (def .public test
+           Test
+           (<| (_.covering /._)
+               (_.for [/.Coverage])
+               (do [! random.monad]
+                 [module (random.upper_case 1)
+                  first (random.lower_case 2)
+                  second (random.lower_case 3)
+                  dummy (random.lower_case 4)])
+               (all _.and
+                    (`` (_.coverage [/.of]
+                          (and (let [[module _] (symbol .._)
+                                     [_ short] (symbol g!defined)]
+                                 (symbol#= [module short]
+                                           (/.of (,, (template.symbol [.._] [g!defined])))))
+                               (exec
+                                 (macro_error (/.of (,, (template.symbol [.._] [g!un_defined]))))
+                                 true))))
+                    (_.coverage [/.encoded /.decoded]
+                      (let [it (/.decoded module (/.encoded (list first second)))]
+                        (and (set.member? it [module first])
+                             (set.member? it [module second])
+                             (not (set.member? it [module dummy])))))
+                    )))))
-- 
cgit v1.2.3