From 8ac980fd3b6d2050edc0e631a00028c1e6c28c73 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 4 Nov 2020 04:04:49 -0400 Subject: Re-named "lux/control/concurrency/process" to "thread". --- stdlib/source/test/lux/control.lux | 30 +++--- .../test/lux/control/concurrency/process.lux | 46 ---------- .../source/test/lux/control/concurrency/thread.lux | 46 ++++++++++ stdlib/source/test/lux/control/security/policy.lux | 7 +- .../test/lux/data/collection/queue/priority.lux | 102 ++++++++++++++------- stdlib/source/test/lux/type/check.lux | 8 +- stdlib/source/test/lux/world.lux | 4 +- stdlib/source/test/lux/world/shell.lux | 58 ++++++++++++ 8 files changed, 198 insertions(+), 103 deletions(-) delete mode 100644 stdlib/source/test/lux/control/concurrency/process.lux create mode 100644 stdlib/source/test/lux/control/concurrency/thread.lux create mode 100644 stdlib/source/test/lux/world/shell.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 50e737e98..14d75527f 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -3,14 +3,14 @@ ["_" test (#+ Test)]] ["." / #_ ["#." concatenative] - [concurrency - ["#." actor] - ["#." atom] - ["#." frp] - ["#." process] - ["#." promise] - ["#." semaphore] - ["#." stm]] + ["#." concurrency #_ + ["#/." actor] + ["#/." atom] + ["#/." frp] + ["#/." thread] + ["#/." promise] + ["#/." semaphore] + ["#/." stm]] ["#." continuation] ["#." exception] ["#." function @@ -44,13 +44,13 @@ (def: concurrency Test ($_ _.and - /actor.test - /atom.test - /frp.test - /process.test - /promise.test - /semaphore.test - /stm.test + /concurrency/actor.test + /concurrency/atom.test + /concurrency/frp.test + /concurrency/thread.test + /concurrency/promise.test + /concurrency/semaphore.test + /concurrency/stm.test )) (def: function diff --git a/stdlib/source/test/lux/control/concurrency/process.lux b/stdlib/source/test/lux/control/concurrency/process.lux deleted file mode 100644 index 6d59672ca..000000000 --- a/stdlib/source/test/lux/control/concurrency/process.lux +++ /dev/null @@ -1,46 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [control - ["." io]] - [data - [number - ["n" nat] - ["i" int]]] - [time - ["." instant (#+ Instant)] - ["." duration]] - [math - ["." random]]] - {1 - ["." / - [// - ["." atom (#+ Atom)] - ["." promise]]]}) - -(def: #export test - Test - (<| (_.covering /._) - (do {! random.monad} - [dummy random.nat - expected random.nat - delay (|> random.nat (:: ! map (n.% 100)))] - ($_ _.and - (_.cover [/.parallelism] - (n.> 0 /.parallelism)) - (wrap (do promise.monad - [reference-time (promise.future instant.now) - #let [box (atom.atom [reference-time dummy])] - _ (promise.future - (/.schedule delay (do io.monad - [execution-time instant.now] - (atom.write [execution-time expected] box)))) - _ (promise.wait delay) - [execution-time actual] (promise.future (atom.read box))] - (_.claim [/.schedule] - (and (i.>= (.int delay) - (duration.to-millis (instant.span reference-time execution-time))) - (n.= expected actual))))) - )))) diff --git a/stdlib/source/test/lux/control/concurrency/thread.lux b/stdlib/source/test/lux/control/concurrency/thread.lux new file mode 100644 index 000000000..6d59672ca --- /dev/null +++ b/stdlib/source/test/lux/control/concurrency/thread.lux @@ -0,0 +1,46 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." io]] + [data + [number + ["n" nat] + ["i" int]]] + [time + ["." instant (#+ Instant)] + ["." duration]] + [math + ["." random]]] + {1 + ["." / + [// + ["." atom (#+ Atom)] + ["." promise]]]}) + +(def: #export test + Test + (<| (_.covering /._) + (do {! random.monad} + [dummy random.nat + expected random.nat + delay (|> random.nat (:: ! map (n.% 100)))] + ($_ _.and + (_.cover [/.parallelism] + (n.> 0 /.parallelism)) + (wrap (do promise.monad + [reference-time (promise.future instant.now) + #let [box (atom.atom [reference-time dummy])] + _ (promise.future + (/.schedule delay (do io.monad + [execution-time instant.now] + (atom.write [execution-time expected] box)))) + _ (promise.wait delay) + [execution-time actual] (promise.future (atom.read box))] + (_.claim [/.schedule] + (and (i.>= (.int delay) + (duration.to-millis (instant.span reference-time execution-time))) + (n.= expected actual))))) + )))) diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux index 4a4f8409a..4885b52eb 100644 --- a/stdlib/source/test/lux/control/security/policy.lux +++ b/stdlib/source/test/lux/control/security/policy.lux @@ -20,7 +20,7 @@ [math ["." random]]] {1 - ["." / (#+ Context Privacy Can-Conceal Can-Reveal Privilege Private with-policy)]}) + ["." / (#+ Context Privacy Can-Conceal Can-Reveal Privilege Private)]}) (def: (injection can-conceal) (All [label] @@ -48,7 +48,7 @@ (def: (policy _) (Ex [%] (-> Any (Policy %))) - (with-policy + (/.with-policy (: (Context Privacy Policy) (function (_ (^@ privilege (^open "%@."))) (structure @@ -72,8 +72,7 @@ Test (<| (_.covering /._) (_.with-cover [/.Policy - /.Can-Upgrade /.Can-Downgrade - /.can-upgrade /.can-downgrade]) + /.Can-Upgrade /.Can-Downgrade]) (do random.monad [#let [policy-0 (policy [])] raw-password (random.ascii 10) diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index 555214148..073ce2c8d 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -1,56 +1,92 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract ["." monad (#+ do)]] [data - ["." maybe] + ["." maybe ("#@." functor)] + ["." bit ("#@." equivalence)] [number ["n" nat]]] [math - ["r" random (#+ Random)]]] + ["." random (#+ Random)]]] {1 ["." / (#+ Queue)]}) -(def: #export (queue size) +(def: #export (random size) (-> Nat (Random (Queue Nat))) - (do {! r.monad} - [inputs (r.list size r.nat)] + (do {! random.monad} + [inputs (random.list size random.nat)] (monad.fold ! (function (_ head tail) (do ! - [priority r.nat] + [priority random.nat] (wrap (/.push priority head tail)))) /.empty inputs))) (def: #export test Test - (<| (_.context (%.name (name-of /.Queue))) - (do {! r.monad} - [size (|> r.nat (:: ! map (n.% 100))) - sample (..queue size) - non-member-priority r.nat - non-member (|> r.nat (r.filter (|>> (/.member? n.equivalence sample) not)))] + (<| (_.covering /._) + (_.with-cover [/.Queue]) + (do {! random.monad} + [size (:: ! map (n.% 100) random.nat) + sample (..random size) + non-member-priority random.nat + non-member (random.filter (|>> (/.member? n.equivalence sample) not) + random.nat) + + max-member random.nat + min-member random.nat] ($_ _.and - (_.test "I can query the size of a queue (and empty queues have size 0)." - (n.= size (/.size sample))) - (_.test "Enqueueing and dequeing affects the size of queues." - (and (n.= (inc size) - (/.size (/.push non-member-priority non-member sample))) - (or (n.= 0 (/.size sample)) - (n.= (dec size) - (/.size (/.pop sample)))))) - (_.test "I can query whether an element belongs to a queue." - (and (and (not (/.member? n.equivalence sample non-member)) - (/.member? n.equivalence - (/.push non-member-priority non-member sample) - non-member)) - (or (n.= 0 (/.size sample)) - (and (/.member? n.equivalence - sample - (maybe.assume (/.peek sample))) - (not (/.member? n.equivalence - (/.pop sample) - (maybe.assume (/.peek sample)))))))) + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit@= (n.= 0 (/.size sample)) + (/.empty? sample))) + (_.cover [/.empty] + (/.empty? /.empty)) + (_.cover [/.peek] + (case (/.peek sample) + (#.Some first) + (n.> 0 (/.size sample)) + + #.None + (/.empty? sample))) + (_.cover [/.member?] + (case (/.peek sample) + (#.Some first) + (/.member? n.equivalence sample first) + + #.None + (/.empty? sample))) + (_.cover [/.push] + (let [sample+ (/.push non-member-priority non-member sample)] + (and (not (/.member? n.equivalence sample non-member)) + (n.= (inc (/.size sample)) + (/.size sample+)) + (/.member? n.equivalence sample+ non-member)))) + (_.cover [/.pop] + (let [sample- (/.pop sample)] + (or (and (/.empty? sample) + (/.empty? sample-)) + (n.= (dec (/.size sample)) + (/.size sample-))))) + (_.with-cover [/.Priority] + ($_ _.and + (_.cover [/.max] + (|> /.empty + (/.push /.min min-member) + (/.push /.max max-member) + /.peek + (maybe@map (n.= max-member)) + (maybe.default false))) + (_.cover [/.min] + (|> /.empty + (/.push /.max max-member) + (/.push /.min min-member) + /.pop + /.peek + (maybe@map (n.= min-member)) + (maybe.default false))) + )) )))) diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index ccd44ed89..3936c7a65 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -36,7 +36,7 @@ (let [(^open "R@.") r.monad pairG (r.and (type' num-vars) (type' num-vars)) - quantifiedG (r.and (R@wrap (list)) (type' (n.+ 2 num-vars))) + quantifiedG (r.and (R@wrap (list)) (type' (inc num-vars))) random-pair (r.either (r.either (R@map (|>> #.Sum) pairG) (R@map (|>> #.Product) pairG)) (r.either (R@map (|>> #.Function) pairG) @@ -45,7 +45,7 @@ (R@map (|>> #.Ex) r.nat))] (case num-vars 0 random-id - _ (r.either (R@map (|>> (n.% num-vars) #.Parameter) r.nat) + _ (r.either (R@map (|>> (n.% num-vars) (n.* 2) inc #.Parameter) r.nat) random-id))) random-quantified (r.either (R@map (|>> #.UnivQ) quantifiedG) (R@map (|>> #.ExQ) quantifiedG))] @@ -108,7 +108,7 @@ (<| (_.context (%.name (name-of /._))) ($_ _.and (do r.monad - [sample (|> ..type (r.filter valid-type?))] + [sample (r.filter ..valid-type? ..type)] ($_ _.and (_.test "Any is the super-type of everything." (/.checks? Any sample)) @@ -159,7 +159,7 @@ nameL gen-short nameR (|> gen-short (r.filter (|>> (text@= nameL) not))) paramL ..type - paramR (|> ..type (r.filter (|>> (/.checks? paramL) not)))] + paramR (r.filter (|>> (/.checks? paramL) not) ..type)] ($_ _.and (_.test "Primitive types match when they have the same name and the same parameters." (/.checks? (#.Primitive nameL (list paramL)) diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux index e46eecda3..c5b0ecc59 100644 --- a/stdlib/source/test/lux/world.lux +++ b/stdlib/source/test/lux/world.lux @@ -2,10 +2,12 @@ [lux #* ["_" test (#+ Test)]] ["." / #_ - ["#." file]]) + ["#." file] + ["#." shell]]) (def: #export test Test ($_ _.and /file.test + /shell.test )) diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux new file mode 100644 index 000000000..f98fc6a17 --- /dev/null +++ b/stdlib/source/test/lux/world/shell.lux @@ -0,0 +1,58 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + [number + ["n" nat] + ["i" int]] + [collection + ["." list]]]] + {1 + ["." /]} + {[1 #spec] + ["$." /]}) + +(exception: dead) + +(def: (simulation [environment command arguments]) + (-> [/.Environment /.Command (List /.Argument)] + (/.Simulation Bit)) + (structure + (def: (on-read dead?) + (if dead? + (exception.throw ..dead []) + (do try.monad + [to-echo (try.from-maybe (list.head arguments))] + (wrap [dead? to-echo])))) + + (def: (on-error dead?) + (if dead? + (exception.throw ..dead []) + (exception.return [dead? ""]))) + + (def: (on-write message dead?) + (if dead? + (exception.throw ..dead []) + (#try.Success dead?))) + + (def: (on-destroy dead?) + (if dead? + (exception.throw ..dead []) + (#try.Success true))) + + (def: (on-await dead?) + (if dead? + (exception.throw ..dead []) + (#try.Success [true /.normal]))))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.mock /.Simulation] + ($/.spec (/.mock (|>> ..simulation #try.Success) + false))))) -- cgit v1.2.3