aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/test')
-rw-r--r--new-luxc/test/test/luxc/analyser/lux.lux173
-rw-r--r--new-luxc/test/tests.lux3
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