From b1f0014dd9080c6643ecd73db5233fbdff032419 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 29 Aug 2020 01:06:42 -0400 Subject: Test programs + auti build/test. --- stdlib/source/test/lux.lux | 2 + stdlib/source/test/lux/macro.lux | 15 ++- stdlib/source/test/lux/macro/code.lux | 31 +++-- stdlib/source/test/lux/meta.lux | 14 +++ stdlib/source/test/lux/meta/annotation.lux | 178 +++++++++++++++++++++++++++++ 5 files changed, 216 insertions(+), 24 deletions(-) create mode 100644 stdlib/source/test/lux/meta.lux create mode 100644 stdlib/source/test/lux/meta/annotation.lux (limited to 'stdlib/source/test') 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 [ ] [(do {@ random.monad} - [value ] + [expected ] (_.cover [] - (and (case (..read (/.to-text ( value))) - (#try.Success lux-code) + (and (case (..read (/.to-text ( expected))) + (#try.Success actual) (:: /.equivalence = - lux-code - ( value)) + actual + ( expected)) (#try.Failure error) false) (:: /.equivalence = - [.dummy-cursor ( value)] - ( value)))))] + [.dummy-cursor ( expected)] + ( 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 [ ] [(do {@ random.monad} - [value ] + [expected ] (_.cover [] - (and (case (..read (/.to-text ( value))) - (#try.Success lux-code) + (and (case (..read (/.to-text ( expected))) + (#try.Success actual) (:: /.equivalence = - lux-code - ( value)) + actual + ( expected)) (#try.Failure error) false) (:: /.equivalence = - [.dummy-cursor ( ["" value])] - ( value))) + [.dummy-cursor ( ["" expected])] + ( 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 ) + (case + 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 [ ] + [(do {@ random.monad} + [expected ] + (_.cover [] + (|> expected + (..annotation key) + ( key) + (!expect (^multi (#.Some actual) + (:: = 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 [ ] + [(do {@ random.monad} + [expected random.bit] + (_.cover [] + (and (|> expected code.bit + (..annotation (name-of )) + + (:: bit.equivalence = expected)) + (not (|> expected code.bit + (..annotation key) + )))))] + + [/.structure? #.struct?] + [/.recursive-type? #.type-rec?] + [/.signature? #.sig?] + )) + )))) + +(def: arguments + Test + (do {@ random.monad} + [key ..random-key] + (`` ($_ _.and + (~~ (template [ ] + [(do {@ random.monad} + [expected (random.list 5 (random.ascii/alpha 1))] + (_.cover [] + (and (|> expected (list@map code.text) code.tuple + (..annotation (name-of )) + + (:: (list.equivalence text.equivalence) = expected)) + (|> expected (list@map code.text) code.tuple + (..annotation key) + + (:: (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 + )))) -- cgit v1.2.3