diff options
Diffstat (limited to 'new-luxc/test/test/luxc/lang/analysis/type.lux')
-rw-r--r-- | new-luxc/test/test/luxc/lang/analysis/type.lux | 91 |
1 files changed, 91 insertions, 0 deletions
diff --git a/new-luxc/test/test/luxc/lang/analysis/type.lux b/new-luxc/test/test/luxc/lang/analysis/type.lux new file mode 100644 index 000000000..649c33fef --- /dev/null +++ b/new-luxc/test/test/luxc/lang/analysis/type.lux @@ -0,0 +1,91 @@ +(;module: + lux + (lux [io] + (control [monad #+ do] + pipe) + (data [bool "bool/" Eq<Bool>] + [text "text/" Eq<Text>] + (text format + ["l" lexer]) + [number] + ["e" error] + [product] + (coll [list "list/" Functor<List> Fold<List>])) + ["r" math/random "r/" Monad<Random>] + [meta #+ Monad<Meta>] + (meta [code] + [type "type/" Eq<Type>]) + test) + (luxc ["&" base] + ["&;" module] + (lang ["~" analysis] + (analysis [";A" expression] + ["@" 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." + (<| (times +100) + (do @ + [[typeC codeT exprC] check] + ($_ seq + (test (format "Can analyse type-checking.") + (|> (do Monad<Meta> + [runtime-bytecode @runtime;generate] + (&;with-scope + (@common;with-unknown-type + (@;analyse-check analyse eval;eval typeC exprC)))) + (meta;run (init-compiler [])) + (case> (#e;Success [_ [analysisT analysisA]]) + (and (type/= codeT analysisT) + (case [exprC analysisA] + (^template [<tag> <test>] + [[_ (<tag> expected)] [_ (<tag> actual)]] + (<test> expected actual)) + ([#;Bool bool/=] + [#;Nat n.=] + [#;Int i.=] + [#;Deg d.=] + [#;Frac f.=] + [#;Text text/=]) + + _ + false)) + + (#e;Error error) + false))) + (test (format "Can analyse type-coercion.") + (|> (do Monad<Meta> + [runtime-bytecode @runtime;generate] + (&;with-scope + (@common;with-unknown-type + (@;analyse-coerce analyse eval;eval typeC exprC)))) + (meta;run (init-compiler [])) + (case> (#e;Success [_ [analysisT analysisA]]) + (type/= codeT analysisT) + + (#e;Error error) + false))) + )))) |