diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/lux/control/state.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/test/lux/target/ruby.lux | 94 | ||||
| -rw-r--r-- | stdlib/source/test/lux/tool.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/tool/compiler/phase.lux | 206 |
4 files changed, 246 insertions, 59 deletions
diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux index fb5ac42a2..40498c0d8 100644 --- a/stdlib/source/test/lux/control/state.lux +++ b/stdlib/source/test/lux/control/state.lux @@ -68,8 +68,7 @@ (def: structures Test (do random.monad - [state random.nat - value random.nat] + [state random.nat] ($_ _.and (_.for [/.functor] ($functor.spec ..injection (..comparison state) /.functor)) diff --git a/stdlib/source/test/lux/target/ruby.lux b/stdlib/source/test/lux/target/ruby.lux index 61fb1197e..d48e16ecb 100644 --- a/stdlib/source/test/lux/target/ruby.lux +++ b/stdlib/source/test/lux/target/ruby.lux @@ -223,34 +223,25 @@ (/.= /.nil))))) ))) -... (def: test|object -... Test -... (do [! random.monad] -... [expected random.safe_frac -... field (random.ascii/upper 5) -... dummy (random.only (|>> (text#= field) not) -... (random.ascii/upper 5)) - -... size (# ! each (|>> (n.% 10) ++) random.nat) -... index (# ! each (n.% size) random.nat) -... items (random.list size random.safe_frac)] -... ($_ _.and -... (_.cover [/.object /.the] -... (expression (|>> (:as Frac) (f.= expected)) -... (/.the field (/.object (list [field (/.float expected)]))))) -... (let [expected (|> items -... (list.item index) -... (maybe.else f.not_a_number))] -... (_.cover [/.do] -... (expression (|>> (:as Frac) f.int (i.= (.int index))) -... (|> (/.array (list#each /.float items)) -... (/.do "lastIndexOf" (list (/.float expected))))))) -... (_.cover [/.undefined] -... (expression (|>> (:as Bit)) -... (|> (/.object (list [field (/.float expected)])) -... (/.the dummy) -... (/.= /.undefined)))) -... ))) +(def: test|object + Test + (do [! random.monad] + [size (# ! each (|>> (n.% 10) ++) random.nat) + index (# ! each (n.% size) random.nat) + items (random.list size random.safe_frac)] + ($_ _.and + (_.cover [/.the] + (expression (|>> (:as Int) (i.= (.int size))) + (|> (/.array (list#each /.float items)) + (/.the "length")))) + (_.cover [/.do] + (expression (let [expected (|> items + (list.item index) + (maybe.else f.not_a_number))] + (|>> (:as Frac) (f.= expected))) + (|> (/.array (list#each /.float items)) + (/.do "at" (list (/.int (.int index))) {.#None})))) + ))) (def: test|computation Test @@ -270,7 +261,7 @@ ..test|int ..test|array ..test|hash - ... ..test|object + ..test|object (_.cover [/.?] (let [expected (if test then else)] (expression (|>> (:as Frac) (f.= expected)) @@ -539,25 +530,9 @@ (|> ($_ /.then (/.function $self (list $arg/0) (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) - (/.apply/1 $self (/.+ (/.int +1) $arg/0)) + (/.apply/* (list (/.+ (/.int +1) $arg/0)) {.#None} $self) $arg/0))) - (/.return (/.apply/1 $self (/.int +0)))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.apply/1] - (expression (|>> (:as Frac) (f.= float/0)) - (|> ($_ /.then - (/.function $self (list $arg/0) - (/.return $arg/0)) - (/.return (/.apply/1 $self (/.float float/0)))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.apply/2] - (expression (|>> (:as Frac) (f.= ($_ f.+ float/0 float/1))) - (|> ($_ /.then - (/.function $self (list $arg/0 $arg/1) - (/.return ($_ /.+ $arg/0 $arg/1))) - (/.return (/.apply/2 $self (/.float float/0) (/.float float/1)))) + (/.return (/.apply/* (list (/.int +0)) {.#None} $self))) [(list)] (/.lambda {.#None}) (/.apply_lambda/* (list))))) (_.cover [/.apply/*] @@ -568,15 +543,6 @@ (/.return (/.apply/* (list (/.float float/0) (/.float float/1) (/.float float/2)) {.#None} $self))) [(list)] (/.lambda {.#None}) (/.apply_lambda/* (list))))) - ... (_.cover [/.new] - ... (let [$this (/.local "this")] - ... (expression (|>> (:as Frac) (f.= float/0)) - ... (/.apply/1 (/.closure (list $arg/0) - ... ($_ /.then - ... (/.function $class (list) - ... (/.set (/.the field $this) $arg/0)) - ... (/.return (/.the field (/.new $class (list)))))) - ... (/.float float/0))))) ))) (def: test|branching @@ -621,7 +587,9 @@ float/2 random.safe_frac $arg/0 (# ! each /.local (random.ascii/lower 10)) $arg/1 (# ! each /.local (random.ascii/lower 11)) - $arg/2 (# ! each /.local (random.ascii/lower 12))] + $arg/2 (# ! each /.local (random.ascii/lower 12)) + expected (# ! each (|>> %.int (text.replaced "+" "")) + random.int)] ($_ _.and (_.cover [/.statement] (expression (|>> (:as Frac) (f.= float/0)) @@ -637,6 +605,15 @@ (/.return $arg/1)) [(list $arg/0 $arg/1)] (/.lambda {.#None}) (/.apply_lambda/* (list (/.float float/0) (/.float float/1)))))) + (_.cover [/.require/1] + (let [$JSON (/.local "JSON")] + (expression (|>> (:as Text) (text#= expected)) + (|> ($_ /.then + (/.statement (/.require/1 (/.string "json"))) + (/.return (let [json (/.do "parse" (list $arg/0) {.#None} $JSON)] + (/.do "generate" (list json) {.#None} $JSON)))) + [(list $arg/0)] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.string expected))))))) ..test|exception ..test|branching ..test|loop @@ -668,6 +645,9 @@ {.#None} true {.#Some _} false))) (try.else false))) + (_.cover [/.process_id] + (expression (|>> (:as Nat) (n.= 0) not) + /.process_id)) )) (def: random_expression diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index c60d3ba2d..79d25b75e 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -7,6 +7,7 @@ ["[1][0]" arity] ["[1][0]" version] ["[1][0]" reference] + ["[1][0]" phase] [language [lux ... ["[1][0]" syntax] @@ -30,6 +31,7 @@ /arity.test /version.test /reference.test + /phase.test /analysis/primitive.test /analysis/composite.test /analysis/pattern.test diff --git a/stdlib/source/test/lux/tool/compiler/phase.lux b/stdlib/source/test/lux/tool/compiler/phase.lux new file mode 100644 index 000000000..f0137730a --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/phase.lux @@ -0,0 +1,206 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" functor {"+" Injection Comparison}] + ["$[0]" monad]]] + [control + [pipe {"+" case>}] + ["[0]" try ("[1]#[0]" functor)] + ["[0]" exception {"+" exception:}]] + [data + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]]] + [math + ["[0]" random] + [number + ["n" nat] + ["i" int]]]]] + [\\library + ["[0]" / + [// + [meta + ["[0]" archive]]]]]) + +(def: (injection value) + (All (_ s) (Injection (/.Operation s))) + (function (_ state) + {try.#Success [state value]})) + +(def: (comparison init) + (All (_ s) (-> s (Comparison (/.Operation s)))) + (function (_ == left right) + (case [(/.result init left) + (/.result init right)] + [{try.#Success left} + {try.#Success right}] + (== left right) + + _ + false))) + +(exception: oops) + +(def: test|error + Test + (do [! random.monad] + [state random.nat + expected random.int + expected_error (random.ascii/lower 1)] + ($_ _.and + (_.cover [/.failure] + (|> (/.failure expected_error) + (/.result state) + (case> {try.#Failure actual_error} + (same? expected_error actual_error) + + _ + false))) + (_.cover [/.lifted] + (and (|> (/.lifted {try.#Failure expected_error}) + (/.result state) + (case> {try.#Failure actual_error} + (same? expected_error actual_error) + + _ + false)) + (|> (/.lifted {try.#Success expected}) + (# /.functor each (same? expected)) + (/.result state) + (try.else false)))) + (_.cover [/.except] + (|> (/.except ..oops []) + (/.result state) + (case> {try.#Failure error} + (exception.match? ..oops error) + + _ + false))) + (_.cover [/.assertion] + (and (|> (/.assertion ..oops [] false) + (/.result state) + (case> {try.#Failure error} + (exception.match? ..oops error) + + _ + false)) + (|> (/.assertion ..oops [] true) + (/.result state) + (case> {try.#Success _} + true + + _ + false)))) + ))) + +(def: test|state + Test + (do [! random.monad] + [state random.nat + dummy random.nat + expected random.int] + ($_ _.and + (_.cover [/.state] + (|> /.state + (# /.functor each (same? state)) + (/.result state) + (try.else false))) + (_.cover [/.with] + (|> (do /.monad + [_ (/.with state)] + /.state) + (# /.functor each (same? state)) + (/.result dummy) + (try.else false))) + (_.cover [/.sub] + (|> (/.sub [(# n.hex encoded) + (function (_ new old) + (|> new (# n.hex decoded) (try.else dummy)))] + (do /.monad + [state/hex /.state] + (in (|> state + (# n.hex encoded) + (text#= state/hex))))) + (/.result' state) + (case> {try.#Success [state' verdict]} + (and verdict + (n.= state state')) + + _ + false))) + ))) + +(def: test|operation + Test + (do [! random.monad] + [state random.nat + expected random.int] + ($_ _.and + (_.for [/.functor] + ($functor.spec ..injection (..comparison state) /.functor)) + (_.for [/.monad] + ($monad.spec ..injection (..comparison state) /.monad)) + + (_.cover [/.result] + (|> (# /.monad in expected) + (/.result state) + (case> {try.#Success actual} + (same? expected actual) + + _ + false))) + (_.cover [/.result'] + (|> (# /.monad in expected) + (/.result' state) + (case> {try.#Success [state' actual]} + (and (same? state state') + (same? expected actual)) + + _ + false))) + ..test|state + ..test|error + ))) + +(def: test|phase + Test + (do [! random.monad] + [state/0 random.nat + state/1 random.rev + expected random.int] + ($_ _.and + (_.cover [/.identity] + (|> (/.identity archive.empty expected) + (/.result state/0) + (try#each (same? expected)) + (try.else false))) + (_.cover [/.composite] + (let [phase (/.composite (: (/.Phase Nat Int Frac) + (function (_ archive input) + (# /.monad in (i.frac input)))) + (: (/.Phase Rev Frac Text) + (function (_ archive input) + (# /.monad in (%.frac input)))))] + (|> (phase archive.empty expected) + (/.result' [state/0 state/1]) + (case> {try.#Success [[state/0' state/1'] actual]} + (and (text#= (%.frac (i.frac expected)) actual) + (same? state/0 state/0') + (same? state/1 state/1')) + + _ + false)))) + ))) + +(def: .public test + Test + (<| (_.covering /._) + ($_ _.and + (_.for [/.Operation] + ..test|operation) + (_.for [/.Phase] + ..test|phase) + ))) |