aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux.lux2
-rw-r--r--stdlib/source/test/lux/macro.lux15
-rw-r--r--stdlib/source/test/lux/macro/code.lux31
-rw-r--r--stdlib/source/test/lux/meta.lux14
-rw-r--r--stdlib/source/test/lux/meta/annotation.lux178
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
+ ))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 18:19:50 +0000