From 8d9fd8b34f8716be7fa1059eb9761330d9667753 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 9 May 2020 02:12:56 -0400 Subject: Including runtime machinery in the cache. --- stdlib/source/test/lux/abstract/functor.lux | 84 +++++-- stdlib/source/test/lux/control/concatenative.lux | 272 +++++++++++------------ stdlib/source/test/lux/control/try.lux | 9 +- 3 files changed, 211 insertions(+), 154 deletions(-) (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/abstract/functor.lux b/stdlib/source/test/lux/abstract/functor.lux index 388a66ffc..0702f00ef 100644 --- a/stdlib/source/test/lux/abstract/functor.lux +++ b/stdlib/source/test/lux/abstract/functor.lux @@ -2,15 +2,19 @@ [lux #* ["_" test (#+ Test)] ["%" data/text/format (#+ format)] - ["r" math/random] [abstract [equivalence (#+ Equivalence)] [monad (#+ do)]] [control ["." function]] [data + ["." maybe] [number - ["n" nat]]]] + ["n" nat]] + [collection + ["." list]]] + [math + ["." random]]] {1 ["." / (#+ Functor)]}) @@ -24,8 +28,8 @@ (def: (identity injection comparison (^open "/@.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do r.monad - [sample (:: @ map injection r.nat)] + (do random.monad + [sample (:: @ map injection random.nat)] (_.test "Identity." ((comparison n.=) (/@map function.identity sample) @@ -33,9 +37,9 @@ (def: (homomorphism injection comparison (^open "/@.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do r.monad - [sample r.nat - increase (:: @ map n.+ r.nat)] + (do random.monad + [sample random.nat + increase (:: @ map n.+ random.nat)] (_.test "Homomorphism." ((comparison n.=) (/@map increase (injection sample)) @@ -43,10 +47,10 @@ (def: (composition injection comparison (^open "/@.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do r.monad - [sample (:: @ map injection r.nat) - increase (:: @ map n.+ r.nat) - decrease (:: @ map n.- r.nat)] + (do random.monad + [sample (:: @ map injection random.nat) + increase (:: @ map n.+ random.nat) + decrease (:: @ map n.- random.nat)] (_.test "Composition." ((comparison n.=) (|> sample (/@map increase) (/@map decrease)) @@ -54,9 +58,55 @@ (def: #export (spec injection comparison functor) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (_.context (%.name (name-of /.Functor)) - ($_ _.and - (..identity injection comparison functor) - (..homomorphism injection comparison functor) - (..composition injection comparison functor) - ))) + (<| (_.with-cover [/.Functor]) + ($_ _.and + (..identity injection comparison functor) + (..homomorphism injection comparison functor) + (..composition injection comparison functor) + ))) + +(def: #export test + Test + (do random.monad + [left random.nat + right random.nat + shift random.nat] + (<| (_.covering /._) + ($_ _.and + (_.cover [/.Or /.sum] + (and (case (:: (/.sum maybe.functor list.functor) map + (n.+ shift) + (#.Left (#.Some left))) + (#.Left (#.Some actual)) + (n.= (n.+ shift left) actual) + + _ + false) + (case (:: (/.sum maybe.functor list.functor) map + (n.+ shift) + (#.Right (list right))) + (^ (#.Right (list actual))) + (n.= (n.+ shift right) actual) + + _ + false))) + (_.cover [/.And /.product] + (case (:: (/.product maybe.functor list.functor) map + (n.+ shift) + [(#.Some left) (list right)]) + (^ [(#.Some actualL) (list actualR)]) + (and (n.= (n.+ shift left) actualL) + (n.= (n.+ shift right) actualR)) + + _ + false)) + (_.cover [/.Then /.compose] + (case (:: (/.compose maybe.functor list.functor) map + (n.+ shift) + (#.Some (list left))) + (^ (#.Some (list actual))) + (n.= (n.+ shift left) actual) + + _ + false)) + )))) diff --git a/stdlib/source/test/lux/control/concatenative.lux b/stdlib/source/test/lux/control/concatenative.lux index c649128b0..6701916fc 100644 --- a/stdlib/source/test/lux/control/concatenative.lux +++ b/stdlib/source/test/lux/control/concatenative.lux @@ -27,70 +27,70 @@ [sample random.nat dummy random.nat] (`` ($_ _.and - (_.test (%.name (name-of /.push)) - (n.= sample - (||> (/.push sample)))) - (_.test (%.name (name-of /.drop)) - (n.= sample - (||> (/.push sample) - (/.push dummy) - /.drop))) - (_.test (%.name (name-of /.nip)) - (n.= sample - (||> (/.push dummy) - (/.push sample) - /.nip))) - (_.test (%.name (name-of /.dup)) - (||> (/.push sample) - /.dup - /.n/=)) - (_.test (%.name (name-of /.swap)) - (n.= sample - (||> (/.push sample) - (/.push dummy) - /.swap))) - (_.test (%.name (name-of /.rotL)) - (n.= sample - (||> (/.push sample) - (/.push dummy) - (/.push dummy) - /.rotL))) - (_.test (%.name (name-of /.rotR)) - (n.= sample - (||> (/.push dummy) - (/.push sample) - (/.push dummy) - /.rotR))) - (_.test (%.name (name-of /.&&)) - (let [[left right] (||> (/.push sample) - (/.push dummy) - /.&&)] - (and (n.= sample left) - (n.= dummy right)))) + (_.cover [/.push] + (n.= sample + (||> (/.push sample)))) + (_.cover [/.drop] + (n.= sample + (||> (/.push sample) + (/.push dummy) + /.drop))) + (_.cover [/.nip] + (n.= sample + (||> (/.push dummy) + (/.push sample) + /.nip))) + (_.cover [/.dup] + (||> (/.push sample) + /.dup + /.n/=)) + (_.cover [/.swap] + (n.= sample + (||> (/.push sample) + (/.push dummy) + /.swap))) + (_.cover [/.rotL] + (n.= sample + (||> (/.push sample) + (/.push dummy) + (/.push dummy) + /.rotL))) + (_.cover [/.rotR] + (n.= sample + (||> (/.push dummy) + (/.push sample) + (/.push dummy) + /.rotR))) + (_.cover [/.&&] + (let [[left right] (||> (/.push sample) + (/.push dummy) + /.&&)] + (and (n.= sample left) + (n.= dummy right)))) (~~ (template [ ] - [(_.test (%.name (name-of )) - ((sum.equivalence n.= n.=) - ( sample) - (||> (/.push sample) - )))] + [(_.cover [] + ((sum.equivalence n.= n.=) + ( sample) + (||> (/.push sample) + )))] [/.||L #.Left] [/.||R #.Right])) - (_.test (%.name (name-of /.dip)) - (n.= (inc sample) - (||> (/.push sample) - (/.push dummy) - (/.push (/.apply/1 inc)) - /.dip - /.drop))) - (_.test (%.name (name-of /.dip/2)) - (n.= (inc sample) - (||> (/.push sample) - (/.push dummy) - (/.push dummy) - (/.push (/.apply/1 inc)) - /.dip/2 - /.drop /.drop))) + (_.cover [/.dip] + (n.= (inc sample) + (||> (/.push sample) + (/.push dummy) + (/.push (/.apply/1 inc)) + /.dip + /.drop))) + (_.cover [/.dip/2] + (n.= (inc sample) + (||> (/.push sample) + (/.push dummy) + (/.push dummy) + (/.push (/.apply/1 inc)) + /.dip/2 + /.drop /.drop))) )))) (template: (!numerical <=> ) @@ -102,19 +102,19 @@ subject ] (`` ($_ _.and (~~ (template [ ] - [(_.test (%.name (name-of )) - (<=> ( parameter subject) - (||> (/.push subject) - (/.push parameter) - )))] + [(_.cover [] + (<=> ( parameter subject) + (||> (/.push subject) + (/.push parameter) + )))] ')) (~~ (template [ ] - [(_.test (%.name (name-of )) - (bit@= ( parameter subject) - (||> (/.push subject) - (/.push parameter) - )))] + [(_.cover [] + (bit@= ( parameter subject) + (||> (/.push subject) + (/.push parameter) + )))] ')) )))))) @@ -146,67 +146,67 @@ |inc| (/.apply/1 inc) |test| (/.apply/1 (|>> (n.- start) (n.< distance)))]] ($_ _.and - (_.test (%.name (name-of /.call)) - (n.= (inc sample) - (||> (/.push sample) - (/.push (/.apply/1 inc)) - /.call))) - (_.test (%.name (name-of /.if)) - (n.= (if choice - (inc sample) - (dec sample)) - (||> (/.push sample) - (/.push choice) - (/.push (/.apply/1 inc)) - (/.push (/.apply/1 dec)) - /.if))) - (_.test (%.name (name-of /.loop)) - (n.= (n.+ distance start) - (||> (/.push start) - (/.push (|>> |inc| /.dup |test|)) - /.loop))) - (_.test (%.name (name-of /.while)) - (n.= (n.+ distance start) - (||> (/.push start) - (/.push (|>> /.dup |test|)) - (/.push |inc|) - /.while))) - (_.test (%.name (name-of /.do)) - (n.= (inc sample) - (||> (/.push sample) - (/.push (|>> (/.push false))) - (/.push |inc|) - /.do /.while))) - (_.test (%.name (name-of /.compose)) - (n.= (inc (inc sample)) - (||> (/.push sample) - (/.push |inc|) - (/.push |inc|) - /.compose - /.call))) - (_.test (%.name (name-of /.curry)) - (n.= (n.+ sample sample) - (||> (/.push sample) - (/.push sample) - (/.push (/.apply/2 n.+)) - /.curry - /.call))) - (_.test (%.name (name-of /.when)) - (n.= (if choice - (inc sample) - sample) - (||> (/.push sample) - (/.push choice) - (/.push (/.apply/1 inc)) - /.when))) - (_.test (%.name (name-of /.?)) - (n.= (if choice - (inc sample) - (dec sample)) - (||> (/.push choice) - (/.push (inc sample)) - (/.push (dec sample)) - /.?))) + (_.cover [/.call] + (n.= (inc sample) + (||> (/.push sample) + (/.push (/.apply/1 inc)) + /.call))) + (_.cover [/.if] + (n.= (if choice + (inc sample) + (dec sample)) + (||> (/.push sample) + (/.push choice) + (/.push (/.apply/1 inc)) + (/.push (/.apply/1 dec)) + /.if))) + (_.cover [/.loop] + (n.= (n.+ distance start) + (||> (/.push start) + (/.push (|>> |inc| /.dup |test|)) + /.loop))) + (_.cover [/.while] + (n.= (n.+ distance start) + (||> (/.push start) + (/.push (|>> /.dup |test|)) + (/.push |inc|) + /.while))) + (_.cover [/.do] + (n.= (inc sample) + (||> (/.push sample) + (/.push (|>> (/.push false))) + (/.push |inc|) + /.do /.while))) + (_.cover [/.compose] + (n.= (inc (inc sample)) + (||> (/.push sample) + (/.push |inc|) + (/.push |inc|) + /.compose + /.call))) + (_.cover [/.curry] + (n.= (n.+ sample sample) + (||> (/.push sample) + (/.push sample) + (/.push (/.apply/2 n.+)) + /.curry + /.call))) + (_.cover [/.when] + (n.= (if choice + (inc sample) + sample) + (||> (/.push sample) + (/.push choice) + (/.push (/.apply/1 inc)) + /.when))) + (_.cover [/.?] + (n.= (if choice + (inc sample) + (dec sample)) + (||> (/.push choice) + (/.push (inc sample)) + (/.push (dec sample)) + /.?))) ))) (word: square @@ -219,14 +219,14 @@ Test (do random.monad [sample random.nat] - (_.test (%.name (name-of /.word:)) - (n.= (n.* sample sample) - (||> (/.push sample) - ..square))))) + (_.cover [/.word:] + (n.= (n.* sample sample) + (||> (/.push sample) + ..square))))) (def: #export test Test - (<| (_.context (name.module (name-of /._))) + (<| (_.covering /._) ($_ _.and ..stack-shuffling ..numerical diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux index ef090c1a9..997a810ba 100644 --- a/stdlib/source/test/lux/control/try.lux +++ b/stdlib/source/test/lux/control/try.lux @@ -72,6 +72,14 @@ (_.cover [/.assume] (n.= expected (/.assume (/.succeed expected)))) + (_.cover [/.from-maybe] + (case [(/.from-maybe (#.Some expected)) + (/.from-maybe #.None)] + [(#/.Success actual) (#/.Failure _)] + (n.= expected actual) + + _ + false)) (_.cover [/.to-maybe] (case [(/.to-maybe (/.succeed expected)) (/.to-maybe (/.fail error))] @@ -86,7 +94,6 @@ (n.= alternative (/.default alternative (: (Try Nat) (/.fail error)))))) - (_.cover [/.with /.lift] (let [lift (/.lift io.monad)] (|> (do (/.with io.monad) -- cgit v1.2.3