From 5b222d040ee361dd4022e88488a6bcef3ca40a71 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 12 Oct 2020 01:04:47 -0400 Subject: Tweaked how I64 masks are made. --- stdlib/source/test/aedifex.lux | 2 + stdlib/source/test/aedifex/parser.lux | 8 +-- stdlib/source/test/aedifex/project.lux | 96 ++++++++++++++++++++++++++ stdlib/source/test/lux/data/number/i64.lux | 18 +++++ stdlib/source/test/lux/data/sum.lux | 107 ++++++++++++++++++++++------- stdlib/source/test/lux/target/jvm.lux | 15 ++-- 6 files changed, 211 insertions(+), 35 deletions(-) create mode 100644 stdlib/source/test/aedifex/project.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index de52e6a9e..48ecc9189 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -8,6 +8,7 @@ ["." / #_ ["#." artifact] ["#." profile] + ["#." project] ["#." cli] ["#." parser]]) @@ -16,6 +17,7 @@ ($_ _.and /artifact.test /profile.test + /project.test /cli.test /parser.test )) diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux index 988883779..a171e694d 100644 --- a/stdlib/source/test/aedifex/parser.lux +++ b/stdlib/source/test/aedifex/parser.lux @@ -73,9 +73,7 @@ (case> (#try.Success actual) (|> expected ..with-default-sources - [//.default] - list - (dictionary.from-list text.hash) + (//project.project //.default) (:: //project.equivalence = actual)) (#try.Failure error) @@ -84,7 +82,7 @@ (def: (with-empty-profile project) (-> Project Project) (if (dictionary.empty? project) - //project.empty + (//project.project //.default (:: //.monoid identity)) project)) (def: multiple-profiles @@ -102,7 +100,7 @@ dictionary.entries (list@map (function (_ [name profile]) [name (..with-default-sources profile)])) - (dictionary.from-list text.hash) + (dictionary.from-list text.hash) (:: //project.equivalence = actual)) (#try.Failure error) diff --git a/stdlib/source/test/aedifex/project.lux b/stdlib/source/test/aedifex/project.lux new file mode 100644 index 000000000..f2c2917a2 --- /dev/null +++ b/stdlib/source/test/aedifex/project.lux @@ -0,0 +1,96 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence] + ["$." monoid]]}] + [control + ["." try ("#@." functor)] + ["." exception]] + [data + ["." product] + ["." text ("#@." equivalence)] + [number + ["n" nat]]] + [math + ["." random (#+ Random) ("#@." monad)]]] + [// + ["@." profile]] + {#program + ["." / + ["/#" // #_ + ["#" profile]]]}) + +(def: profile + (Random [//.Name //.Profile]) + (|> @profile.random + (random@map (set@ #//.parents (list))) + (random.and (random.ascii/alpha 1)))) + +(def: #export random + (Random /.Project) + (do random.monad + [[name profile] ..profile] + (wrap (/.project name profile)))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Project /.project] + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.with-cover [/.monoid] + ($monoid.spec /.equivalence /.monoid ..random)) + + (do random.monad + [[super-name super-profile] ..profile + [dummy-name dummy-profile] (random.filter (|>> product.left (text@= super-name) not) + ..profile) + [sub-name sub-profile] (random.filter (function (_ [name profile]) + (and (not (text@= super-name name)) + (not (text@= dummy-name name)))) + ..profile) + fake-name (random.filter (function (_ name) + (and (not (text@= super-name name)) + (not (text@= dummy-name name)) + (not (text@= sub-name name)))) + (random.ascii/alpha 1)) + #let [project ($_ (:: /.monoid compose) + (/.project super-name super-profile) + (/.project dummy-name dummy-profile) + (/.project sub-name (set@ #//.parents (list super-name) sub-profile))) + circular ($_ (:: /.monoid compose) + (/.project super-name (set@ #//.parents (list sub-name) super-profile)) + (/.project dummy-name dummy-profile) + (/.project sub-name (set@ #//.parents (list super-name) sub-profile)))]] + ($_ _.and + (_.cover [/.profile] + (and (|> (/.profile super-name project) + (try@map (:: //.equivalence = super-profile)) + (try.default false)) + (|> (/.profile dummy-name project) + (try@map (:: //.equivalence = dummy-profile)) + (try.default false)) + (|> (/.profile sub-name project) + (try@map (:: //.equivalence = (:: //.monoid compose sub-profile super-profile))) + (try.default false)))) + (_.cover [/.unknown-profile] + (case (/.profile fake-name project) + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.unknown-profile error))) + (_.cover [/.circular-dependency] + (case (/.profile sub-name circular) + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.circular-dependency error))) + )) + )))) diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux index 390861169..592b5fe41 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/data/number/i64.lux @@ -87,4 +87,22 @@ (if (i.< +0 value) (i.< +0 (/.arithmetic-right-shift idx value)) (i.>= +0 (/.arithmetic-right-shift idx value))))) + (_.cover [/.mask] + (let [mask (/.mask idx) + idempotent? (:: /.equivalence = + (/.and mask pattern) + (/.and mask (/.and mask pattern))) + + limit (inc (.nat mask)) + below-limit? (if (//nat.< limit pattern) + (//nat.= pattern (/.and mask pattern)) + (//nat.< limit (/.and mask pattern))) + + with-empty-mask? (//nat.= 0 (/.and (/.mask 0) pattern)) + with-full-mask? (//nat.= pattern (/.and (/.mask /.width) pattern))] + (and idempotent? + below-limit? + + with-empty-mask? + with-full-mask?))) )))) diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index 7434d7509..972677361 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -1,7 +1,11 @@ (.module: [lux #* ["_" test (#+ Test)] - ["%" data/text/format (#+ format)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] [control pipe] [data @@ -9,33 +13,86 @@ [number ["n" nat]] [collection - ["." list]]]] + ["." list ("#@." functor)]]] + [math + ["." random]]] {1 ["." /]}) (def: #export test Test - (<| (_.context (%.name (name-of .|))) - (let [(^open "list/.") (list.equivalence text.equivalence)] - ($_ _.and - (_.test "Can inject values into Either." - (and (|> (/.left "Hello") (case> (0 #0 "Hello") #1 _ #0)) - (|> (/.right "World") (case> (0 #1 "World") #1 _ #0)))) - (_.test "Can discriminate eithers based on their cases." - (let [[_lefts _rights] (/.partition (: (List (| Text Text)) - (list (0 #0 "0") (0 #1 "1") (0 #0 "2"))))] - (and (list/= _lefts - (/.lefts (: (List (| Text Text)) - (list (0 #0 "0") (0 #1 "1") (0 #0 "2"))))) + (<| (_.covering /._) + (do {@ random.monad} + [expected random.nat + shift random.nat]) + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence n.equivalence) + (random.or random.nat random.nat))) - (list/= _rights - (/.rights (: (List (| Text Text)) - (list (0 #0 "0") (0 #1 "1") (0 #0 "2")))))))) - (_.test "Can apply a function to an Either value depending on the case." - (and (n.= 10 (/.either (function (_ _) 10) - (function (_ _) 20) - (: (| Text Text) (0 #0 "")))) - (n.= 20 (/.either (function (_ _) 10) - (function (_ _) 20) - (: (| Text Text) (0 #1 "")))))) - )))) + (_.cover [/.left] + (|> (/.left expected) + (: (| Nat Nat)) + (case> (0 #0 actual) (n.= expected actual) + _ false))) + (_.cover [/.right] + (|> (/.right expected) + (: (| Nat Nat)) + (case> (0 #1 actual) (n.= expected actual) + _ false))) + (_.cover [/.either] + (and (|> (/.left expected) + (: (| Nat Nat)) + (/.either (n.+ shift) (n.- shift)) + (n.= (n.+ shift expected))) + (|> (/.right expected) + (: (| Nat Nat)) + (/.either (n.+ shift) (n.- shift)) + (n.= (n.- shift expected))))) + (_.cover [/.each] + (and (|> (/.left expected) + (: (| Nat Nat)) + (/.each (n.+ shift) (n.- shift)) + (case> (0 #0 actual) (n.= (n.+ shift expected) actual) _ false)) + (|> (/.right expected) + (: (| Nat Nat)) + (/.each (n.+ shift) (n.- shift)) + (case> (0 #1 actual) (n.= (n.- shift expected) actual) _ false)))) + (do @ + [size (:: @ map (n.% 5) random.nat) + expected (random.list size random.nat)] + ($_ _.and + (_.cover [/.lefts] + (let [actual (: (List (| Nat Nat)) + (list@map /.left expected))] + (and (:: (list.equivalence n.equivalence) = + expected + (/.lefts actual)) + (:: (list.equivalence n.equivalence) = + (list) + (/.rights actual))))) + (_.cover [/.rights] + (let [actual (: (List (| Nat Nat)) + (list@map /.right expected))] + (and (:: (list.equivalence n.equivalence) = + expected + (/.rights actual)) + (:: (list.equivalence n.equivalence) = + (list) + (/.lefts actual))))) + (_.cover [/.partition] + (let [[lefts rights] (|> expected + (list@map (function (_ value) + (if (n.even? value) + (/.left value) + (/.right value)))) + (: (List (| Nat Nat))) + /.partition)] + (and (:: (list.equivalence n.equivalence) = + (list.filter n.even? expected) + lefts) + (:: (list.equivalence n.equivalence) = + (list.filter (|>> n.even? not) expected) + rights)))) + )) + ))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 28ea97944..b9639a82f 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -251,6 +251,11 @@ #random ..$Double::random #literal ..$Double::literal}) +(def: valid-double + (Random java/lang/Double) + (random.filter (|>> (:coerce Frac) f.not-a-number? not) + ..$Double::random)) + (def: $Character (/type.class "java.lang.Character" (list))) (def: $Character::wrap @@ -1192,15 +1197,15 @@ (let [test (!::= java/lang/Double "jvm deq" "jvm double =")] ($_ _.and (_.lift "DSTORE_0/DLOAD_0" - (store-and-load ..$Double::random ..$Double::literal ..$Double::wrap [(function.constant /.dstore-0) (function.constant /.dload-0)] test)) + (store-and-load ..valid-double ..$Double::literal ..$Double::wrap [(function.constant /.dstore-0) (function.constant /.dload-0)] test)) (_.lift "DSTORE_1/DLOAD_1" - (store-and-load ..$Double::random ..$Double::literal ..$Double::wrap [(function.constant /.dstore-1) (function.constant /.dload-1)] test)) + (store-and-load ..valid-double ..$Double::literal ..$Double::wrap [(function.constant /.dstore-1) (function.constant /.dload-1)] test)) (_.lift "DSTORE_2/DLOAD_2" - (store-and-load ..$Double::random ..$Double::literal ..$Double::wrap [(function.constant /.dstore-2) (function.constant /.dload-2)] test)) + (store-and-load ..valid-double ..$Double::literal ..$Double::wrap [(function.constant /.dstore-2) (function.constant /.dload-2)] test)) (_.lift "DSTORE_3/DLOAD_3" - (store-and-load ..$Double::random ..$Double::literal ..$Double::wrap [(function.constant /.dstore-3) (function.constant /.dload-3)] test)) + (store-and-load ..valid-double ..$Double::literal ..$Double::wrap [(function.constant /.dstore-3) (function.constant /.dload-3)] test)) (_.lift "DSTORE/DLOAD" - (store-and-load ..$Double::random ..$Double::literal ..$Double::wrap [/.dstore /.dload] test))))) + (store-and-load ..valid-double ..$Double::literal ..$Double::wrap [/.dstore /.dload] test))))) (<| (_.context "object") (let [test (: (-> java/lang/String Any Bit) (function (_ expected actual) -- cgit v1.2.3