aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/test/test/luxc/analyser/common.lux5
-rw-r--r--new-luxc/test/test/luxc/analyser/type.lux89
-rw-r--r--new-luxc/test/test/luxc/generator/structure.lux10
-rw-r--r--new-luxc/test/tests.lux1
4 files changed, 98 insertions, 7 deletions
diff --git a/new-luxc/test/test/luxc/analyser/common.lux b/new-luxc/test/test/luxc/analyser/common.lux
index 6d701e823..60f3eef50 100644
--- a/new-luxc/test/test/luxc/analyser/common.lux
+++ b/new-luxc/test/test/luxc/analyser/common.lux
@@ -6,7 +6,8 @@
[macro]
(macro [code]))
(luxc ["&" base]
- [analyser])
+ [analyser]
+ [eval])
(test/luxc common))
(def: gen-unit
@@ -33,7 +34,7 @@
(def: #export analyse
&;Analyser
- (analyser;analyser (:!! [])))
+ (analyser;analyser eval;eval))
(do-template [<name> <on-success> <on-failure>]
[(def: #export (<name> analysis)
diff --git a/new-luxc/test/test/luxc/analyser/type.lux b/new-luxc/test/test/luxc/analyser/type.lux
new file mode 100644
index 000000000..b23b16d6a
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/type.lux
@@ -0,0 +1,89 @@
+(;module:
+ lux
+ (lux [io]
+ (control [monad #+ do]
+ pipe)
+ (data [bool "bool/" Eq<Bool>]
+ [text "text/" Eq<Text>]
+ (text format
+ ["l" lexer])
+ [number]
+ ["R" result]
+ [product]
+ (coll [list "list/" Functor<List> Fold<List>]))
+ ["r" math/random "r/" Monad<Random>]
+ [type "type/" Eq<Type>]
+ [macro #+ Monad<Lux>]
+ (macro [code])
+ test)
+ (luxc ["&" base]
+ ["&;" module]
+ (lang ["~" analysis])
+ [analyser]
+ (analyser ["@" type]
+ ["@;" common])
+ (generator ["@;" runtime])
+ [eval])
+ (.. common)
+ (test/luxc common))
+
+(def: check
+ (r;Random [Code Type Code])
+ (with-expansions [<triples> (do-template [<random> <type> <code>]
+ [(do r;Monad<Random>
+ [value <random>]
+ (wrap [(` <type>)
+ <type>
+ (<code> value)]))]
+
+ [r;bool (+0 "#Bool" (+0)) code;bool]
+ [r;nat (+0 "#Nat" (+0)) code;nat]
+ [r;int (+0 "#Int" (+0)) code;int]
+ [r;deg (+0 "#Deg" (+0)) code;deg]
+ [r;frac (+0 "#Frac" (+0)) code;frac]
+ [(r;text +5) (+0 "#Text" (+0)) code;text]
+ )]
+ ($_ r;either
+ <triples>)))
+
+(context: "Type checking/coercion."
+ [[typeC codeT exprC] check]
+ ($_ seq
+ (test (format "Can analyse type-checking.")
+ (|> (do Monad<Lux>
+ [runtime-bytecode @runtime;generate]
+ (&;with-scope
+ (@common;with-unknown-type
+ (@;analyse-check analyse eval;eval typeC exprC))))
+ (macro;run (init-compiler []))
+ (case> (#R;Success [_ [analysisT analysisA]])
+ (and (type/= codeT analysisT)
+ (case [exprC analysisA]
+ (^template [<expected> <actual> <test>]
+ [[_ (<expected> expected)] (<actual> actual)]
+ (<test> expected actual))
+ ([#;Bool #~;Bool bool/=]
+ [#;Nat #~;Nat n.=]
+ [#;Int #~;Int i.=]
+ [#;Deg #~;Deg d.=]
+ [#;Frac #~;Frac f.=]
+ [#;Text #~;Text text/=])
+
+ _
+ false))
+
+ (#R;Error error)
+ false)))
+ (test (format "Can analyse type-coercion.")
+ (|> (do Monad<Lux>
+ [runtime-bytecode @runtime;generate]
+ (&;with-scope
+ (@common;with-unknown-type
+ (@;analyse-coerce analyse eval;eval typeC exprC))))
+ (macro;run (init-compiler []))
+ (case> (#R;Success [_ [analysisT analysisA]])
+ (type/= codeT analysisT)
+
+ (#R;Error error)
+ false)))
+ ))
diff --git a/new-luxc/test/test/luxc/generator/structure.lux b/new-luxc/test/test/luxc/generator/structure.lux
index 4652c4bd9..ab0c17ade 100644
--- a/new-luxc/test/test/luxc/generator/structure.lux
+++ b/new-luxc/test/test/luxc/generator/structure.lux
@@ -5,8 +5,8 @@
pipe)
(data text/format
["R" result]
- [bool "B/" Eq<Bool>]
- [text "T/" Eq<Text>]
+ [bool "bool/" Eq<Bool>]
+ [text "text/" Eq<Text>]
(coll ["a" array]
[list]))
["r" math/random "r/" Monad<Random>]
@@ -48,12 +48,12 @@
(#R;Error error)
false))
- ([#ls;Bool Bool B/=]
+ ([#ls;Bool Bool bool/=]
[#ls;Nat Nat n.=]
[#ls;Int Int i.=]
[#ls;Deg Deg d.=]
[#ls;Frac Frac f.=]
- [#ls;Text Text T/=])
+ [#ls;Text Text text/=])
_
false
@@ -92,7 +92,7 @@
(and (n.= tag (|> _tag host;i2l int-to-nat))
(case _last?
(#;Some _last?')
- (and last? (T/= "" (:! Text _last?')))
+ (and last? (text/= "" (:! Text _last?')))
#;None
(not last?))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
index 30fab3878..28ccefc42 100644
--- a/new-luxc/test/tests.lux
+++ b/new-luxc/test/tests.lux
@@ -11,6 +11,7 @@
["_;A" reference]
["_;A" case]
["_;A" function]
+ ["_;A" type]
(procedure ["_;A" common]))
(synthesizer ["_;S" primitive]
["_;S" structure]