From a5a15c191c43a660bb0c8e78e93d097e27966177 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 28 Aug 2020 00:06:26 -0400
Subject: Build programs.

---
 stdlib/source/test/lux.lux                  | 29 ++++++-------
 stdlib/source/test/lux/data/number/frac.lux |  6 +--
 stdlib/source/test/lux/macro.lux            | 18 ++++-----
 stdlib/source/test/lux/macro/poly.lux       | 18 +++++++++
 stdlib/source/test/lux/macro/template.lux   | 63 +++++++++++++++++++++++++++++
 5 files changed, 106 insertions(+), 28 deletions(-)
 create mode 100644 stdlib/source/test/lux/macro/poly.lux
 create mode 100644 stdlib/source/test/lux/macro/template.lux

(limited to 'stdlib/source/test')

diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index d41c295c4..d3107c0e5 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -313,20 +313,21 @@
 
 (def: sub-tests
   Test
-  (_.in-parallel (list /abstract.test
-                       /control.test
-                       /data.test
-                       /locale.test
-                       /macro.test
-                       /math.test
-                       /time.test
-                       ## /tool.test
-                       /type.test
-                       /world.test
-                       /host.test
-                       /extension.test
-                       /target/jvm.test
-                       )))
+  (_.in-parallel (list& /abstract.test
+                        /control.test
+                        /data.test
+                        /locale.test
+                        /macro.test
+                        /math.test
+                        /time.test
+                        ## /tool.test
+                        /type.test
+                        /world.test
+                        /host.test
+                        /target/jvm.test
+                        (for {@.old (list)}
+                             (list /extension.test))
+                        )))
 
 (def: test
   (<| (_.context (name.module (name-of /._)))
diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux
index ab6ceaa52..365bf9e7f 100644
--- a/stdlib/source/test/lux/data/number/frac.lux
+++ b/stdlib/source/test/lux/data/number/frac.lux
@@ -11,7 +11,7 @@
       ["$." monoid]
       ["$." codec]]}]
    [math
-    ["r" random]]]
+    ["." random]]]
   {1
    ["." /
     [// #*
@@ -19,7 +19,7 @@
 
 (def: #export test
   Test
-  (let [gen-frac (:: r.monad map (|>> (i.% +100) i.frac) r.int)]
+  (let [gen-frac (:: random.monad map (|>> (i.% +100) i.frac) random.int)]
     (<| (_.context (%.name (name-of /._)))
         (`` ($_ _.and
                 ($equivalence.spec /.equivalence gen-frac)
@@ -45,7 +45,7 @@
                                   (oct "-615,2.43"))
                              (/.= (hex "+deadBE.EF")
                                   (hex "+dead,BE.EF"))))
-                (do r.monad
+                (do random.monad
                   [sample gen-frac]
                   (_.test (format (%.name (name-of /.to-bits))
                                   " & " (%.name (name-of /.from-bits)))
diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux
index 1851fb4a4..14189ca35 100644
--- a/stdlib/source/test/lux/macro.lux
+++ b/stdlib/source/test/lux/macro.lux
@@ -1,26 +1,22 @@
 (.module:
   [lux #*
-   ["_" test (#+ Test)]
-   ["%" data/text/format]]
+   ["_" test (#+ Test)]]
   {1
    ["." /]}
   ["." / #_
    ["#." code]
+   ["#." template]
+   ["#." poly]
    ["#." syntax
-    ["#/." common]]
-   ["#." poly #_
-    ["#/." equivalence]
-    ["#/." functor]
-    ["#/." json]]])
+    ["#/." common]]])
 
 (def: #export test
   Test
-  (<| (_.context (%.name (name-of /._)))
+  (<| (_.covering /._)
       ($_ _.and
           /code.test
+          /template.test
           /syntax.test
           /syntax/common.test
-          /poly/equivalence.test
-          /poly/functor.test
-          /poly/json.test
+          /poly.test
           )))
diff --git a/stdlib/source/test/lux/macro/poly.lux b/stdlib/source/test/lux/macro/poly.lux
new file mode 100644
index 000000000..9a42c450a
--- /dev/null
+++ b/stdlib/source/test/lux/macro/poly.lux
@@ -0,0 +1,18 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]]
+  {1
+   ["." /]}
+  ["." / #_
+   ["#." equivalence]
+   ["#." functor]
+   ["#." json]])
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      ($_ _.and
+          /equivalence.test
+          /functor.test
+          /json.test
+          )))
diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux
new file mode 100644
index 000000000..6e90ac1bb
--- /dev/null
+++ b/stdlib/source/test/lux/macro/template.lux
@@ -0,0 +1,63 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [math
+    ["." random (#+ Random)]]
+   [abstract
+    [monad (#+ do)]]
+   [data
+    [collection
+     ["." list]]
+    [number
+     ["." nat]]]]
+  {1
+   ["." /]})
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (do {@ random.monad}
+        [left random.nat
+         mid random.nat
+         right random.nat]
+        (with-expansions [<module> (as-is [-8.9 +6.7 .5 -4 +3 2 #1 #0 #c b "a"])
+                          <module>' "-8.9+6.7.5-4+32#1#0cba"
+                          <short> (as-is ["a" b #c #0 #1 2 +3 -4 .5 +6.7 -8.9])
+                          <short>' "abc#0#12+3-4.5+6.7-8.9"]
+          ($_ _.and
+              (_.cover [/.splice]
+                       (:: (list.equivalence nat.equivalence) =
+                           (list left mid right)
+                           (`` (list (~~ (/.splice [left mid right]))))))
+              (_.cover [/.count]
+                       (case (/.count [left mid right])
+                         3 true
+                         _ false))
+              (_.cover [/.text]
+                       (case (/.text <short>)
+                         <short>' true
+                         _ false))
+              (_.cover [/.identifier]
+                       (and (case (`` (name-of (~~ (/.identifier <short>))))
+                              ["" <short>'] true
+                              _ false)
+                            (case (`` (name-of (~~ (/.identifier <module> <short>))))
+                              [<module>' <short>'] true
+                              _ false)
+                            ))
+              (_.cover [/.tag]
+                       (and (case (`` (name-of (~~ (/.tag <short>))))
+                              ["" <short>'] true
+                              _ false)
+                            (case (`` (name-of (~~ (/.tag <module> <short>))))
+                              [<module>' <short>'] true
+                              _ false)
+                            ))
+              (_.cover [/.with-locals]
+                       (/.with-locals [var0 var1]
+                         (let [var0 left
+                               var1 right]
+                           (and (nat.= left var0)
+                                (nat.= right var1)))))
+              )))
+      ))
-- 
cgit v1.2.3