diff options
Diffstat (limited to 'new-luxc/test')
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/lux.lux | 173 | ||||
| -rw-r--r-- | new-luxc/test/tests.lux | 3 |
2 files changed, 175 insertions, 1 deletions
diff --git a/new-luxc/test/test/luxc/analyser/lux.lux b/new-luxc/test/test/luxc/analyser/lux.lux new file mode 100644 index 000000000..beb26513c --- /dev/null +++ b/new-luxc/test/test/luxc/analyser/lux.lux @@ -0,0 +1,173 @@ +(;module: + lux + (lux [io] + (control monad + pipe) + (data [bool "B/" Eq<Bool>] + [char "C/" Eq<Char>] + [text "T/" Eq<Text>] + (text format + ["l" lexer]) + [number] + ["E" error] + [product] + (coll [list "L/" Functor<List> Fold<List>])) + ["R" math/random "R/" Monad<Random>] + [type "Type/" Eq<Type>] + [macro #+ Monad<Lux>] + (macro [code]) + test) + (luxc ["&" base] + ["&;" env] + ["&;" module] + (lang ["~" analysis]) + [analyser] + (analyser ["@" lux] + ["@;" common]))) + +(def: init-cursor Cursor ["" +0 +0]) + +(def: compiler-version Text "0.6.0") + +(def: init-compiler-info + Compiler-Info + {#;compiler-version compiler-version + #;compiler-mode #;Build}) + +(def: init-type-context + Type-Context + {#;ex-counter +0 + #;var-counter +0 + #;var-bindings (list)}) + +(def: init-compiler + Compiler + {#;info init-compiler-info + #;source [init-cursor ""] + #;cursor init-cursor + #;modules (list) + #;scopes (list) + #;type-context init-type-context + #;expected #;None + #;seed +0 + #;scope-type-vars (list) + #;host (:! Void [])}) + +(test: "Simple primitives" + [%bool% R;bool + %nat% R;nat + %int% R;int + %deg% R;deg + %real% R;real + %char% R;char + %text% (R;text +5)] + (with-expansions + [<primitives> (do-template [<desc> <type> <tag> <value> <analyser>] + [(assert (format "Can analyse " <desc> ".") + (|> (@common;with-unknown-type + (<analyser> init-cursor <value>)) + (macro;run init-compiler) + (case> (#E;Success [[_type _cursor] (<tag> value)]) + (and (Type/= <type> _type) + (is <value> value)) + + _ + false)) + )] + + ["unit" Unit #~;Unit [] (function [cursor value] (@;analyse-unit cursor))] + ["bool" Bool #~;Bool %bool% @;analyse-bool] + ["nat" Nat #~;Nat %nat% @;analyse-nat] + ["int" Int #~;Int %int% @;analyse-int] + ["deg" Deg #~;Deg %deg% @;analyse-deg] + ["real" Real #~;Real %real% @;analyse-real] + ["char" Char #~;Char %char% @;analyse-char] + ["text" Text #~;Text %text% @;analyse-text] + )] + ($_ seq + <primitives>))) + +(def: gen-unit + (R;Random Code) + (R/wrap (' []))) + +(def: gen-simple-primitive + (R;Random [Type Code]) + (with-expansions + [<generators> (do-template [<type> <code-wrapper> <value-gen>] + [(R;seq (R/wrap <type>) (R/map <code-wrapper> <value-gen>))] + + [Unit code;tuple (R;list +0 gen-unit)] + [Bool code;bool R;bool] + [Nat code;nat R;nat] + [Int code;int R;int] + [Deg code;deg R;deg] + [Real code;real R;real] + [Char code;char R;char] + [Text code;text (R;text +5)] + )] + ($_ R;either + <generators> + ))) + +(test: "Tuples" + [size (|> R;nat (:: @ map (|>. (n.% +10) (n.max +2)))) + primitives (R;list size gen-simple-primitive)] + ($_ seq + (let [tuple-type (type;tuple (L/map product;left primitives))] + (assert "Can analyse tuple." + (|> (@common;with-unknown-type + (@;analyse-tuple (analyser;analyse (:!! [])) + init-cursor + (L/map product;right primitives))) + (macro;run init-compiler) + (case> (#E;Success [[_type _cursor] (#~;Tuple elems)]) + (and (Type/= tuple-type _type) + (n.= size (list;size elems)) + (L/fold (function [[pt at] so-far] + (and so-far (Type/= pt at))) + true + (list;zip2 (L/map product;left primitives) + (L/map ~;get-type elems)))) + + _ + false)) + )))) + +(test: "References" + [[ref-type _] gen-simple-primitive + module-name (R;text +5) + scope-name (R;text +5) + var-name (R;text +5)] + ($_ seq + (assert "Can analyse relative reference." + (|> (&env;with-scope scope-name + (&env;with-local [var-name ref-type] + (@common;with-unknown-type + (@;analyse-reference init-cursor ["" var-name])))) + (macro;run init-compiler) + (case> (#E;Success [[_type _cursor] (#~;Relative idx)]) + (Type/= ref-type _type) + + (#E;Error error) + false + + _ + false))) + (assert "Can analyse absolute reference." + (|> (do Monad<Lux> + [_ (&module;create +0 module-name) + _ (&module;define [module-name var-name] + [ref-type (list) (:! Void [])])] + (@common;with-unknown-type + (@;analyse-reference init-cursor [module-name var-name]))) + (macro;run init-compiler) + (case> (#E;Success [[_type _cursor] (#~;Absolute idx)]) + (Type/= ref-type _type) + + (#E;Error error) + false + + _ + false))) + )) diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux index 443ec6757..cbff78c2e 100644 --- a/new-luxc/test/tests.lux +++ b/new-luxc/test/tests.lux @@ -5,7 +5,8 @@ (concurrency [promise]) [cli #+ program:] [test]) - (test (luxc ["_;" parser]))) + (test (luxc ["_;" parser] + (analyser ["_;" lux])))) ## [Program] (program: args |