Test programs + auti build/test.

5 files changed, 216 insertions, 24 deletions

diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index d3107c0e5..6549f9a17 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -130,6 +130,7 @@
    ["#." locale]
    ["#." macro]
    ["#." math]
+   ["#." meta]
    ["#." time]
    ## ["#." tool]
    ["#." type]
@@ -319,6 +320,7 @@
                         /locale.test
                         /macro.test
                         /math.test
+                        /meta.test
                         /time.test
                         ## /tool.test
                         /type.test
diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux
index 14189ca35..3b95e6f3a 100644
--- a/stdlib/source/test/lux/macro.lux
+++ b/stdlib/source/test/lux/macro.lux
@@ -12,11 +12,10 @@
 
 (def: #export test
   Test
-  (<| (_.covering /._)
-      ($_ _.and
-          /code.test
-          /template.test
-          /syntax.test
-          /syntax/common.test
-          /poly.test
-          )))
+  ($_ _.and
+      /code.test
+      /template.test
+      /syntax.test
+      /syntax/common.test
+      /poly.test
+      ))
diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux
index 00a805f26..0cdbc9610 100644
--- a/stdlib/source/test/lux/macro/code.lux
+++ b/stdlib/source/test/lux/macro/code.lux
@@ -121,19 +121,19 @@
             (`` ($_ _.and
                     (~~ (template [<coverage> <random> <tag>]
                           [(do {@ random.monad}
-                             [value <random>]
+                             [expected <random>]
                              (_.cover [<coverage>]
-                                      (and (case (..read (/.to-text (<coverage> value)))
-                                             (#try.Success lux-code)
+                                      (and (case (..read (/.to-text (<coverage> expected)))
+                                             (#try.Success actual)
                                              (:: /.equivalence =
-                                                 lux-code
-                                                 (<coverage> value))
+                                                 actual
+                                                 (<coverage> expected))
                                              
                                              (#try.Failure error)
                                              false)
                                            (:: /.equivalence =
-                                               [.dummy-cursor (<tag> value)]
-                                               (<coverage> value)))))]
+                                               [.dummy-cursor (<tag> expected)]
+                                               (<coverage> expected)))))]
 
                           [/.bit random.bit #.Bit]
                           [/.nat random.nat #.Nat]
@@ -145,23 +145,22 @@
                           [/.identifier ..random-name #.Identifier]
                           [/.form (..random-sequence ..random) #.Form]
                           [/.tuple (..random-sequence ..random) #.Tuple]
-                          [/.record (..random-record ..random) #.Record]
-                          ))
+                          [/.record (..random-record ..random) #.Record]))
                     (~~ (template [<coverage> <random> <tag>]
                           [(do {@ random.monad}
-                             [value <random>]
+                             [expected <random>]
                              (_.cover [<coverage>]
-                                      (and (case (..read (/.to-text (<coverage> value)))
-                                             (#try.Success lux-code)
+                                      (and (case (..read (/.to-text (<coverage> expected)))
+                                             (#try.Success actual)
                                              (:: /.equivalence =
-                                                 lux-code
-                                                 (<coverage> value))
+                                                 actual
+                                                 (<coverage> expected))
                                              
                                              (#try.Failure error)
                                              false)
                                            (:: /.equivalence =
-                                               [.dummy-cursor (<tag> ["" value])]
-                                               (<coverage> value)))
+                                               [.dummy-cursor (<tag> ["" expected])]
+                                               (<coverage> expected)))
                                       ))]
 
                           [/.local-tag        ..random-text #.Tag]
diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux
new file mode 100644
index 000000000..d0a531404
--- /dev/null
+++ b/stdlib/source/test/lux/meta.lux
@@ -0,0 +1,14 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]]
+  ## {1
+  ##  ["." /]}
+  ["." / #_
+   ["#." annotation]])
+
+(def: #export test
+  Test
+  (<| ## (_.covering /._)
+      ($_ _.and
+          /annotation.test
+          )))
diff --git a/stdlib/source/test/lux/meta/annotation.lux b/stdlib/source/test/lux/meta/annotation.lux
new file mode 100644
index 000000000..f8f569bde
--- /dev/null
+++ b/stdlib/source/test/lux/meta/annotation.lux
@@ -0,0 +1,178 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [math
+    ["." random (#+ Random)]]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." try (#+ Try)]]
+   [data
+    ["." product]
+    ["." bit]
+    ["." name]
+    ["." text
+     ["%" format (#+ format)]]
+    [number
+     ["." nat]
+     ["." int]
+     ["." rev]
+     ["." frac]]
+    [collection
+     ["." list ("#@." functor)]]]
+   [macro
+    ["." code ("#@." equivalence)]]]
+  {1
+   ["." /]}
+  [///
+   [macro
+    ["_." code]]])
+
+(def: random-key
+  (Random Name)
+  (random.and (random.ascii/alpha 1)
+              (random.ascii/alpha 1)))
+
+(def: (random-sequence random)
+  (All [a] (-> (Random a) (Random (List a))))
+  (do {@ random.monad}
+    [size (|> random.nat (:: @ map (nat.% 3)))]
+    (random.list size random)))
+
+(def: (random-record random)
+  (All [a] (-> (Random a) (Random (List [a a]))))
+  (do {@ random.monad}
+    [size (|> random.nat (:: @ map (nat.% 3)))]
+    (random.list size (random.and random random))))
+
+(template: (!expect <pattern> <value>)
+  (case <value>
+    <pattern> true
+    _ false))
+
+(def: (annotation key value)
+  (-> Name Code /.Annotation)
+  (code.record (list [(code.tag key)
+                      value])))
+
+(def: typed-value
+  Test
+  (do {@ random.monad}
+    [key ..random-key]
+    (`` ($_ _.and
+            (~~ (template [<definition> <random> <constructor> <equivalence>]
+                  [(do {@ random.monad}
+                     [expected <random>]
+                     (_.cover [<definition>]
+                              (|> expected <constructor>
+                                  (..annotation key)
+                                  (<definition> key)
+                                  (!expect (^multi (#.Some actual)
+                                                   (:: <equivalence> = expected actual))))))]
+
+                  [/.bit random.bit code.bit bit.equivalence]
+                  [/.nat random.nat code.nat nat.equivalence]
+                  [/.int random.int code.int int.equivalence]
+                  [/.rev random.rev code.rev rev.equivalence]
+                  [/.frac random.frac code.frac frac.equivalence]
+                  [/.text (random.ascii/alpha 1) code.text text.equivalence]
+                  [/.identifier ..random-key code.identifier name.equivalence]
+                  [/.tag ..random-key code.tag name.equivalence]
+                  [/.form (..random-sequence _code.random) code.form (list.equivalence code.equivalence)]
+                  [/.tuple (..random-sequence _code.random) code.tuple (list.equivalence code.equivalence)]
+                  [/.record (..random-record _code.random) code.record (list.equivalence (product.equivalence code.equivalence code.equivalence))]
+                  ))
+            ))))
+
+(def: flag
+  Test
+  (do {@ random.monad}
+    [key ..random-key]
+    (`` ($_ _.and
+            (do {@ random.monad}
+              [dummy ..random-key
+               expected random.bit]
+              (_.cover [/.flagged?]
+                       (and (|> expected code.bit
+                                (..annotation key)
+                                (/.flagged? key)
+                                (:: bit.equivalence = expected))
+                            (not (|> expected code.bit
+                                     (..annotation dummy)
+                                     (/.flagged? key))))))
+            (~~ (template [<definition> <tag>]
+                  [(do {@ random.monad}
+                     [expected random.bit]
+                     (_.cover [<definition>]
+                              (and (|> expected code.bit
+                                       (..annotation (name-of <tag>))
+                                       <definition>
+                                       (:: bit.equivalence = expected))
+                                   (not (|> expected code.bit
+                                            (..annotation key)
+                                            <definition>)))))]
+
+                  [/.structure? #.struct?]
+                  [/.recursive-type? #.type-rec?]
+                  [/.signature? #.sig?]
+                  ))
+            ))))
+
+(def: arguments
+  Test
+  (do {@ random.monad}
+    [key ..random-key]
+    (`` ($_ _.and
+            (~~ (template [<definition> <tag>]
+                  [(do {@ random.monad}
+                     [expected (random.list 5 (random.ascii/alpha 1))]
+                     (_.cover [<definition>]
+                              (and (|> expected (list@map code.text) code.tuple
+                                       (..annotation (name-of <tag>))
+                                       <definition>
+                                       (:: (list.equivalence text.equivalence) = expected))
+                                   (|> expected (list@map code.text) code.tuple
+                                       (..annotation key)
+                                       <definition>
+                                       (:: (list.equivalence text.equivalence) = (list))))))]
+
+                  [/.function-arguments #.func-args]
+                  [/.type-arguments #.type-args]
+                  ))
+            ))))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.with-cover [/.Annotation])
+      (do {@ random.monad}
+        [key ..random-key]
+        ($_ _.and
+            (do {@ random.monad}
+              [expected _code.random]
+              (_.cover [/.value]
+                       (|> expected
+                           (..annotation key)
+                           (/.value key)
+                           (!expect (^multi (#.Some actual)
+                                            (code@= expected actual))))))
+            
+            ..typed-value
+            
+            (do {@ random.monad}
+              [expected (random.ascii/alpha 10)]
+              (_.cover [/.documentation]
+                       (and (not (|> expected code.text
+                                     (..annotation key)
+                                     /.documentation
+                                     (!expect (^multi (#.Some actual)
+                                                      (:: text.equivalence = expected actual)))))
+                            (|> expected code.text
+                                (..annotation (name-of #.doc))
+                                /.documentation
+                                (!expect (^multi (#.Some actual)
+                                                 (:: text.equivalence = expected actual)))))))
+
+            ..flag
+            ..arguments
+            ))))