diff options
| -rw-r--r-- | stdlib/test/test/lux/data/char.lux | 64 | ||||
| -rw-r--r-- | stdlib/test/test/lux/host.lux | 5 | ||||
| -rw-r--r-- | stdlib/test/test/lux/type/check.lux | 40 | ||||
| -rw-r--r-- | stdlib/test/tests.lux | 6 |
4 files changed, 71 insertions, 44 deletions
diff --git a/stdlib/test/test/lux/data/char.lux b/stdlib/test/test/lux/data/char.lux index 025dd4b32..cd3b7e101 100644 --- a/stdlib/test/test/lux/data/char.lux +++ b/stdlib/test/test/lux/data/char.lux @@ -8,41 +8,47 @@ (lux (control [monad]) (codata [io]) (data char - [text]) + [text] + text/format) (math ["R" random]) pipe [host #- try]) lux/test) (test: "Char operations" - [value R;char] - (assert "" (and (:: Eq<Char> = value value) - (|> value code char (:: Eq<Char> = value)) - (|> value - (:: Codec<Text,Char> encode) - (:: Codec<Text,Char> decode) - (case> (#;Right dec-value) - (:: Eq<Char> = value dec-value) + [value R;char + other R;char] + ($_ seq + (assert "Can compare characterss for equality." + (:: Eq<Char> = value value)) - (#;Left _) - false)) - (|> value as-text - (text;at +0) (default (undefined)) - (:: Eq<Char> = value)) - (|> value as-text text;upper-case - (text;at +0) (default (undefined)) - (:: Ord<Char> <= value)) - (|> value as-text text;lower-case - (text;at +0) (default (undefined)) - (:: Ord<Char> >= value)) - ))) + (assert "Can go back-and-forth into numeric codes." + (|> value code char (:: Eq<Char> = value))) -(test: "Special cases" - ($_ seq - (assert "" (space? #" ")) - (assert "" (space? #"\n")) - (assert "" (space? #"\t")) - (assert "" (space? #"\r")) - (assert "" (space? #"\f")) - (assert "" (not (space? #"a"))) + (assert "Can encode/decode as text." + (and (|> value + (:: Codec<Text,Char> encode) + (:: Codec<Text,Char> decode) + (case> (#;Right dec-value) + (:: Eq<Char> = value dec-value) + + (#;Left _) + false)) + (|> value as-text + (text;at +0) (default (undefined)) + (:: Eq<Char> = value)))) + + (assert "Characters have an ordering relationship." + (if (:: Ord<Char> < other value) + (:: Ord<Char> > value other) + (:: Ord<Char> >= other value))) )) + +(test: "Special cases" + (assert "Can test whether a char is white-space." + (and (space? #" ") + (space? #"\n") + (space? #"\t") + (space? #"\r") + (space? #"\f") + (not (space? #"a"))))) diff --git a/stdlib/test/test/lux/host.lux b/stdlib/test/test/lux/host.lux index f15963e1d..41e171eb7 100644 --- a/stdlib/test/test/lux/host.lux +++ b/stdlib/test/test/lux/host.lux @@ -64,7 +64,7 @@ [(assert <message> (or (|> sample <to> <from> (i.= sample)) (let [capped-sample (|> sample <to> <from>)] - (|> capped-sample <to> <from> (i.= sample)))))] + (|> capped-sample <to> <from> (i.= capped-sample)))))] [&;l2b &;b2l "Can succesfully convert to/from byte."] [&;l2s &;s2l "Can succesfully convert to/from short."] @@ -82,7 +82,8 @@ (assert "Can check if an object is of a certain class." (and (&;instance? String "") (not (&;instance? Long "")) - (&;instance? Object (&;null)))) + (&;instance? Object "") + (not (&;instance? Object (&;null))))) (assert "Can run code in a \"synchronized\" block." (&;synchronized "" true)) diff --git a/stdlib/test/test/lux/type/check.lux b/stdlib/test/test/lux/type/check.lux index 273dbad4c..817f40273 100644 --- a/stdlib/test/test/lux/type/check.lux +++ b/stdlib/test/test/lux/type/check.lux @@ -7,7 +7,7 @@ lux (lux (codata [io]) (control monad) - (data [text "Text/" Monoid<Text>] + (data [text "Text/" Monoid<Text> Eq<Text>] text/format [number] maybe @@ -49,6 +49,26 @@ (R;seq gen-ident gen-type) ))))) +(def: (valid-type? type) + (-> Type Bool) + (case type + (#;HostT name params) + (list;every? valid-type? params) + + (^or #;VoidT #;UnitT (#;ExT id)) + true + + (^template [<tag>] + (<tag> left right) + (and (valid-type? left) (valid-type? right))) + ([#;SumT] [#;ProdT] [#;LambdaT]) + + (#;NamedT name type') + (valid-type? type') + + _ + false)) + (def: (type-checks? input) (-> (&;Check []) Bool) (case (&;run &;fresh-context input) @@ -60,12 +80,12 @@ ## [Tests] (test: "Top and Bottom" - [sample gen-type] + [sample (|> gen-type (R;filter valid-type?))] ($_ seq - (assert "Top is the super-type 0f everything." + (assert "Top is the super-type of everything." (&;checks? Top sample)) - (assert "Bottom is the sub-type 0f everything." + (assert "Bottom is the sub-type of everything." (&;checks? sample Bottom)) )) @@ -116,21 +136,21 @@ (test: "Host types" [nameL gen-name - nameR gen-name + nameR (|> gen-name (R;filter (. not (Text/= nameL)))) paramL gen-type - paramR gen-type] + paramR (|> gen-type (R;filter (|>. (&;checks? paramL) not)))] ($_ seq (assert "Host types match when they have the same name and the same parameters." (&;checks? (#;HostT nameL (list paramL)) (#;HostT nameL (list paramL)))) (assert "Names matter to host types." - (&;checks? (#;HostT nameL (list paramL)) - (#;HostT nameR (list paramL)))) + (not (&;checks? (#;HostT nameL (list paramL)) + (#;HostT nameR (list paramL))))) (assert "Parameters matter to host types." - (&;checks? (#;HostT nameL (list paramL)) - (#;HostT nameL (list paramR)))) + (not (&;checks? (#;HostT nameL (list paramL)) + (#;HostT nameL (list paramR))))) )) (test: "Type-vars" diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index c5c7fd934..9e7c1c246 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -21,11 +21,11 @@ ["_;" state] ["_;" cont] (struct ["_;" stream])) - (concurrency [actor] + (concurrency ["_;" actor] ["_;" atom] - [frp] + ["_;" frp] ["_;" promise] - [stm]) + ["_;" stm]) (control [effect]) (data [bit] [bool] |