From 571d816dfd0b056a1649f5057867abbfa4421f5d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 4 Feb 2021 01:30:34 -0400 Subject: Updates for Lua compiler. --- stdlib/source/test/aedifex/artifact/versioning.lux | 24 ++++-- .../source/test/lux/control/concurrency/atom.lux | 60 ++++++++++----- .../test/lux/control/concurrency/semaphore.lux | 26 +++---- stdlib/source/test/lux/type.lux | 2 + stdlib/source/test/lux/type/refinement.lux | 88 ++++++++++++++++++++++ 5 files changed, 162 insertions(+), 38 deletions(-) create mode 100644 stdlib/source/test/lux/type/refinement.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex/artifact/versioning.lux b/stdlib/source/test/aedifex/artifact/versioning.lux index c0704440e..ab0e94236 100644 --- a/stdlib/source/test/aedifex/artifact/versioning.lux +++ b/stdlib/source/test/aedifex/artifact/versioning.lux @@ -13,14 +13,17 @@ [math ["." random (#+ Random)]]] {#program - ["." /]}) + ["." /]} + ["$." // #_ + ["#." snapshot + ["#/." version]]]) (def: #export random (Random /.Versioning) ($_ random.and + $//snapshot.random random.instant - random.nat - (random.list 5 (random.ascii/lower_alpha 3)) + (random.list 5 $//snapshot/version.random) )) (def: #export test @@ -32,12 +35,19 @@ ($equivalence.spec /.equivalence ..random)) (do random.monad - [expected ..random - version (random.ascii/upper_alpha 3)] + [expected ..random] (_.cover [/.format /.parser] (|> expected - (/.format version) - (.run (/.parser version)) + /.format + list + (.run /.parser) (try\map (\ /.equivalence = expected)) (try.default false)))) + (_.cover [/.init] + (|> /.init + /.format + list + (.run /.parser) + (try\map (\ /.equivalence = /.init)) + (try.default false))) ))) diff --git a/stdlib/source/test/lux/control/concurrency/atom.lux b/stdlib/source/test/lux/control/concurrency/atom.lux index c8496c210..ab86747e5 100644 --- a/stdlib/source/test/lux/control/concurrency/atom.lux +++ b/stdlib/source/test/lux/control/concurrency/atom.lux @@ -15,25 +15,49 @@ (def: #export test Test (<| (_.covering /._) - (do random.monad - [value random.nat - swap_value random.nat - set_value random.nat - #let [box (/.atom value)]] - ($_ _.and + ($_ _.and + (do random.monad + [expected random.nat + #let [box (/.atom expected)]] (_.cover [/.Atom /.atom /.read] - (n.= value - (io.run (/.read box)))) + (io.run + (do io.monad + [actual (/.read box)] + (wrap (is? expected actual)))))) + (do random.monad + [target random.nat + unknown (random.filter (|>> (is? target) not) random.nat) + expected random.nat + #let [box (/.atom target)]] (_.cover [/.compare_and_swap] - (and (io.run (/.compare_and_swap value swap_value box)) - (n.= swap_value - (io.run (/.read box))))) + (io.run + (do io.monad + [swapped_unknown? (/.compare_and_swap unknown expected box) + swapped_target? (/.compare_and_swap target expected box) + actual (/.read box)] + (wrap (and (not swapped_unknown?) + swapped_target? + (is? expected actual))))))) + (do random.monad + [init random.nat + shift random.nat + #let [box (/.atom init)]] (_.cover [/.update] - (exec (io.run (/.update inc box)) - (n.= (inc swap_value) - (io.run (/.read box))))) + (io.run + (do io.monad + [[pre post] (/.update (n.+ shift) box)] + (wrap (and (is? init pre) + (n.= (n.+ shift init) + post))))))) + (do random.monad + [pre random.nat + post random.nat + #let [box (/.atom pre)]] (_.cover [/.write] - (exec (io.run (/.write set_value box)) - (n.= set_value - (io.run (/.read box))))) - )))) + (io.run + (do io.monad + [old (/.write post box) + new (/.read box)] + (wrap (and (is? pre old) + (is? post new))))))) + ))) diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index 729e986c2..a8e64124c 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -154,26 +154,26 @@ _ false))) (do {! random.monad} - [limit (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1)))) + [limit (\ ! map (|>> (n.% 9) inc) random.nat) #let [barrier (/.barrier (maybe.assume (/.limit limit))) resource (atom.atom "")]] (wrap (do {! promise.monad} - [#let [ending (|> "_" - (list.repeat limit) - (text.join_with "")) - ids (enum.range n.enum 0 (dec limit)) - waiters (list\map (function (_ id) - (exec (io.run (atom.update (|>> (format "_")) resource)) - (waiter resource barrier id))) - ids)] - _ (monad.seq ! waiters) + [#let [suffix "_" + expected_ending (|> suffix + (list.repeat limit) + (text.join_with "")) + expected_ids (enum.range n.enum 0 (dec limit))] + _ (|> expected_ids + (list\map (function (_ id) + (exec (io.run (atom.update (|>> (format suffix)) resource)) + (waiter resource barrier id)))) + (monad.seq !)) #let [outcome (io.run (atom.read resource))]] (_.cover' [/.barrier /.block] - (and (text.ends_with? ending outcome) + (and (text.ends_with? expected_ending outcome) (list.every? (function (_ id) (text.contains? (%.nat id) outcome)) - ids) - ))))) + expected_ids)))))) ))) (def: #export test diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index b1d205e4a..0b3f3b4d8 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -22,6 +22,7 @@ ["#." dynamic] ["#." implicit] ["#." quotient] + ["#." refinement] ["#." resource]]) (def: short @@ -171,5 +172,6 @@ /dynamic.test /implicit.test /quotient.test + /refinement.test /resource.test ))) diff --git a/stdlib/source/test/lux/type/refinement.lux b/stdlib/source/test/lux/type/refinement.lux new file mode 100644 index 000000000..260f5f51f --- /dev/null +++ b/stdlib/source/test/lux/type/refinement.lux @@ -0,0 +1,88 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [predicate (#+ Predicate)] + [monad (#+ do)]] + [data + ["." maybe ("#\." monad)] + [collection + ["." list ("#\." functor)]]] + [math + ["." random] + [number + ["n" nat]]]] + {1 + ["." /]}) + +(def: _refiner + (/.refinement (n.> 123))) + +(def: _type + (/.type _refiner)) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Refined]) + (do {! random.monad} + [raw random.nat + modulus (\ ! map (|>> (n.% 10) (n.+ 2)) random.nat) + #let [predicate (: (Predicate Nat) + (|>> (n.% modulus) (n.= 0)))] + total_raws (\ ! map (|>> (n.% 20) inc) random.nat) + raws (random.list total_raws random.nat)] + ($_ _.and + (_.for [/.Refiner] + ($_ _.and + (_.cover [/.refinement] + (case (/.refinement predicate raw) + (#.Some refined) + (predicate raw) + + #.None + (not (predicate raw)))) + (_.cover [/.predicate] + (|> (/.refinement predicate modulus) + (maybe\map (|>> /.predicate (is? predicate))) + (maybe.default false))) + )) + (_.cover [/.un_refine] + (|> (/.refinement predicate modulus) + (maybe\map (|>> /.un_refine (n.= modulus))) + (maybe.default false))) + (_.cover [/.lift] + (and (|> (/.refinement predicate modulus) + (maybe\map (/.lift (n.+ modulus))) + maybe\join + (maybe\map (|>> /.un_refine (n.= (n.+ modulus modulus)))) + (maybe.default false)) + (|> (/.refinement predicate modulus) + (maybe\map (/.lift (n.+ (inc modulus)))) + maybe\join + (maybe\map (|>> /.un_refine (n.= (n.+ modulus (inc modulus))))) + (maybe.default false) + not))) + (_.cover [/.filter] + (let [expected (list.filter predicate raws) + actual (/.filter (/.refinement predicate) raws)] + (and (n.= (list.size expected) + (list.size actual)) + (\ (list.equivalence n.equivalence) = + expected + (list\map /.un_refine actual))))) + (_.cover [/.partition] + (let [expected (list.filter predicate raws) + [actual alternative] (/.partition (/.refinement predicate) raws)] + (and (n.= (list.size expected) + (list.size actual)) + (n.= (n.- (list.size expected) total_raws) + (list.size alternative)) + (\ (list.equivalence n.equivalence) = + expected + (list\map /.un_refine actual))))) + (_.cover [/.type] + (exec (: (Maybe .._type) + (.._refiner raw)) + true)) + )))) -- cgit v1.2.3