aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux/program.lux42
-rw-r--r--stdlib/source/test/lux/target/jvm.lux4
-rw-r--r--stdlib/source/test/lux/target/ruby.lux146
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux2
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux341
5 files changed, 467 insertions, 68 deletions
diff --git a/stdlib/source/test/lux/program.lux b/stdlib/source/test/lux/program.lux
index 0899dcb64..e78630278 100644
--- a/stdlib/source/test/lux/program.lux
+++ b/stdlib/source/test/lux/program.lux
@@ -1,25 +1,25 @@
(.using
- [library
- [lux "*"
- ["_" test {"+" Test}]
- [abstract
- [monad {"+" do}]]
- [control
- ["[0]" io]
- ["[0]" try]
- ["<>" parser
- ["<[0]>" code]
- ["<[0]>" cli]]]
- [data
- ["[0]" text]
- [collection
- ["[0]" list]]]
- [macro
- [syntax {"+" syntax:}]]
- [math
- ["[0]" random]]]]
- [\\library
- ["[0]" /]])
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ [abstract
+ [monad {"+" do}]]
+ [control
+ ["[0]" io]
+ ["[0]" try]
+ ["<>" parser
+ ["<[0]>" code]
+ ["<[0]>" cli]]]
+ [data
+ ["[0]" text]
+ [collection
+ ["[0]" list]]]
+ [macro
+ [syntax {"+" syntax:}]]
+ [math
+ ["[0]" random]]]]
+ [\\library
+ ["[0]" /]])
(syntax: (actual_program [actual_program (<| <code>.form
(<>.after (<code>.text! "lux def program"))
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 616f3f1f5..b6762f168 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -857,8 +857,8 @@
{.#None}
(/name.internal "java.lang.Object")
(list)
- (list (/field.field /field.static class_field /type.long (sequence.sequence))
- (/field.field /field.public object_field /type.long (sequence.sequence)))
+ (list (/field.field /field.static class_field /type.long false (sequence.sequence))
+ (/field.field /field.public object_field /type.long false (sequence.sequence)))
(list (/method.method /method.private
constructor
constructor::type
diff --git a/stdlib/source/test/lux/target/ruby.lux b/stdlib/source/test/lux/target/ruby.lux
index 5a52dc1b8..281ffe594 100644
--- a/stdlib/source/test/lux/target/ruby.lux
+++ b/stdlib/source/test/lux/target/ruby.lux
@@ -234,6 +234,8 @@
items (random.list size random.safe_frac)
$class (# ! each (|>> %.nat (format "class_") /.local)
random.nat)
+ $sub_class (# ! each (|>> %.nat (format "sub_class_") /.local)
+ random.nat)
$method/0 (# ! each (|>> %.nat (format "method_") /.local)
random.nat)
$method/1 (|> random.nat
@@ -296,6 +298,32 @@
(/.do (/.code $method/1) (list (/.float single)) {.#None}))))
[(list)] (/.lambda {.#None})
(/.apply_lambda/* (list)))))
+ (_.for [/.module]
+ ($_ _.and
+ (_.cover [/.include/1]
+ (expression (|>> (:as Frac) (f.= (f.+ single single)))
+ (|> ($_ /.then
+ (/.set (list $class) (/.module [/.#parameters (list)
+ /.#body double]))
+ (/.set (list $sub_class) (/.class [/.#parameters (list)
+ /.#body (/.statement (/.include/1 $class))]))
+ (/.return (|> $sub_class
+ (/.new (list) {.#None})
+ (/.do (/.code $method/0) (list (/.float single)) {.#None}))))
+ [(list)] (/.lambda {.#None})
+ (/.apply_lambda/* (list)))))
+ (_.cover [/.extend/1]
+ (expression (|>> (:as Frac) (f.= (f.+ single single)))
+ (|> ($_ /.then
+ (/.set (list $class) (/.module [/.#parameters (list)
+ /.#body double]))
+ (/.set (list $sub_class) (/.class [/.#parameters (list)
+ /.#body (/.statement (/.extend/1 $class))]))
+ (/.return (|> $sub_class
+ (/.do (/.code $method/0) (list (/.float single)) {.#None}))))
+ [(list)] (/.lambda {.#None})
+ (/.apply_lambda/* (list)))))
+ ))
)))
(def: test|io
@@ -305,34 +333,67 @@
right (random.ascii/upper 5)
$old (# ! each /.local (random.ascii/upper 1))
$new (# ! each /.local (random.ascii/upper 2))
+ $it (# ! each /.local (random.ascii/upper 3))
.let [expected (format left right)]])
- (_.for [/.stdout])
($_ _.and
- (_.cover [/.print/1]
- (expression (|>> (:as Text) (text#= expected))
- (|> ($_ /.then
- (/.statement (/.require/1 (/.string "stringio")))
- (/.set (list $old) /.stdout)
- (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO")))
- (/.set (list /.stdout) $new)
- (/.statement (/.print/1 (/.string left)))
- (/.statement (/.print/1 (/.string right)))
- (/.set (list /.stdout) $old)
- (/.return (/.the "string" $new)))
- [(list)] (/.lambda {.#None})
- (/.apply_lambda/* (list)))))
- (_.cover [/.print/2]
- (expression (|>> (:as Text) (text#= expected))
- (|> ($_ /.then
- (/.statement (/.require/1 (/.string "stringio")))
- (/.set (list $old) /.stdout)
- (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO")))
- (/.set (list /.stdout) $new)
- (/.statement (/.print/2 (/.string left) (/.string right)))
- (/.set (list /.stdout) $old)
- (/.return (/.the "string" $new)))
- [(list)] (/.lambda {.#None})
- (/.apply_lambda/* (list)))))
+ (_.for [/.stdout]
+ ($_ _.and
+ (_.cover [/.print/1]
+ (expression (|>> (:as Text) (text#= expected))
+ (|> ($_ /.then
+ (/.statement (/.require/1 (/.string "stringio")))
+ (/.set (list $old) /.stdout)
+ (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO")))
+ (/.set (list /.stdout) $new)
+ (/.statement (/.print/1 (/.string left)))
+ (/.statement (/.print/1 (/.string right)))
+ (/.set (list /.stdout) $old)
+ (/.return (/.the "string" $new)))
+ [(list)] (/.lambda {.#None})
+ (/.apply_lambda/* (list)))))
+ (_.cover [/.print/2]
+ (expression (|>> (:as Text) (text#= expected))
+ (|> ($_ /.then
+ (/.statement (/.require/1 (/.string "stringio")))
+ (/.set (list $old) /.stdout)
+ (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO")))
+ (/.set (list /.stdout) $new)
+ (/.statement (/.print/2 (/.string left) (/.string right)))
+ (/.set (list /.stdout) $old)
+ (/.return (/.the "string" $new)))
+ [(list)] (/.lambda {.#None})
+ (/.apply_lambda/* (list)))))
+ ))
+ (_.for [/.stdin]
+ ($_ _.and
+ (_.cover [/.gets/0]
+ (expression (|>> (:as Text) (text#= (format left text.\n)))
+ (|> ($_ /.then
+ (/.statement (/.require/1 (/.string "stringio")))
+ (/.set (list $old) /.stdin)
+ (/.set (list /.stdin) (/.new (list (/.string (format left text.\n))) {.#None}
+ (/.manual "StringIO")))
+ (/.set (list $it) /.gets/0)
+ (/.set (list /.stdin) $old)
+ (/.return $it))
+ [(list)] (/.lambda {.#None})
+ (/.apply_lambda/* (list)))))
+ (_.cover [/.last_string_read]
+ (expression (|>> (:as Text) (text#= (format right text.\n)))
+ (|> ($_ /.then
+ (/.statement (/.require/1 (/.string "stringio")))
+ (/.set (list $old) /.stdin)
+ (/.set (list /.stdin) (/.new (list (/.string (format right text.\n))) {.#None}
+ (/.manual "StringIO")))
+ (/.set (list $it) /.gets/0)
+ (/.set (list /.stdin) $old)
+ (/.return /.last_string_read))
+ [(list)] (/.lambda {.#None})
+ (/.apply_lambda/* (list)))))
+ (_.cover [/.last_line_number_read]
+ (expression (|>> (:as Nat) (n.= 2))
+ /.last_line_number_read))
+ ))
)))
(def: test|computation
@@ -367,18 +428,6 @@
(/.float then))))
)))
-(def: test|expression
- Test
- (do [! random.monad]
- [dummy random.safe_frac
- expected random.safe_frac]
- (`` ($_ _.and
- (_.for [/.Literal]
- ..test|literal)
- (_.for [/.Computation]
- ..test|computation)
- ))))
-
(def: test|global
Test
(do [! random.monad]
@@ -397,11 +446,6 @@
(|>> (:as Text)
(text.ends_with? file)))
/.script_name))
- (_.cover [/.script_name]
- (expression (let [file (format (# file.default separator) packager.main_file)]
- (|>> (:as Text)
- (text.ends_with? file)))
- /.script_name))
(_.cover [/.input_record_separator]
(expression (|>> (:as Text)
(text#= text.\n))
@@ -635,6 +679,20 @@
))
)))
+(def: test|expression
+ Test
+ (do [! random.monad]
+ [dummy random.safe_frac
+ expected random.safe_frac]
+ (`` ($_ _.and
+ (_.for [/.Literal]
+ ..test|literal)
+ (_.for [/.Computation]
+ ..test|computation)
+ (_.for [/.Location]
+ ..test|location)
+ ))))
+
(def: test|label
Test
(do [! random.monad]
@@ -948,8 +1006,6 @@
..test|loop
(_.for [/.Block]
..test|function)
- (_.for [/.Location]
- ..test|location)
)))
(def: random_expression
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux
index f19111e2d..8f6a7b381 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux
@@ -29,6 +29,7 @@
["[1][0]" pattern]
["[1][0]" macro]
["[1][0]" type]
+ ["[1][0]" module]
[////
["[1][0]" reference
["[2][0]" variable]]
@@ -440,4 +441,5 @@
/pattern.test
/macro.test
/type.test
+ /module.test
))))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux
new file mode 100644
index 000000000..ab07c98b3
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux
@@ -0,0 +1,341 @@
+(.using
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ ["[0]" meta]
+ [abstract
+ ["[0]" monad {"+" do}]]
+ [control
+ [pipe {"+" case>}]
+ ["[0]" try ("[1]#[0]" functor)]
+ ["[0]" exception]]
+ [data
+ ["[0]" bit ("[1]#[0]" equivalence)]
+ ["[0]" text ("[1]#[0]" equivalence)]
+ [collection
+ ["[0]" list]
+ ["[0]" set]]]
+ [math
+ ["[0]" random {"+" Random}]
+ [number
+ ["n" nat]]]]]
+ [\\library
+ ["[0]" /
+ ["/[1]" //
+ [//
+ [phase
+ ["[2][0]" extension]]
+ [///
+ ["[2][0]" phase]]]]]])
+
+(def: random_state
+ (Random Lux)
+ (do random.monad
+ [version random.nat
+ host (random.ascii/lower 1)]
+ (in (//.state (//.info version host)))))
+
+(def: primitive
+ (Random Type)
+ (do random.monad
+ [name (random.ascii/lower 1)]
+ (in {.#Primitive name (list)})))
+
+(def: (new? hash it)
+ (-> Nat .Module Bit)
+ (and (same? hash (value@ .#module_hash it))
+ (list.empty? (value@ .#module_aliases it))
+ (list.empty? (value@ .#definitions it))
+ (list.empty? (value@ .#imports it))
+ (case (value@ .#module_state it)
+ {.#Active}
+ true
+
+ _
+ false)))
+
+(def: test|module
+ Test
+ (do [! random.monad]
+ [lux ..random_state
+ .let [state [/extension.#bundle /extension.empty
+ /extension.#state lux]]
+ name (random.ascii/lower 1)
+ hash random.nat
+ expected_import (random.ascii/lower 2)
+ expected_alias (random.ascii/lower 3)]
+ ($_ _.and
+ (_.cover [/.empty]
+ (..new? hash (/.empty hash)))
+ (_.cover [/.create]
+ (|> (do /phase.monad
+ [_ (/.create hash name)]
+ (/extension.lifted (meta.module name)))
+ (/phase.result state)
+ (try#each (..new? hash))
+ (try.else false)))
+ (_.cover [/.exists?]
+ (|> (do /phase.monad
+ [pre (/.exists? name)
+ _ (/.create hash name)
+ post (/.exists? name)]
+ (in (and (not pre) post)))
+ (/phase.result state)
+ (try.else false)))
+ (_.cover [/.with_module]
+ (|> (do /phase.monad
+ [[it _] (/.with_module hash name
+ (in []))]
+ (in it))
+ (/phase.result state)
+ (try#each (..new? hash))
+ (try.else false)))
+ (_.cover [/.import]
+ (`` (and (~~ (template [<expected>]
+ [(|> (do [! /phase.monad]
+ [_ (/.create hash expected_import)
+ [it ?] (/.with_module hash name
+ (do !
+ [_ (if <expected>
+ (/.import expected_import)
+ (in []))]
+ (/extension.lifted
+ (meta.imported? expected_import))))]
+ (in ?))
+ (/phase.result state)
+ (try#each (bit#= <expected>))
+ (try.else false))]
+
+ [false]
+ [true])))))
+ (_.cover [/.alias]
+ (|> (do [! /phase.monad]
+ [_ (/.create hash expected_import)
+ [it _] (/.with_module hash name
+ (do !
+ [_ (/.import expected_import)]
+ (/.alias expected_alias expected_import)))]
+ (in it))
+ (/phase.result state)
+ (try#each (|>> (value@ .#module_aliases)
+ (case> (^ (list [actual_alias actual_import]))
+ (and (same? expected_alias actual_alias)
+ (same? expected_import actual_import))
+
+ _
+ false)))
+ (try.else false)))
+ )))
+
+(def: test|state
+ Test
+ (do [! random.monad]
+ [lux ..random_state
+ .let [state [/extension.#bundle /extension.empty
+ /extension.#state lux]]
+ name (random.ascii/lower 1)
+ hash random.nat]
+ (`` ($_ _.and
+ (~~ (template [<set> <query> <not/0> <not/1>]
+ [(_.cover [<set> <query>]
+ (|> (do [! /phase.monad]
+ [[it ?] (/.with_module hash name
+ (do !
+ [_ (<set> name)
+ ? (<query> name)
+ ~0 (<not/0> name)
+ ~1 (<not/1> name)]
+ (in (and ? (not ~0) (not ~1)))))]
+ (in ?))
+ (/phase.result state)
+ (try.else false)))]
+
+ [/.set_active /.active? /.compiled? /.cached?]
+ [/.set_compiled /.compiled? /.cached? /.active?]
+ [/.set_cached /.cached? /.active? /.compiled?]
+ ))
+ (_.cover [/.can_only_change_state_of_active_module]
+ (and (~~ (template [<pre> <post>]
+ [(|> (/.with_module hash name
+ (do /phase.monad
+ [_ (<pre> name)]
+ (<post> name)))
+ (/phase.result state)
+ (case> {try.#Success _}
+ false
+
+ {try.#Failure error}
+ (text.contains? (value@ exception.#label /.can_only_change_state_of_active_module) error)))]
+
+ [/.set_compiled /.set_active]
+ [/.set_compiled /.set_compiled]
+ [/.set_compiled /.set_cached]
+ [/.set_cached /.set_active]
+ [/.set_cached /.set_compiled]
+ [/.set_cached /.set_cached]
+ ))))
+ (_.cover [/.unknown_module]
+ (and (~~ (template [<set>]
+ [(|> (<set> name)
+ (/phase.result state)
+ (case> {try.#Success _}
+ false
+
+ {try.#Failure error}
+ (text.contains? (value@ exception.#label /.unknown_module) error)))]
+
+ [/.set_active]
+ [/.set_compiled]
+ [/.set_cached]
+ ))))
+ ))))
+
+(def: test|definition
+ Test
+ (do [! random.monad]
+ [lux ..random_state
+ .let [state [/extension.#bundle /extension.empty
+ /extension.#state lux]]
+ module_name (random.ascii/lower 1)
+ hash random.nat
+ def_name (random.ascii/lower 2)
+ alias_name (random.ascii/lower 3)
+
+ public? random.bit
+ def_type ..primitive
+ arity (# ! each (|>> (n.% 10) ++) random.nat)
+ labels|head (random.ascii/lower 1)
+ labels|tail (|> (random.ascii/lower 1)
+ (random.only (|>> (text#= labels|head) not))
+ (random.set text.hash (-- arity))
+ (# ! each set.list))
+ index (# ! each (n.% arity) random.nat)
+ .let [definition {.#Definition [public? def_type []]}
+ alias {.#Alias [module_name def_name]}]]
+ ($_ _.and
+ (_.cover [/.define]
+ (`` (and (~~ (template [<global>]
+ [(|> (/.with_module hash module_name
+ (/.define def_name <global>))
+ (/phase.result state)
+ (case> {try.#Success _} true
+ {try.#Failure _} false))]
+
+ [definition]
+ [{.#Type [public? def_type {.#Left [labels|head labels|tail]}]}]
+ [{.#Type [public? def_type {.#Right [labels|head labels|tail]}]}]
+ [{.#Tag [public? def_type (list& labels|head labels|tail) index]}]
+ [{.#Slot [public? def_type (list& labels|head labels|tail) index]}]))
+ (|> (/.with_module hash module_name
+ (do /phase.monad
+ [_ (/.define def_name definition)]
+ (/.define alias_name alias)))
+ (/phase.result state)
+ (case> {try.#Success _} true
+ {try.#Failure _} false)))))
+ (_.cover [/.cannot_define_more_than_once]
+ (`` (and (~~ (template [<global>]
+ [(|> (/.with_module hash module_name
+ (do /phase.monad
+ [_ (/.define def_name <global>)]
+ (/.define def_name <global>)))
+ (/phase.result state)
+ (case> {try.#Success _} false
+ {try.#Failure _} true))]
+
+ [{.#Definition [public? def_type []]}]
+ [{.#Type [public? def_type {.#Left [labels|head labels|tail]}]}]
+ [{.#Type [public? def_type {.#Right [labels|head labels|tail]}]}]
+ [{.#Tag [public? def_type (list& labels|head labels|tail) index]}]
+ [{.#Slot [public? def_type (list& labels|head labels|tail) index]}]))
+ (|> (/.with_module hash module_name
+ (do /phase.monad
+ [_ (/.define def_name definition)
+ _ (/.define alias_name alias)]
+ (/.define alias_name alias)))
+ (/phase.result state)
+ (case> {try.#Success _} false
+ {try.#Failure _} true)))))
+ )))
+
+(def: test|label
+ Test
+ (do [! random.monad]
+ [lux ..random_state
+ .let [state [/extension.#bundle /extension.empty
+ /extension.#state lux]]
+ module_name (random.ascii/lower 1)
+ hash random.nat
+ def_name (random.ascii/lower 2)
+ foreign_module (random.ascii/lower 3)
+
+ public? random.bit
+ def_type ..primitive
+ arity (# ! each (|>> (n.% 10) ++) random.nat)
+ labels|head (random.ascii/lower 1)
+ labels|tail (|> (random.ascii/lower 1)
+ (random.only (|>> (text#= labels|head) not))
+ (random.set text.hash (-- arity))
+ (# ! each set.list))]
+ ($_ _.and
+ (_.cover [/.declare_labels]
+ (`` (and (~~ (template [<side> <record?> <query> <on_success>]
+ [(|> (/.with_module hash module_name
+ (do [! /phase.monad]
+ [.let [it {.#Named [module_name def_name] def_type}]
+ _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})
+ _ (/.declare_labels <record?> (list& labels|head labels|tail) public? it)]
+ (monad.each ! (|>> [module_name] <query> /extension.lifted)
+ (list& labels|head labels|tail))))
+ (/phase.result state)
+ (case> {try.#Success _} <on_success>
+ {try.#Failure _} (not <on_success>)))]
+
+ [.#Left false meta.tag true]
+ [.#Left false meta.slot false]
+ [.#Right true meta.slot true]
+ [.#Right true meta.tag false])))))
+ (_.cover [/.cannot_declare_labels_for_anonymous_type]
+ (`` (and (~~ (template [<side> <record?>]
+ [(|> (/.with_module hash module_name
+ (do [! /phase.monad]
+ [.let [it def_type]
+ _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})]
+ (/.declare_labels <record?> (list& labels|head labels|tail) public? it)))
+ (/phase.result state)
+ (case> {try.#Success _}
+ false
+
+ {try.#Failure error}
+ (text.contains? (value@ exception.#label /.cannot_declare_labels_for_anonymous_type) error)))]
+
+ [.#Left false]
+ [.#Right true])))))
+ (_.cover [/.cannot_declare_labels_for_foreign_type]
+ (`` (and (~~ (template [<side> <record?>]
+ [(|> (/.with_module hash module_name
+ (do [! /phase.monad]
+ [.let [it {.#Named [foreign_module def_name] def_type}]
+ _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})]
+ (/.declare_labels <record?> (list& labels|head labels|tail) public? it)))
+ (/phase.result state)
+ (case> {try.#Success _}
+ false
+
+ {try.#Failure error}
+ (text.contains? (value@ exception.#label /.cannot_declare_labels_for_foreign_type) error)))]
+
+ [.#Left false]
+ [.#Right true])))))
+ )))
+
+(def: .public test
+ Test
+ (<| (_.covering /._)
+ ($_ _.and
+ ..test|module
+ ..test|state
+ ..test|definition
+ (_.for [/.Label]
+ ..test|label)
+ )))
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-18 11:18:52 +0000