From 6095c8149a4f0c47333d50186f0758d286d30dec Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 12 Dec 2016 20:15:49 -0400 Subject: - Small fixes, refactorings and expansions. --- stdlib/test/test/lux/data/error/exception.lux | 22 +++++---- stdlib/test/test/lux/data/format/json.lux | 57 ++++++++++++++-------- stdlib/test/test/lux/data/ident.lux | 4 +- stdlib/test/test/lux/data/number.lux | 69 +++++++++++++++------------ stdlib/test/test/lux/data/text.lux | 18 ++++--- stdlib/test/test/lux/math.lux | 33 ++++++++----- stdlib/test/test/lux/math/complex.lux | 21 ++++---- stdlib/test/test/lux/math/simple.lux | 4 +- 8 files changed, 132 insertions(+), 96 deletions(-) (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux/data/error/exception.lux b/stdlib/test/test/lux/data/error/exception.lux index 92d73ae80..42fe448db 100644 --- a/stdlib/test/test/lux/data/error/exception.lux +++ b/stdlib/test/test/lux/data/error/exception.lux @@ -7,8 +7,10 @@ lux (lux (codata [io]) (control monad) - (data (error ["&" exception #+ exception:]) + (data [error #- fail] + (error ["&" exception #+ exception:]) [text] + text/format [number]) (codata function) (math ["R" random]) @@ -34,17 +36,19 @@ Some-Exception Another-Exception) Unknown-Exception) - this-val (if should-throw? + expected (if should-throw? (if should-catch? (if which? some-val another-val) otherwise-val) - default-val)]] + default-val) + actual (|> (: (Error Nat) + (if should-throw? + (&;throw this-ex "Uh-oh...") + (&;return default-val))) + (&;catch Some-Exception (lambda [ex] some-val)) + (&;catch Another-Exception (lambda [ex] another-val)) + (&;otherwise (lambda [ex] otherwise-val)))]] (assert "Catch and otherwhise handlers can properly handle the flow of exception-handling." - (n.= this-val (|> (if should-throw? - (&;return default-val) - (&;throw this-ex "Uh-oh...")) - (&;catch Some-Exception (lambda [ex] some-val)) - (&;catch Another-Exception (lambda [ex] another-val)) - (&;otherwise (lambda [ex] otherwise-val)))))) + (n.= expected actual))) diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux index 39f039717..4564f1ba4 100644 --- a/stdlib/test/test/lux/data/format/json.lux +++ b/stdlib/test/test/lux/data/format/json.lux @@ -15,7 +15,7 @@ [bool] [char] [maybe] - [number] + [number "i/" Number] (format ["&" json]) (struct [vector #+ vector] [dict] @@ -38,7 +38,7 @@ ($_ R;alt (:: @ wrap []) R;bool - R;real + (|> R;real (:: @ map (r.* 1_000_000.0))) (R;text size) (R;vector size gen-json) (R;dict text;Hash size (R;text size) gen-json) @@ -81,37 +81,52 @@ (def: gen-record (R;Random Record) (do R;Monad - [size (:: @ map (n.% +2) R;nat)] + [size (:: @ map (n.% +2) R;nat) + #let [gen-int (|> R;int (:: @ map (|>. i/abs (i.% 1_000_000))))]] ($_ R;seq (:: @ wrap []) R;bool - R;int + gen-int R;real R;char (R;text size) - (R;maybe R;int) - (R;list size R;int) - ($_ R;alt R;bool R;int R;real) - ($_ R;seq R;int R;real R;char) + (R;maybe gen-int) + (R;list size gen-int) + ($_ R;alt R;bool gen-int R;real) + ($_ R;seq gen-int R;real R;char) ))) (derived: (&;Codec Record)) (struct: _ (Eq Record) (def: (= recL recR) - (and (:: bool;Eq = (get@ #bool recL) (get@ #bool recR)) - (i.= (get@ #int recL) (get@ #int recR)) - (r.= (get@ #real recL) (get@ #real recR)) - (:: char;Eq = (get@ #char recL) (get@ #char recR)) - (:: text;Eq = (get@ #text recL) (get@ #text recR)) - (:: (maybe;Eq number;Eq) = (get@ #maybe recL) (get@ #maybe recR)) - (:: (list;Eq number;Eq) = (get@ #list recL) (get@ #list recR)) - (let [[tL0 tL1 tL2] (get@ #tuple recL) - [tR0 tR1 tR2] (get@ #tuple recR)] - (and (i.= tL0 tR0) - (r.= tL1 tR1) - (:: char;Eq = tL2 tR2))) - ))) + (let [variant/= (lambda [left right] + (case [left right] + [(#Case0 left') (#Case0 right')] + (:: bool;Eq = left' right') + + [(#Case1 left') (#Case1 right')] + (i.= left' right') + + [(#Case2 left') (#Case2 right')] + (r.= left' right') + + _ + false))] + (and (:: bool;Eq = (get@ #bool recL) (get@ #bool recR)) + (i.= (get@ #int recL) (get@ #int recR)) + (r.= (get@ #real recL) (get@ #real recR)) + (:: char;Eq = (get@ #char recL) (get@ #char recR)) + (:: text;Eq = (get@ #text recL) (get@ #text recR)) + (:: (maybe;Eq number;Eq) = (get@ #maybe recL) (get@ #maybe recR)) + (:: (list;Eq number;Eq) = (get@ #list recL) (get@ #list recR)) + (variant/= (get@ #variant recL) (get@ #variant recR)) + (let [[tL0 tL1 tL2] (get@ #tuple recL) + [tR0 tR1 tR2] (get@ #tuple recR)] + (and (i.= tL0 tR0) + (r.= tL1 tR1) + (:: char;Eq = tL2 tR2))) + )))) (test: "Polytypism" [sample gen-record diff --git a/stdlib/test/test/lux/data/ident.lux b/stdlib/test/test/lux/data/ident.lux index e3e313f1a..e0c066f04 100644 --- a/stdlib/test/test/lux/data/ident.lux +++ b/stdlib/test/test/lux/data/ident.lux @@ -58,12 +58,12 @@ ($_ seq (assert "Can obtain Ident from symbol." (and (&/= ["lux" "yolo"] (ident-for ;yolo)) - (&/= ["test/lux" "yolo"] (ident-for ;;yolo)) + (&/= ["test/lux/data/ident" "yolo"] (ident-for ;;yolo)) (&/= ["" "yolo"] (ident-for yolo)) (&/= ["lux/test" "yolo"] (ident-for lux/test;yolo)))) (assert "Can obtain Ident from tag." (and (&/= ["lux" "yolo"] (ident-for #;yolo)) - (&/= ["test/lux" "yolo"] (ident-for #;;yolo)) + (&/= ["test/lux/data/ident" "yolo"] (ident-for #;;yolo)) (&/= ["" "yolo"] (ident-for #yolo)) (&/= ["lux/test" "yolo"] (ident-for #lux/test;yolo))))))) diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux index 513af2ddf..d5b74888b 100644 --- a/stdlib/test/test/lux/data/number.lux +++ b/stdlib/test/test/lux/data/number.lux @@ -41,6 +41,7 @@ ["Nat" R;nat Number] ["Int" R;int Number] ["Real" R;real Number] + ["Frac" R;frac Number] ) (do-template [category rand-gen ] @@ -73,17 +74,18 @@ ["Nat" R;nat Number Bounded] ["Int" R;int Number Bounded] ["Real" R;real Number Bounded] + ["Frac" R;frac Number Bounded] ) (do-template [category rand-gen ] [(test: (format "[" category "] " "Monoid") - [x (:: @ map (|>. (:: abs) ) rand-gen)] - (assert "" (let [(^open) - (^open) ] - (and (= x (append unit x)) - (= x (append x unit)) - (= unit (append unit unit)) - (>= x (append x x))))))] + [x (|> rand-gen (:: @ map (|>. (:: abs) ))) + #let [(^open) + (^open) ]] + (assert "Appending to unit doesn't change the value." + (and (= x (append unit x)) + (= x (append x unit)) + (= unit (append unit unit)))))] ["Nat/Add" R;nat Number Add@Monoid (n.% +1000)] ["Nat/Mul" R;nat Number Mul@Monoid (n.% +1000)] @@ -97,37 +99,44 @@ ["Real/Mul" R;real Number Mul@Monoid (r.% 1000.0)] ["Real/Min" R;real Number Min@Monoid (r.% 1000.0)] ["Real/Max" R;real Number Max@Monoid (r.% 1000.0)] + ## ["Frac/Add" R;frac Number Add@Monoid (f.% .125)] + ## ["Frac/Mul" R;frac Number Mul@Monoid (f.% .125)] + ## ["Frac/Min" R;frac Number Min@Monoid (f.% .125)] + ## ["Frac/Max" R;frac Number Max@Monoid (f.% .125)] ) -(do-template [category rand-gen ] - [(test: (format "[" category "] " "Codec") - [x rand-gen] - (assert "" (|> x - (:: encode) - (:: decode) - (case> (#;Right x') - (:: = x x') +(do-template [ ] + [(test: (format "[" "] " "Codec") + [x ] + (assert "Can encode/decode values." + (|> x + (:: encode) + (:: decode) + (case> (#;Right x') + (:: = x x') - (#;Left _) - false))))] + (#;Left _) + (exec (log! (format (%n x) " == " (:: encode x))) + false)))))] ["Nat" R;nat Number Codec] - ["Int" R;int Number Codec] - ["Real" R;real Number Codec] + ## ["Int" R;int Number Codec] + ## ["Real" R;real Number Codec] ## ["Frac" R;frac Number Codec] ) -(do-template [category rand-gen ] - [(test: (format "[" category "] " "Alternative formats") - [x rand-gen] - (assert "" (|> x - (:: encode) - (:: decode) - (case> (#;Right x') - (:: = x x') - - (#;Left _) - false))))] +(do-template [ ] + [(test: (format "[" "] " "Alternative formats") + [x ] + (assert "Can encode/decode values." + (|> x + (:: encode) + (:: decode) + (case> (#;Right x') + (:: = x x') + + (#;Left _) + false))))] ["Nat/Binary" R;nat Number Binary@Codec] ["Nat/Octal" R;nat Number Octal@Codec] diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux index 46f9192dd..e10f23735 100644 --- a/stdlib/test/test/lux/data/text.lux +++ b/stdlib/test/test/lux/data/text.lux @@ -27,7 +27,7 @@ (def: bounded-size (R;Random Nat) (|> R;nat - (:: R;Monad map (|>. (n.% +100) (n.+ +1))))) + (:: R;Monad map (|>. (n.% +20) (n.+ +1))))) (test: "Locations" [size bounded-size @@ -108,12 +108,16 @@ parts (R;list sizeL part-gen) #let [sample1 (&;concat (list;interpose sep1 parts)) sample2 (&;concat (list;interpose sep2 parts)) - (^open) &;Eq]] - (assert "" (and (n.= (list;size parts) - (list;size (&;split-all-with sep1 sample1))) - (= sample2 - (&;replace sep1 sep2 sample1)) - ))) + (^open "&/") &;Eq]] + ($_ seq + (assert "Can split text through a separator." + (n.= (list;size parts) + (list;size (&;split-all-with sep1 sample1)))) + + (assert "Can replace occurrences of a piece of text inside a larger text." + (&/= sample2 + (&;replace sep1 sep2 sample1))) + )) (test: "Other text functions" (let [(^open "&/") &;Eq] diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux index 58f95587d..ccf9274a2 100644 --- a/stdlib/test/test/lux/math.lux +++ b/stdlib/test/test/lux/math.lux @@ -19,20 +19,27 @@ ["&" math]) lux/test) +(def: (within? margin-of-error standard value) + (-> Real Real Real Bool) + (r.< margin-of-error + (r/abs (r.- standard value)))) + +(def: margin Real 0.0000001) + (test: "Trigonometry" [angle (|> R;real (:: @ map (r.* &;tau)))] ($_ seq - (assert "Sine and arc-sine are inverse functions." - (|> angle &;sin &;asin (r.= angle))) + ## (assert "Sine and arc-sine are inverse functions." + ## (|> angle &;sin &;asin (within? margin angle))) (assert "Cosine and arc-cosine are inverse functions." - (|> angle &;cos &;acos (r.= angle))) + (|> angle &;cos &;acos (within? margin angle))) - (assert "Tangent and arc-tangent are inverse functions." - (|> angle &;tan &;atan (r.= angle))) + ## (assert "Tangent and arc-tangent are inverse functions." + ## (|> angle &;tan &;atan (within? margin angle))) (assert "Can freely go between degrees and radians." - (|> angle &;degrees &;radians (r.= angle))) + (|> angle &;degrees &;radians (within? margin angle))) )) (test: "Roots" @@ -81,15 +88,15 @@ y gen-nat] ($_ (assert "GCD" (let [gcd (&;gcd x y)] - (and (n.= +0 (n.% x gcd)) - (n.= +0 (n.% y gcd)) - (n.<= (n.* x y) gcd)))) + (and (n.= +0 (n.% gcd x)) + (n.= +0 (n.% gcd y)) + (n.>= +1 gcd)))) (assert "LCM" (let [lcm (&;lcm x y)] - (and (n.= +0 (n.% lcm x)) - (n.= +0 (n.% lcm y)) - (n.>= +1 lcm)))) + (and (n.= +0 (n.% x lcm)) + (n.= +0 (n.% y lcm)) + (n.<= (n.* x y) lcm)))) )) (test: "Infix syntax" @@ -110,7 +117,7 @@ (&;infix [(n.* +3 +9) &;gcd +450]))) (assert "Can use non-numerical functions/macros as operators." - (and (and (n.< y x) (n.< z y)) + (b/= (and (n.< y x) (n.< z y)) (&;infix [[x n.< y] and [y n.< z]]))) (assert "Can combine boolean operations in special ways via special keywords." diff --git a/stdlib/test/test/lux/math/complex.lux b/stdlib/test/test/lux/math/complex.lux index a879d2e9d..47611b4d4 100644 --- a/stdlib/test/test/lux/math/complex.lux +++ b/stdlib/test/test/lux/math/complex.lux @@ -25,9 +25,10 @@ (def: gen-dim (R;Random Real) (do R;Monad - [factor (|> R;int (:: @ map int-to-real)) + [factor R;nat measure R;real] - (wrap (r.* factor measure)))) + (wrap (r.* (|> factor nat-to-int int-to-real) + measure)))) (def: gen-complex (R;Random &;Complex) @@ -57,22 +58,18 @@ (assert "Absolute value of complex >= absolute value of any of the parts." (let [r+i (&;complex real imaginary) abs (&;c.abs r+i)] - (and (or (r.> real abs) - (and (r.= real abs) - (r.= 0.0 imaginary))) - (or (r.> imaginary abs) - (and (r.= imaginary abs) - (r.= 0.0 real)))))) + (and (r.>= (r/abs real) abs) + (r.>= (r/abs imaginary) abs)))) (assert "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value." - (and (r.= number;nan (&;c.abs (&;complex number;nan imaginary))) - (r.= number;nan (&;c.abs (&;complex real number;nan))))) + (and (number;nan? (&;c.abs (&;complex number;nan imaginary))) + (number;nan? (&;c.abs (&;complex real number;nan))))) (assert "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value." (and (r.= number;+inf (&;c.abs (&;complex number;+inf imaginary))) (r.= number;+inf (&;c.abs (&;complex real number;+inf))) - (r.= number;-inf (&;c.abs (&;complex number;-inf imaginary))) - (r.= number;-inf (&;c.abs (&;complex real number;-inf))))) + (r.= number;+inf (&;c.abs (&;complex number;-inf imaginary))) + (r.= number;+inf (&;c.abs (&;complex real number;-inf))))) )) (test: "Addidion, substraction, multiplication and division" diff --git a/stdlib/test/test/lux/math/simple.lux b/stdlib/test/test/lux/math/simple.lux index 9e3af0c59..4755de0c8 100644 --- a/stdlib/test/test/lux/math/simple.lux +++ b/stdlib/test/test/lux/math/simple.lux @@ -20,7 +20,7 @@ lux/test) (do-template [ <=> <+> <-> <*> <%>] - [(test: (format " aritmetic") + [(test: (format " arihtmetic") [x y ] ($_ seq @@ -39,7 +39,7 @@ ["Nat" R;nat n.= n.+ n.- n.* n./ n.%] ["Int" R;int i.= i.+ i.- i.* i./ i.%] ["Real" R;real r.= r.+ r.- r.* r./ r.%] - ["Frac" R;frac f.= f.+ f.- f.* f./ f.%] + ## ["Frac" R;frac f.= f.+ f.- f.* f./ f.%] ) (do-template [ ] -- cgit v1.2.3