From 33090b088deb20180108e6713309e0dfc627c6e5 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 11 May 2020 23:07:20 -0400 Subject: Now storing and loading extensions in the cache. --- stdlib/source/test/lux/abstract.lux | 6 ++ stdlib/source/test/lux/abstract/monad.lux | 109 ++++++++++++++++++++++-------- stdlib/source/test/lux/abstract/order.lux | 39 ++++++----- 3 files changed, 104 insertions(+), 50 deletions(-) (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux index d927dcd3e..4becb6344 100644 --- a/stdlib/source/test/lux/abstract.lux +++ b/stdlib/source/test/lux/abstract.lux @@ -5,7 +5,10 @@ ["#." codec] ["#." enum] ["#." equivalence] + ["#." fold] + ["#." functor] ["#." interval] + ["#." monad] ["#." order] ["#." predicate]]) @@ -15,7 +18,10 @@ /codec.test /enum.test /equivalence.test + /fold.test + /functor.test /interval.test + /monad.test /order.test /predicate.test )) diff --git a/stdlib/source/test/lux/abstract/monad.lux b/stdlib/source/test/lux/abstract/monad.lux index ecb292afb..4d85a6e90 100644 --- a/stdlib/source/test/lux/abstract/monad.lux +++ b/stdlib/source/test/lux/abstract/monad.lux @@ -1,61 +1,110 @@ (.module: [lux #* [data + ["." identity (#+ Identity)] [number ["n" nat]] - [text - ["%" format (#+ format)]]] - [control - ["." function]] + [collection + ["." list ("#@." functor fold)]]] [math - ["r" random]] + ["." random]] ["_" test (#+ Test)]] {1 ["." / (#+ Monad do)]} [// [functor (#+ Injection Comparison)]]) -(def: (left-identity injection comparison (^open "_;.")) +(def: (left-identity injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) - (do r.monad - [sample r.nat + (do random.monad + [sample random.nat morphism (:: @ map (function (_ diff) - (|>> (n.+ diff) _;wrap)) - r.nat)] + (|>> (n.+ diff) _@wrap)) + random.nat)] (_.test "Left identity." ((comparison n.=) - (|> (injection sample) (_;map morphism) _;join) + (|> (injection sample) (_@map morphism) _@join) (morphism sample))))) -(def: (right-identity injection comparison (^open "_;.")) +(def: (right-identity injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) - (do r.monad - [sample r.nat] + (do random.monad + [sample random.nat] (_.test "Right identity." ((comparison n.=) - (|> (injection sample) (_;map _;wrap) _;join) + (|> (injection sample) (_@map _@wrap) _@join) (injection sample))))) -(def: (associativity injection comparison (^open "_;.")) +(def: (associativity injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) - (do r.monad - [sample r.nat + (do random.monad + [sample random.nat increase (:: @ map (function (_ diff) - (|>> (n.+ diff) _;wrap)) - r.nat) + (|>> (n.+ diff) _@wrap)) + random.nat) decrease (:: @ map (function (_ diff) - (|>> (n.- diff) _;wrap)) - r.nat)] + (|>> (n.- diff) _@wrap)) + random.nat)] (_.test "Associativity." ((comparison n.=) - (|> (injection sample) (_;map increase) _;join (_;map decrease) _;join) - (|> (injection sample) (_;map (|>> increase (_;map decrease) _;join)) _;join))))) + (|> (injection sample) (_@map increase) _@join (_@map decrease) _@join) + (|> (injection sample) (_@map (|>> increase (_@map decrease) _@join)) _@join))))) (def: #export (spec injection comparison monad) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) - (_.context (%.name (name-of /.Monad)) - ($_ _.and - (..left-identity injection comparison monad) - (..right-identity injection comparison monad) - (..associativity injection comparison monad) - ))) + (<| (_.with-cover [/.Monad]) + ($_ _.and + (..left-identity injection comparison monad) + (..right-identity injection comparison monad) + (..associativity injection comparison monad) + ))) + +(def: #export test + Test + (do random.monad + [mono random.nat + poly (random.list 10 random.nat)] + (<| (_.covering /._) + ($_ _.and + (_.cover [/.do] + (n.= (inc mono) + (: (Identity Nat) + (/.do identity.monad + [sample (wrap mono)] + (wrap (inc sample)))))) + (_.cover [/.bind] + (n.= (inc mono) + (: (Identity Nat) + (/.bind identity.monad + (|>> inc (:: identity.monad wrap)) + (:: identity.monad wrap mono))))) + (_.cover [/.seq] + (:: (list.equivalence n.equivalence) = + (list@map inc poly) + (|> poly + (list@map (|>> inc (:: identity.monad wrap))) + (: (List (Identity Nat))) + (/.seq identity.monad) + (: (Identity (List Nat)))))) + (_.cover [/.map] + (:: (list.equivalence n.equivalence) = + (list@map inc poly) + (|> poly + (/.map identity.monad (|>> inc (:: identity.monad wrap))) + (: (Identity (List Nat)))))) + (_.cover [/.filter] + (:: (list.equivalence n.equivalence) = + (list.filter n.even? poly) + (|> poly + (/.filter identity.monad (|>> n.even? (:: identity.monad wrap))) + (: (Identity (List Nat)))))) + (_.cover [/.fold] + (n.= (list@fold n.+ 0 poly) + (|> poly + (/.fold identity.monad + (function (_ part whole) + (:: identity.monad wrap + (n.+ part whole))) + 0) + (: (Identity Nat))))) + )))) diff --git a/stdlib/source/test/lux/abstract/order.lux b/stdlib/source/test/lux/abstract/order.lux index ed64b5d46..a92dd06ad 100644 --- a/stdlib/source/test/lux/abstract/order.lux +++ b/stdlib/source/test/lux/abstract/order.lux @@ -1,43 +1,42 @@ (.module: [lux #* ["_" test (#+ Test)] - [abstract/monad (#+ do)] + [abstract + [monad (#+ do)]] [data - [text - ["%" format (#+ format)]] [number ["n" nat]]] [math - ["r" random (#+ Random)]]] + ["." random (#+ Random)]]] {1 ["." / (#+ Order)]}) (def: #export test Test - (<| (_.context (%.name (name-of /.Order))) - (do r.monad - [left r.nat - right (|> r.nat (r.filter (|>> (n.= left) not)))]) + (<| (_.covering /._) + (do random.monad + [left random.nat + right (|> random.nat (random.filter (|>> (n.= left) not)))]) ($_ _.and - (_.test (format (%.name (name-of /.min)) " &&& " (%.name (name-of /.max))) - (n.< (/.max n.order left right) - (/.min n.order left right))) + (_.cover [/.Choice /.min /.max] + (n.< (/.max n.order left right) + (/.min n.order left right))) ))) -(def: #export (spec (^open ",@.") generator) +(def: #export (spec (^open "/@.") generator) (All [a] (-> (Order a) (Random a) Test)) - (<| (_.context (%.name (name-of /.Order))) - (do r.monad + (<| (_.with-cover [/.Order]) + (do random.monad [parameter generator subject generator]) ($_ _.and (_.test "Values are either ordered, or they are equal. All options are mutually exclusive." - (cond (,@< parameter subject) - (not (or (,@< subject parameter) - (,@= parameter subject))) + (cond (/@< parameter subject) + (not (or (/@< subject parameter) + (/@= parameter subject))) - (,@< subject parameter) - (not (,@= parameter subject)) + (/@< subject parameter) + (not (/@= parameter subject)) ## else - (,@= parameter subject)))))) + (/@= parameter subject)))))) -- cgit v1.2.3