diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/aedifex.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/cli.lux | 108 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/parser.lux | 108 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/profile.lux | 154 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/parser/synthesis.lux | 148 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/number.lux | 88 | ||||
| -rw-r--r-- | stdlib/source/test/lux/target/jvm.lux | 10 |
8 files changed, 450 insertions, 172 deletions
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 7286aa50a..8699ad8b9 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -6,11 +6,15 @@ [parser [cli (#+ program:)]]]] ["." / #_ + ["#." profile] + ["#." cli] ["#." parser]]) (def: test Test ($_ _.and + /profile.test + /cli.test /parser.test )) diff --git a/stdlib/source/test/aedifex/cli.lux b/stdlib/source/test/aedifex/cli.lux new file mode 100644 index 000000000..dfbf0b7a9 --- /dev/null +++ b/stdlib/source/test/aedifex/cli.lux @@ -0,0 +1,108 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + [pipe (#+ case>)] + ["." try] + [parser + ["." cli]]] + [data + ["." text ("#@." equivalence)]] + [math + ["." random (#+ Random) ("#@." monad)]]] + {#program + ["." / + ["/#" // #_ + ["#" profile] + [upload (#+ User Password)]]]}) + +(def: compilation + (Random /.Compilation) + (random.or (random@wrap []) + (random@wrap []))) + +(def: command + (Random /.Command) + ($_ random.or + ## #POM + (random@wrap []) + ## #Dependencies + (random@wrap []) + ## #Install + (random@wrap []) + ## #Deploy + ($_ random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1) + (random.ascii/alpha 1)) + ## #Compilation + ..compilation + ## #Auto + ..compilation)) + +(def: (format-compilation value) + (-> /.Compilation (List Text)) + (case value + #/.Build (list "build") + #/.Test (list "test"))) + +(def: (format value) + (-> /.Command (List Text)) + (case value + #/.POM (list "pom") + #/.Dependencies (list "deps") + #/.Install (list "install") + (#/.Deploy repository user password) (list "deploy" repository user password) + (#/.Compilation compilation) (..format-compilation compilation) + (#/.Auto compilation) (list& "auto" (..format-compilation compilation)))) + +(def: without-profile + Test + (do random.monad + [expected ..command] + (_.test "Without profile." + (|> expected + ..format + (cli.run /.command) + (case> (#try.Success [name actual]) + (and (text@= //.default name) + (:: /.equivalence = expected actual)) + + (#try.Failure error) + false))))) + +(def: with-profile + Test + (do random.monad + [expected-profile (random.ascii/alpha 1) + expected-command ..command] + (_.test "With profile." + (|> expected-command + ..format + (list& "with" expected-profile) + (cli.run /.command) + (case> (#try.Success [actual-profile actual-command]) + (and (text@= expected-profile actual-profile) + (:: /.equivalence = expected-command actual-command)) + + (#try.Failure error) + false))))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Compilation /.Command] + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence ..command)) + + (_.with-cover [/.command] + ($_ _.and + ..without-profile + ..with-profile + )))))) diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux index 97895a201..988883779 100644 --- a/stdlib/source/test/aedifex/parser.lux +++ b/stdlib/source/test/aedifex/parser.lux @@ -10,8 +10,7 @@ [parser ["<c>" code]]] [data - ["." text - ["%" format (#+ format)]] + ["." text] [number ["n" nat]] [collection @@ -22,6 +21,8 @@ ["." random (#+ Random) ("#@." monad)]] [macro ["." code]]] + [// + ["_." profile]] {#program ["." / ["/#" // #_ @@ -31,120 +32,25 @@ ["#." dependency (#+ Repository Dependency)] ["#." format]]]}) -(def: distribution - (Random //.Distribution) - (random.or (random@wrap []) - (random@wrap []))) - -(def: license - (Random //.License) - ($_ random.and - (random.ascii/alpha 1) - (random.ascii/alpha 1) - ..distribution)) - -(def: scm - (Random //.SCM) - (random.ascii/alpha 1)) - -(def: organization - (Random //.Organization) - ($_ random.and - (random.ascii/alpha 1) - (random.ascii/alpha 1))) - -(def: email - (Random //.Email) +(def: name + (Random //.Name) (random.ascii/alpha 1)) -(def: developer - (Random //.Developer) - ($_ random.and - (random.ascii/alpha 1) - (random.ascii/alpha 1) - (random.maybe organization))) - -(def: contributor - (Random //.Contributor) - ..developer) - (def: (list-of random) (All [a] (-> (Random a) (Random (List a)))) (do {@ random.monad} [size (:: @ map (n.% 5) random.nat)] (random.list size random))) -(def: (set-of hash random) - (All [a] (-> (Hash a) (Random a) (Random (Set a)))) - (:: random.functor map - (set.from-list hash) - (..list-of random))) - (def: (dictionary-of key-hash key-random value-random) (All [k v] (-> (Hash k) (Random k) (Random v) (Random (Dictionary k v)))) (:: random.functor map (dictionary.from-list key-hash) (..list-of (random.and key-random value-random)))) -(def: info - (Random //.Info) - ($_ random.and - (random.maybe (random.ascii/alpha 1)) - (random.maybe ..scm) - (random.maybe (random.ascii/alpha 1)) - (..list-of ..license) - (random.maybe ..organization) - (..list-of ..developer) - (..list-of ..contributor) - )) - -(def: name - (Random //.Name) - (random.ascii/alpha 1)) - -(def: artifact - (Random Artifact) - ($_ random.and - (random.ascii/alpha 1) - (random.ascii/alpha 1) - (random.ascii/alpha 1))) - -(def: repository - (Random Repository) - (random.ascii/alpha 1)) - -(def: dependency - (Random Dependency) - ($_ random.and - ..artifact - (random.ascii/alpha 1))) - -(def: source - (Random //.Source) - (random.ascii/alpha 1)) - -(def: target - (Random //.Target) - (random.ascii/alpha 1)) - -(def: profile - (Random //.Profile) - ($_ random.and - (..list-of ..name) - (random.maybe ..artifact) - (random.maybe ..info) - (..set-of text.hash ..repository) - (..set-of //dependency.hash ..dependency) - (..set-of text.hash ..source) - (random.maybe ..target) - (random.maybe (random.ascii/alpha 1)) - (random.maybe (random.ascii/alpha 1)) - (..dictionary-of text.hash (random.ascii/alpha 1) ..repository) - )) - (def: project (Random Project) - (..dictionary-of text.hash ..name ..profile)) + (..dictionary-of text.hash ..name _profile.random)) (def: with-default-sources (-> //.Profile //.Profile) @@ -158,7 +64,7 @@ (def: single-profile Test (do random.monad - [expected ..profile] + [expected _profile.random] (_.test "Single profile." (|> expected //format.profile diff --git a/stdlib/source/test/aedifex/profile.lux b/stdlib/source/test/aedifex/profile.lux new file mode 100644 index 000000000..3f1e08cc7 --- /dev/null +++ b/stdlib/source/test/aedifex/profile.lux @@ -0,0 +1,154 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + [hash (#+ Hash)] + {[0 #spec] + [/ + ["$." equivalence] + ["$." monoid]]}] + [control + [pipe (#+ case>)] + ["." try] + [parser + ["." cli]]] + [data + ["." text ("#@." equivalence)] + [number + ["n" nat]] + [collection + ["." set (#+ Set)] + ["." dictionary (#+ Dictionary)]]] + [math + ["." random (#+ Random) ("#@." monad)]]] + {#program + ["." / + ["/#" // #_ + ["#." artifact (#+ Artifact)] + ["#." dependency (#+ Repository Dependency)] + ["#." format]]]}) + +(def: distribution + (Random /.Distribution) + (random.or (random@wrap []) + (random@wrap []))) + +(def: license + (Random /.License) + ($_ random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1) + ..distribution)) + +(def: scm + (Random /.SCM) + (random.ascii/alpha 1)) + +(def: organization + (Random /.Organization) + ($_ random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1))) + +(def: email + (Random /.Email) + (random.ascii/alpha 1)) + +(def: developer + (Random /.Developer) + ($_ random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1) + (random.maybe organization))) + +(def: contributor + (Random /.Contributor) + ..developer) + +(def: (list-of random) + (All [a] (-> (Random a) (Random (List a)))) + (do {@ random.monad} + [size (:: @ map (n.% 5) random.nat)] + (random.list size random))) + +(def: (set-of hash random) + (All [a] (-> (Hash a) (Random a) (Random (Set a)))) + (:: random.functor map + (set.from-list hash) + (..list-of random))) + +(def: (dictionary-of key-hash key-random value-random) + (All [k v] (-> (Hash k) (Random k) (Random v) (Random (Dictionary k v)))) + (:: random.functor map + (dictionary.from-list key-hash) + (..list-of (random.and key-random value-random)))) + +(def: info + (Random /.Info) + ($_ random.and + (random.maybe (random.ascii/alpha 1)) + (random.maybe ..scm) + (random.maybe (random.ascii/alpha 1)) + (..list-of ..license) + (random.maybe ..organization) + (..list-of ..developer) + (..list-of ..contributor) + )) + +(def: name + (Random /.Name) + (random.ascii/alpha 1)) + +(def: artifact + (Random Artifact) + ($_ random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1) + (random.ascii/alpha 1))) + +(def: repository + (Random Repository) + (random.ascii/alpha 1)) + +(def: dependency + (Random Dependency) + ($_ random.and + ..artifact + (random.ascii/alpha 1))) + +(def: source + (Random /.Source) + (random.ascii/alpha 1)) + +(def: target + (Random /.Target) + (random.ascii/alpha 1)) + +(def: #export random + (Random /.Profile) + ($_ random.and + (..list-of ..name) + (random.maybe ..artifact) + (random.maybe ..info) + (..set-of text.hash ..repository) + (..set-of //dependency.hash ..dependency) + (..set-of text.hash ..source) + (random.maybe ..target) + (random.maybe (random.ascii/alpha 1)) + (random.maybe (random.ascii/alpha 1)) + (..dictionary-of text.hash (random.ascii/alpha 1) ..repository) + )) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Distribution /.License /.SCM /.Organization + /.Email /.Developer /.Contributor /.Info + /.Source /.Target /.Name /.Profile] + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.with-cover [/.monoid] + ($monoid.spec /.equivalence /.monoid ..random)) + )))) diff --git a/stdlib/source/test/lux/control/parser/synthesis.lux b/stdlib/source/test/lux/control/parser/synthesis.lux index 1896d4ca4..dc341a44f 100644 --- a/stdlib/source/test/lux/control/parser/synthesis.lux +++ b/stdlib/source/test/lux/control/parser/synthesis.lux @@ -57,6 +57,84 @@ (:: @ map (|>> synthesis.variable)) (random.list size)))) +(def: valid-frac + (Random Frac) + (random.filter (|>> frac.not-a-number? not) random.frac)) + +(def: simple + Test + (`` ($_ _.and + (~~ (template [<query> <check> <random> <synthesis> <equivalence>] + [(do {@ random.monad} + [expected <random> + dummy (|> <random> (random.filter (|>> (:: <equivalence> = expected) not)))] + ($_ _.and + (_.cover [<query>] + (|> (/.run <query> (list (<synthesis> expected))) + (!expect (^multi (#try.Success actual) + (:: <equivalence> = expected actual))))) + (_.cover [<check>] + (and (|> (/.run (<check> expected) (list (<synthesis> expected))) + (!expect (#try.Success _))) + (|> (/.run (<check> expected) (list (<synthesis> dummy))) + (!expect (^multi (#try.Failure error) + (exception.match? /.cannot-parse error))))))))] + + [/.bit /.bit! random.bit synthesis.bit bit.equivalence] + [/.i64 /.i64! (:: @ map .i64 random.nat) synthesis.i64 i64.equivalence] + [/.f64 /.f64! ..valid-frac synthesis.f64 frac.equivalence] + [/.text /.text! (random.unicode 1) synthesis.text text.equivalence] + [/.local /.local! random.nat synthesis.variable/local n.equivalence] + [/.foreign /.foreign! random.nat synthesis.variable/foreign n.equivalence] + [/.constant /.constant! ..random-constant synthesis.constant name.equivalence] + )) + ))) + +(def: complex + Test + ($_ _.and + (do {@ random.monad} + [expected-bit random.bit + expected-i64 (:: @ map .i64 random.nat) + expected-f64 ..valid-frac + expected-text (random.unicode 1)] + (_.cover [/.tuple] + (and (|> (/.run (/.tuple ($_ <>.and /.bit /.i64 /.f64 /.text)) + (list (synthesis.tuple (list (synthesis.bit expected-bit) + (synthesis.i64 expected-i64) + (synthesis.f64 expected-f64) + (synthesis.text expected-text))))) + (!expect (^multi (#try.Success [actual-bit actual-i64 actual-f64 actual-text]) + (and (:: bit.equivalence = expected-bit actual-bit) + (:: i64.equivalence = expected-i64 actual-i64) + (:: frac.equivalence = expected-f64 actual-f64) + (:: text.equivalence = expected-text actual-text))))) + (|> (/.run (/.tuple ($_ <>.and /.bit /.i64 /.f64 /.text)) + (list (synthesis.text expected-text))) + (!expect (^multi (#try.Failure error) + (exception.match? /.cannot-parse error))))))) + (do {@ random.monad} + [arity random.nat + expected-environment ..random-environment + expected-body (random.unicode 1)] + (_.cover [/.function /.wrong-arity] + (and (|> (/.run (/.function arity /.text) + (list (synthesis.function/abstraction [expected-environment arity (synthesis.text expected-body)]))) + (!expect (^multi (#try.Success [actual-environment actual-body]) + (and (:: (list.equivalence synthesis.equivalence) = + expected-environment + actual-environment) + (:: text.equivalence = expected-body actual-body))))) + (|> (/.run (/.function arity /.text) + (list (synthesis.text expected-body))) + (!expect (^multi (#try.Failure error) + (exception.match? /.cannot-parse error)))) + (|> (/.run (/.function (inc arity) /.text) + (list (synthesis.function/abstraction [expected-environment arity (synthesis.text expected-body)]))) + (!expect (^multi (#try.Failure error) + (exception.match? /.wrong-arity error))))))) + )) + (def: #export test Test (<| (_.covering /._) @@ -94,70 +172,8 @@ (|> (/.run (<>.before /.any /.end?) (list dummy)) (!expect (#try.Success #0)))))) (_.with-cover [/.cannot-parse] - (`` ($_ _.and - (~~ (template [<query> <check> <random> <synthesis> <equivalence>] - [(do {@ random.monad} - [expected <random> - dummy (|> <random> (random.filter (|>> (:: <equivalence> = expected) not)))] - ($_ _.and - (_.cover [<query>] - (|> (/.run <query> (list (<synthesis> expected))) - (!expect (^multi (#try.Success actual) - (:: <equivalence> = expected actual))))) - (_.cover [<check>] - (and (|> (/.run (<check> expected) (list (<synthesis> expected))) - (!expect (#try.Success _))) - (|> (/.run (<check> expected) (list (<synthesis> dummy))) - (!expect (^multi (#try.Failure error) - (exception.match? /.cannot-parse error))))))))] - - [/.bit /.bit! random.bit synthesis.bit bit.equivalence] - [/.i64 /.i64! (:: @ map .i64 random.nat) synthesis.i64 i64.equivalence] - [/.f64 /.f64! random.frac synthesis.f64 frac.equivalence] - [/.text /.text! (random.unicode 1) synthesis.text text.equivalence] - [/.local /.local! random.nat synthesis.variable/local n.equivalence] - [/.foreign /.foreign! random.nat synthesis.variable/foreign n.equivalence] - [/.constant /.constant! ..random-constant synthesis.constant name.equivalence] - )) - (do {@ random.monad} - [expected-bit random.bit - expected-i64 (:: @ map .i64 random.nat) - expected-f64 random.frac - expected-text (random.unicode 1)] - (_.cover [/.tuple] - (and (|> (/.run (/.tuple ($_ <>.and /.bit /.i64 /.f64 /.text)) - (list (synthesis.tuple (list (synthesis.bit expected-bit) - (synthesis.i64 expected-i64) - (synthesis.f64 expected-f64) - (synthesis.text expected-text))))) - (!expect (^multi (#try.Success [actual-bit actual-i64 actual-f64 actual-text]) - (and (:: bit.equivalence = expected-bit actual-bit) - (:: i64.equivalence = expected-i64 actual-i64) - (:: frac.equivalence = expected-f64 actual-f64) - (:: text.equivalence = expected-text actual-text))))) - (|> (/.run (/.tuple ($_ <>.and /.bit /.i64 /.f64 /.text)) - (list (synthesis.text expected-text))) - (!expect (^multi (#try.Failure error) - (exception.match? /.cannot-parse error))))))) - (do {@ random.monad} - [arity random.nat - expected-environment ..random-environment - expected-body (random.unicode 1)] - (_.cover [/.function /.wrong-arity] - (and (|> (/.run (/.function arity /.text) - (list (synthesis.function/abstraction [expected-environment arity (synthesis.text expected-body)]))) - (!expect (^multi (#try.Success [actual-environment actual-body]) - (and (:: (list.equivalence synthesis.equivalence) = - expected-environment - actual-environment) - (:: text.equivalence = expected-body actual-body))))) - (|> (/.run (/.function arity /.text) - (list (synthesis.text expected-body))) - (!expect (^multi (#try.Failure error) - (exception.match? /.cannot-parse error)))) - (|> (/.run (/.function (inc arity) /.text) - (list (synthesis.function/abstraction [expected-environment arity (synthesis.text expected-body)]))) - (!expect (^multi (#try.Failure error) - (exception.match? /.wrong-arity error))))))) - ))) + ($_ _.and + ..simple + ..complex + )) ))) diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 47a79b530..287a93526 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -13,6 +13,7 @@ ["#." lazy] ["#." maybe] ["#." name] + ["#." number] ["#." product] ["#." sum] [number @@ -88,6 +89,7 @@ /lazy.test /maybe.test /name.test + /number.test /product.test) test2 ($_ _.and /sum.test diff --git a/stdlib/source/test/lux/data/number.lux b/stdlib/source/test/lux/data/number.lux new file mode 100644 index 000000000..876cf4c4d --- /dev/null +++ b/stdlib/source/test/lux/data/number.lux @@ -0,0 +1,88 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [control + ["." try]] + [data + ["." text + ["%" format (#+ format)]] + [number + ["n" nat] + ["i" int] + ["r" rev] + ["f" frac]]]] + {1 + ["." /]}) + +(def: clean-commas + (-> Text Text) + (text.replace-all "," "")) + +(def: #export test + Test + (<| (_.covering /._) + ($_ _.and + (_.cover [/.bin] + (`` (and (~~ (template [<=> <codec> <number>] + [(case (:: <codec> decode (..clean-commas <number>)) + (#try.Success actual) + (<=> (/.bin <number>) actual) + + (#try.Failure error) + false)] + + [n.= n.binary "11001001"] + [n.= n.binary "11,00,10,01"] + + [i.= i.binary "+11001001"] + [i.= i.binary "-11,00,10,01"] + + [r.= r.binary ".11001001"] + [r.= r.binary ".11,00,10,01"] + + [f.= f.binary "+1100.1001"] + [f.= f.binary "-11,00.10,01"] + ))))) + (_.cover [/.oct] + (`` (and (~~ (template [<=> <codec> <number>] + [(case (:: <codec> decode (..clean-commas <number>)) + (#try.Success actual) + (<=> (/.oct <number>) actual) + + (#try.Failure error) + false)] + + [n.= n.octal "615243"] + [n.= n.octal "615,243"] + + [i.= i.octal "+615243"] + [i.= i.octal "-615,243"] + + [r.= r.octal ".615243"] + [r.= r.octal ".615,243"] + + [f.= f.octal "+6152.43"] + [f.= f.octal "-61,52.43"] + ))))) + (_.cover [/.hex] + (`` (and (~~ (template [<=> <codec> <number>] + [(case (:: <codec> decode (..clean-commas <number>)) + (#try.Success actual) + (<=> (/.hex <number>) actual) + + (#try.Failure error) + false)] + + [n.= n.hex "deadBEEF"] + [n.= n.hex "dead,BEEF"] + + [i.= i.hex "+deadBEEF"] + [i.= i.hex "-dead,BEEF"] + + [r.= r.hex ".deadBEEF"] + [r.= r.hex ".dead,BEEF"] + + [f.= f.hex "+dead.BEEF"] + [f.= f.hex "-dead,BE.EF"] + ))))) + ))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 511635a2a..26d3cb42f 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -288,7 +288,7 @@ #random ..$String::random #literal ..$String::literal}) -(template [<name> <bits> <type> <push> <wrap> <message> <to-long> <unsigned>] +(template [<name> <bits> <type> <push> <wrap> <message> <to-long> <signed>] [(def: <name> Test (do {@ random.monad} @@ -299,11 +299,11 @@ @.jvm (|>> (:coerce <type>) <to-long> "jvm object cast" ("jvm long =" ("jvm object cast" (:coerce java/lang/Long expected))))})) (do /.monad - [_ (<push> (|> expected <unsigned> try.assume))] + [_ (<push> (|> expected .int <signed> try.assume))] <wrap>))))] - [byte 7 java/lang/Byte /.bipush ..$Byte::wrap "BIPUSH" host.byte-to-long /unsigned.u1] - [short 15 java/lang/Short /.sipush ..$Short::wrap "SIPUSH" host.short-to-long /unsigned.u2] + [byte 7 java/lang/Byte /.bipush ..$Byte::wrap "BIPUSH" host.byte-to-long /signed.s1] + [short 15 java/lang/Short /.sipush ..$Short::wrap "SIPUSH" host.short-to-long /signed.s2] ) (template [<name> <type>] @@ -1473,7 +1473,7 @@ [@right /.new-label @wrong /.new-label @return /.new-label - _ (/.bipush (|> minimum /signed.value .nat /unsigned.u1 try.assume)) + _ (/.bipush (|> minimum /signed.value .int /signed.s1 try.assume)) _ (/.tableswitch minimum @wrong [@right (list.repeat afterwards @wrong)]) _ (/.set-label @wrong) _ (..$Long::literal dummy) |