aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--stdlib/test/test/lux/data/char.lux64
-rw-r--r--stdlib/test/test/lux/host.lux5
-rw-r--r--stdlib/test/test/lux/type/check.lux40
-rw-r--r--stdlib/test/tests.lux6
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]