From fcb1dcee2a4d502b41852a4c8e26b53ae7b2041e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 28 May 2020 22:13:39 -0400 Subject: Can now export Lux code as library TAR files. --- stdlib/source/test/lux/control.lux | 29 ++--- stdlib/source/test/lux/control/concurrency/stm.lux | 14 +-- stdlib/source/test/lux/control/continuation.lux | 122 +++++++++++---------- .../source/test/lux/control/function/contract.lux | 39 +++++++ stdlib/source/test/lux/data/format/tar.lux | 2 +- 5 files changed, 123 insertions(+), 83 deletions(-) create mode 100644 stdlib/source/test/lux/control/function/contract.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index dbfb5b4a4..5c7f7b9ef 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -5,7 +5,9 @@ ["#." concatenative] ["#." continuation] ["#." exception] - ["#." function] + ["#." function + ["#/." memo] + ["#/." contract]] ["#." try] ["#." io] ["#." parser] @@ -28,9 +30,7 @@ ["#/." text] ["#/." cli]] [security - ["#." policy]] - [function - ["#." memo]]]) + ["#." policy]]]) (def: concurrency Test @@ -44,9 +44,18 @@ /stm.test )) +(def: function + Test + ($_ _.and + /function.test + /function/memo.test + /function/contract.test + )) + (def: parser Test ($_ _.and + /parser.test /parser/text.test /parser/cli.test )) @@ -57,22 +66,16 @@ /policy.test )) -(def: function - Test - ($_ _.and - /memo.test - )) - (def: #export test Test ($_ _.and /concatenative.test /continuation.test /exception.test - /function.test + ..function /try.test /io.test - /parser.test + ..parser /pipe.test /reader.test /region.test @@ -81,7 +84,5 @@ /thread.test /writer.test ..concurrency - ..parser ..security - ..function )) diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index ab795ea79..628aedfaf 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -11,6 +11,7 @@ [control ["." io (#+ IO)]] [data + ["." product] [number ["n" nat]] [collection @@ -31,17 +32,8 @@ (def: comparison (Comparison /.STM) (function (_ == left right) - (io.run - (do io.monad - [?left (promise.poll (/.commit left)) - ?right (promise.poll (/.commit right))] - (wrap (case [?left ?right] - [(#.Some left) - (#.Some right)] - (== left right) - - _ - false)))))) + (== (product.right (left (list))) + (product.right (right (list)))))) (def: #export test Test diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux index 1d07460c9..95aa5ec7a 100644 --- a/stdlib/source/test/lux/control/continuation.lux +++ b/stdlib/source/test/lux/control/continuation.lux @@ -11,78 +11,86 @@ [data [number ["n" nat]] - [text - ["%" format (#+ format)]] [collection ["." list]]] [math - ["r" random]]] + ["." random]]] {1 - ["." / (#+ Cont)]}) + ["." /]}) (def: injection - (All [o] (Injection (All [i] (Cont i o)))) + (All [o] (Injection (All [i] (/.Cont i o)))) (|>> /.pending)) (def: comparison - (Comparison Cont) + (Comparison /.Cont) (function (_ == left right) (== (/.run left) (/.run right)))) (def: #export test Test - (<| (_.context (%.name (name-of /.Cont))) - (do r.monad - [sample r.nat + (<| (_.covering /._) + (do random.monad + [sample random.nat #let [(^open "_@.") /.apply (^open "_@.") /.monad] - elems (r.list 3 r.nat)] - ($_ _.and - ($functor.spec ..injection ..comparison /.functor) - ($apply.spec ..injection ..comparison /.apply) - ($monad.spec ..injection ..comparison /.monad) + elems (random.list 3 random.nat)]) + (_.with-cover [/.Cont]) + ($_ _.and + (_.with-cover [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.with-cover [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.with-cover [/.monad] + ($monad.spec ..injection ..comparison /.monad)) - (_.test "Can run continuations to compute their values." - (n.= sample (/.run (_@wrap sample)))) + (_.cover [/.run] + (n.= sample (/.run (_@wrap sample)))) + (_.cover [/.call/cc] + (n.= (n.* 2 sample) + (/.run (do {@ /.monad} + [value (/.call/cc + (function (_ k) + (do @ + [temp (k sample)] + ## If this code where to run, + ## the output would be + ## (n.* 4 sample) + (k temp))))] + (wrap (n.* 2 value)))))) + (_.cover [/.portal] + (n.= (n.+ 100 sample) + (/.run (do /.monad + [[restart [output idx]] (/.portal [sample 0])] + (if (n.< 10 idx) + (restart [(n.+ 10 output) (inc idx)]) + (wrap output)))))) + (_.cover [/.shift /.reset] + (let [(^open "_@.") /.monad + (^open "list@.") (list.equivalence n.equivalence) + visit (: (-> (List Nat) + (/.Cont (List Nat) (List Nat))) + (function (visit xs) + (case xs + #.Nil + (_@wrap #.Nil) - (_.test "Can use the current-continuation as a escape hatch." - (n.= (n.* 2 sample) - (/.run (do {@ /.monad} - [value (/.call/cc - (function (_ k) - (do @ - [temp (k sample)] - ## If this code where to run, - ## the output would be - ## (n.* 4 sample) - (k temp))))] - (wrap (n.* 2 value)))))) - - (_.test "Can use the current-continuation to build a time machine." - (n.= (n.+ 100 sample) - (/.run (do /.monad - [[restart [output idx]] (/.portal [sample 0])] - (if (n.< 10 idx) - (restart [(n.+ 10 output) (inc idx)]) - (wrap output)))))) - - (_.test "Can use delimited continuations with shifting." - (let [(^open "_@.") /.monad - (^open "list@.") (list.equivalence n.equivalence) - visit (: (-> (List Nat) - (Cont (List Nat) (List Nat))) - (function (visit xs) - (case xs - #.Nil - (_@wrap #.Nil) - - (#.Cons x xs') - (do {@ /.monad} - [output (/.shift (function (_ k) - (do @ - [tail (k xs')] - (wrap (#.Cons x tail)))))] - (visit output)))))] - (list@= elems - (/.run (/.reset (visit elems)))))) - )))) + (#.Cons x xs') + (do {@ /.monad} + [output (/.shift (function (_ k) + (do @ + [tail (k xs')] + (wrap (#.Cons x tail)))))] + (visit output)))))] + (list@= elems + (/.run (/.reset (visit elems)))))) + (_.cover [/.continue] + (/.continue (is? sample) + (: (/.Cont Nat Bit) + (function (_ next) + (next sample))))) + (_.cover [/.pending] + (/.continue (is? sample) + (: (/.Cont Nat Bit) + (/.pending sample)))) + ))) diff --git a/stdlib/source/test/lux/control/function/contract.lux b/stdlib/source/test/lux/control/function/contract.lux new file mode 100644 index 000000000..0cde16295 --- /dev/null +++ b/stdlib/source/test/lux/control/function/contract.lux @@ -0,0 +1,39 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + ["." host] + [abstract + [monad (#+ do)]] + [control + ["." try]] + [math + ["." random]] + [data + [number + ["n" nat]]]] + {1 + ["." /]}) + +(def: #export test + Test + (<| (_.covering /._) + (do {@ random.monad} + [expected random.nat]) + ($_ _.and + (_.cover [/.pre] + (case (host.try (/.pre (n.even? expected) + true)) + (#try.Success output) + output + + (#try.Failure error) + (not (n.even? expected)))) + (_.cover [/.post] + (case (host.try (/.post n.odd? + expected)) + (#try.Success actual) + (is? expected actual) + + (#try.Failure error) + (not (n.odd? expected)))) + ))) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index b8ba1af51..ebbdd8f1e 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -152,7 +152,7 @@ Test (do {@ random.monad} [expected-path (random.ascii/lower-alpha (dec /.path-size)) - expected-moment (:: @ map (|>> (n.% 1,00,00,00,00,00,000) .int instant.from-millis) + expected-moment (:: @ map (|>> (n.% 1,0,00,00,00,00,000) .int instant.from-millis) random.nat) chunk (random.ascii/lower-alpha chunk-size) chunks (:: @ map (n.% 100) random.nat) -- cgit v1.2.3