From dd5220e13b03c8f85972feac535a34ef64525222 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 9 May 2017 17:48:27 -0400 Subject: - Added tests for some kinds of analysis. - WIP: Porting more code. --- new-luxc/test/test/luxc/analyser/lux.lux | 173 +++++++++++++++++++++++++++++++ new-luxc/test/tests.lux | 3 +- 2 files changed, 175 insertions(+), 1 deletion(-) create mode 100644 new-luxc/test/test/luxc/analyser/lux.lux (limited to 'new-luxc/test') 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] + [char "C/" Eq] + [text "T/" Eq] + (text format + ["l" lexer]) + [number] + ["E" error] + [product] + (coll [list "L/" Functor Fold])) + ["R" math/random "R/" Monad] + [type "Type/" Eq] + [macro #+ Monad] + (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 + [ (do-template [ ] + [(assert (format "Can analyse " ".") + (|> (@common;with-unknown-type + ( init-cursor )) + (macro;run init-compiler) + (case> (#E;Success [[_type _cursor] ( value)]) + (and (Type/= _type) + (is 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 + ))) + +(def: gen-unit + (R;Random Code) + (R/wrap (' []))) + +(def: gen-simple-primitive + (R;Random [Type Code]) + (with-expansions + [ (do-template [ ] + [(R;seq (R/wrap ) (R/map ))] + + [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 + + ))) + +(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 + [_ (&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 -- cgit v1.2.3