From de673c2adf9fdf848f8fff977a6cddc036cbfa9e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 4 Oct 2020 21:50:52 -0400 Subject: Test to make sure modules cannot import themselves. --- stdlib/source/test/lux/data/bit.lux | 35 +++--- stdlib/source/test/lux/data/color.lux | 231 ++++++++++++++++++++++++---------- 2 files changed, 183 insertions(+), 83 deletions(-) (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/data/bit.lux b/stdlib/source/test/lux/data/bit.lux index 6f281818d..0be42e466 100644 --- a/stdlib/source/test/lux/data/bit.lux +++ b/stdlib/source/test/lux/data/bit.lux @@ -1,8 +1,8 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] - ["r" math/random] + [math + ["." random]] [abstract [monad (#+ do)] {[0 #spec] @@ -17,21 +17,20 @@ (def: #export test Test - (<| (_.context (%.name (name-of .Bit))) - (do r.monad - [value r.bit] + (<| (_.covering /._) + (do random.monad + [value random.bit] ($_ _.and - ($equivalence.spec /.equivalence r.bit) - ($codec.spec /.equivalence /.codec r.bit) - (<| (_.context "Disjunction.") - ($monoid.spec /.equivalence /.disjunction r.bit)) - (<| (_.context "Conjunction.") - ($monoid.spec /.equivalence /.conjunction r.bit)) - (_.test "A value cannot be true and false at the same time." - (not (and value (not value)))) - (_.test "A value must be either true or false at any time." - (or value (not value))) - (_.test "Can create the complement of a predicate." - (and (not (:: /.equivalence = value ((/.complement function.identity) value))) - (:: /.equivalence = value ((/.complement not) value)))) + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence random.bit)) + (_.with-cover [/.disjunction] + ($monoid.spec /.equivalence /.disjunction random.bit)) + (_.with-cover [/.conjunction] + ($monoid.spec /.equivalence /.conjunction random.bit)) + (_.with-cover [/.codec] + ($codec.spec /.equivalence /.codec random.bit)) + + (_.cover [/.complement] + (and (not (:: /.equivalence = value ((/.complement function.identity) value))) + (:: /.equivalence = value ((/.complement not) value)))) )))) diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index a7b5c0088..388b49d93 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -5,41 +5,53 @@ [monad (#+ do)] {[0 #spec] [/ - ["$." equivalence]]}] + ["$." equivalence] + ["$." monoid]]}] [data - ["%" text/format (#+ format)] [number + ["n" nat] ["." int] - ["f" frac]]] + ["f" frac] + ["r" rev]] + [collection + ["." list]]] + [macro + ["." template]] ["." math - ["r" random (#+ Random)]]] + ["." random (#+ Random)]]] {1 - ["." / (#+ Color)]}) + ["." / (#+ Color) + ["." named]]}) (def: #export color (Random Color) - (|> ($_ r.and r.nat r.nat r.nat) - (:: r.monad map /.from-rgb))) + (|> ($_ random.and random.nat random.nat random.nat) + (:: random.monad map /.from-rgb))) (def: scale (-> Nat Frac) (|>> .int int.frac)) (def: square (-> Frac Frac) (math.pow +2.0)) +(def: square-root (-> Frac Frac) (math.pow +0.5)) -(def: (distance from to) +(def: (distance/1 from to) + (-> Frac Frac Frac) + (square-root + (square + (f.- from to)))) + +(def: (distance/3 from to) (-> Color Color Frac) (let [[fr fg fb] (/.to-rgb from) [tr tg tb] (/.to-rgb to)] - (math.pow +0.5 ($_ f.+ - (|> (scale tr) (f.- (scale fr)) square) - (|> (scale tg) (f.- (scale fg)) square) - (|> (scale tb) (f.- (scale fb)) square))))) - -(def: error-margin Frac +1.8) + (square-root + ($_ f.+ + (|> (scale tr) (f.- (scale fr)) square) + (|> (scale tg) (f.- (scale fg)) square) + (|> (scale tb) (f.- (scale fb)) square))))) -(def: black (/.from-rgb [0 0 0])) -(def: white (/.from-rgb [255 255 255])) +(def: rgb-error-margin +1.8) (template [] [(def: ( color) @@ -51,56 +63,145 @@ [luminance] ) +(def: (encoding expected) + (-> /.Color Test) + ($_ _.and + (_.cover [/.RGB /.to-rgb /.from-rgb] + (|> expected /.to-rgb /.from-rgb + (:: /.equivalence = expected))) + (_.cover [/.HSL /.to-hsl /.from-hsl] + (|> expected /.to-hsl /.from-hsl + (distance/3 expected) + (f.<= ..rgb-error-margin))) + (_.cover [/.HSB /.to-hsb /.from-hsb] + (|> expected /.to-hsb /.from-hsb + (distance/3 expected) + (f.<= ..rgb-error-margin))) + (_.cover [/.CMYK /.to-cmyk /.from-cmyk] + (|> expected /.to-cmyk /.from-cmyk + (distance/3 expected) + (f.<= ..rgb-error-margin))) + )) + +(def: transformation + Test + (do random.monad + [colorful (|> ..color + (random.filter (function (_ color) (|> (distance/3 color /.black) (f.>= +100.0)))) + (random.filter (function (_ color) (|> (distance/3 color /.white) (f.>= +100.0))))) + mediocre (|> ..color + (random.filter (|>> saturation + ((function (_ saturation) + (and (f.>= +0.25 saturation) + (f.<= +0.75 saturation))))))) + ratio (|> random.safe-frac (random.filter (f.>= +0.5)))] + ($_ _.and + (_.cover [/.darker /.brighter] + (and (f.<= (distance/3 colorful /.black) + (distance/3 (/.darker ratio colorful) /.black)) + (f.<= (distance/3 colorful /.white) + (distance/3 (/.brighter ratio colorful) /.white)))) + (_.cover [/.interpolate] + (and (f.<= (distance/3 colorful /.black) + (distance/3 (/.interpolate ratio /.black colorful) /.black)) + (f.<= (distance/3 colorful /.white) + (distance/3 (/.interpolate ratio /.white colorful) /.white)))) + (_.cover [/.saturate] + (f.> (saturation mediocre) + (saturation (/.saturate ratio mediocre)))) + (_.cover [/.de-saturate] + (f.< (saturation mediocre) + (saturation (/.de-saturate ratio mediocre)))) + (_.cover [/.gray-scale] + (let [gray'ed (/.gray-scale mediocre)] + (and (f.= +0.0 + (saturation gray'ed)) + (|> (luminance gray'ed) + (f.- (luminance mediocre)) + f.abs + (f.<= ..rgb-error-margin))))) + ))) + +(def: palette + Test + (_.with-cover [/.Spread /.Palette] + (do {@ random.monad} + [eH (:: @ map (|>> f.abs (f.% +0.9) (f.+ +0.05)) + random.safe-frac) + #let [eS +0.5] + variations (:: @ map (|>> (n.% 3) (n.+ 2)) random.nat) + #let [max-spread (f./ (|> variations inc .int int.frac) + +1.0) + min-spread (f./ +2.0 max-spread) + spread-space (f.- min-spread max-spread)] + spread (:: @ map (|>> f.abs (f.% spread-space) (f.+ min-spread)) + random.safe-frac)] + (`` ($_ _.and + (~~ (template [ ] + [(_.cover [] + (let [eB + expected (/.from-hsb [eH eS eB]) + palette ( spread variations expected)] + (and (n.= variations (list.size palette)) + (not (list.any? (:: /.equivalence = expected) palette)))))] + [+1.0 /.analogous] + [+0.5 /.monochromatic] + )) + (~~ (template [] + [(_.cover [] + (let [expected (/.from-hsb [eH eS +0.5]) + [c0 c1 c2] ( expected)] + (and (:: /.equivalence = expected c0) + (not (:: /.equivalence = expected c1)) + (not (:: /.equivalence = expected c2)))))] + + [/.triad] + [/.clash] + [/.split-complement])) + (~~ (template [] + [(_.cover [] + (let [expected (/.from-hsb [eH eS +0.5]) + [c0 c1 c2 c3] ( expected)] + (and (:: /.equivalence = expected c0) + (not (:: /.equivalence = expected c1)) + (not (:: /.equivalence = expected c2)) + (not (:: /.equivalence = expected c3)))))] + + [/.square] + [/.tetradic])) + ))))) + (def: #export test Test - (<| (_.context (%.name (name-of /._))) - (do r.monad - [any ..color - colorful (|> color - (r.filter (function (_ color) (|> (distance color black) (f.>= +100.0)))) - (r.filter (function (_ color) (|> (distance color white) (f.>= +100.0))))) - mediocre (|> color - (r.filter (|>> saturation - ((function (_ saturation) - (and (f.>= +0.25 saturation) - (f.<= +0.75 saturation))))))) - ratio (|> r.safe-frac (r.filter (f.>= +0.5)))] + (<| (_.covering /._) + (_.with-cover [/.Color]) + (do {@ random.monad} + [expected ..color] ($_ _.and - ($equivalence.spec /.equivalence ..color) - (_.test "Can convert to/from HSL." - (|> any /.to-hsl /.from-hsl - (distance any) - (f.<= error-margin))) - (_.test "Can convert to/from HSB." - (|> any /.to-hsb /.from-hsb - (distance any) - (f.<= error-margin))) - (_.test "Can convert to/from CMYK." - (|> any /.to-cmyk /.from-cmyk - (distance any) - (f.<= error-margin))) - (_.test "Can interpolate between 2 colors." - (and (f.<= (distance colorful black) - (distance (/.darker ratio colorful) black)) - (f.<= (distance colorful white) - (distance (/.brighter ratio colorful) white)))) - (_.test "Can calculate complement." - (let [~any (/.complement any) - (^open "/@.") /.equivalence] - (and (not (/@= any ~any)) - (/@= any (/.complement ~any))))) - (_.test "Can saturate color." - (f.> (saturation mediocre) - (saturation (/.saturate ratio mediocre)))) - (_.test "Can de-saturate color." - (f.< (saturation mediocre) - (saturation (/.de-saturate ratio mediocre)))) - (_.test "Can gray-scale color." - (let [gray'ed (/.gray-scale mediocre)] - (and (f.= +0.0 - (saturation gray'ed)) - (|> (luminance gray'ed) - (f.- (luminance mediocre)) - f.abs - (f.<= error-margin))))) + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence ..color)) + (_.with-cover [/.addition] + ($monoid.spec /.equivalence /.addition ..color)) + (_.with-cover [/.subtraction] + ($monoid.spec /.equivalence /.addition ..color)) + + (..encoding expected) + (_.cover [/.complement] + (let [~expected (/.complement expected) + (^open "/@.") /.equivalence] + (and (not (/@= expected ~expected)) + (/@= expected (/.complement ~expected))))) + (_.cover [/.black /.white] + (and (:: /.equivalence = /.white (/.complement /.black)) + (:: /.equivalence = /.black (/.complement /.white)))) + ..transformation + ..palette + (_.with-cover [/.Alpha /.Pigment] + ($_ _.and + (_.cover [/.transparent /.opaque] + (and (r.= /.opaque (dec /.transparent)) + (r.= /.transparent (inc /.opaque)))) + (_.cover [/.translucent] + (r.= /.transparent (r.+ /.translucent /.translucent))) + )) )))) -- cgit v1.2.3