From 3e524725cfb47cb56466a08ac290ed5a389748be Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 6 May 2020 04:19:54 -0400 Subject: Loading the artifacts from the cache and re-populating the analyser's state. --- stdlib/source/test/lux/abstract/equivalence.lux | 56 ++++--- .../source/test/lux/control/concurrency/actor.lux | 165 +++++++++++++++------ stdlib/source/test/lux/control/try.lux | 6 +- stdlib/source/test/lux/control/writer.lux | 48 +++--- 4 files changed, 176 insertions(+), 99 deletions(-) (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/abstract/equivalence.lux b/stdlib/source/test/lux/abstract/equivalence.lux index 7ae9b37af..b7db2ee70 100644 --- a/stdlib/source/test/lux/abstract/equivalence.lux +++ b/stdlib/source/test/lux/abstract/equivalence.lux @@ -4,50 +4,48 @@ [abstract/monad (#+ do)] [data ["." bit ("#@." equivalence)] - [text - ["%" format (#+ format)]] [number ["n" nat] ["i" int]]] [math - ["r" random (#+ Random)]]] + ["." random (#+ Random)]]] {1 ["." / (#+ Equivalence)]}) (def: #export test Test - (do r.monad - [leftN r.nat - rightN r.nat - leftI r.int - rightI r.int] - (<| (_.context (%.name (name-of /._))) + (do random.monad + [leftN random.nat + rightN random.nat + leftI random.int + rightI random.int] + (<| (_.covering /._) ($_ _.and - (_.test (%.name (name-of /.sum)) - (let [equivalence (/.sum n.equivalence i.equivalence)] - (and (bit@= (:: n.equivalence = leftN leftN) - (:: equivalence = (#.Left leftN) (#.Left leftN))) - (bit@= (:: n.equivalence = leftN rightN) - (:: equivalence = (#.Left leftN) (#.Left rightN))) - (bit@= (:: i.equivalence = leftI leftI) - (:: equivalence = (#.Right leftI) (#.Right leftI))) - (bit@= (:: i.equivalence = leftI rightI) - (:: equivalence = (#.Right leftI) (#.Right rightI)))))) - (_.test (%.name (name-of /.product)) - (let [equivalence (/.product n.equivalence i.equivalence)] - (and (bit@= (and (:: n.equivalence = leftN leftN) - (:: i.equivalence = leftI leftI)) - (:: equivalence = [leftN leftI] [leftN leftI])) - (bit@= (and (:: n.equivalence = leftN rightN) - (:: i.equivalence = leftI rightI)) - (:: equivalence = [leftN leftI] [rightN rightI]))))))))) + (_.cover [/.sum] + (let [equivalence (/.sum n.equivalence i.equivalence)] + (and (bit@= (:: n.equivalence = leftN leftN) + (:: equivalence = (#.Left leftN) (#.Left leftN))) + (bit@= (:: n.equivalence = leftN rightN) + (:: equivalence = (#.Left leftN) (#.Left rightN))) + (bit@= (:: i.equivalence = leftI leftI) + (:: equivalence = (#.Right leftI) (#.Right leftI))) + (bit@= (:: i.equivalence = leftI rightI) + (:: equivalence = (#.Right leftI) (#.Right rightI)))))) + (_.cover [/.product] + (let [equivalence (/.product n.equivalence i.equivalence)] + (and (bit@= (and (:: n.equivalence = leftN leftN) + (:: i.equivalence = leftI leftI)) + (:: equivalence = [leftN leftI] [leftN leftI])) + (bit@= (and (:: n.equivalence = leftN rightN) + (:: i.equivalence = leftI rightI)) + (:: equivalence = [leftN leftI] [rightN rightI]))))))))) (def: #export (spec (^open "_@.") generator) (All [a] (-> (Equivalence a) (Random a) Test)) - (do r.monad + (do random.monad [left generator right generator] - (<| (_.context (%.name (name-of /.Equivalence))) + (<| (_.with-cover [/.Equivalence]) ($_ _.and (_.test "Reflexivity." (_@= left left)) diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index cde83e09d..741b848cb 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -3,8 +3,8 @@ ["_" test (#+ Test)] [abstract/monad (#+ do)] [control - ["." try] - ["ex" exception] + ["." try (#+ Try)] + ["." exception (#+ exception:)] ["." io (#+ IO io)]] [data [number @@ -12,59 +12,95 @@ [text ["%" format (#+ format)]]] [math - ["r" random]]] + ["." random]]] {1 ["." / (#+ actor: message:) [// - ["." promise ("#;." monad)]]]}) + ["." promise (#+ Promise Resolver) ("#@." monad)]]]}) + +(exception: get-wrecked) (actor: Counter Nat - ((handle message state self) - (do (try.with promise.monad) - [#let [_ (log! "BEFORE")] - output (message state self) - #let [_ (log! "AFTER")]] - (wrap output))) + ((handle [message state self]) + (message state self)) - ((stop cause state) - (promise;wrap (log! (if (ex.match? /.poisoned cause) - (format "Counter was poisoned: " (%.nat state)) - cause))))) + ((stop [cause state]) + (promise@wrap []))) (message: #export Counter (count! {increment Nat} state self Nat) (let [state' (n.+ increment state)] - (promise;wrap (#try.Success [state' state'])))) + (promise@wrap (#try.Success [state' state'])))) (def: #export test Test - (do r.monad - [_ (wrap [])] - (<| (_.context (%.name (name-of /.Actor))) + (do random.monad + [initial-state random.nat] + (<| (_.covering /._) + (_.with-cover [/.Actor]) ($_ _.and - (_.test "Can check if an actor is alive." - (io.run (do io.monad - [counter (new@Counter 0)] - (wrap (/.alive? counter))))) - - (_.test "Can poison actors." - (io.run (do io.monad - [counter (new@Counter 0) - poisoned? (/.poison counter)] - (wrap (and poisoned? - (not (/.alive? counter))))))) - - (_.test "Cannot poison an already dead actor." - (io.run (do io.monad - [counter (new@Counter 0) - first-time (/.poison counter) - second-time (/.poison counter)] - (wrap (and first-time - (not second-time)))))) - - (:: r.monad wrap + (_.cover [/.alive?] + (io.run (do io.monad + [actor (/.spawn /.default-behavior 0)] + (/.alive? actor)))) + + (_.cover [/.poison] + (and (io.run (do io.monad + [actor (/.spawn /.default-behavior 0) + poisoned? (/.poison actor) + alive? (/.alive? actor)] + (wrap (and poisoned? + (not alive?))))) + (io.run (do io.monad + [actor (/.spawn /.default-behavior 0) + first-time? (/.poison actor) + second-time? (/.poison actor)] + (wrap (and first-time? + (not second-time?))))))) + + (let [inc! (: (/.Message Nat) + (function (_ state actor) + (promise@wrap + (#try.Success + (inc state)))))] + (:: random.monad wrap + (do promise.monad + [result (promise.future (do io.monad + [actor (/.spawn /.default-behavior 0) + sent? (/.send inc! actor)] + (wrap (#try.Success sent?))))] + (_.claim [/.Behavior /.Message + /.default-behavior /.spawn /.send] + (case result + (#try.Success outcome) + outcome + + (#try.Failure error) + false))))) + + (let [[read write] (: [(Promise Text) (Resolver Text)] + (promise.promise []))] + (:: random.monad wrap + (do promise.monad + [result (promise.future (do io.monad + [actor (/.spawn {#/.handle (function (_ message state self) + (message state self)) + #/.end (function (_ cause state) + (promise.future (write cause)))} + write) + _ (/.poison actor)] + (io.io (promise.poll read))))] + (_.claim [/.poisoned] + (case result + (#.Some error) + (exception.match? /.poisoned error) + + #.None + false))))) + + (:: random.monad wrap (do promise.monad [result (do (try.with promise.monad) [#let [counter (io.run (new@Counter 0))] @@ -74,11 +110,50 @@ (wrap (and (n.= 1 output-1) (n.= 2 output-2) (n.= 3 output-3))))] - (_.assert "Can send messages to actors." - (case result - (#try.Success outcome) - outcome + (_.claim [/.actor: /.message:] + (case result + (#try.Success outcome) + outcome + + (#try.Failure error) + false)))) + + (:: random.monad wrap + (do promise.monad + [result (do (try.with promise.monad) + [counter (promise.future (do io.monad + [counter (new@Counter 0) + _ (/.poison counter)] + (wrap (#try.Success counter))))] + (count! 1 counter))] + (_.claim [/.dead] + (case result + (#try.Success outcome) + false + + (#try.Failure error) + (exception.match? /.dead error))))) + + (let [die! (: (/.Message Nat) + (function (_ state actor) + (promise@wrap (exception.throw ..get-wrecked []))))] + (:: random.monad wrap + (do promise.monad + [result (promise.future (do io.monad + [actor (/.spawn /.default-behavior initial-state) + sent? (/.send die! actor) + alive? (/.alive? actor) + obituary (/.obituary actor)] + (wrap (#try.Success [actor sent? alive? obituary]))))] + (_.claim [/.Obituary /.obituary] + (case result + (^ (#try.Success [actor sent? alive? (#.Some [error state (list single-pending-message)])])) + (and sent? + (not alive?) + (exception.match? ..get-wrecked error) + (n.= initial-state state) + (is? die! single-pending-message)) - (#try.Failure _) - #0)))) + _ + false))))) )))) diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux index 08c19794d..ef090c1a9 100644 --- a/stdlib/source/test/lux/control/try.lux +++ b/stdlib/source/test/lux/control/try.lux @@ -72,9 +72,9 @@ (_.cover [/.assume] (n.= expected (/.assume (/.succeed expected)))) - (_.cover [/.maybe] - (case [(/.maybe (/.succeed expected)) - (/.maybe (/.fail error))] + (_.cover [/.to-maybe] + (case [(/.to-maybe (/.succeed expected)) + (/.to-maybe (/.fail error))] [(#.Some actual) #.None] (n.= expected actual) diff --git a/stdlib/source/test/lux/control/writer.lux b/stdlib/source/test/lux/control/writer.lux index d33cd3969..09dd2aef5 100644 --- a/stdlib/source/test/lux/control/writer.lux +++ b/stdlib/source/test/lux/control/writer.lux @@ -16,10 +16,10 @@ ["." product] [number ["n" nat]] - ["." text ("#;." equivalence) + ["." text ("#@." equivalence) ["%" format (#+ format)]]] [math - ["r" random]]] + ["." random]]] {1 ["." / (#+ Writer)]}) @@ -34,26 +34,30 @@ (def: #export test Test - (do r.monad - [log (r.ascii 1) - left r.nat - right r.nat] - (<| (_.context (%.name (name-of /.Writer))) + (do random.monad + [log (random.ascii 1) + left random.nat + right random.nat] + (<| (_.covering /._) + (_.with-cover [/.Writer]) ($_ _.and - ($functor.spec (..injection text.monoid) ..comparison /.functor) - ($apply.spec (..injection text.monoid) ..comparison (/.apply text.monoid)) - ($monad.spec (..injection text.monoid) ..comparison (/.monad text.monoid)) + (_.with-cover [/.functor] + ($functor.spec (..injection text.monoid) ..comparison /.functor)) + (_.with-cover [/.apply] + ($apply.spec (..injection text.monoid) ..comparison (/.apply text.monoid))) + (_.with-cover [/.monad] + ($monad.spec (..injection text.monoid) ..comparison (/.monad text.monoid))) - (_.test "Can write any value." - (text;= log - (product.left (/.write log)))) - (let [lift (/.lift text.monoid io.monad) - (^open "io;.") io.monad] - (_.test "Can add writer functionality to any monad." - (|> (io.run (do (/.with text.monoid io.monad) - [a (lift (io;wrap left)) - b (wrap right)] - (wrap (n.+ a b)))) - product.right - (n.= (n.+ left right))))) + (_.cover [/.write] + (text@= log + (product.left (/.write log)))) + (_.cover [/.with /.lift] + (let [lift (/.lift text.monoid io.monad) + (^open "io@.") io.monad] + (|> (io.run (do (/.with text.monoid io.monad) + [a (lift (io@wrap left)) + b (wrap right)] + (wrap (n.+ a b)))) + product.right + (n.= (n.+ left right))))) )))) -- cgit v1.2.3