aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/test/test/luxc/analyser/common.lux53
-rw-r--r--new-luxc/test/test/luxc/analyser/lux.lux173
-rw-r--r--new-luxc/test/test/luxc/analyser/primitive.lux61
-rw-r--r--new-luxc/test/test/luxc/analyser/reference.lux49
-rw-r--r--new-luxc/test/test/luxc/analyser/struct.lux39
-rw-r--r--new-luxc/test/tests.lux4
6 files changed, 205 insertions, 174 deletions
diff --git a/new-luxc/test/test/luxc/analyser/common.lux b/new-luxc/test/test/luxc/analyser/common.lux
new file mode 100644
index 000000000..9e3db3513
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/common.lux
@@ -0,0 +1,53 @@
+(;module:
+ lux
+ (lux ["R" math/random "R/" Monad<Random>]
+ (macro [code])))
+
+(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: #export init-compiler
+ Compiler
+ {#;info init-compiler-info
+ #;source [dummy-cursor ""]
+ #;cursor dummy-cursor
+ #;modules (list)
+ #;scopes (list)
+ #;type-context init-type-context
+ #;expected #;None
+ #;seed +0
+ #;scope-type-vars (list)
+ #;host (:! Void [])})
+
+(def: gen-unit
+ (R;Random Code)
+ (R/wrap (' [])))
+
+(def: #export 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>
+ )))
diff --git a/new-luxc/test/test/luxc/analyser/lux.lux b/new-luxc/test/test/luxc/analyser/lux.lux
deleted file mode 100644
index beb26513c..000000000
--- a/new-luxc/test/test/luxc/analyser/lux.lux
+++ /dev/null
@@ -1,173 +0,0 @@
-(;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/test/luxc/analyser/primitive.lux b/new-luxc/test/test/luxc/analyser/primitive.lux
new file mode 100644
index 000000000..321a51fcb
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/primitive.lux
@@ -0,0 +1,61 @@
+(;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 ["@" primitive]
+ ["@;" common]))
+ (.. common))
+
+(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> <value>))
+ (macro;run init-compiler)
+ (case> (#E;Success [_type (<tag> value)])
+ (and (Type/= <type> _type)
+ (is <value> value))
+
+ _
+ false))
+ )]
+
+ ["unit" Unit #~;Unit [] (function [value] @;analyse-unit)]
+ ["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>)))
diff --git a/new-luxc/test/test/luxc/analyser/reference.lux b/new-luxc/test/test/luxc/analyser/reference.lux
new file mode 100644
index 000000000..4e83a7af8
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/reference.lux
@@ -0,0 +1,49 @@
+(;module:
+ lux
+ (lux [io]
+ (control monad
+ pipe)
+ (data ["E" error])
+ ["R" math/random "R/" Monad<Random>]
+ [type "Type/" Eq<Type>]
+ [macro #+ Monad<Lux>]
+ test)
+ (luxc ["&;" env]
+ ["&;" module]
+ (lang ["~" analysis])
+ [analyser]
+ (analyser ["@" reference]
+ ["@;" common]))
+ (.. common))
+
+(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 ["" var-name]))))
+ (macro;run init-compiler)
+ (case> (#E;Success [_type (#~;Relative idx)])
+ (Type/= ref-type _type)
+
+ _
+ 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 [module-name var-name])))
+ (macro;run init-compiler)
+ (case> (#E;Success [_type (#~;Absolute idx)])
+ (Type/= ref-type _type)
+
+ _
+ false)))
+ ))
diff --git a/new-luxc/test/test/luxc/analyser/struct.lux b/new-luxc/test/test/luxc/analyser/struct.lux
new file mode 100644
index 000000000..a86f6da9c
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/struct.lux
@@ -0,0 +1,39 @@
+(;module:
+ lux
+ (lux [io]
+ (control monad
+ pipe)
+ (data ["E" error]
+ [product]
+ (coll [list "L/" Functor<List>]))
+ ["R" math/random "R/" Monad<Random>]
+ [type "Type/" Eq<Type>]
+ [macro #+ Monad<Lux>]
+ test)
+ (luxc ["&" base]
+ (lang ["~" analysis])
+ [analyser]
+ (analyser ["@" struct]
+ ["@;" common]))
+ (.. common))
+
+(def: analyse
+ &;Analyser
+ (analyser;analyser (:!! [])))
+
+(test: "Tuples"
+ [size (|> R;nat (:: @ map (|>. (n.% +10) (n.max +2))))
+ primitives (R;list size gen-simple-primitive)]
+ ($_ seq
+ (assert "Can analyse tuple."
+ (|> (@common;with-unknown-type
+ (@;analyse-tuple analyse (L/map product;right primitives)))
+ (macro;run init-compiler)
+ (case> (#E;Success [_type (#~;Tuple elems)])
+ (and (Type/= (type;tuple (L/map product;left primitives))
+ _type)
+ (n.= size (list;size elems)))
+
+ _
+ false))
+ )))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
index cbff78c2e..a330560fc 100644
--- a/new-luxc/test/tests.lux
+++ b/new-luxc/test/tests.lux
@@ -6,7 +6,9 @@
[cli #+ program:]
[test])
(test (luxc ["_;" parser]
- (analyser ["_;" lux]))))
+ (analyser ["_;" primitive]
+ ["_;" struct]
+ ["_;" reference]))))
## [Program]
(program: args
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-15 13:53:32 +0000