diff options
Diffstat (limited to 'stdlib/source/test/lux/meta/compiler/target')
| -rw-r--r-- | stdlib/source/test/lux/meta/compiler/target/js.lux | 848 | ||||
| -rw-r--r-- | stdlib/source/test/lux/meta/compiler/target/jvm.lux | 1759 | ||||
| -rw-r--r-- | stdlib/source/test/lux/meta/compiler/target/lua.lux | 725 | ||||
| -rw-r--r-- | stdlib/source/test/lux/meta/compiler/target/python.lux | 844 | ||||
| -rw-r--r-- | stdlib/source/test/lux/meta/compiler/target/ruby.lux | 1062 |
5 files changed, 5238 insertions, 0 deletions
diff --git a/stdlib/source/test/lux/meta/compiler/target/js.lux b/stdlib/source/test/lux/meta/compiler/target/js.lux new file mode 100644 index 000000000..2ad2b03ad --- /dev/null +++ b/stdlib/source/test/lux/meta/compiler/target/js.lux @@ -0,0 +1,848 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["[0]" pipe] + ["[0]" maybe (.use "[1]#[0]" functor)] + ["[0]" try (.only Try) (.use "[1]#[0]" functor)] + ["[0]" function (.only) + ["[0]" predicate]]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.only \n) (.use "[1]#[0]" equivalence) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor)]]] + [math + ["[0]" random (.only Random) (.use "[1]#[0]" monad)] + [number + ["n" nat] + ["i" int] + ["f" frac] + ["[0]" i64]]] + [meta + ["[0]" static] + [macro + ["[0]" template]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(def (eval code) + (-> /.Expression (Try (Maybe Any))) + ... Note: I have to call "eval" this way + ... in order to avoid a quirk of calling eval in Node + ... when the code is running under "use strict";. + (try (let [return (.js_apply# (function.identity (.js_constant# "eval")) [(/.code code)])] + (if (.js_object_null?# return) + {.#None} + {.#Some return})))) + +(def (expression ??? it) + (-> (-> Any Bit) /.Expression Bit) + (|> it + ..eval + (try#each (|>> (maybe#each ???) + (maybe.else false))) + (try.else false))) + +(with_template [<range>] + [(`` (def (,, (template.symbol ["as_int_" <range>])) + (-> Int Int) + (|>> (i64.and (static.nat (-- (i64.left_shifted <range> 1))))))) + (`` (def (,, (template.symbol ["int_" <range>])) + (Random Int) + (do [! random.monad] + [negative? random.bit + mantissa (of ! each (|>> (i64.and (static.nat (-- (i64.left_shifted (-- <range>) 1)))) + .int) + random.nat)] + (in (if negative? + (i.* -1 mantissa) + mantissa)))))] + + [16] + [32] + ) + +(def test|literal + Test + (do [! random.monad] + [boolean random.bit + number random.frac + int ..int_32 + string (random.upper_cased 5)] + (all _.and + (_.coverage [/.null] + (|> /.null + ..eval + (try#each (function (_ it) + (when it + {.#None} true + {.#Some _} false))) + (try.else false))) + (_.coverage [/.boolean] + (expression (|>> (as Bit) (bit#= boolean)) + (/.boolean boolean))) + (_.coverage [/.number] + (expression (|>> (as Frac) (f.= number)) + (/.number number))) + (_.coverage [/.int] + (expression (|>> (as Frac) f.int (i.= int)) + (/.int int))) + (_.coverage [/.string] + (expression (|>> (as Text) (text#= string)) + (/.string string))) + ))) + +(def test|boolean + Test + (do [! random.monad] + [left random.bit + right random.bit] + (`` (all _.and + (,, (with_template [<js> <lux>] + [(_.coverage [<js>] + (let [expected (<lux> left right)] + (expression (|>> (as Bit) (bit#= expected)) + (<js> (/.boolean left) (/.boolean right)))))] + + [/.or .or] + [/.and .and] + )) + (_.coverage [/.not] + (expression (|>> (as Bit) (bit#= (not left))) + (/.not (/.boolean left)))) + )))) + +(def test|number + Test + (do [! random.monad] + [parameter (random.only (|>> (f.= +0.0) not) + random.safe_frac) + subject random.safe_frac] + (`` (all _.and + (,, (with_template [<js> <lux>] + [(_.coverage [<js>] + (let [expected (<lux> parameter subject)] + (expression (|>> (as Frac) (f.= expected)) + (<js> (/.number parameter) (/.number subject)))))] + + [/.+ f.+] + [/.- f.-] + [/.* f.*] + [/./ f./] + [/.% f.%] + )) + (,, (with_template [<js> <lux>] + [(_.coverage [<js>] + (let [expected (<lux> parameter subject)] + (expression (|>> (as Bit) (bit#= expected)) + (<js> (/.number parameter) (/.number subject)))))] + + [/.< f.<] + [/.<= f.<=] + [/.> f.>] + [/.>= f.>=] + [/.= f.=] + )) + )))) + +(def test|i32 + Test + (do [! random.monad] + [left ..int_32 + right ..int_32 + + i32 ..int_32 + i16 ..int_16 + shift (of ! each (n.% 16) random.nat)] + (`` (all _.and + (,, (with_template [<js> <lux>] + [(_.coverage [<js>] + (let [expected (<lux> left right)] + (expression (|>> (as Frac) f.int (i.= expected)) + (<js> (/.int left) (/.int right)))))] + + [/.bit_or i64.or] + [/.bit_xor i64.xor] + [/.bit_and i64.and] + )) + (_.coverage [/.opposite] + (expression (|>> (as Frac) f.int (i.= (i.* -1 i32))) + (/.opposite (/.i32 i32)))) + + (_.coverage [/.i32] + (expression (|>> (as Frac) f.int (i.= i32)) + (/.i32 i32))) + (_.coverage [/.to_i32] + (expression (|>> (as Frac) f.int (i.= i32)) + (/.to_i32 (/.int i32)))) + (_.coverage [/.left_shift] + (let [expected (i64.left_shifted shift i16)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.left_shift (/.int (.int shift)) + (/.i32 i16))))) + (_.coverage [/.logic_right_shift] + (let [expected (i64.right_shifted shift (as_int_32 i16))] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.logic_right_shift (/.int (.int shift)) + (/.i32 i16))))) + (_.coverage [/.arithmetic_right_shift] + (let [expected (i.right_shifted shift i16)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.arithmetic_right_shift (/.int (.int shift)) + (/.i32 i16))))) + (_.coverage [/.bit_not] + (let [expected (if (i.< +0 i32) + (as_int_32 (i64.not i32)) + (i64.not (as_int_32 i32)))] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.bit_not (/.i32 i32))))) + )))) + +(def test|array + Test + (do [! random.monad] + [size (of ! each (|>> (n.% 10) ++) random.nat) + index (of ! each (n.% size) random.nat) + items (random.list size random.safe_frac) + .let [expected (|> items + (list.item index) + (maybe.else f.not_a_number))]] + (all _.and + (_.coverage [/.array /.at] + (and (expression (|>> (as Frac) (f.= expected)) + (/.at (/.int (.int index)) + (/.array (list#each /.number items)))) + (expression (|>> (as Bit)) + (|> (/.array (list#each /.number items)) + (/.at (/.int (.int size))) + (/.= /.undefined))))) + ))) + +(def test|object + Test + (do [! random.monad] + [expected random.safe_frac + field (random.upper_cased 5) + dummy (random.only (|>> (text#= field) not) + (random.upper_cased 5)) + + size (of ! each (|>> (n.% 10) ++) random.nat) + index (of ! each (n.% size) random.nat) + items (random.list size random.safe_frac)] + (all _.and + (_.coverage [/.object /.the] + (expression (|>> (as Frac) (f.= expected)) + (/.the field (/.object (list [field (/.number expected)]))))) + (let [expected (|> items + (list.item index) + (maybe.else f.not_a_number))] + (_.coverage [/.do] + (expression (|>> (as Frac) f.int (i.= (.int index))) + (|> (/.array (list#each /.number items)) + (/.do "lastIndexOf" (list (/.number expected))))))) + (_.coverage [/.undefined] + (expression (|>> (as Bit)) + (|> (/.object (list [field (/.number expected)])) + (/.the dummy) + (/.= /.undefined)))) + ))) + +(def test|computation + Test + (do [! random.monad] + [test random.bit + then random.safe_frac + else random.safe_frac + + boolean random.bit + number random.frac + string (random.upper_cased 5) + + comment (random.upper_cased 10)] + (all _.and + ..test|boolean + ..test|number + ..test|i32 + ..test|array + ..test|object + (_.coverage [/.?] + (let [expected (if test then else)] + (expression (|>> (as Frac) (f.= expected)) + (/.? (/.boolean test) + (/.number then) + (/.number else))))) + (_.coverage [/.not_a_number?] + (and (expression (|>> (as Bit)) + (/.not_a_number? (/.number f.not_a_number))) + (expression (|>> (as Bit) not) + (/.not_a_number? (/.number then))))) + (_.coverage [/.type_of] + (and (expression (|>> (as Text) (text#= "boolean")) + (/.type_of (/.boolean boolean))) + (expression (|>> (as Text) (text#= "number")) + (/.type_of (/.number number))) + (expression (|>> (as Text) (text#= "string")) + (/.type_of (/.string string))) + (expression (|>> (as Text) (text#= "object")) + (/.type_of /.null)) + (expression (|>> (as Text) (text#= "object")) + (/.type_of (/.object (list [string (/.number number)])))) + (expression (|>> (as Text) (text#= "object")) + (/.type_of (/.array (list (/.boolean boolean) + (/.number number) + (/.string string))))) + (expression (|>> (as Text) (text#= "undefined")) + (/.type_of /.undefined)))) + (_.coverage [/.comment] + (expression (|>> (as Frac) (f.= then)) + (/.comment comment + (/.number then)))) + ))) + +(def test|expression + Test + (do [! random.monad] + [dummy random.safe_frac + expected random.safe_frac] + (`` (all _.and + (_.for [/.Literal] + ..test|literal) + (_.for [/.Computation] + ..test|computation) + (_.coverage [/.,] + (expression (|>> (as Frac) (f.= expected)) + (/., (/.number dummy) (/.number expected)))) + )))) + +(def test/var + Test + (do [! random.monad] + [number/0 random.safe_frac + number/1 random.safe_frac + number/2 random.safe_frac + foreign (random.lower_cased 10) + local (random.only (|>> (text#= foreign) not) + (random.lower_cased 10)) + .let [$foreign (/.var foreign) + $local (/.var local)]] + (all _.and + (_.coverage [/.var] + (expression (|>> (as Frac) (f.= number/0)) + (/.apply (/.closure (list $foreign) (/.return $foreign)) + (list (/.number number/0))))) + (_.coverage [/.define] + (expression (|>> (as Frac) (f.= number/1)) + (/.apply (/.closure (list $foreign) + (all /.then + (/.define $local (/.number number/1)) + (/.return $local))) + (list (/.number number/0))))) + (_.coverage [/.declare] + (expression (|>> (as Frac) (f.= number/1)) + (/.apply (/.closure (list $foreign) + (all /.then + (/.declare $local) + (/.statement (/.set $local (/.number number/1))) + (/.return $local))) + (list (/.number number/0))))) + ))) + +(def test/location + Test + (do [! random.monad] + [number/0 random.safe_frac + int/0 ..int_16 + $foreign (of ! each /.var (random.lower_cased 10)) + field (random.upper_cased 10)] + (all _.and + (_.coverage [/.set] + (and (expression (|>> (as Frac) (f.= (f.+ number/0 number/0))) + (/.apply (/.closure (list $foreign) + (all /.then + (/.statement (/.set $foreign (/.+ $foreign $foreign))) + (/.return $foreign))) + (list (/.number number/0)))) + (expression (|>> (as Frac) (f.= (f.+ number/0 number/0))) + (let [@ (/.at (/.int +0) $foreign)] + (/.apply (/.closure (list $foreign) + (all /.then + (/.statement (/.set $foreign (/.array (list $foreign)))) + (/.statement (/.set @ (/.+ @ @))) + (/.return @))) + (list (/.number number/0))))) + (expression (|>> (as Frac) (f.= (f.+ number/0 number/0))) + (let [@ (/.the field $foreign)] + (/.apply (/.closure (list $foreign) + (all /.then + (/.statement (/.set $foreign (/.object (list [field $foreign])))) + (/.statement (/.set @ (/.+ @ @))) + (/.return @))) + (list (/.number number/0))))))) + (_.coverage [/.delete] + (and (and (expression (|>> (as Bit)) + (/.apply (/.closure (list) + (all /.then + (/.statement (/.set $foreign (/.number number/0))) + (/.return (/.delete $foreign)))) + (list))) + (expression (|>> (as Bit) not) + (/.apply (/.closure (list $foreign) + (/.return (/.delete $foreign))) + (list (/.number number/0))))) + (expression (|>> (as Bit)) + (let [@ (/.at (/.int +0) $foreign)] + (/.apply (/.closure (list $foreign) + (all /.then + (/.statement (/.set $foreign (/.array (list $foreign)))) + (/.return (|> (/.= (/.boolean true) (/.delete @)) + (/.and (/.= /.undefined @)))))) + (list (/.number number/0))))) + (expression (|>> (as Bit)) + (let [@ (/.the field $foreign)] + (/.apply (/.closure (list $foreign) + (all /.then + (/.statement (/.set $foreign (/.object (list [field $foreign])))) + (/.return (|> (/.= (/.boolean true) (/.delete @)) + (/.and (/.= /.undefined @)))))) + (list (/.number number/0))))) + )) + (_.coverage [/.Access] + (`` (and (,, (with_template [<js> <lux>] + [(expression (|>> (as Frac) f.int (i.= (<lux> int/0))) + (/.apply (/.closure (list $foreign) + (all /.then + (/.statement (<js> $foreign)) + (/.return $foreign))) + (list (/.int int/0)))) + (expression (|>> (as Frac) f.int (i.= (<lux> int/0))) + (let [@ (/.at (/.int +0) $foreign)] + (/.apply (/.closure (list $foreign) + (all /.then + (/.statement (/.set $foreign (/.array (list $foreign)))) + (/.statement (<js> @)) + (/.return @))) + (list (/.int int/0))))) + (expression (|>> (as Frac) f.int (i.= (<lux> int/0))) + (let [@ (/.the field $foreign)] + (/.apply (/.closure (list $foreign) + (all /.then + (/.statement (/.set $foreign (/.object (list [field $foreign])))) + (/.statement (<js> @)) + (/.return @))) + (list (/.int int/0)))))] + + [/.++ .++] + [/.-- .--] + ))))) + (_.for [/.Var] + ..test/var) + ))) + +(def test|label + Test + (do [! random.monad] + [input ..int_16 + + full_inner_iterations (of ! each (|>> (n.% 20) ++) random.nat) + expected_inner_iterations (of ! each (n.% full_inner_iterations) random.nat) + + @outer (of ! each /.label (random.upper_cased 5)) + full_outer_iterations (of ! each (|>> (n.% 10) ++) random.nat) + expected_outer_iterations (of ! each (n.% full_outer_iterations) random.nat) + + .let [$input (/.var "input") + $output (/.var "output") + $inner_index (/.var "inner_index") + $outer_index (/.var "outer_index")]] + (all _.and + (_.coverage [/.break] + (let [expected (i.* (.int expected_inner_iterations) input)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.apply (/.closure (list $input) + (all /.then + (/.define $inner_index (/.int +0)) + (/.define $output (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + (all /.then + (/.when (/.= (/.int (.int expected_inner_iterations)) $inner_index) + /.break) + (/.statement (/.set $output (/.+ $input $output))) + (/.statement (/.set $inner_index (/.+ (/.int +1) $inner_index))) + )) + (/.return $output))) + (list (/.int input)))))) + (_.coverage [/.continue] + (let [expected (i.* (.int (n.- expected_inner_iterations full_inner_iterations)) input)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.apply (/.closure (list $input) + (all /.then + (/.define $inner_index (/.int +0)) + (/.define $output (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + (all /.then + (/.statement (/.set $inner_index (/.+ (/.int +1) $inner_index))) + (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) + /.continue) + (/.statement (/.set $output (/.+ $input $output))) + )) + (/.return $output))) + (list (/.int input)))))) + (_.for [/.label /.with_label] + (all _.and + (_.coverage [/.break_at] + (let [expected (i.* (.int (n.* expected_outer_iterations + expected_inner_iterations)) + input)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.apply (/.closure (list $input) + (all /.then + (/.define $output (/.int +0)) + (/.define $outer_index (/.int +0)) + (/.with_label @outer + (/.while (/.< (/.int (.int full_outer_iterations)) $outer_index) + (all /.then + (/.define $inner_index (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + (all /.then + (/.when (/.= (/.int (.int expected_outer_iterations)) $outer_index) + (/.break_at @outer)) + (/.when (/.= (/.int (.int expected_inner_iterations)) $inner_index) + /.break) + (/.statement (/.set $output (/.+ $input $output))) + (/.statement (/.set $inner_index (/.+ (/.int +1) $inner_index))) + )) + (/.statement (/.set $outer_index (/.+ (/.int +1) $outer_index))) + ))) + (/.return $output))) + (list (/.int input)))))) + (_.coverage [/.continue_at] + (let [expected (i.* (.int (n.* (n.- expected_outer_iterations full_outer_iterations) + (n.- expected_inner_iterations full_inner_iterations))) + input)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.apply (/.closure (list $input) + (all /.then + (/.define $output (/.int +0)) + (/.define $outer_index (/.int +0)) + (/.with_label @outer + (/.while (/.< (/.int (.int full_outer_iterations)) $outer_index) + (all /.then + (/.statement (/.set $outer_index (/.+ (/.int +1) $outer_index))) + (/.define $inner_index (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + (all /.then + (/.statement (/.set $inner_index (/.+ (/.int +1) $inner_index))) + (/.when (/.<= (/.int (.int expected_outer_iterations)) $outer_index) + (/.continue_at @outer)) + (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) + /.continue) + (/.statement (/.set $output (/.+ $input $output))) + )) + ) + )) + (/.return $output))) + (list (/.int input)))))) + )) + ))) + +(def test|loop + Test + (do [! random.monad] + [input ..int_16 + iterations (of ! each (n.% 10) random.nat) + .let [$input (/.var "input") + $output (/.var "output") + $index (/.var "index") + expected|while (i.* (.int iterations) input) + expected|do_while (i.* (.int (n.max 1 iterations)) input)]] + (all _.and + (_.coverage [/.while] + (expression (|>> (as Frac) f.int (i.= expected|while)) + (/.apply (/.closure (list $input) + (all /.then + (/.define $index (/.int +0)) + (/.define $output (/.int +0)) + (/.while (/.< (/.int (.int iterations)) $index) + (all /.then + (/.statement (/.set $output (/.+ $input $output))) + (/.statement (/.set $index (/.+ (/.int +1) $index))) + )) + (/.return $output))) + (list (/.int input))))) + (_.coverage [/.do_while] + (expression (|>> (as Frac) f.int (i.= expected|do_while)) + (/.apply (/.closure (list $input) + (all /.then + (/.define $index (/.int +0)) + (/.define $output (/.int +0)) + (/.do_while (/.< (/.int (.int iterations)) $index) + (all /.then + (/.statement (/.set $output (/.+ $input $output))) + (/.statement (/.set $index (/.+ (/.int +1) $index))) + )) + (/.return $output))) + (list (/.int input))))) + (_.coverage [/.for] + (expression (|>> (as Frac) f.int (i.= expected|while)) + (/.apply (/.closure (list $input) + (all /.then + (/.define $output (/.int +0)) + (/.for $index (/.int +0) + (/.< (/.int (.int iterations)) $index) + (/.++ $index) + (/.statement (/.set $output (/.+ $input $output)))) + (/.return $output))) + (list (/.int input))))) + (_.for [/.Label] + ..test|label) + ))) + +(def test|exception + Test + (do [! random.monad] + [expected random.safe_frac + dummy (random.only (|>> (f.= expected) not) + random.safe_frac) + $ex (of ! each /.var (random.lower_cased 10))] + (all _.and + (_.coverage [/.try] + (expression (|>> (as Frac) (f.= expected)) + (/.apply (/.closure (list) + (/.try (/.return (/.number expected)) + [$ex (/.return (/.number dummy))])) + (list)))) + (_.coverage [/.throw] + (expression (|>> (as Frac) (f.= expected)) + (/.apply (/.closure (list) + (/.try (all /.then + (/.throw (/.number expected)) + (/.return (/.number dummy))) + [$ex (/.return $ex)])) + (list)))) + ))) + +(def test|apply + Test + (do [! random.monad] + [number/0 random.safe_frac + number/1 random.safe_frac + number/2 random.safe_frac + $arg/0 (of ! each /.var (random.lower_cased 10)) + $arg/1 (of ! each /.var (random.lower_cased 11)) + $arg/2 (of ! each /.var (random.lower_cased 12))] + (`` (all _.and + (_.coverage [/.apply_1] + (expression (|>> (as Frac) (f.= number/0)) + (/.apply_1 (/.closure (list $arg/0) (/.return $arg/0)) + (/.number number/0)))) + (_.coverage [/.apply_2] + (expression (|>> (as Frac) (f.= (all f.+ number/0 number/1))) + (/.apply_2 (/.closure (list $arg/0 $arg/1) (/.return (all /.+ $arg/0 $arg/1))) + (/.number number/0) + (/.number number/1)))) + (_.coverage [/.apply_3] + (expression (|>> (as Frac) (f.= (all f.+ number/0 number/1 number/2))) + (/.apply_3 (/.closure (list $arg/0 $arg/1 $arg/2) (/.return (all /.+ $arg/0 $arg/1 $arg/2))) + (/.number number/0) + (/.number number/1) + (/.number number/2)))) + (_.coverage [/.apply] + (expression (|>> (as Frac) (f.= (all f.+ number/0 number/1 number/2))) + (/.apply (/.closure (list $arg/0 $arg/1 $arg/2) (/.return (all /.+ $arg/0 $arg/1 $arg/2))) + (list (/.number number/0) + (/.number number/1) + (/.number number/2))))) + )))) + +(def test|function + Test + (do [! random.monad] + [number/0 random.safe_frac + iterations (of ! each (n.% 10) random.nat) + $self (of ! each /.var (random.lower_cased 1)) + $arg/0 (of ! each /.var (random.lower_cased 2)) + field (random.lower_cased 3) + $class (of ! each /.var (random.upper_cased 4))] + (all _.and + (_.coverage [/.closure /.return] + (expression (|>> (as Frac) (f.= number/0)) + (/.apply (/.closure (list) (/.return (/.number number/0))) + (list)))) + (_.coverage [/.function] + (expression (|>> (as Frac) f.nat (n.= iterations)) + (/.apply_1 (/.function $self (list $arg/0) + (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) + (/.apply_1 $self (/.+ (/.int +1) $arg/0)) + $arg/0))) + (/.int +0)))) + (_.coverage [/.function_definition] + (expression (|>> (as Frac) f.nat (n.= iterations)) + (/.apply (/.closure (list) + (all /.then + (/.function_definition $self (list $arg/0) + (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) + (/.apply_1 $self (/.+ (/.int +1) $arg/0)) + $arg/0))) + (/.return (/.apply_1 $self (/.int +0))))) + (list)))) + (_.coverage [/.new] + (let [$this (/.var "this")] + (expression (|>> (as Frac) (f.= number/0)) + (/.apply_1 (/.closure (list $arg/0) + (all /.then + (/.function_definition $class (list) + (/.statement (/.set (/.the field $this) $arg/0))) + (/.return (/.the field (/.new $class (list)))))) + (/.number number/0))))) + ..test|apply + ))) + +(def test|branching + Test + (do [! random.monad] + [number/0 random.safe_frac + number/1 random.safe_frac + number/2 random.safe_frac + arg/0 (random.lower_cased 10) + arg/1 (random.only (|>> (text#= arg/0) not) + (random.lower_cased 10)) + arg/2 (random.only (predicate.and (|>> (text#= arg/0) not) + (|>> (text#= arg/1) not)) + (random.lower_cased 10)) + .let [$arg/0 (/.var arg/0) + $arg/1 (/.var arg/1) + $arg/2 (/.var arg/2)] + ??? random.bit + int ..int_16] + (all _.and + (_.coverage [/.if] + (expression (|>> (as Frac) (f.= (if ??? number/0 number/1))) + (/.apply (/.closure (list) + (/.if (/.boolean ???) + (/.return (/.number number/0)) + (/.return (/.number number/1)))) + (list)))) + (_.coverage [/.when] + (expression (|>> (as Frac) (f.= (if ??? number/0 number/1))) + (/.apply (/.closure (list) + (all /.then + (/.when (/.boolean ???) + (/.return (/.number number/0))) + (/.return (/.number number/1)))) + (list)))) + (_.coverage [/.switch] + (let [number/0' (%.frac number/0) + number/1' (%.frac number/1) + number/2' (%.frac number/2)] + (and (expression (|>> (as Text) (text#= number/0')) + (/.apply (/.closure (list) + (/.switch (/.number number/0) + (list [(list (/.number number/0)) (/.return (/.string number/0'))] + [(list (/.number number/1)) (/.return (/.string number/1'))]) + {.#None})) + (list))) + (expression (|>> (as Text) (text#= number/1')) + (/.apply (/.closure (list) + (/.switch (/.number number/1) + (list [(list (/.number number/0)) (/.return (/.string number/0'))] + [(list (/.number number/1)) (/.return (/.string number/1'))]) + {.#Some (/.return (/.string number/2'))})) + (list))) + (expression (|>> (as Text) (text#= number/2')) + (/.apply (/.closure (list) + (/.switch (/.number number/2) + (list [(list (/.number number/0)) (/.return (/.string number/0'))] + [(list (/.number number/1)) (/.return (/.string number/1'))]) + {.#Some (/.return (/.string number/2'))})) + (list))) + ))) + ))) + +(def test|statement + Test + (do [! random.monad] + [number/0 random.safe_frac + number/1 random.safe_frac + number/2 random.safe_frac + $arg/0 (of ! each /.var (random.lower_cased 10)) + $arg/1 (of ! each /.var (random.lower_cased 11)) + $arg/2 (of ! each /.var (random.lower_cased 12)) + ??? random.bit + int ..int_16] + (`` (all _.and + (_.coverage [/.statement] + (expression (|>> (as Frac) (f.= number/0)) + (/.apply_1 (/.closure (list $arg/0) + (all /.then + (/.statement (/.+ $arg/0 $arg/0)) + (/.return $arg/0))) + (/.number number/0)))) + (,, (with_template [<js> <lux>] + [(_.coverage [<js>] + (expression (|>> (as Frac) f.int (i.= (<lux> int))) + (/.apply_1 (/.closure (list $arg/0) + (/.return (/., (<js> $arg/0) + $arg/0))) + (/.int int))))] + + [/.++ .++] + [/.-- .--] + )) + (_.coverage [/.then] + (expression (|>> (as Frac) (f.= number/0)) + (/.apply_2 (/.closure (list $arg/0 $arg/1) + (all /.then + (/.return $arg/0) + (/.return $arg/1))) + (/.number number/0) + (/.number number/1)))) + (_.coverage [/.use_strict] + (and (expression (|>> (as Frac) (f.= number/0)) + (/.apply (/.closure (list) + (all /.then + /.use_strict + (/.declare $arg/0) + (/.statement (/.set $arg/0 (/.number number/0))) + (/.return $arg/0))) + (list))) + (|> (/.apply (/.closure (list) + (all /.then + /.use_strict + ... (/.declare $arg/0) + (/.statement (/.set $arg/0 (/.number number/0))) + (/.return $arg/0))) + (list)) + ..eval + (pipe.when + {try.#Success it} + false + + {try.#Failure error} + true)))) + ..test|exception + ..test|function + ..test|branching + (_.for [/.Location] + ..test/location) + (_.for [/.Loop] + ..test|loop) + )))) + +(def .public test + Test + (do [! random.monad] + [] + (<| (_.covering /._) + (_.for [/.Code /.code]) + (`` (all _.and + (_.for [/.Expression] + ..test|expression) + (_.for [/.Statement] + ..test|statement) + ))))) diff --git a/stdlib/source/test/lux/meta/compiler/target/jvm.lux b/stdlib/source/test/lux/meta/compiler/target/jvm.lux new file mode 100644 index 000000000..2fed717cd --- /dev/null +++ b/stdlib/source/test/lux/meta/compiler/target/jvm.lux @@ -0,0 +1,1759 @@ +(.require + [library + [lux (.except Type Label int) + ["[0]" ffi (.only import)] + [abstract + ["[0]" monad (.only do)]] + [control + ["[0]" function] + ["[0]" io] + ["[0]" maybe] + ["[0]" try] + [concurrency + ["[0]" atom]]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format (.only format)]] + ["[0]" binary + ["[1]" \\format]] + [collection + ["[0]" array] + ["[0]" dictionary] + ["[0]" set] + ["[0]" sequence] + ["[0]" list (.use "[1]#[0]" functor)]]] + [math + ["[0]" random (.only Random) (.use "[1]#[0]" monad)] + [number + ["n" nat] + ["i" int] + ["f" frac] + ["[0]" i32 (.only I32)] + ["[0]" i64]]] + [meta + [compiler + ["@" target]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / + ["[1][0]" loader (.only Library)] + ["[1][0]" version] + ["[1][0]" modifier (.use "[1]#[0]" monoid)] + ["[1][0]" field] + ["[1][0]" method (.only Method)] + ["[1][0]" class] + ["[1][0]" attribute (.only) + ["[1]/[0]" code]] + ["[1][0]" constant (.only) + ["[1]/[0]" pool (.only Resource)]] + [encoding + ["[1][0]" name] + ["[1][0]" signed] + ["[1][0]" unsigned]] + ["[1]" bytecode (.only Label Bytecode) + ["[1][0]" instruction]] + ["[1][0]" type (.only Type) + ["[0]" category (.only Value Object Class)]]]]) + +(def method_modifier + (all /modifier#composite + /method.public + /method.static)) + +(import java/lang/Boolean + "[1]::[0]") + +(import java/lang/Byte + "[1]::[0]") + +(import java/lang/Short + "[1]::[0]") + +(import java/lang/Integer + "[1]::[0]") + +(import java/lang/Long + "[1]::[0]") + +(import java/lang/Float + "[1]::[0]") + +(import java/lang/Double + "[1]::[0]" + ("static" compare [double double] int)) + +(import java/lang/Character + "[1]::[0]") + +(import java/lang/String + "[1]::[0]") + +(import java/lang/reflect/Method + "[1]::[0]" + (invoke [java/lang/Object [java/lang/Object]] "try" java/lang/Object)) + +(import (java/lang/Class c) + "[1]::[0]" + (getDeclaredMethod [java/lang/String [(java/lang/Class [? < java/lang/Object])]] java/lang/reflect/Method)) + +(import java/lang/Object + "[1]::[0]" + (getClass [] (java/lang/Class java/lang/Object)) + (toString [] java/lang/String)) + +(def class_name + (Random Text) + (do random.monad + [super_package (random.lower_cased 10) + package (random.lower_cased 10) + name (random.upper_cased 10)] + (in (format super_package + /name.external_separator package + /name.external_separator name)))) + +(def (get_method name class) + (-> Text (java/lang/Class java/lang/Object) java/lang/reflect/Method) + (java/lang/Class::getDeclaredMethod (ffi.as_string name) + (ffi.array (java/lang/Class java/lang/Object) 0) + class)) + +(def $Object (/type.class "java.lang.Object" (list))) + +(def (bytecode test bytecode) + (-> (-> Any Bit) (Bytecode Any) (Random Bit)) + (do random.monad + [class_name ..class_name + method_name (random.upper_cased 10)] + (in (when (do try.monad + [class (/class.class /version.v6_0 /class.public + (/name.internal class_name) + {.#None} + (/name.internal "java.lang.Object") + (list) + (list) + (list (/method.method ..method_modifier + method_name + false (/type.method [(list) (list) ..$Object (list)]) + (list) + {.#Some (do /.monad + [_ bytecode] + /.areturn)})) + (list)) + .let [bytecode (binary.result /class.format class) + loader (/loader.memory (/loader.new_library []))] + _ (/loader.define class_name bytecode loader) + class (io.run! (/loader.load class_name loader)) + method (try (get_method method_name class))] + (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)) + {try.#Success actual} + (test actual) + + {try.#Failure error} + false)))) + +(type (Primitive a) + (Record + [#unboxed (Type category.Return) + #boxed (Type category.Class) + #wrap (Bytecode Any) + #random (Random a) + #literal (-> a (Bytecode Any))])) + +(def $Boolean + (/type.class "java.lang.Boolean" (list))) +(def $Boolean::wrap + (/.invokestatic ..$Boolean "valueOf" (/type.method [(list) (list /type.boolean) ..$Boolean (list)]))) +(def $Boolean::random (as (Random java/lang/Boolean) random.bit)) +(def !false (|> 0 .i64 i32.i32 /.int)) +(def !true (|> 1 .i64 i32.i32 /.int)) +(def ($Boolean::literal value) + (-> java/lang/Boolean (Bytecode Any)) + (if (as Bit value) + ..!true + ..!false)) +(def $Boolean::primitive + (Primitive java/lang/Boolean) + [#unboxed /type.boolean + #boxed ..$Boolean + #wrap ..$Boolean::wrap + #random ..$Boolean::random + #literal ..$Boolean::literal]) + +(def $Byte + (/type.class "java.lang.Byte" (list))) +(def $Byte::wrap + (/.invokestatic ..$Byte "valueOf" (/type.method [(list) (list /type.byte) ..$Byte (list)]))) +(def $Byte::random + (Random java/lang/Byte) + (of random.monad each (|>> (as java/lang/Long) ffi.long_to_byte) random.int)) +(def $Byte::literal + (-> java/lang/Byte (Bytecode Any)) + (|>> ffi.byte_to_long (as I64) i32.i32 /.int)) +(def $Byte::primitive + (Primitive java/lang/Byte) + [#unboxed /type.byte + #boxed ..$Byte + #wrap ..$Byte::wrap + #random ..$Byte::random + #literal ..$Byte::literal]) + +(def $Short + (/type.class "java.lang.Short" (list))) +(def $Short::wrap + (/.invokestatic ..$Short "valueOf" (/type.method [(list) (list /type.short) ..$Short (list)]))) +(def $Short::random + (Random java/lang/Short) + (of random.monad each (|>> (as java/lang/Long) ffi.long_to_short) random.int)) +(def $Short::literal + (-> java/lang/Short (Bytecode Any)) + (|>> ffi.short_to_long (as I64) i32.i32 /.int)) +(def $Short::primitive + (Primitive java/lang/Short) + [#unboxed /type.short + #boxed ..$Short + #wrap ..$Short::wrap + #random ..$Short::random + #literal ..$Short::literal]) + +(def $Integer + (/type.class "java.lang.Integer" (list))) +(def $Integer::wrap + (/.invokestatic ..$Integer "valueOf" (/type.method [(list) (list /type.int) ..$Integer (list)]))) +(def $Integer::random + (Random java/lang/Integer) + (of random.monad each (|>> (as java/lang/Long) ffi.long_to_int) random.int)) +(def $Integer::literal + (-> java/lang/Integer (Bytecode Any)) + (|>> ffi.int_to_long (as I64) i32.i32 /.int)) +(def $Integer::primitive + (Primitive java/lang/Integer) + [#unboxed /type.int + #boxed ..$Integer + #wrap ..$Integer::wrap + #random ..$Integer::random + #literal ..$Integer::literal]) + +(def $Long (/type.class "java.lang.Long" (list))) +(def $Long::wrap (/.invokestatic ..$Long "valueOf" (/type.method [(list) (list /type.long) ..$Long (list)]))) +(def $Long::random (as (Random java/lang/Long) random.int)) +(def $Long::literal (-> java/lang/Long (Bytecode Any)) (|>> (as Int) /.long)) +(def $Long::primitive + (Primitive java/lang/Long) + [#unboxed /type.long + #boxed ..$Long + #wrap ..$Long::wrap + #random ..$Long::random + #literal ..$Long::literal]) + +(def $Float (/type.class "java.lang.Float" (list))) +(def $Float::wrap (/.invokestatic ..$Float "valueOf" (/type.method [(list) (list /type.float) ..$Float (list)]))) +(def $Float::random + (Random java/lang/Float) + (of random.monad each + (|>> (as java/lang/Double) ffi.double_to_float) + random.frac)) +(def $Float::literal /.float) +(def valid_float + (Random java/lang/Float) + (random.only (|>> ffi.float_to_double (as Frac) f.not_a_number? not) + ..$Float::random)) +(def $Float::primitive + (Primitive java/lang/Float) + [#unboxed /type.float + #boxed ..$Float + #wrap ..$Float::wrap + #random ..valid_float + #literal ..$Float::literal]) + +(def $Double (/type.class "java.lang.Double" (list))) +(def $Double::wrap (/.invokestatic ..$Double "valueOf" (/type.method [(list) (list /type.double) ..$Double (list)]))) +(def $Double::random (as (Random java/lang/Double) random.frac)) +(def $Double::literal + (-> java/lang/Double (Bytecode Any)) + /.double) +(def valid_double + (Random java/lang/Double) + (random.only (|>> (as Frac) f.not_a_number? not) + ..$Double::random)) +(def $Double::primitive + (Primitive java/lang/Double) + [#unboxed /type.double + #boxed ..$Double + #wrap ..$Double::wrap + #random ..valid_double + #literal ..$Double::literal]) + +(def $Character + (/type.class "java.lang.Character" (list))) +(def $Character::wrap + (/.invokestatic ..$Character "valueOf" (/type.method [(list) (list /type.char) ..$Character (list)]))) +(def $Character::random + (Random java/lang/Character) + (of random.monad each (|>> (as java/lang/Long) ffi.long_to_int ffi.int_to_char) random.int)) +(def $Character::literal + (-> java/lang/Character (Bytecode Any)) + (|>> ffi.char_to_long (as I64) i32.i32 /.int)) +(def $Character::primitive + (Primitive java/lang/Character) + [#unboxed /type.char + #boxed ..$Character + #wrap ..$Character::wrap + #random ..$Character::random + #literal ..$Character::literal]) + +(def $String + (/type.class "java.lang.String" (list))) + +(def $String::random + (as (Random java/lang/String) + (random.alphabetic 10))) + +(def $String::literal + (-> java/lang/String (Bytecode Any)) + (|>> (as Text) /.string)) + +(def $String::primitive + (Primitive java/lang/String) + [#unboxed ..$String + #boxed ..$String + #wrap /.nop + #random ..$String::random + #literal ..$String::literal]) + +(with_template [<name> <bits> <type> <push> <wrap> <message> <to_long> <signed>] + [(def <name> + Test + (do [! random.monad] + [expected (of ! each (i64.and (i64.mask <bits>)) random.nat)] + (<| (_.lifted <message>) + (..bytecode (for @.old + (|>> (as <type>) <to_long> ("jvm leq" expected)) + + @.jvm + (|>> (as <type>) <to_long> .jvm_object_cast# (.jvm_long_=# (.jvm_object_cast# (as java/lang/Long expected)))))) + (do /.monad + [_ (<push> (|> expected .int <signed> try.trusted))] + <wrap>))))] + + [byte 7 java/lang/Byte /.bipush ..$Byte::wrap "BIPUSH" ffi.byte_to_long /signed.s1] + [short 15 java/lang/Short /.sipush ..$Short::wrap "SIPUSH" ffi.short_to_long /signed.s2] + ) + +(with_template [<name> <type>] + [(def <name> + (template (_ <old_extension> <new_extension>) + [(is (-> <type> <type> <type>) + (function (_ parameter subject) + (for @.old + (<old_extension> subject parameter) + + @.jvm + (.jvm_object_cast# + (<new_extension> (.jvm_object_cast# parameter) + (.jvm_object_cast# subject))))))]))] + + [int/2 java/lang/Integer] + [long/2 java/lang/Long] + [float/2 java/lang/Float] + [double/2 java/lang/Double] + ) + +(def int+long/2 + (template (_ <old_extension> <new_extension>) + [(is (-> java/lang/Integer java/lang/Long java/lang/Long) + (function (_ parameter subject) + (for @.old + (<old_extension> subject parameter) + + @.jvm + (.jvm_object_cast# + (<new_extension> (.jvm_object_cast# parameter) + (.jvm_object_cast# subject))))))])) + +(def int + Test + (let [int (is (-> java/lang/Integer (Bytecode Any) (Random Bit)) + (function (_ expected bytecode) + (<| (..bytecode (for @.old + (|>> (as java/lang/Integer) ("jvm ieq" expected)) + + @.jvm + (|>> (as java/lang/Integer) .jvm_object_cast# (.jvm_int_=# (.jvm_object_cast# expected))))) + (do /.monad + [_ bytecode] + ..$Integer::wrap)))) + unary (is (-> (-> java/lang/Integer java/lang/Integer) (Bytecode Any) (Random Bit)) + (function (_ reference instruction) + (do random.monad + [subject ..$Integer::random] + (int (reference subject) + (do /.monad + [_ (..$Integer::literal subject)] + instruction))))) + binary (is (-> (-> java/lang/Integer java/lang/Integer java/lang/Integer) + (Bytecode Any) + (Random Bit)) + (function (_ reference instruction) + (do random.monad + [parameter ..$Integer::random + subject ..$Integer::random] + (int (reference parameter subject) + (do /.monad + [_ (..$Integer::literal subject) + _ (..$Integer::literal parameter)] + instruction))))) + shift (is (-> (-> java/lang/Integer java/lang/Integer java/lang/Integer) (Bytecode Any) (Random Bit)) + (function (_ reference instruction) + (do [! random.monad] + [parameter (of ! each (|>> (n.% 32) .int (as java/lang/Long) ffi.long_to_int) random.nat) + subject ..$Integer::random] + (int (reference parameter subject) + (do /.monad + [_ (..$Integer::literal subject) + _ (..$Integer::literal parameter)] + instruction))))) + literal (all _.and + (_.lifted "ICONST_M1" (int (ffi.long_to_int (as java/lang/Long -1)) /.iconst_m1)) + (_.lifted "ICONST_0" (int (ffi.long_to_int (as java/lang/Long +0)) /.iconst_0)) + (_.lifted "ICONST_1" (int (ffi.long_to_int (as java/lang/Long +1)) /.iconst_1)) + (_.lifted "ICONST_2" (int (ffi.long_to_int (as java/lang/Long +2)) /.iconst_2)) + (_.lifted "ICONST_3" (int (ffi.long_to_int (as java/lang/Long +3)) /.iconst_3)) + (_.lifted "ICONST_4" (int (ffi.long_to_int (as java/lang/Long +4)) /.iconst_4)) + (_.lifted "ICONST_5" (int (ffi.long_to_int (as java/lang/Long +5)) /.iconst_5)) + (_.lifted "LDC_W/INTEGER" + (do random.monad + [expected ..$Integer::random] + (int expected (..$Integer::literal expected))))) + arithmetic (all _.and + (_.lifted "IADD" (binary (int/2 "jvm iadd" .jvm_int_+#) /.iadd)) + (_.lifted "ISUB" (binary (int/2 "jvm isub" .jvm_int_-#) /.isub)) + (_.lifted "IMUL" (binary (int/2 "jvm imul" .jvm_int_*#) /.imul)) + (_.lifted "IDIV" (binary (int/2 "jvm idiv" .jvm_int_/#) /.idiv)) + (_.lifted "IREM" (binary (int/2 "jvm irem" .jvm_int_%#) /.irem)) + (_.lifted "INEG" (unary (function (_ value) + ((int/2 "jvm isub" .jvm_int_-#) + value + (ffi.long_to_int (as java/lang/Long +0)))) + /.ineg))) + bitwise (all _.and + (_.lifted "IAND" (binary (int/2 "jvm iand" .jvm_int_and#) /.iand)) + (_.lifted "IOR" (binary (int/2 "jvm ior" .jvm_int_or#) /.ior)) + (_.lifted "IXOR" (binary (int/2 "jvm ixor" .jvm_int_xor#) /.ixor)) + (_.lifted "ISHL" (shift (int/2 "jvm ishl" .jvm_int_shl#) /.ishl)) + (_.lifted "ISHR" (shift (int/2 "jvm ishr" .jvm_int_shr#) /.ishr)) + (_.lifted "IUSHR" (shift (int/2 "jvm iushr" .jvm_int_ushr#) /.iushr)))] + (all _.and + (<| (_.context "literal") + literal) + (<| (_.context "arithmetic") + arithmetic) + (<| (_.context "bitwise") + bitwise) + ))) + +(def long + Test + (let [long (is (-> java/lang/Long (Bytecode Any) (Random Bit)) + (function (_ expected bytecode) + (<| (..bytecode (for @.old + (|>> (as Int) (i.= expected)) + + @.jvm + (|>> (as java/lang/Long) .jvm_object_cast# (.jvm_long_=# (.jvm_object_cast# expected))))) + (do /.monad + [_ bytecode] + ..$Long::wrap)))) + unary (is (-> (-> java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit)) + (function (_ reference instruction) + (do random.monad + [subject ..$Long::random] + (long (reference subject) + (do /.monad + [_ (..$Long::literal subject)] + instruction))))) + binary (is (-> (-> java/lang/Long java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit)) + (function (_ reference instruction) + (do random.monad + [parameter ..$Long::random + subject ..$Long::random] + (long (reference parameter subject) + (do /.monad + [_ (..$Long::literal subject) + _ (..$Long::literal parameter)] + instruction))))) + shift (is (-> (-> java/lang/Integer java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit)) + (function (_ reference instruction) + (do [! random.monad] + [parameter (of ! each (|>> (n.% 64) (as java/lang/Long)) random.nat) + subject ..$Long::random] + (long (reference (ffi.long_to_int parameter) subject) + (do /.monad + [_ (..$Long::literal subject) + _ (..$Integer::literal (ffi.long_to_int parameter))] + instruction))))) + literal (all _.and + (_.lifted "LCONST_0" (long (as java/lang/Long +0) /.lconst_0)) + (_.lifted "LCONST_1" (long (as java/lang/Long +1) /.lconst_1)) + (_.lifted "LDC2_W/LONG" + (do random.monad + [expected ..$Long::random] + (long expected (..$Long::literal expected))))) + arithmetic (all _.and + (_.lifted "LADD" (binary (long/2 "jvm ladd" .jvm_long_+#) /.ladd)) + (_.lifted "LSUB" (binary (long/2 "jvm lsub" .jvm_long_-#) /.lsub)) + (_.lifted "LMUL" (binary (long/2 "jvm lmul" .jvm_long_*#) /.lmul)) + (_.lifted "LDIV" (binary (long/2 "jvm ldiv" .jvm_long_/#) /.ldiv)) + (_.lifted "LREM" (binary (long/2 "jvm lrem" .jvm_long_%#) /.lrem)) + (_.lifted "LNEG" (unary (function (_ value) + ((long/2 "jvm lsub" .jvm_long_-#) + value + (as java/lang/Long +0))) + /.lneg))) + bitwise (all _.and + (_.lifted "LAND" (binary (long/2 "jvm land" .jvm_long_and#) /.land)) + (_.lifted "LOR" (binary (long/2 "jvm lor" .jvm_long_or#) /.lor)) + (_.lifted "LXOR" (binary (long/2 "jvm lxor" .jvm_long_xor#) /.lxor)) + (_.lifted "LSHL" (shift (int+long/2 "jvm lshl" .jvm_long_shl#) /.lshl)) + (_.lifted "LSHR" (shift (int+long/2 "jvm lshr" .jvm_long_shr#) /.lshr)) + (_.lifted "LUSHR" (shift (int+long/2 "jvm lushr" .jvm_long_ushr#) /.lushr))) + comparison (_.lifted "LCMP" + (do random.monad + [reference ..$Long::random + subject ..$Long::random + .let [expected (cond (i.= (as Int reference) (as Int subject)) + (as java/lang/Long +0) + + (i.> (as Int reference) (as Int subject)) + (as java/lang/Long +1) + + ... (i.< (as Int reference) (as Int subject)) + (as java/lang/Long -1))]] + (<| (..bytecode (for @.old + (|>> (as Int) (i.= expected)) + + @.jvm + (|>> (as java/lang/Long) .jvm_object_cast# (.jvm_long_=# (.jvm_object_cast# expected))))) + (do /.monad + [_ (..$Long::literal subject) + _ (..$Long::literal reference) + _ /.lcmp + _ /.i2l] + ..$Long::wrap))))] + (all _.and + (<| (_.context "literal") + literal) + (<| (_.context "arithmetic") + arithmetic) + (<| (_.context "bitwise") + bitwise) + (<| (_.context "comparison") + comparison) + ))) + +(def float + Test + (let [float (is (-> java/lang/Float (Bytecode Any) (Random Bit)) + (function (_ expected bytecode) + (<| (..bytecode (for @.old + (function (_ actual) + (or (|> actual (as java/lang/Float) ("jvm feq" expected)) + (and (f.not_a_number? (as Frac (ffi.float_to_double expected))) + (f.not_a_number? (as Frac (ffi.float_to_double (as java/lang/Float actual))))))) + + @.jvm + (function (_ actual) + (or (|> actual (as java/lang/Float) .jvm_object_cast# (.jvm_float_=# (.jvm_object_cast# expected))) + (and (f.not_a_number? (as Frac (ffi.float_to_double expected))) + (f.not_a_number? (as Frac (ffi.float_to_double (as java/lang/Float actual))))))))) + (do /.monad + [_ bytecode] + ..$Float::wrap)))) + unary (is (-> (-> java/lang/Float java/lang/Float) + (Bytecode Any) + (Random Bit)) + (function (_ reference instruction) + (do random.monad + [subject ..$Float::random] + (float (reference subject) + (do /.monad + [_ (..$Float::literal subject)] + instruction))))) + binary (is (-> (-> java/lang/Float java/lang/Float java/lang/Float) + (Bytecode Any) + (Random Bit)) + (function (_ reference instruction) + (do random.monad + [parameter ..$Float::random + subject ..$Float::random] + (float (reference parameter subject) + (do /.monad + [_ (..$Float::literal subject) + _ (..$Float::literal parameter)] + instruction))))) + literal (all _.and + (_.lifted "FCONST_0" (float (ffi.double_to_float (as java/lang/Double +0.0)) /.fconst_0)) + (_.lifted "FCONST_1" (float (ffi.double_to_float (as java/lang/Double +1.0)) /.fconst_1)) + (_.lifted "FCONST_2" (float (ffi.double_to_float (as java/lang/Double +2.0)) /.fconst_2)) + (_.lifted "LDC_W/FLOAT" + (do random.monad + [expected ..$Float::random] + (float expected (..$Float::literal expected))))) + arithmetic (all _.and + (_.lifted "FADD" (binary (float/2 "jvm fadd" .jvm_float_+#) /.fadd)) + (_.lifted "FSUB" (binary (float/2 "jvm fsub" .jvm_float_-#) /.fsub)) + (_.lifted "FMUL" (binary (float/2 "jvm fmul" .jvm_float_*#) /.fmul)) + (_.lifted "FDIV" (binary (float/2 "jvm fdiv" .jvm_float_/#) /.fdiv)) + (_.lifted "FREM" (binary (float/2 "jvm frem" .jvm_float_%#) /.frem)) + (_.lifted "FNEG" (unary (function (_ value) + ((float/2 "jvm fsub" .jvm_float_-#) + value + (ffi.double_to_float (as java/lang/Double +0.0)))) + /.fneg))) + comparison (is (-> (Bytecode Any) (-> java/lang/Float java/lang/Float Bit) (Random Bit)) + (function (_ instruction standard) + (do random.monad + [.let [valid_float (random.only (|>> ffi.float_to_double (as Frac) f.not_a_number? not) + ..$Float::random)] + reference valid_float + subject valid_float + .let [expected (if (for @.old + ("jvm feq" reference subject) + + @.jvm + (.jvm_float_=# (.jvm_object_cast# reference) (.jvm_object_cast# subject))) + +0 + (if (standard reference subject) + +1 + -1))]] + (<| (..bytecode (|>> (as Int) (i.= expected))) + (do /.monad + [_ (..$Float::literal subject) + _ (..$Float::literal reference) + _ instruction + _ /.i2l] + ..$Long::wrap))))) + comparison_standard (is (-> java/lang/Float java/lang/Float Bit) + (function (_ reference subject) + (for @.old + ("jvm fgt" subject reference) + + @.jvm + (.jvm_float_<# (.jvm_object_cast# subject) (.jvm_object_cast# reference))))) + comparison (all _.and + (_.lifted "FCMPL" (comparison /.fcmpl comparison_standard)) + (_.lifted "FCMPG" (comparison /.fcmpg comparison_standard)))] + (all _.and + (<| (_.context "literal") + literal) + (<| (_.context "arithmetic") + arithmetic) + (<| (_.context "comparison") + comparison) + ))) + +(def double + Test + (let [double (is (-> java/lang/Double (Bytecode Any) (Random Bit)) + (function (_ expected bytecode) + (<| (..bytecode (for @.old + (function (_ actual) + (or (|> actual (as java/lang/Double) ("jvm deq" expected)) + (and (f.not_a_number? (as Frac expected)) + (f.not_a_number? (as Frac actual))))) + + @.jvm + (function (_ actual) + (or (|> actual (as java/lang/Double) .jvm_object_cast# (.jvm_double_=# (.jvm_object_cast# expected))) + (and (f.not_a_number? (as Frac expected)) + (f.not_a_number? (as Frac actual))))))) + (do /.monad + [_ bytecode] + ..$Double::wrap)))) + unary (is (-> (-> java/lang/Double java/lang/Double) (Bytecode Any) (Random Bit)) + (function (_ reference instruction) + (do random.monad + [subject ..$Double::random] + (double (reference subject) + (do /.monad + [_ (..$Double::literal subject)] + instruction))))) + binary (is (-> (-> java/lang/Double java/lang/Double java/lang/Double) (Bytecode Any) (Random Bit)) + (function (_ reference instruction) + (do random.monad + [parameter ..$Double::random + subject ..$Double::random] + (double (reference parameter subject) + (do /.monad + [_ (..$Double::literal subject) + _ (..$Double::literal parameter)] + instruction))))) + literal (all _.and + (_.lifted "DCONST_0" (double (as java/lang/Double +0.0) /.dconst_0)) + (_.lifted "DCONST_1" (double (as java/lang/Double +1.0) /.dconst_1)) + (_.lifted "LDC2_W/DOUBLE" + (do random.monad + [expected ..$Double::random] + (double expected (..$Double::literal expected))))) + arithmetic (all _.and + (_.lifted "DADD" (binary (double/2 "jvm dadd" .jvm_double_+#) /.dadd)) + (_.lifted "DSUB" (binary (double/2 "jvm dsub" .jvm_double_-#) /.dsub)) + (_.lifted "DMUL" (binary (double/2 "jvm dmul" .jvm_double_*#) /.dmul)) + (_.lifted "DDIV" (binary (double/2 "jvm ddiv" .jvm_double_/#) /.ddiv)) + (_.lifted "DREM" (binary (double/2 "jvm drem" .jvm_double_%#) /.drem)) + (_.lifted "DNEG" (unary (function (_ value) + ((double/2 "jvm dsub" .jvm_double_-#) + value + (as java/lang/Double +0.0))) + /.dneg))) + comparison (is (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit)) + (function (_ instruction standard) + (do random.monad + [reference ..valid_double + subject ..valid_double + .let [expected (if (for @.old + ("jvm deq" reference subject) + + @.jvm + (.jvm_double_=# (.jvm_object_cast# reference) (.jvm_object_cast# subject))) + +0 + (if (standard reference subject) + +1 + -1))]] + (<| (..bytecode (|>> (as Int) (i.= expected))) + (do /.monad + [_ (..$Double::literal subject) + _ (..$Double::literal reference) + _ instruction + _ /.i2l] + ..$Long::wrap))))) + ... https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-6.html#jvms-6.5.dcmp_op + comparison_standard (is (-> java/lang/Double java/lang/Double Bit) + (function (_ reference subject) + (for @.old + ("jvm dgt" subject reference) + + @.jvm + (.jvm_double_<# (.jvm_object_cast# subject) (.jvm_object_cast# reference))))) + comparison (all _.and + (_.lifted "DCMPL" (comparison /.dcmpl comparison_standard)) + (_.lifted "DCMPG" (comparison /.dcmpg comparison_standard)))] + (all _.and + (<| (_.context "literal") + literal) + (<| (_.context "arithmetic") + arithmetic) + (<| (_.context "comparison") + comparison) + ))) + +(def primitive + Test + (all _.and + (<| (_.context "byte") + ..byte) + (<| (_.context "short") + ..short) + (<| (_.context "int") + ..int) + (<| (_.context "long") + ..long) + (<| (_.context "float") + ..float) + (<| (_.context "double") + ..double) + )) + +(def object + Test + (let [!object (is (Bytecode Any) + (do /.monad + [_ (/.new ..$Object) + _ /.dup] + (/.invokespecial ..$Object "<init>" (/type.method [(list) (list) /type.void (list)]))))] + (all _.and + (<| (_.lifted "ACONST_NULL") + (..bytecode (|>> (as Bit) not)) + (do /.monad + [_ /.aconst_null + _ (/.instanceof ..$String)] + ..$Boolean::wrap)) + (<| (_.lifted "INSTANCEOF") + (do random.monad + [value ..$String::random]) + (..bytecode (|>> (as Bit))) + (do /.monad + [_ (/.string (as Text value)) + _ (/.instanceof ..$String)] + ..$Boolean::wrap)) + (<| (_.lifted "NEW & CHECKCAST") + (..bytecode (|>> (as Bit))) + (do /.monad + [_ !object + _ (/.checkcast ..$Object) + _ (/.instanceof ..$Object)] + ..$Boolean::wrap)) + (<| (_.lifted "MONITORENTER & MONITOREXIT") + (do random.monad + [value ..$String::random]) + (..bytecode (|>> (as Bit))) + (do /.monad + [_ (/.string (as Text value)) + _ /.dup _ /.monitorenter + _ /.dup _ /.monitorexit + _ (/.instanceof ..$String)] + ..$Boolean::wrap)) + ))) + +(def method + Test + (all _.and + (<| (_.lifted "INVOKESTATIC") + (do random.monad + [expected (random.only (|>> (as Frac) f.not_a_number? not) + ..$Double::random)]) + (..bytecode (for @.old + (|>> (as java/lang/Double) ("jvm deq" expected)) + + @.jvm + (|>> (as java/lang/Double) .jvm_object_cast# (.jvm_double_=# (.jvm_object_cast# expected))))) + (do /.monad + [_ (/.double expected)] + (/.invokestatic ..$Double "valueOf" (/type.method [(list) (list /type.double) ..$Double (list)])))) + (<| (_.lifted "INVOKEVIRTUAL") + (do random.monad + [expected ..$Double::random]) + (..bytecode (|>> (as Bit) (bit#= (f.not_a_number? (as Frac expected))))) + (do /.monad + [_ (/.double expected) + _ ..$Double::wrap + _ (/.invokevirtual ..$Double "isNaN" (/type.method [(list) (list) /type.boolean (list)]))] + ..$Boolean::wrap)) + (<| (_.lifted "INVOKESPECIAL") + (do random.monad + [expected (random.only (|>> (as Frac) f.not_a_number? not) + ..$Double::random)]) + (..bytecode (for @.old + (|>> (as java/lang/Double) ("jvm deq" expected)) + + @.jvm + (|>> (as java/lang/Double) .jvm_object_cast# (.jvm_double_=# (.jvm_object_cast# expected))))) + (do /.monad + [_ (/.new ..$Double) + _ /.dup + _ (/.double expected)] + (/.invokespecial ..$Double "<init>" (/type.method [(list) (list /type.double) /type.void (list)])))) + (<| (_.lifted "INVOKEINTERFACE") + (do random.monad + [subject ..$String::random]) + (..bytecode (|>> (as Nat) (n.= (text.size (as Text subject))))) + (do /.monad + [_ (/.string (as Text subject)) + _ (/.invokeinterface (/type.class "java.lang.CharSequence" (list)) "length" (/type.method [(list) (list) /type.int (list)])) + _ /.i2l] + ..$Long::wrap)) + )) + +(def field + Test + (do random.monad + [class_name ..class_name + part0 ..$Long::random + part1 ..$Long::random + .let [expected (is java/lang/Long + (for @.old + ("jvm ladd" part0 part1) + + @.jvm + (.jvm_object_cast# + (.jvm_long_+# (.jvm_object_cast# part0) (.jvm_object_cast# part1))))) + $Self (/type.class class_name (list)) + class_field "class_field" + object_field "object_field" + constructor "<init>" + constructor::type (/type.method [(list) (list /type.long) /type.void (list)]) + static_method "static_method" + bytecode (|> (/class.class /version.v6_0 /class.public + (/name.internal class_name) + {.#None} + (/name.internal "java.lang.Object") + (list) + (list (/field.field /field.static class_field false /type.long (sequence.sequence)) + (/field.field /field.public object_field false /type.long (sequence.sequence))) + (list (/method.method /method.private + constructor + false constructor::type + (list) + {.#Some (do /.monad + [_ /.aload_0 + _ (/.invokespecial ..$Object constructor (/type.method [(list) (list) /type.void (list)])) + _ (..$Long::literal part0) + _ (/.putstatic $Self class_field /type.long) + _ /.aload_0 + _ /.lload_1 + _ (/.putfield $Self object_field /type.long)] + /.return)}) + (/method.method (all /modifier#composite + /method.public + /method.static) + static_method + false (/type.method [(list) (list) ..$Long (list)]) + (list) + {.#Some (do /.monad + [_ (/.new $Self) + _ /.dup + _ (..$Long::literal part1) + _ (/.invokespecial $Self constructor constructor::type) + _ (/.getfield $Self object_field /type.long) + _ (/.getstatic $Self class_field /type.long) + _ /.ladd + _ ..$Long::wrap] + /.areturn)})) + (list)) + try.trusted + (binary.result /class.format)) + loader (/loader.memory (/loader.new_library []))]] + (_.test "PUTSTATIC & PUTFIELD & GETFIELD & GETSTATIC" + (when (do try.monad + [_ (/loader.define class_name bytecode loader) + class (io.run! (/loader.load class_name loader)) + method (try (get_method static_method class)) + output (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)] + (in (as Int output))) + {try.#Success actual} + (i.= (as Int expected) (as Int actual)) + + {try.#Failure error} + false)))) + +(def array + Test + (let [!length (is (-> Nat (Bytecode Any)) + (function (_ size) + (do /.monad + [_ ($Long::literal (as java/lang/Long size))] + /.l2i))) + ?length (is (Bytecode Any) + (do /.monad + [_ /.arraylength] + /.i2l)) + length (is (-> Nat (Bytecode Any) (Random Bit)) + (function (_ size constructor) + (<| (..bytecode (|>> (as Nat) (n.= size))) + (do /.monad + [_ (!length size) + _ constructor + _ ?length] + $Long::wrap)))) + write_and_read (is (All (_ a) + (-> Nat (Bytecode Any) + a (-> a (Bytecode Any)) + [(Bytecode Any) (Bytecode Any) (Bytecode Any)] + (-> a Any Bit) + (Random Bit))) + (function (_ size constructor value literal [*store *load *wrap] test) + (let [!index ($Integer::literal (ffi.long_to_int (as java/lang/Long +0)))] + (<| (..bytecode (test value)) + (do /.monad + [_ (!length size) + _ constructor + _ /.dup _ !index _ (literal value) _ *store + _ /.dup _ !index _ *load] + *wrap))))) + array (is (All (_ a) + (-> (Bytecode Any) (Random a) (-> a (Bytecode Any)) + [(Bytecode Any) (Bytecode Any) (Bytecode Any)] + (-> a Any Bit) + Test)) + (function (_ constructor random literal [*store *load *wrap] test) + (do [! random.monad] + [size (of ! each (|>> (n.% 1024) (n.max 1)) random.nat) + value random] + (all _.and + (<| (_.lifted "length") + (length size constructor)) + (<| (_.lifted "write and read") + (write_and_read size constructor value literal [*store *load *wrap] test))))))] + (all _.and + (_.context "boolean" + (array (/.newarray /instruction.t_boolean) $Boolean::random $Boolean::literal [/.bastore /.baload $Boolean::wrap] + (function (_ expected) (|>> (as Bit) (bit#= (as Bit expected)))))) + (_.context "byte" + (array (/.newarray /instruction.t_byte) $Byte::random $Byte::literal [/.bastore /.baload $Byte::wrap] + (function (_ expected) + (for @.old + (|>> (as java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) + + @.jvm + (|>> (as java/lang/Byte) ffi.byte_to_long .jvm_object_cast# (.jvm_long_=# (.jvm_object_cast# (ffi.byte_to_long (as java/lang/Byte expected))))))))) + (_.context "short" + (array (/.newarray /instruction.t_short) $Short::random $Short::literal [/.sastore /.saload $Short::wrap] + (function (_ expected) + (for @.old + (|>> (as java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) + + @.jvm + (|>> (as java/lang/Short) ffi.short_to_long .jvm_object_cast# (.jvm_long_=# (.jvm_object_cast# (ffi.short_to_long (as java/lang/Short expected))))))))) + (_.context "int" + (array (/.newarray /instruction.t_int) $Integer::random $Integer::literal [/.iastore /.iaload $Integer::wrap] + (function (_ expected) + (for @.old + (|>> (as java/lang/Integer) ("jvm ieq" (as java/lang/Integer expected))) + + @.jvm + (|>> (as java/lang/Integer) .jvm_object_cast# (.jvm_int_=# (.jvm_object_cast# (as java/lang/Integer expected)))))))) + (_.context "long" + (array (/.newarray /instruction.t_long) $Long::random $Long::literal [/.lastore /.laload $Long::wrap] + (function (_ expected) + (for @.old + (|>> (as java/lang/Long) ("jvm leq" expected)) + + @.jvm + (|>> (as java/lang/Long) .jvm_object_cast# (.jvm_long_=# (.jvm_object_cast# (as java/lang/Long expected)))))))) + (_.context "float" + (array (/.newarray /instruction.t_float) ..valid_float $Float::literal [/.fastore /.faload $Float::wrap] + (function (_ expected) + (for @.old + (|>> (as java/lang/Float) ("jvm feq" expected)) + + @.jvm + (|>> (as java/lang/Float) .jvm_object_cast# (.jvm_float_=# (.jvm_object_cast# (as java/lang/Float expected)))))))) + (_.context "double" + (array (/.newarray /instruction.t_double) ..valid_double $Double::literal [/.dastore /.daload $Double::wrap] + (function (_ expected) + (for @.old + (|>> (as java/lang/Double) ("jvm deq" expected)) + + @.jvm + (|>> (as java/lang/Double) .jvm_object_cast# (.jvm_double_=# (.jvm_object_cast# (as java/lang/Double expected)))))))) + (_.context "char" + (array (/.newarray /instruction.t_char) $Character::random $Character::literal [/.castore /.caload $Character::wrap] + (function (_ expected) + (for @.old + (|>> (as java/lang/Character) ("jvm ceq" expected)) + + @.jvm + (|>> (as java/lang/Character) .jvm_object_cast# (.jvm_char_=# (.jvm_object_cast# (as java/lang/Character expected)))))))) + (_.context "object" + (array (/.anewarray ..$String) $String::random $String::literal [/.aastore /.aaload /.nop] + (function (_ expected) (|>> (as Text) (text#= (as Text expected)))))) + (<| (_.context "multi") + (do [! random.monad] + [.let [size (of ! each (|>> (n.% 5) (n.+ 1)) + random.nat)] + dimensions size + sizesH size + sizesT (random.list (-- dimensions) size) + .let [type (loop (again [dimensions dimensions + type (is (Type Object) + ..$Object)]) + (when dimensions + 0 type + _ (again (-- dimensions) (/type.array type))))]] + (<| (_.lifted "MULTIANEWARRAY") + (..bytecode (|>> (as Nat) (n.= sizesH))) + (do [! /.monad] + [_ (monad.each ! (|>> (as java/lang/Long) ffi.long_to_int ..$Integer::literal) + {.#Item sizesH sizesT}) + _ (/.multianewarray type (|> dimensions /unsigned.u1 try.trusted)) + _ ?length] + $Long::wrap)))) + ))) + +(def !::= + (template (_ <type> <old> <new>) + [(is (-> <type> Any Bit) + (function (_ expected) + (for @.old + (|>> (as <type>) (<old> expected)) + + @.jvm + (|>> (as <type>) .jvm_object_cast# (<new> (.jvm_object_cast# (as <type> expected)))))))])) + +(def conversion + Test + (let [conversion (is (All (_ a z) + (-> (Primitive a) (Primitive z) (Bytecode Any) (-> a z) (-> z Any Bit) (Random Bit))) + (function (_ from to instruction convert test) + (do random.monad + [input (the #random from) + .let [expected (convert input)]] + (..bytecode (test expected) + (do /.monad + [_ ((the #literal from) input) + _ instruction] + (the #wrap to)))))) + int::= (!::= java/lang/Integer "jvm ieq" .jvm_int_=#) + long::= (!::= java/lang/Long "jvm leq" .jvm_long_=#) + float::= (!::= java/lang/Float "jvm feq" .jvm_float_=#) + double::= (!::= java/lang/Double "jvm deq" .jvm_double_=#)] + (all _.and + (<| (_.context "int") + (all _.and + (_.lifted "I2L" (conversion ..$Integer::primitive ..$Long::primitive /.i2l (|>> ffi.int_to_long) long::=)) + (_.lifted "I2F" (conversion ..$Integer::primitive ..$Float::primitive /.i2f (|>> ffi.int_to_float) float::=)) + (_.lifted "I2D" (conversion ..$Integer::primitive ..$Double::primitive /.i2d (|>> ffi.int_to_double) double::=)) + (_.lifted "I2B" (conversion ..$Integer::primitive ..$Byte::primitive /.i2b (|>> ffi.int_to_byte) + (function (_ expected) + (for @.old + (|>> (as java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) + + @.jvm + (|>> (as java/lang/Byte) ffi.byte_to_long .jvm_object_cast# (.jvm_long_=# (.jvm_object_cast# (ffi.byte_to_long (as java/lang/Byte expected))))))))) + (_.lifted "I2C" (conversion ..$Integer::primitive ..$Character::primitive /.i2c (|>> ffi.int_to_char) + (!::= java/lang/Character "jvm ceq" .jvm_char_=#))) + (_.lifted "I2S" (conversion ..$Integer::primitive ..$Short::primitive /.i2s (|>> ffi.int_to_short) + (function (_ expected) + (for @.old + (|>> (as java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) + + @.jvm + (|>> (as java/lang/Short) ffi.short_to_long .jvm_object_cast# (.jvm_long_=# (.jvm_object_cast# (ffi.short_to_long (as java/lang/Short expected))))))))))) + (<| (_.context "long") + (all _.and + (_.lifted "L2I" (conversion ..$Long::primitive ..$Integer::primitive /.l2i (|>> ffi.long_to_int) int::=)) + (_.lifted "L2F" (conversion ..$Long::primitive ..$Float::primitive /.l2f (|>> ffi.long_to_float) float::=)) + (_.lifted "L2D" (conversion ..$Long::primitive ..$Double::primitive /.l2d (|>> ffi.long_to_double) double::=)))) + (<| (_.context "float") + (all _.and + (_.lifted "F2I" (conversion ..$Float::primitive ..$Integer::primitive /.f2i (|>> ffi.float_to_int) int::=)) + (_.lifted "F2L" (conversion ..$Float::primitive ..$Long::primitive /.f2l (|>> ffi.float_to_long) long::=)) + (_.lifted "F2D" (conversion ..$Float::primitive ..$Double::primitive /.f2d (|>> ffi.float_to_double) double::=)))) + (<| (_.context "double") + (all _.and + (_.lifted "D2I" (conversion ..$Double::primitive ..$Integer::primitive /.d2i (|>> ffi.double_to_int) int::=)) + (_.lifted "D2L" (conversion ..$Double::primitive ..$Long::primitive /.d2l (|>> ffi.double_to_long) long::=)) + (_.lifted "D2F" (conversion ..$Double::primitive ..$Float::primitive /.d2f (|>> ffi.double_to_float) float::=)))) + ))) + +(def value + Test + (all _.and + (<| (_.context "primitive") + ..primitive) + (<| (_.context "object") + ..object) + (<| (_.context "method") + ..method) + (<| (_.context "field") + ..field) + (<| (_.context "array") + ..array) + (<| (_.context "conversion") + ..conversion) + )) + +(def registry + Test + (let [store_and_load (is (All (_ a) + (-> (Random a) (-> a (Bytecode Any)) (Bytecode Any) + [(-> Nat (Bytecode Any)) (-> Nat (Bytecode Any))] + (-> a (-> Any Bit)) + (Random Bit))) + (function (_ random_value literal *wrap [store load] test) + (do [! random.monad] + [expected random_value + register (of ! each (n.% 128) random.nat)] + (<| (..bytecode (test expected)) + (do /.monad + [_ (literal expected) + _ (store register) + _ (load register)] + *wrap)))))] + (all _.and + (<| (_.context "int") + (let [test (!::= java/lang/Integer "jvm ieq" .jvm_int_=#)] + (all _.and + (_.lifted "ISTORE_0/ILOAD_0" + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_0) (function.constant /.iload_0)] test)) + (_.lifted "ISTORE_1/ILOAD_1" + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_1) (function.constant /.iload_1)] test)) + (_.lifted "ISTORE_2/ILOAD_2" + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_2) (function.constant /.iload_2)] test)) + (_.lifted "ISTORE_3/ILOAD_3" + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_3) (function.constant /.iload_3)] test)) + (_.lifted "ISTORE/ILOAD" + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [/.istore /.iload] test)) + (_.lifted "IINC" + (do [! random.monad] + [base ..$Byte::random + increment (of ! each (|>> (n.% 100) /unsigned.u1 try.trusted) + random.nat) + .let [expected (is java/lang/Long + (for @.old + ("jvm ladd" + (ffi.byte_to_long base) + (.int (/unsigned.value increment))) + + @.jvm + (.jvm_object_cast# + (.jvm_long_+# (.jvm_object_cast# (ffi.byte_to_long base)) + (.jvm_object_cast# (as java/lang/Long (/unsigned.value increment)))))))]] + (..bytecode (|>> (as Int) (i.= (as Int expected))) + (do /.monad + [_ (..$Byte::literal base) + _ /.istore_0 + _ (/.iinc 0 increment) + _ /.iload_0 + _ /.i2l] + ..$Long::wrap))))))) + (<| (_.context "long") + (let [test (!::= java/lang/Long "jvm leq" .jvm_long_=#)] + (all _.and + (_.lifted "LSTORE_0/LLOAD_0" + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_0) (function.constant /.lload_0)] test)) + (_.lifted "LSTORE_1/LLOAD_1" + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_1) (function.constant /.lload_1)] test)) + (_.lifted "LSTORE_2/LLOAD_2" + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_2) (function.constant /.lload_2)] test)) + (_.lifted "LSTORE_3/LLOAD_3" + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_3) (function.constant /.lload_3)] test)) + (_.lifted "LSTORE/LLOAD" + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [/.lstore /.lload] test))))) + (<| (_.context "float") + (let [test (!::= java/lang/Float "jvm feq" .jvm_float_=#)] + (all _.and + (_.lifted "FSTORE_0/FLOAD_0" + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_0) (function.constant /.fload_0)] test)) + (_.lifted "FSTORE_1/FLOAD_1" + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_1) (function.constant /.fload_1)] test)) + (_.lifted "FSTORE_2/FLOAD_2" + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_2) (function.constant /.fload_2)] test)) + (_.lifted "FSTORE_3/FLOAD_3" + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_3) (function.constant /.fload_3)] test)) + (_.lifted "FSTORE/FLOAD" + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [/.fstore /.fload] test))))) + (<| (_.context "double") + (let [test (!::= java/lang/Double "jvm deq" .jvm_double_=#)] + (all _.and + (_.lifted "DSTORE_0/DLOAD_0" + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_0) (function.constant /.dload_0)] test)) + (_.lifted "DSTORE_1/DLOAD_1" + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_1) (function.constant /.dload_1)] test)) + (_.lifted "DSTORE_2/DLOAD_2" + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_2) (function.constant /.dload_2)] test)) + (_.lifted "DSTORE_3/DLOAD_3" + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_3) (function.constant /.dload_3)] test)) + (_.lifted "DSTORE/DLOAD" + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [/.dstore /.dload] test))))) + (<| (_.context "object") + (let [test (is (-> java/lang/String Any Bit) + (function (_ expected actual) + (|> actual (as Text) (text#= (as Text expected)))))] + (all _.and + (_.lifted "ASTORE_0/ALOAD_0" + (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_0) (function.constant /.aload_0)] test)) + (_.lifted "ASTORE_1/ALOAD_1" + (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_1) (function.constant /.aload_1)] test)) + (_.lifted "ASTORE_2/ALOAD_2" + (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_2) (function.constant /.aload_2)] test)) + (_.lifted "ASTORE_3/ALOAD_3" + (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_3) (function.constant /.aload_3)] test)) + (_.lifted "ASTORE/ALOAD" + (store_and_load ..$String::random ..$String::literal /.nop [/.astore /.aload] test))))) + ))) + +(def stack + Test + (do random.monad + [expected/1 $String::random + .let [object_test (is (-> Any Bit) + (|>> (as Text) (text#= (as Text expected/1))))] + dummy/1 $String::random + .let [single (all _.and + (<| (_.lifted "DUP & POP") + (..bytecode object_test) + (do /.monad + [_ ($String::literal expected/1) + _ /.dup] + /.pop)) + (<| (_.lifted "DUP_X1 & POP2") + (..bytecode object_test) + (do /.monad + [_ ($String::literal dummy/1) + _ ($String::literal expected/1) + _ /.dup_x1] + /.pop2)) + (<| (_.lifted "DUP_X2") + (..bytecode object_test) + (do /.monad + [_ ($String::literal dummy/1) + _ ($String::literal dummy/1) + _ ($String::literal expected/1) + _ /.dup_x2 + _ /.pop2] + /.pop)) + (<| (_.lifted "SWAP") + (..bytecode object_test) + (do /.monad + [_ ($String::literal dummy/1) + _ ($String::literal expected/1) + _ /.swap] + /.pop)) + )] + expected/2 $Long::random + .let [long_test (is (-> Any Bit) + (|>> (as Int) (i.= (as Int expected/2))))] + dummy/2 $Long::random + .let [double (all _.and + (<| (_.lifted "DUP2") + (..bytecode long_test) + (do /.monad + [_ ($Long::literal expected/2) + _ /.dup2 + _ /.pop2] + ..$Long::wrap)) + (<| (_.lifted "DUP2_X1") + (..bytecode long_test) + (do /.monad + [_ ($String::literal dummy/1) + _ ($Long::literal expected/2) + _ /.dup2_x1 + _ /.pop2 + _ /.pop] + ..$Long::wrap)) + (<| (_.lifted "DUP2_X2") + (..bytecode long_test) + (do /.monad + [_ ($Long::literal dummy/2) + _ ($Long::literal expected/2) + _ /.dup2_x2 + _ /.pop2 + _ /.pop2] + ..$Long::wrap)) + )]] + (all _.and + (<| (_.context "single") + single) + (<| (_.context "double") + double) + ))) + +(def resource + Test + (all _.and + (<| (_.context "registry") + ..registry) + (<| (_.context "stack") + ..stack) + )) + +(def return + Test + (let [primitive_return (is (All (_ a) (-> (Primitive a) (Bytecode Any) (Maybe (-> a (Bytecode Any))) (-> a Any Bit) (Random Bit))) + (function (_ primitive return substitute test) + (do random.monad + [class_name ..class_name + primitive_method_name (random.upper_cased 10) + .let [primitive_method_type (/type.method [(list) (list) (the #unboxed primitive) (list)])] + object_method_name (|> (random.upper_cased 10) + (random.only (|>> (text#= primitive_method_name) not))) + expected (the #random primitive) + .let [$Self (/type.class class_name (list))]] + (in (when (do try.monad + [class (/class.class /version.v6_0 /class.public + (/name.internal class_name) + {.#None} + (/name.internal "java.lang.Object") + (list) + (list) + (list (/method.method ..method_modifier + primitive_method_name + false primitive_method_type + (list) + {.#Some (do /.monad + [_ ((the #literal primitive) expected)] + return)}) + (/method.method ..method_modifier + object_method_name + false (/type.method [(list) (list) (the #boxed primitive) (list)]) + (list) + {.#Some (do /.monad + [_ (/.invokestatic $Self primitive_method_name primitive_method_type) + _ (when substitute + {.#None} + (in []) + + {.#Some substitute} + (substitute expected)) + _ (the #wrap primitive)] + /.areturn)})) + (list)) + .let [bytecode (binary.result /class.format class) + loader (/loader.memory (/loader.new_library []))] + _ (/loader.define class_name bytecode loader) + class (io.run! (/loader.load class_name loader)) + method (try (get_method object_method_name class))] + (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)) + {try.#Success actual} + (test expected actual) + + {try.#Failure error} + false) + ))))] + (all _.and + (_.lifted "IRETURN" (primitive_return ..$Integer::primitive /.ireturn {.#None} (!::= java/lang/Integer "jvm ieq" .jvm_int_=#))) + (_.lifted "LRETURN" (primitive_return ..$Long::primitive /.lreturn {.#None} (!::= java/lang/Long "jvm leq" .jvm_long_=#))) + (_.lifted "FRETURN" (primitive_return ..$Float::primitive /.freturn {.#None} (!::= java/lang/Float "jvm feq" .jvm_float_=#))) + (_.lifted "DRETURN" (primitive_return ..$Double::primitive /.dreturn {.#None} (!::= java/lang/Double "jvm deq" .jvm_double_=#))) + (_.lifted "ARETURN" (primitive_return ..$String::primitive /.areturn {.#None} (function (_ expected actual) (text#= (as Text expected) (as Text actual))))) + (_.lifted "RETURN" (primitive_return (is (Primitive java/lang/String) + [#unboxed /type.void + #boxed ..$String + #wrap /.nop + #random ..$String::random + #literal (function.constant /.nop)]) + /.return + {.#Some ..$String::literal} + (function (_ expected actual) (text#= (as Text expected) (as Text actual))))) + ))) + +(def branching + Test + (do random.monad + [expected ..$Long::random + dummy ..$Long::random + .let [if! (is (-> (-> Label (Bytecode Any)) (Bytecode Any) (Random Bit)) + (function (_ instruction prelude) + (<| (..bytecode ((!::= java/lang/Long "jvm leq" .jvm_long_=#) expected)) + (do /.monad + [@then /.new_label + @end /.new_label + _ prelude + _ (instruction @then) + _ (..$Long::literal dummy) + _ (/.goto @end) + _ (/.set_label @then) + _ (..$Long::literal expected) + _ (/.set_label @end)] + ..$Long::wrap)))) + comparison_against_zero (all _.and + (_.lifted "IFEQ" (if! /.ifeq /.iconst_0)) + (_.lifted "IFNE" (if! /.ifne /.iconst_1)) + (_.lifted "IFLT" (if! /.iflt /.iconst_m1)) + (_.lifted "IFLE" (if! /.ifle /.iconst_0)) + (_.lifted "IFGT" (if! /.ifgt /.iconst_1)) + (_.lifted "IFGE" (if! /.ifge /.iconst_0))) + null_test (all _.and + (_.lifted "IFNULL" (if! /.ifnull /.aconst_null)) + (_.lifted "IFNONNULL" (if! /.ifnonnull (/.string ""))))] + reference ..$Integer::random + subject (|> ..$Integer::random + (random.only (|>> ((!::= java/lang/Integer "jvm ieq" .jvm_int_=#) reference) not))) + .let [[lesser greater] (if (for @.old + ("jvm ilt" reference subject) + + @.jvm + (.jvm_int_<# (.jvm_object_cast# subject) (.jvm_object_cast# reference))) + [reference subject] + [subject reference]) + int_comparison (all _.and + (_.lifted "IF_ICMPEQ" (if! /.if_icmpeq (do /.monad [_ (..$Integer::literal reference)] /.dup))) + (_.lifted "IF_ICMPNE" (if! /.if_icmpne (do /.monad [_ (..$Integer::literal reference)] (..$Integer::literal subject)))) + (_.lifted "IF_ICMPLT" (if! /.if_icmplt (do /.monad [_ (..$Integer::literal lesser)] (..$Integer::literal greater)))) + (_.lifted "IF_ICMPLE" (if! /.if_icmple (do /.monad [_ (..$Integer::literal lesser)] (..$Integer::literal greater)))) + (_.lifted "IF_ICMPGT" (if! /.if_icmpgt (do /.monad [_ (..$Integer::literal greater)] (..$Integer::literal lesser)))) + (_.lifted "IF_ICMPGE" (if! /.if_icmpge (do /.monad [_ (..$Integer::literal greater)] (..$Integer::literal lesser))))) + new_object (is (Bytecode Any) + (do /.monad + [_ (/.new ..$Object) + _ /.dup] + (/.invokespecial ..$Object "<init>" (/type.method [(list) (list) /type.void (list)])))) + reference_comparison (all _.and + (_.lifted "IF_ACMPEQ" (if! /.if_acmpeq (do /.monad [_ new_object] /.dup))) + (_.lifted "IF_ACMPNE" (if! /.if_acmpne (do /.monad [_ new_object] new_object))) + )]] + (all _.and + comparison_against_zero + null_test + int_comparison + reference_comparison + ))) + +(def jump + Test + (do random.monad + [expected ..$Long::random + dummy ..$Long::random + .let [jump (is (-> (-> Label (Bytecode Any)) (Random Bit)) + (function (_ goto) + (<| (..bytecode ((!::= java/lang/Long "jvm leq" .jvm_long_=#) expected)) + (do /.monad + [@skipped /.new_label + @value /.new_label + @end /.new_label + _ (goto @value) + _ (/.set_label @skipped) + _ (..$Long::literal dummy) + _ (goto @end) + _ (/.set_label @value) + _ (..$Long::literal expected) + _ (/.set_label @end)] + ..$Long::wrap))))]] + (all _.and + (_.lifted "GOTO" (jump /.goto)) + (_.lifted "GOTO_W" (jump /.goto_w))))) + +(def switch + Test + (all _.and + (<| (_.lifted "TABLESWITCH") + (do [! random.monad] + [expected ..$Long::random + dummy ..$Long::random + minimum (of ! each (|>> (n.% 100) .int /signed.s4 try.trusted) + random.nat) + afterwards (of ! each (n.% 10) random.nat)]) + (..bytecode ((!::= java/lang/Long "jvm leq" .jvm_long_=#) expected)) + (do /.monad + [@right /.new_label + @wrong /.new_label + @return /.new_label + _ (/.bipush (|> minimum /signed.value .int /signed.s1 try.trusted)) + _ (/.tableswitch minimum @wrong [@right (list.repeated afterwards @wrong)]) + _ (/.set_label @wrong) + _ (..$Long::literal dummy) + _ (/.goto @return) + _ (/.set_label @right) + _ (..$Long::literal expected) + _ (/.set_label @return)] + ..$Long::wrap)) + (<| (_.lifted "LOOKUPSWITCH") + (do [! random.monad] + [options (of ! each (|>> (n.% 10) (n.+ 1)) + random.nat) + choice (of ! each (n.% options) random.nat) + options (|> random.int + (of ! each (|>> (as java/lang/Long) ffi.long_to_int ffi.int_to_long (as Int))) + (random.set i.hash options) + (of ! each set.list)) + .let [choice (maybe.trusted (list.item choice options))] + expected ..$Long::random + dummy ..$Long::random]) + (..bytecode ((!::= java/lang/Long "jvm leq" .jvm_long_=#) expected)) + (do /.monad + [@right /.new_label + @wrong /.new_label + @return /.new_label + _ (..$Integer::literal (ffi.long_to_int (as java/lang/Long choice))) + _ (/.lookupswitch @wrong (list#each (function (_ option) + [(|> option /signed.s4 try.trusted) + (if (i.= choice option) @right @wrong)]) + options)) + _ (/.set_label @wrong) + _ (..$Long::literal dummy) + _ (/.goto @return) + _ (/.set_label @right) + _ (..$Long::literal expected) + _ (/.set_label @return)] + ..$Long::wrap)) + )) + +(def exception + Test + (do random.monad + [expected ..$Long::random + dummy ..$Long::random + exception ..$String::random] + (<| (_.lifted "ATHROW") + (..bytecode ((!::= java/lang/Long "jvm leq" .jvm_long_=#) expected)) + (do /.monad + [.let [$Exception (/type.class "java.lang.Exception" (list))] + @skipped /.new_label + @try /.new_label + @handler /.new_label + @return /.new_label + _ (/.try @try @handler @handler $Exception) + _ (/.set_label @try) + _ (/.new $Exception) + _ /.dup + _ (..$String::literal exception) + _ (/.invokespecial $Exception "<init>" (/type.method [(list) (list ..$String) /type.void (list)])) + _ /.athrow + _ (/.set_label @skipped) + _ (..$Long::literal dummy) + _ (/.goto @return) + _ (/.set_label @handler) + _ /.pop + _ (..$Long::literal expected) + _ (/.set_label @return)] + ..$Long::wrap)))) + +(def code + Test + (all _.and + (<| (_.context "return") + ..return) + (<| (_.context "branching") + ..branching) + (<| (_.context "jump") + ..jump) + (<| (_.context "switch") + ..switch) + (<| (_.context "exception") + ..exception) + )) + +(def instruction + Test + (all _.and + (<| (_.context "value") + ..value) + (<| (_.context "resource") + ..resource) + (<| (_.context "code") + ..code) + )) + +(def inheritance + Test + (do random.monad + [abstract_class ..class_name + interface_class (|> ..class_name + (random.only (|>> (text#= abstract_class) not))) + concrete_class (|> ..class_name + (random.only (function (_ class) + (not (or (text#= abstract_class class) + (text#= interface_class class)))))) + part0 ..$Long::random + part1 ..$Long::random + part2 ..$Long::random + fake_part2 ..$Long::random + part3 ..$Long::random + part4 ..$Long::random + .let [expected (all i.+ + (as Int part0) + (as Int part1) + (as Int part2) + (as Int part3) + (as Int part4)) + $Concrete (/type.class concrete_class (list)) + $Abstract (/type.class abstract_class (list)) + $Interface (/type.class interface_class (list)) + + constructor::type (/type.method [(list) (list) /type.void (list)]) + method::type (/type.method [(list) (list) /type.long (list)]) + + inherited_method "inherited_method" + overriden_method "overriden_method" + abstract_method "abstract_method" + interface_method "interface_method" + virtual_method "virtual_method" + static_method "static_method" + + method (is (-> Text java/lang/Long (Resource Method)) + (function (_ name value) + (/method.method /method.public + name + false method::type + (list) + {.#Some (do /.monad + [_ (..$Long::literal value)] + /.lreturn)}))) + + interface_bytecode (|> (/class.class /version.v6_0 (all /modifier#composite /class.public /class.abstract /class.interface) + (/name.internal interface_class) + {.#None} + (/name.internal "java.lang.Object") + (list) + (list) + (list (/method.method (all /modifier#composite /method.public /method.abstract) + interface_method false method::type (list) {.#None})) + (list)) + try.trusted + (binary.result /class.format)) + abstract_bytecode (|> (/class.class /version.v6_0 (all /modifier#composite /class.public /class.abstract) + (/name.internal abstract_class) + {.#None} + (/name.internal "java.lang.Object") + (list) + (list) + (list (/method.method /method.public + "<init>" + false constructor::type + (list) + {.#Some (do /.monad + [_ /.aload_0 + _ (/.invokespecial ..$Object "<init>" constructor::type)] + /.return)}) + (method inherited_method part0) + (method overriden_method fake_part2) + (/method.method (all /modifier#composite /method.public /method.abstract) + abstract_method false method::type (list) {.#None})) + (list)) + try.trusted + (binary.result /class.format)) + invoke (is (-> (Type Class) Text (Bytecode Any)) + (function (_ class method) + (do /.monad + [_ /.aload_0] + (/.invokevirtual class method method::type)))) + concrete_bytecode (|> (/class.class /version.v6_0 /class.public + (/name.internal concrete_class) + {.#None} + (/name.internal abstract_class) + (list (/name.internal interface_class)) + (list) + (list (/method.method /method.public + "<init>" + false constructor::type + (list) + {.#Some (do /.monad + [_ /.aload_0 + _ (/.invokespecial $Abstract "<init>" constructor::type)] + /.return)}) + (method virtual_method part1) + (method overriden_method part2) + (method abstract_method part3) + (method interface_method part4) + (/method.method (all /modifier#composite + /method.public + /method.static) + static_method + false (/type.method [(list) (list) ..$Long (list)]) + (list) + {.#Some (do /.monad + [_ (/.new $Concrete) + _ /.dup + _ (/.invokespecial $Concrete "<init>" constructor::type) + _ /.astore_0 + _ (invoke $Abstract inherited_method) + _ (invoke $Concrete virtual_method) + _ /.ladd + _ (invoke $Abstract overriden_method) + _ /.ladd + _ /.aload_0 _ (/.invokeinterface $Interface interface_method method::type) + _ /.ladd + _ (invoke $Abstract abstract_method) + _ /.ladd + _ ..$Long::wrap] + /.areturn)})) + (list)) + try.trusted + (binary.result /class.format)) + loader (/loader.memory (/loader.new_library []))]] + (_.test "Class & interface inheritance" + (when (do try.monad + [_ (/loader.define abstract_class abstract_bytecode loader) + _ (/loader.define interface_class interface_bytecode loader) + _ (/loader.define concrete_class concrete_bytecode loader) + class (io.run! (/loader.load concrete_class loader)) + method (try (get_method static_method class)) + output (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)] + (in (as Int output))) + {try.#Success actual} + (i.= (as Int expected) (as Int actual)) + + {try.#Failure error} + false)))) + +(def .public test + Test + (<| (_.context (%.symbol (symbol .._))) + (all _.and + (<| (_.context "instruction") + ..instruction) + (<| (_.context "inheritance") + ..inheritance) + ))) diff --git a/stdlib/source/test/lux/meta/compiler/target/lua.lux b/stdlib/source/test/lux/meta/compiler/target/lua.lux new file mode 100644 index 000000000..8aa357f30 --- /dev/null +++ b/stdlib/source/test/lux/meta/compiler/target/lua.lux @@ -0,0 +1,725 @@ +(.require + [library + [lux (.except) + ["[0]" ffi] + [abstract + [monad (.only do)] + ["[0]" hash + ["[1]T" \\test]] + ["[0]" equivalence + ["[1]T" \\test]]] + [control + ["[0]" pipe] + ["[0]" function] + ["[0]" maybe (.use "[1]#[0]" functor)] + ["[0]" try (.only Try) (.use "[1]#[0]" functor)]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.only \n) (.use "[1]#[0]" equivalence) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor)]]] + [math + ["[0]" random (.only Random) (.use "[1]#[0]" monad)] + [number + ["n" nat] + ["i" int] + ["f" frac] + ["[0]" i64]]] + [meta + ["[0]" static] + [macro + ["[0]" template]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +... http://www.lua.org/manual/5.3/manual.html#pdf-load +(ffi.import (load [Text] "?" (-> Any Any))) + +(def (expression ??? it) + (-> (-> Any Bit) /.Expression Bit) + (|> it + /.code + (format "return ") + ..load + (maybe#each (|>> (function.on []) ???)) + (maybe.else false))) + +(def test|literal + Test + (do [! random.monad] + [boolean random.bit + int random.int + float random.frac + string (random.upper_cased 5)] + (all _.and + (_.coverage [/.nil] + (|> /.nil + /.code + ..load + (pipe.when + {.#None} true + {.#Some _} false))) + (_.coverage [/.boolean] + (expression (|>> (as Bit) (bit#= boolean)) + (/.boolean boolean))) + (_.coverage [/.int] + (expression (|>> (as Int) (i.= int)) + (/.int int))) + (_.coverage [/.float] + (expression (|>> (as Frac) (f.= float)) + (/.float float))) + (_.coverage [/.string] + (expression (|>> (as Text) (text#= string)) + (/.string string))) + ))) + +(def test|boolean + Test + (do [! random.monad] + [left random.bit + right random.bit] + (`` (all _.and + (,, (with_template [</> <lux>] + [(_.coverage [</>] + (let [expected (<lux> left right)] + (expression (|>> (as Bit) (bit#= expected)) + (</> (/.boolean left) (/.boolean right)))))] + + [/.or .or] + [/.and .and] + )) + (_.coverage [/.not] + (expression (|>> (as Bit) (bit#= (not left))) + (/.not (/.boolean left)))) + )))) + +(with_template [<bits>] + [(`` (def (,, (template.symbol [int_ <bits>])) + (Random Int) + (let [mask (|> 1 (i64.left_shifted (-- <bits>)) --)] + (random#each (|>> (i64.and mask) .int) random.nat))))] + + [16] + [32] + ) + +(def test|int + Test + (do [! random.monad] + [left random.int + right random.int + shift (of ! each (n.% 65) random.nat) + + parameter (random.only (|>> (i.= +0) not) + random.int) + subject random.int] + (`` (all _.and + (,, (with_template [</> <lux>] + [(_.coverage [</>] + (let [expected (<lux> left right)] + (expression (|>> (as Int) (i.= expected)) + (</> (/.int left) (/.int right)))))] + + [/.bit_or i64.or] + [/.bit_xor i64.xor] + [/.bit_and i64.and] + )) + (_.coverage [/.opposite] + (expression (|>> (as Int) (i.= (i.- left +0))) + (/.opposite (/.int left)))) + (_.coverage [/.bit_shl] + (let [expected (i64.left_shifted shift left)] + (expression (|>> (as Int) (i.= expected)) + (/.bit_shl (/.int (.int shift)) + (/.int left))))) + (_.coverage [/.bit_shr] + (let [expected (i64.right_shifted shift left)] + (expression (|>> (as Int) (i.= expected)) + (/.bit_shr (/.int (.int shift)) + (/.int left))))) + (_.coverage [/.//] + (let [expected (if (or (i.= (i.signum parameter) (i.signum subject)) + (i.= +0 (i.% parameter subject))) + (i./ parameter subject) + (-- (i./ parameter subject)))] + (expression (|>> (as Int) (i.= expected)) + (/.// (/.int parameter) (/.int subject))))) + )))) + +(def test|float + Test + (do [! random.monad] + [parameter (random.only (|>> (f.= +0.0) not) + random.safe_frac) + subject random.safe_frac] + (`` (all _.and + (,, (with_template [</> <lux> <pre>] + [(_.coverage [</>] + (let [expected (<lux> (<pre> parameter) (<pre> subject))] + (expression (|>> (as Frac) (f.= expected)) + (</> (/.float (<pre> parameter)) (/.float (<pre> subject))))))] + + [/.+ f.+ |>] + [/.- f.- |>] + [/.* f.* |>] + [/./ f./ |>] + [/.% f.mod |>] + [/.^ f.pow f.abs] + )) + (,, (with_template [</> <lux>] + [(_.coverage [</>] + (let [expected (<lux> parameter subject)] + (expression (|>> (as Bit) (bit#= expected)) + (</> (/.float parameter) (/.float subject)))))] + + [/.< f.<] + [/.<= f.<=] + [/.> f.>] + [/.>= f.>=] + [/.= f.=] + )) + )))) + +(def test|string + Test + (do random.monad + [left (random.lower_cased 8) + right (random.lower_cased 8) + .let [expected (format left right)]] + (all _.and + (_.coverage [/.concat] + (expression (|>> (as Text) (text#= expected)) + (|> (/.string left) + (/.concat (/.string right))))) + ))) + +(def test|array + Test + (do [! random.monad] + [size (of ! each (|>> (n.% 10) ++) random.nat) + index (of ! each (n.% size) random.nat) + items (random.list size random.safe_frac) + .let [expected (|> items + (list.item index) + maybe.trusted)]] + (all _.and + (_.coverage [/.array /.item] + (and (expression (|>> (as Frac) (f.= expected)) + (/.item (/.int (.int (++ index))) + (/.array (list#each /.float items)))) + (expression (|>> (as Bit)) + (|> (/.array (list#each /.float items)) + (/.item (/.int (.int (++ size)))) + (/.= /.nil))))) + (_.coverage [/.length] + (expression (|>> (as Int) (i.= (.int size))) + (/.length (/.array (list#each /.float items))))) + ))) + +(def test|table + Test + (do [! random.monad] + [expected random.safe_frac + dummy (random.only (|>> (f.= expected) not) + random.safe_frac) + + size (of ! each (|>> (n.% 10) ++) random.nat) + index (of ! each (n.% size) random.nat) + items (random.list size random.safe_frac) + + $self (of ! each /.var (random.lower_cased 10)) + $table (of ! each /.var (random.lower_cased 11)) + $arg (of ! each /.var (random.lower_cased 12)) + field (random.upper_cased 5) + non_field (random.only (|>> (text#= field) not) + (random.upper_cased 5)) + method (random.upper_cased 6)] + (all _.and + (_.coverage [/.table /.the] + (and (expression (|>> (as Frac) (f.= expected)) + (/.the field (/.table (list [field (/.float expected)])))) + (expression (|>> (as Bit)) + (|> (/.table (list [field (/.float expected)])) + (/.the non_field) + (/.= /.nil))))) + (_.coverage [/.do /.function] + (expression (|>> (as Frac) (f.= expected)) + (|> (all /.then + (/.local/1 $table (/.table (list [field (/.float expected)]))) + (/.function (/.the method $table) (list $self $arg) + (/.if (/.= (/.float dummy) $arg) + (/.return (/.the field $self)) + (/.return $arg))) + (/.return (/.do method (list (/.float dummy)) $table))) + (/.closure (list)) + (/.apply (list))))) + ))) + +(def test|computation + Test + (do [! random.monad] + [test random.bit + then random.safe_frac + else random.safe_frac + + boolean random.bit + int random.int + float random.frac + string (random.upper_cased 5) + + comment (random.upper_cased 10)] + (all _.and + ..test|boolean + ..test|int + ..test|float + ..test|string + ..test|array + ..test|table + (_.coverage [/.type/1] + (and (expression (|>> (as Text) (text#= "boolean")) + (/.type/1 (/.boolean boolean))) + (expression (|>> (as Text) (text#= "number")) + (/.type/1 (/.int int))) + (expression (|>> (as Text) (text#= "number")) + (/.type/1 (/.float float))) + (expression (|>> (as Text) (text#= "string")) + (/.type/1 (/.string string))) + (expression (|>> (as Text) (text#= "nil")) + (/.type/1 /.nil)) + (expression (|>> (as Text) (text#= "table")) + (/.type/1 (/.table (list [string (/.float float)])))) + (expression (|>> (as Text) (text#= "table")) + (/.type/1 (/.array (list (/.boolean boolean) + (/.float float) + (/.string string))))) + )) + (_.coverage [/.require/1] + (expression (|>> (as Int) (i.= (i.abs int))) + (|> (/.require/1 (/.string "math")) + (/.the "abs") + (/.apply (list (/.int int)))))) + (_.coverage [/.comment] + (expression (|>> (as Frac) (f.= then)) + (/.comment comment + (/.float then)))) + ))) + +(def test|expression + Test + (`` (all _.and + (_.for [/.Literal] + ..test|literal) + (_.for [/.Computation] + ..test|computation) + ))) + +(def test/var + Test + (do [! random.monad] + [float/0 random.safe_frac + float/1 random.safe_frac + float/2 random.safe_frac + foreign (random.lower_cased 10) + local (random.only (|>> (text#= foreign) not) + (random.lower_cased 10)) + .let [$foreign (/.var foreign) + $local (/.var local)]] + (all _.and + (_.coverage [/.var] + (expression (|>> (as Frac) (f.= float/0)) + (|> (/.return $foreign) + (/.closure (list $foreign)) + (/.apply (list (/.float float/0)))))) + (_.coverage [/.let] + (expression (|>> (as Frac) (f.= float/1)) + (|> (all /.then + (/.let (list $local) (/.float float/1)) + (/.return $local)) + (/.closure (list $foreign)) + (/.apply (list (/.float float/0)))))) + (_.coverage [/.local/1] + (expression (|>> (as Frac) (f.= float/1)) + (|> (all /.then + (/.local/1 $local (/.float float/1)) + (/.return $local)) + (/.closure (list $foreign)) + (/.apply (list (/.float float/0)))))) + (_.coverage [/.local] + (expression (|>> (as Frac) (f.= float/1)) + (|> (all /.then + (/.local (list $local)) + (/.set (list $local) (/.float float/1)) + (/.return $local)) + (/.closure (list $foreign)) + (/.apply (list (/.float float/0)))))) + ))) + +(def test/location + Test + (do [! random.monad] + [float/0 random.safe_frac + float/1 random.safe_frac + int/0 ..int_16 + $foreign (of ! each /.var (random.lower_cased 10)) + $arg/0 (of ! each /.var (random.lower_cased 11)) + $arg/1 (of ! each /.var (random.lower_cased 12)) + field (random.upper_cased 10)] + (all _.and + (_.coverage [/.set] + (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) + (|> (all /.then + (/.set (list $foreign) (/.+ $foreign $foreign)) + (/.return $foreign)) + (/.closure (list $foreign)) + (/.apply (list (/.float float/0)))))) + (_.coverage [/.multi] + (and (expression (|>> (as Frac) (f.= float/0)) + (|> (all /.then + (/.set (list $arg/0 $arg/1) (/.multi (list (/.float float/0) (/.float float/1)))) + (/.return $arg/0)) + (/.closure (list)) + (/.apply (list)))) + (expression (|>> (as Frac) (f.= float/1)) + (|> (all /.then + (/.set (list $arg/0 $arg/1) (/.multi (list (/.float float/0) (/.float float/1)))) + (/.return $arg/1)) + (/.closure (list)) + (/.apply (list)))))) + (_.coverage [/.Access] + (and (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) + (let [@ (/.item (/.int +1) $foreign)] + (|> (all /.then + (/.set (list $foreign) (/.array (list $foreign))) + (/.set (list @) (/.+ @ @)) + (/.return @)) + (/.closure (list $foreign)) + (/.apply (list (/.float float/0)))))) + (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) + (let [@ (/.the field $foreign)] + (|> (all /.then + (/.set (list $foreign) (/.table (list [field $foreign]))) + (/.set (list @) (/.+ @ @)) + (/.return @)) + (/.closure (list $foreign)) + (/.apply (list (/.float float/0)))))))) + (_.for [/.Var] + ..test/var) + ))) + +(def test|label + Test + (do [! random.monad] + [input ..int_16 + + full_iterations (of ! each (|>> (n.% 20) ++) random.nat) + expected_iterations (of ! each (|>> (n.% full_iterations) .int) random.nat) + + $input (of ! each /.var (random.lower_cased 10)) + $output (of ! each /.var (random.lower_cased 11)) + $index (of ! each /.var (random.lower_cased 12)) + + @loop (of ! each /.label (random.lower_cased 13)) + + .let [expected (i.* expected_iterations input) + expected_iterations (/.int expected_iterations)]] + (all _.and + (_.coverage [/.break] + (let [=for_in (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $output (/.int +0)) + (/.for_in (list $index $input) (/.ipairs/1 (/.array (list.repeated full_iterations $input))) + (all /.then + (/.when (/.> expected_iterations $index) + /.break) + (/.set (list $output) (/.+ $input $output)))) + (/.return $output)) + (/.closure (list $input)) + (/.apply (list (/.int input))))) + + full_iterations (/.int (.int full_iterations)) + =while (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $index (/.int +0)) + (/.local/1 $output (/.int +0)) + (/.while (/.< full_iterations $index) + (all /.then + (/.when (/.= expected_iterations $index) + /.break) + (/.set (list $output) (/.+ $input $output)) + (/.set (list $index) (/.+ (/.int +1) $index)) + )) + (/.return $output)) + (/.closure (list $input)) + (/.apply (list (/.int input))))) + =repeat (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $index (/.int +0)) + (/.local/1 $output (/.int +0)) + (/.repeat (/.= full_iterations $index) + (all /.then + (/.when (/.= expected_iterations $index) + /.break) + (/.set (list $output) (/.+ $input $output)) + (/.set (list $index) (/.+ (/.int +1) $index)) + )) + (/.return $output)) + (/.closure (list $input)) + (/.apply (list (/.int input))))) + =for_step (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $output (/.int +0)) + (/.for_step $index (/.int +0) full_iterations (/.int +1) + (all /.then + (/.when (/.= expected_iterations $index) + /.break) + (/.set (list $output) (/.+ $input $output)))) + (/.return $output)) + (/.closure (list $input)) + (/.apply (list (/.int input)))))] + (and =while + =repeat + =for_step + =for_in))) + (_.coverage [/.label /.set_label /.go_to] + (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $index (/.int +0)) + (/.local/1 $output (/.int +0)) + (/.set_label @loop) + (/.if (/.< expected_iterations $index) + (all /.then + (/.set (list $output) (/.+ $input $output)) + (/.set (list $index) (/.+ (/.int +1) $index)) + (/.go_to @loop)) + (/.return $output))) + (/.closure (list $input)) + (/.apply (list (/.int input)))))) + ))) + +(def test|loop + Test + (do [! random.monad] + [input ..int_16 + iterations (of ! each (n.% 10) random.nat) + .let [$input (/.var "input") + $output (/.var "output") + $index (/.var "index") + expected (i.* (.int iterations) input)]] + (all _.and + (_.coverage [/.while] + (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $index (/.int +0)) + (/.local/1 $output (/.int +0)) + (/.while (/.< (/.int (.int iterations)) $index) + (all /.then + (/.set (list $output) (/.+ $input $output)) + (/.set (list $index) (/.+ (/.int +1) $index)) + )) + (/.return $output)) + (/.closure (list $input)) + (/.apply (list (/.int input)))))) + (_.coverage [/.repeat] + (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $index (/.int +0)) + (/.local/1 $output (/.int +0)) + (/.repeat (/.= (/.int (.int iterations)) $index) + (all /.then + (/.set (list $output) (/.+ $input $output)) + (/.set (list $index) (/.+ (/.int +1) $index)) + )) + (/.return $output)) + (/.closure (list $input)) + (/.apply (list (/.int input)))))) + (_.coverage [/.for_step] + (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $output (/.int +0)) + (/.for_step $index (/.int +0) (/.int (.int (-- iterations))) (/.int +1) + (/.set (list $output) (/.+ $input $output))) + (/.return $output)) + (/.closure (list $input)) + (/.apply (list (/.int input)))))) + (_.coverage [/.for_in /.ipairs/1] + (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $output (/.int +0)) + (/.for_in (list $index $input) (/.ipairs/1 (/.array (list.repeated iterations $input))) + (/.set (list $output) (/.+ $input $output))) + (/.return $output)) + (/.closure (list $input)) + (/.apply (list (/.int input)))))) + (_.for [/.Label] + ..test|label) + ))) + +(def test|exception + Test + (do [! random.monad] + [expected random.safe_frac + dummy (random.only (|>> (f.= expected) not) + random.safe_frac) + $verdict (of ! each /.var (random.lower_cased 10)) + $outcome (of ! each /.var (random.lower_cased 11))] + (all _.and + (_.coverage [/.pcall/1] + (expression (|>> (as Frac) (f.= expected)) + (|> (all /.then + (/.let (list $verdict $outcome) (/.pcall/1 (/.closure (list) + (/.return (/.float expected))))) + (/.if $verdict + (/.return $outcome) + (/.return (/.float dummy)))) + (/.closure (list)) + (/.apply (list))))) + (_.coverage [/.error/1] + (expression (|>> (as Frac) (f.= expected)) + (|> (all /.then + (/.let (list $verdict $outcome) (/.pcall/1 (/.closure (list) + (all /.then + (/.statement (/.error/1 (/.float expected))) + (/.return (/.float dummy)))))) + (/.if $verdict + (/.return (/.float dummy)) + (/.return $outcome))) + (/.closure (list)) + (/.apply (list))))) + (_.coverage [/.error/2] + (expression (|>> (as Frac) (f.= expected)) + (|> (all /.then + (/.let (list $verdict $outcome) (/.pcall/1 (/.closure (list) + (all /.then + (/.statement (/.error/2 (/.float expected) (/.int +2))) + (/.return (/.float dummy)))))) + (/.if $verdict + (/.return (/.float dummy)) + (/.return $outcome))) + (/.closure (list)) + (/.apply (list))))) + ))) + +(def test|function + Test + (do [! random.monad] + [float/0 random.safe_frac + iterations (of ! each (n.% 10) random.nat) + $self (of ! each /.var (random.lower_cased 1)) + $arg/0 (of ! each /.var (random.lower_cased 2)) + field (random.lower_cased 3) + $class (of ! each /.var (random.upper_cased 4))] + (all _.and + (_.coverage [/.closure /.return] + (expression (|>> (as Frac) (f.= float/0)) + (/.apply (list) + (/.closure (list) (/.return (/.float float/0)))))) + (_.coverage [/.local_function] + (expression (|>> (as Int) .nat (n.= iterations)) + (|> (all /.then + (/.local_function $self (list $arg/0) + (/.if (/.< (/.int (.int iterations)) $arg/0) + (/.return (/.apply (list (/.+ (/.int +1) $arg/0)) $self)) + (/.return $arg/0))) + (/.return (/.apply (list (/.int +0)) $self))) + (/.closure (list)) + (/.apply (list))))) + (do [! random.monad] + [float/0 random.safe_frac + float/1 random.safe_frac + float/2 random.safe_frac + $arg/0 (of ! each /.var (random.lower_cased 10)) + $arg/1 (of ! each /.var (random.lower_cased 11)) + $arg/2 (of ! each /.var (random.lower_cased 12))] + (`` (all _.and + (_.coverage [/.apply] + (expression (|>> (as Frac) (f.= (all f.+ float/0 float/1 float/2))) + (/.apply (list (/.float float/0) + (/.float float/1) + (/.float float/2)) + (/.closure (list $arg/0 $arg/1 $arg/2) (/.return (all /.+ $arg/0 $arg/1 $arg/2)))))) + ))) + ))) + +(def test|branching + Test + (do [! random.monad] + [float/0 random.safe_frac + float/1 random.safe_frac + ??? random.bit] + (all _.and + (_.coverage [/.if] + (expression (|>> (as Frac) (f.= (if ??? float/0 float/1))) + (|> (/.if (/.boolean ???) + (/.return (/.float float/0)) + (/.return (/.float float/1))) + (/.closure (list)) + (/.apply (list))))) + (_.coverage [/.when] + (expression (|>> (as Frac) (f.= (if ??? float/0 float/1))) + (|> (all /.then + (/.when (/.boolean ???) + (/.return (/.float float/0))) + (/.return (/.float float/1))) + (/.closure (list)) + (/.apply (list))))) + ))) + +(def test|binding + Test + (all _.and + ..test|function + (_.for [/.Location] + ..test/location) + )) + +(def test|control + Test + (all _.and + ..test|branching + ..test|loop + ..test|exception + )) + +(def test|statement + Test + (do [! random.monad] + [float/0 random.safe_frac + float/1 random.safe_frac + $arg/0 (of ! each /.var (random.lower_cased 10)) + $arg/1 (of ! each /.var (random.lower_cased 11))] + (`` (all _.and + (_.coverage [/.statement /.then /.print/1] + (expression (|>> (as Frac) (f.= float/0)) + (|> (all /.then + (/.statement (/.print/1 $arg/0)) + (/.return $arg/0)) + (/.closure (list $arg/0)) + (/.apply (list (/.float float/0)))))) + ..test|binding + ..test|control + )))) + +(def .public test + Test + (do [! random.monad] + [.let [random (of ! each /.int random.int)] + expected random.int] + (<| (_.covering /._) + (_.for [/.Code /.code]) + (`` (all _.and + (_.for [/.equivalence] + (equivalenceT.spec /.equivalence random)) + (_.for [/.hash] + (hashT.spec /.hash random)) + + (_.coverage [/.manual] + (expression (|>> (as Int) (i.= expected)) + (/.manual (/.code (/.int expected))))) + (_.for [/.Expression] + ..test|expression) + (_.for [/.Statement] + ..test|statement) + ))))) diff --git a/stdlib/source/test/lux/meta/compiler/target/python.lux b/stdlib/source/test/lux/meta/compiler/target/python.lux new file mode 100644 index 000000000..ac5ba6d0b --- /dev/null +++ b/stdlib/source/test/lux/meta/compiler/target/python.lux @@ -0,0 +1,844 @@ +(.require + [library + [lux (.except) + ["[0]" ffi] + [abstract + [monad (.only do)] + ["[0]" hash + ["[1]T" \\test]] + ["[0]" equivalence + ["[1]T" \\test]]] + [control + ["[0]" maybe (.use "[1]#[0]" functor)] + ["[0]" try (.only Try) (.use "[1]#[0]" functor)] + ["[0]" function (.only) + ["[0]" predicate]]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor)]]] + [math + ["[0]" random (.only Random) (.use "[1]#[0]" monad)] + [number + ["n" nat] + ["i" int] + ["f" frac] + ["[0]" i64]]] + [meta + ["[0]" static] + ["[0]" code]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.use "[1]#[0]" equivalence)]]) + +(ffi.import (eval [Text] "try" "?" Any)) + +(def (expression ??? it) + (-> (-> Any Bit) (/.Expression Any) Bit) + (|> it + /.code + ..eval + (try#each (|>> (maybe#each ???) + (maybe.else false))) + (try.else false))) + +(def test|literal + Test + (do [! random.monad] + [bool random.bit + float random.frac + int random.int + string (random.upper_cased 1)] + (all _.and + (_.coverage [/.none] + (|> /.none + /.code + ..eval + (try#each (function (_ it) + (when it + {.#None} true + {.#Some _} false))) + (try.else false))) + (_.coverage [/.bool] + (expression (|>> (as Bit) (bit#= bool)) + (/.bool bool))) + (_.coverage [/.int] + (expression (|>> (as Int) (i.= int)) + (/.int int))) + ... (_.coverage [/.long] + ... (expression (|>> (as Int) (i.= int)) + ... (/.long int))) + (_.coverage [/.float] + (expression (|>> (as Frac) (f.= float)) + (/.float float))) + (_.coverage [/.string] + (expression (|>> (as Text) (text#= string)) + (/.string string))) + (_.coverage [/.unicode] + (expression (|>> (as Text) (text#= string)) + (/.unicode string))) + ))) + +(def test|bool + Test + (do [! random.monad] + [left random.bit + right random.bit] + (`` (all _.and + (,, (with_template [</> <lux>] + [(_.coverage [</>] + (let [expected (<lux> left right)] + (expression (|>> (as Bit) (bit#= expected)) + (</> (/.bool left) (/.bool right)))))] + + [/.or .or] + [/.and .and] + )) + (_.coverage [/.not] + (expression (|>> (as Bit) (bit#= (not left))) + (/.not (/.bool left)))) + )))) + +(def test|float + Test + (do [! random.monad] + [parameter (random.only (|>> (f.= +0.0) not) + random.safe_frac) + subject random.safe_frac] + (`` (all _.and + (,, (with_template [</> <lux> <pre>] + [(_.coverage [</>] + (let [expected (<lux> (<pre> parameter) (<pre> subject))] + (expression (|>> (as Frac) (f.= expected)) + (</> (/.float (<pre> parameter)) (/.float (<pre> subject))))))] + + [/.+ f.+ |>] + [/.- f.- |>] + [/.* f.* |>] + [/./ f./ |>] + [/.% f.mod |>] + [/.** f.pow f.abs] + )) + (,, (with_template [</> <lux>] + [(_.coverage [</>] + (let [expected (<lux> parameter subject)] + (expression (|>> (as Bit) (bit#= expected)) + (</> (/.float parameter) (/.float subject)))))] + + [/.< f.<] + [/.<= f.<=] + [/.> f.>] + [/.>= f.>=] + [/.= f.=] + )) + (_.coverage [/.float/1] + (expression (|>> (as Frac) (f.= subject)) + (/.float/1 (/.string (%.frac subject))))) + (_.coverage [/.repr/1] + (expression (|>> (as Text) (text#= (text.replaced "+" "" (%.frac subject)))) + (/.repr/1 (/.float subject)))) + )))) + +(def python_3? + (/.Expression Any) + (|> (/.__import__/1 (/.unicode "sys")) + (/.the "version_info") + (/.the "major") + (/.= (/.int +3)))) + +(def int_16 + (-> Int Int) + (i64.and (-- (i64.left_shifted 15 1)))) + +(def test|int + Test + (do [! random.monad] + [left random.int + right random.int + + i16 (of ! each ..int_16 random.int) + shift (of ! each (n.% 16) random.nat)] + (`` (all _.and + (,, (with_template [</> <lux>] + [(_.coverage [</>] + (let [expected (<lux> left right)] + (expression (|>> (as Frac) f.int (i.= expected)) + (</> (/.int left) (/.int right)))))] + + [/.bit_or i64.or] + [/.bit_xor i64.xor] + [/.bit_and i64.and] + )) + (,, (with_template [</> <lux>] + [(_.coverage [</>] + (let [left (.int shift) + right (i.* (.int shift) i16) + expected (<lux> left right)] + (expression (|>> (as Int) (i.= expected)) + (</> (/.int left) (/.int right)))))] + + [/.// i./] + )) + (_.coverage [/.opposite] + (expression (|>> (as Int) (i.= (i.* -1 left))) + (/.opposite (/.int left)))) + (_.coverage [/.bit_shl] + (let [expected (i64.left_shifted shift i16)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.bit_shl (/.int (.int shift)) + (/.int i16))))) + (_.coverage [/.bit_shr] + (let [expected (i.right_shifted shift i16)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.bit_shr (/.int (.int shift)) + (/.int i16))))) + (_.coverage [/.int/1] + (expression (|>> (as Int) (i.= left)) + (/.int/1 (/.string (%.int left))))) + (_.coverage [/.str/1] + (expression (|>> (as Text) (text#= (text.replaced "+" "" (%.int left)))) + (/.str/1 (/.int left)))) + (_.coverage [/.long] + (or (expression (|>> (as Bit)) + ..python_3?) + (expression (|>> (as Int) (i.= left)) + (/.long left)))) + )))) + +(def test|text + Test + (do [! random.monad] + [expected_code (of ! each (n.% 128) random.nat) + .let [expected_char (text.of_char expected_code)]] + (all _.and + (_.coverage [/.chr/1 /.ord/1 + /.unichr/1 /.unicode/1] + (and (expression (|>> (as Int) .nat (n.= expected_code)) + (/.? python_3? + (/.ord/1 (/.chr/1 (/.int (.int expected_code)))) + (/.unicode/1 (/.unichr/1 (/.int (.int expected_code)))))) + (expression (|>> (as Text) (text#= expected_char)) + (/.? python_3? + (/.chr/1 (/.ord/1 (/.string expected_char))) + (/.unichr/1 (/.unicode/1 (/.string expected_char))))))) + ))) + +(def test|array + Test + (do [! random.monad] + [size (of ! each (|>> (n.% 10) ++) random.nat) + index (of ! each (n.% size) random.nat) + items (random.list size random.safe_frac) + .let [expected (|> items + (list.item index) + (maybe.else f.not_a_number))] + from (of ! each (n.% size) random.nat) + plus (of ! each (n.% (n.- from size)) random.nat) + .let [slice_from|size (n.- from size) + to (/.int (.int (n.+ plus from))) + from (/.int (.int from))]] + (all _.and + (_.for [/.item] + (all _.and + (_.coverage [/.list] + (expression (|>> (as Frac) (f.= expected)) + (/.item (/.int (.int index)) + (/.list (list#each /.float items))))) + (_.coverage [/.tuple] + (expression (|>> (as Frac) (f.= expected)) + (/.item (/.int (.int index)) + (/.tuple (list#each /.float items))))))) + (_.coverage [/.slice /.len/1] + (expression (|>> (as Int) (i.= (.int plus))) + (|> (/.list (list#each /.float items)) + (/.slice from to) + /.len/1))) + (_.coverage [/.slice_from] + (expression (|>> (as Int) (i.= (.int slice_from|size))) + (|> (/.list (list#each /.float items)) + (/.slice_from from) + /.len/1))) + ))) + +(def test|dict + Test + (do [! random.monad] + [expected random.safe_frac + field (random.upper_cased 5) + dummy (random.only (|>> (text#= field) not) + (random.upper_cased 5)) + .let [field (/.string field) + dummy (/.string dummy)]] + (all _.and + (_.coverage [/.dict] + (expression (|>> (as Frac) (f.= expected)) + (/.item field (/.dict (list [field (/.float expected)]))))) + (_.coverage [/.in?] + (and (expression (|>> (as Bit) not) + (/.in? (/.dict (list)) field)) + (expression (|>> (as Bit)) + (/.in? (/.dict (list [field (/.float expected)])) field)))) + ))) + +(def test|computation + Test + (do [! random.monad] + [test random.bit + then random.safe_frac + else random.safe_frac + + bool random.bit + float (random.only (|>> f.not_a_number? not) random.frac) + string (random.upper_cased 5) + + comment (random.upper_cased 10) + $arg/0 (of ! each /.var (random.lower_cased 10)) + $arg/1 (of ! each /.var (random.lower_cased 11))] + (all _.and + ..test|bool + ..test|float + ..test|int + ..test|text + ..test|array + ..test|dict + (_.coverage [/.?] + (let [expected (if test then else)] + (expression (|>> (as Frac) (f.= expected)) + (/.? (/.bool test) + (/.float then) + (/.float else))))) + (_.coverage [/.comment] + (expression (|>> (as Frac) (f.= then)) + (/.comment comment + (/.float then)))) + (_.coverage [/.__import__/1] + (expression (function.constant true) + (/.__import__/1 (/.string "math")))) + (_.coverage [/.do] + (expression (|>> (as Frac) (f.= (f.ceil float))) + (|> (/.__import__/1 (/.string "math")) + (/.do "ceil" (list (/.float float)))))) + (_.coverage [/.is] + (and (expression (|>> (as Bit)) + (/.apply (list (/.string (format string string))) + (/.lambda (list $arg/0) + (/.is $arg/0 $arg/0)))) + (expression (|>> (as Bit) not) + (/.apply (list (/.string (format string string)) + (/.string string)) + (/.lambda (list $arg/0 $arg/1) + (/.is $arg/0 (/.+ $arg/1 $arg/1))))))) + ))) + +(def test|function + Test + (do [! random.monad] + [float/0 random.safe_frac + float/1 random.safe_frac + float/2 random.safe_frac + $arg/0 (of ! each /.var (random.lower_cased 10)) + $arg/1 (of ! each /.var (random.lower_cased 11)) + $arg/2 (of ! each /.var (random.lower_cased 12))] + (all _.and + (_.coverage [/.lambda] + (expression (|>> (as Frac) (f.= float/0)) + (/.apply (list) + (/.lambda (list) + (/.float float/0))))) + (_.coverage [/.apply] + (expression (|>> (as Frac) (f.= (all f.+ float/0 float/1 float/2))) + (/.apply (list (/.float float/0) (/.float float/1) (/.float float/2)) + (/.lambda (list $arg/0 $arg/1 $arg/2) + (all /.+ $arg/0 $arg/1 $arg/2))))) + ))) + +(def test|var + Test + (do [! random.monad] + [expected/0 random.safe_frac + expected/1 random.safe_frac + poly_choice (of ! each (n.% 2) random.nat) + .let [keyword (|>> %.nat (format "k") /.string) + keyword/0 (keyword 0) + keyword/1 (keyword 1) + keyword_choice (keyword poly_choice)] + .let [expected/? (when poly_choice + 0 expected/0 + _ expected/1)] + $var (of ! each (|>> %.nat (format "v") /.var) random.nat) + $choice (of ! each (|>> %.nat (format "c") /.var) random.nat)] + (all _.and + (_.coverage [/.Single /.SVar /.var] + (expression (|>> (as Frac) (f.= expected/0)) + (/.apply (list (/.float expected/0)) + (/.lambda (list $var) $var)))) + (_.for [/.Poly /.PVar] + (all _.and + (_.coverage [/.poly] + (expression (|>> (as Frac) (f.= expected/?)) + (/.apply (list (/.int (.int poly_choice)) + (/.float expected/0) + (/.float expected/1)) + (/.lambda (list $choice (/.poly $var)) + (/.item $choice $var))))) + (_.coverage [/.splat_poly] + (expression (|>> (as Frac) (f.= expected/?)) + (/.apply (list (/.int (.int poly_choice)) + (/.splat_poly + (/.list (list (/.float expected/0) + (/.float expected/1))))) + (/.lambda (list $choice (/.poly $var)) + (/.item $choice $var))))) + )) + (_.for [/.Keyword /.KVar] + (all _.and + (_.coverage [/.keyword] + (expression (|>> (as Nat) (n.= 2)) + (/.apply (list keyword_choice + (/.splat_keyword + (/.dict (list [keyword/0 (/.float expected/0)] + [keyword/1 (/.float expected/1)])))) + (/.lambda (list $choice (/.keyword $var)) + (/.len/1 $var))))) + (_.coverage [/.splat_keyword] + (expression (|>> (as Frac) (f.= expected/?)) + (/.apply (list keyword_choice + (/.splat_keyword + (/.dict (list [keyword/0 (/.float expected/0)] + [keyword/1 (/.float expected/1)])))) + (/.lambda (list $choice (/.keyword $var)) + (/.item $choice $var))))) + )) + ))) + +(def test|expression + Test + (do [! random.monad] + [dummy random.safe_frac + expected random.safe_frac] + (`` (all _.and + (_.for [/.Literal] + ..test|literal) + (_.for [/.Computation] + ..test|computation) + ..test|function + (_.for [/.Var] + ..test|var) + )))) + +(ffi.import Dict + "[1]::[0]" + (get [ffi.String] Any)) + +(ffi.import (dict [] ..Dict)) + +(def (statement it) + (-> (-> /.SVar (/.Statement Any)) Any) + (let [$output (static.random (|>> %.nat (format "output_") code.text) + random.nat) + environment (..dict [])] + (exec + (.python_exec# (/.code (it (/.var $output))) (as_expected environment)) + (Dict::get $output environment)))) + +(def test|access + Test + (do [! random.monad] + [$var/0 (of ! each (|>> %.nat (format "v0_") /.var) random.nat) + expected/0 random.safe_frac + dummy/0 random.safe_frac + field (of ! each /.string (random.upper_cased 1))] + (all _.and + (_.coverage [/.item] + (`` (and (,, (with_template [<seq>] + [(expression (|>> (as Frac) (f.= expected/0)) + (/.item (/.int +0) + (<seq> (list (/.float expected/0)))))] + + [/.list] + [/.tuple] + )) + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0) (/.list (list (/.float dummy/0)))) + (/.set (list (/.item (/.int +0) $var/0)) (/.float expected/0)) + (/.set (list $output) (/.item (/.int +0) $var/0))))) + (as Frac) + (f.= expected/0)) + + (expression (|>> (as Frac) (f.= expected/0)) + (/.item field (/.dict (list [field (/.float expected/0)])))) + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0) (/.dict (list [field (/.float dummy/0)]))) + (/.set (list (/.item field $var/0)) (/.float expected/0)) + (/.set (list $output) (/.item field $var/0))))) + (as Frac) + (f.= expected/0))))) + ))) + +(def test|location + Test + (do [! random.monad] + [$var/0 (of ! each (|>> %.nat (format "v0_") /.var) random.nat) + $var/1 (of ! each (|>> %.nat (format "v1_") /.var) random.nat) + $def (of ! each (|>> %.nat (format "def_") /.var) random.nat) + expected/0 random.safe_frac + expected/1 random.safe_frac + dummy/0 random.safe_frac + field/0 (of ! each /.string (random.upper_cased 1))] + (all _.and + (_.coverage [/.set] + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0) (/.float expected/0)) + (/.set (list $output) $var/0)))) + (as Frac) + (f.= expected/0))) + (_.coverage [/.multi] + (`` (and (,, (with_template [<var> <value>] + [(|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0 $var/1) (/.multi (list (/.float expected/0) (/.float expected/1)))) + (/.set (list $output) <var>)))) + (as Frac) + (f.= <value>))] + + [$var/0 expected/0] + [$var/1 expected/1] + ))))) + (_.coverage [/.delete] + (and (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0) (/.list (list (/.float dummy/0) (/.float expected/0)))) + (/.delete (/.item (/.int +0) $var/0)) + (/.set (list $output) (/.item (/.int +0) $var/0))))) + (as Frac) + (f.= expected/0)) + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0) (/.list (list (/.float dummy/0) (/.float expected/0)))) + (/.delete (/.slice (/.int +0) (/.int +1) $var/0)) + (/.set (list $output) (/.item (/.int +0) $var/0))))) + (as Frac) + (f.= expected/0)) + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0) (/.list (list (/.float dummy/0) (/.float dummy/0)))) + (/.delete (/.slice_from (/.int +0) $var/0)) + (/.statement (/.do "append" (list (/.float expected/0)) $var/0)) + (/.set (list $output) (/.item (/.int +0) $var/0))))) + (as Frac) + (f.= expected/0)) + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0) (/.dict (list [field/0 (/.float dummy/0)]))) + (/.delete (/.item field/0 $var/0)) + (/.set (list $output) (/.in? $var/0 field/0))))) + (as Bit) + not) + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0) (/.float dummy/0)) + (/.delete $var/0) + (/.set (list $output) (/.or (/.in? /.locals/0 (/.string (/.code $var/0))) + (/.in? /.globals/0 (/.string (/.code $var/0)))))))) + (as Bit) + not) + )) + (_.coverage [/.globals/0] + (|> (..statement + (function (_ $output) + (all /.then + (/.def $def (list $var/0) + (/.return (/.in? /.globals/0 (/.string (/.code $var/0))))) + (/.set (list $output) (/.and (/.not (/.in? /.globals/0 (/.string (/.code $var/0)))) + (/.not (/.apply (list (/.float dummy/0)) $def)))) + (/.set (list $var/0) (/.float dummy/0)) + (/.set (list $output) (/.and $output + (/.in? /.globals/0 (/.string (/.code $var/0)))))))) + (as Bit))) + (_.coverage [/.locals/0] + (|> (..statement + (function (_ $output) + (all /.then + (/.def $def (list $var/0) + (/.return (/.in? /.locals/0 (/.string (/.code $var/0))))) + (/.set (list $output) (/.and (/.not (/.in? /.locals/0 (/.string (/.code $var/0)))) + (/.apply (list (/.float dummy/0)) $def))) + (/.set (list $var/0) (/.float dummy/0)) + (/.set (list $output) (/.and $output + (/.in? /.locals/0 (/.string (/.code $var/0)))))))) + (as Bit))) + (_.coverage [/.import] + (|> (..statement + (function (_ $output) + (all /.then + (/.import "math") + (/.set (list $output) (/.in? /.globals/0 (/.string "math")))))) + (as Bit))) + (_.for [/.Access] + ..test|access) + ))) + +(def test|exception + Test + (do [! random.monad] + [expected_error (random.upper_cased 10) + expected random.safe_frac + dummy (random.only (|>> (f.= expected) not) + random.safe_frac) + $ex (of ! each (|>> %.nat (format "ex_") /.var) random.nat)] + (all _.and + (_.coverage [/.raise /.Exception/1] + (when (try (..statement + (function (_ $output) + (all /.then + (/.raise (/.Exception/1 (/.string expected_error))) + (/.set (list $output) (/.float dummy)))))) + {try.#Failure actual_error} + (text#= expected_error actual_error) + + {try.#Success _} + false)) + (_.coverage [/.try /.Except] + (and (|> (..statement + (function (_ $output) + (/.try (all /.then + (/.raise (/.Exception/1 (/.string expected_error))) + (/.set (list $output) (/.float dummy))) + (list [/.#classes (list "Exception") + /.#exception $ex + /.#handler (/.set (list $output) (/.float expected))])))) + (as Frac) + (f.= expected)) + (when (try (..statement + (function (_ $output) + (/.try (all /.then + (/.raise (/.Exception/1 (/.string expected_error))) + (/.set (list $output) (/.float dummy))) + (list [/.#classes (list) + /.#exception $ex + /.#handler (/.set (list $output) (/.float expected))]))))) + {try.#Failure actual_error} + (text#= expected_error actual_error) + + {try.#Success actual} + false))) + ))) + +(def test|loop + Test + (do [! random.monad] + [base (of ! each (n.% 100) random.nat) + factor (of ! each (|>> (n.% 10) ++) random.nat) + extra (of ! each (|>> (n.% 10) ++) random.nat) + .let [expected (n.* factor base)] + $iteration (of ! each (|>> %.nat (format "iteration_") /.var) random.nat) + $temp (of ! each (|>> %.nat (format "temp_") /.var) random.nat)] + (all _.and + (_.coverage [/.while] + (and (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $output) (/.int +0)) + (/.set (list $iteration) (/.int +0)) + (/.while (/.< (/.int (.int factor)) $iteration) + (all /.then + (/.set (list $output) (/.+ (/.int (.int base)) + $output)) + (/.set (list $iteration) (/.+ (/.int +1) + $iteration)) + ) + {.#None})))) + (as Nat) + (n.= expected)) + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $temp) (/.int +0)) + (/.set (list $iteration) (/.int +0)) + (/.while (/.< (/.int (.int factor)) $iteration) + (all /.then + (/.set (list $temp) (/.+ (/.int (.int base)) + $temp)) + (/.set (list $iteration) (/.+ (/.int +1) + $iteration)) + ) + {.#Some (/.set (list $output) $temp)})))) + (as Nat) + (n.= expected)))) + (_.coverage [/.for_in] + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $output) (/.int +0)) + (/.for_in $iteration + (/.list (list.repeated factor (/.int (.int base)))) + (/.set (list $output) (/.+ $iteration + $output)))))) + (as Nat) + (n.= expected))) + (_.coverage [/.pass] + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $output) (/.int +0)) + (/.set (list $iteration) (/.int +0)) + (/.while (/.< (/.int (.int (n.+ extra factor))) $iteration) + (all /.then + (/.set (list $iteration) (/.+ (/.int +1) + $iteration)) + (/.if (/.> (/.int (.int extra)) $iteration) + (/.set (list $output) (/.+ (/.int (.int base)) + $output)) + /.pass)) + {.#None})))) + (as Nat) + (n.= expected))) + (_.coverage [/.continue] + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $output) (/.int +0)) + (/.set (list $iteration) (/.int +0)) + (/.while (/.< (/.int (.int (n.+ extra factor))) $iteration) + (all /.then + (/.set (list $iteration) (/.+ (/.int +1) + $iteration)) + (/.if (/.> (/.int (.int extra)) $iteration) + (/.set (list $output) (/.+ (/.int (.int base)) + $output)) + /.continue)) + {.#None})))) + (as Nat) + (n.= expected))) + (_.coverage [/.break] + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $output) (/.int +0)) + (/.set (list $iteration) (/.int +0)) + (/.while (/.< (/.int (.int (n.+ extra factor))) $iteration) + (all /.then + (/.set (list $iteration) (/.+ (/.int +1) + $iteration)) + (/.if (/.> (/.int (.int factor)) $iteration) + /.break + (/.set (list $output) (/.+ (/.int (.int base)) + $output)))) + {.#None})))) + (as Nat) + (n.= expected))) + ))) + +(def test|statement + Test + (do [! random.monad] + [$def (of ! each (|>> %.nat (format "def_") /.var) random.nat) + $input/0 (of ! each (|>> %.nat (format "input_") /.var) random.nat) + expected/0 random.safe_frac + test random.bit + then random.safe_frac + else random.safe_frac + .let [expected/? (if test then else)]] + (all _.and + (_.coverage [/.def /.return] + (|> (..statement + (function (_ $output) + (all /.then + (/.def $def (list $input/0) + (/.return $input/0)) + (/.set (list $output) (/.apply (list (/.float expected/0)) $def))))) + (as Frac) + (f.= expected/0))) + (_.coverage [/.if] + (|> (..statement + (function (_ $output) + (all /.then + (/.def $def (list) + (/.if (/.bool test) + (/.return (/.float then)) + (/.return (/.float else)))) + (/.set (list $output) (/.apply (list) $def))))) + (as Frac) + (f.= expected/?))) + (_.coverage [/.when /.then] + (|> (..statement + (function (_ $output) + (all /.then + (/.def $def (list) + (all /.then + (/.when (/.bool test) + (/.return (/.float then))) + (/.return (/.float else)))) + (/.set (list $output) (/.apply (list) $def))))) + (as Frac) + (f.= expected/?))) + (_.coverage [/.statement] + (|> (..statement + (function (_ $output) + (all /.then + (/.def $def (list) + (all /.then + (/.statement (/.+ (/.float expected/0) (/.float expected/0))) + (/.return (/.float expected/0)))) + (/.set (list $output) (/.apply (list) $def))))) + (as Frac) + (f.= expected/0))) + (_.coverage [/.exec] + (|> (..statement + (function (_ $output) + (/.exec {.#Some /.globals/0} + (/.string (/.code (/.set (list $output) (/.float expected/0))))))) + (as Frac) + (f.= expected/0))) + ..test|exception + (_.for [/.Location] + ..test|location) + (_.for [/.Loop] + ..test|loop) + ))) + +(def random_expression + (Random /.Literal) + (all random.either + (random#each /.bool random.bit) + (random#each /.float random.frac) + (random#each /.int random.int) + (random#each /.string (random.lower_cased 1)) + )) + +(def .public test + Test + (do [! random.monad] + [expected ..random_expression] + (<| (_.covering /._) + (_.for [/.Code]) + (all _.and + (_.for [/.equivalence] + (equivalenceT.spec /.equivalence ..random_expression)) + (_.for [/.hash] + (hashT.spec /.hash ..random_expression)) + + (_.coverage [/.code /.manual] + (|> (/.manual (/.code expected)) + (is /.Expression) + (/#= expected))) + (_.for [/.Expression] + ..test|expression) + (_.for [/.Statement] + ..test|statement) + )))) diff --git a/stdlib/source/test/lux/meta/compiler/target/ruby.lux b/stdlib/source/test/lux/meta/compiler/target/ruby.lux new file mode 100644 index 000000000..900e630e7 --- /dev/null +++ b/stdlib/source/test/lux/meta/compiler/target/ruby.lux @@ -0,0 +1,1062 @@ +(.require + [library + [lux (.except) + ["[0]" ffi] + [abstract + [monad (.only do)] + ["[0]" predicate] + ["[0]" equivalence + ["[1]T" \\test]]] + [control + ["[0]" pipe] + ["[0]" maybe (.use "[1]#[0]" functor)] + ["[0]" try (.only Try) (.use "[1]#[0]" functor)]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor)] + ["[0]" set]]] + [math + ["[0]" random (.only Random) (.use "[1]#[0]" monad)] + [number (.only hex) + ["n" nat] + ["i" int] + ["f" frac] + ["[0]" i64]]] + [meta + [compiler + [meta + ["[0]" packager + ["[1]" ruby]]]]] + [world + ["[0]" file]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.use "[1]#[0]" equivalence)]]) + +(ffi.import (eval [Text] "try" "?" Any)) + +(def (expression ??? it) + (-> (-> Any Bit) /.Expression Bit) + (|> it + /.code + ..eval + (try#each (|>> (maybe#each ???) + (maybe.else false))) + (try.else false))) + +(def nil + (-> /.Expression Bit) + (|>> /.code + ..eval + (try#each (|>> (pipe.when + {.#None} true + {.#Some _} false))) + (try.else false))) + +(def test|literal + Test + (do [! random.monad] + [bool random.bit + float random.frac + int random.int + string (random.upper_cased 5)] + (all _.and + (_.coverage [/.nil] + (..nil /.nil)) + (_.coverage [/.bool] + (expression (|>> (as Bit) (bit#= bool)) + (/.bool bool))) + (_.coverage [/.int] + (expression (|>> (as Int) (i.= int)) + (/.int int))) + (_.coverage [/.float] + (expression (|>> (as Frac) (f.= float)) + (/.float float))) + (_.coverage [/.string] + (expression (|>> (as Text) (text#= string)) + (/.string string))) + (_.coverage [/.symbol] + (expression (|>> (as Text) (text#= string)) + (/.do "id2name" (list) {.#None} (/.symbol string)))) + ))) + +(def test|bool + Test + (do [! random.monad] + [left random.bit + right random.bit] + (`` (all _.and + (,, (with_template [</> <lux>] + [(_.coverage [</>] + (let [expected (<lux> left right)] + (expression (|>> (as Bit) (bit#= expected)) + (</> (/.bool left) (/.bool right)))))] + + [/.or .or] + [/.and .and] + )) + (_.coverage [/.not] + (expression (|>> (as Bit) (bit#= (not left))) + (/.not (/.bool left)))) + )))) + +(def test|float + Test + (do [! random.monad] + [parameter (random.only (|>> (f.= +0.0) not) + random.safe_frac) + subject random.safe_frac] + (`` (all _.and + (,, (with_template [</> <lux> <pre>] + [(_.coverage [</>] + (let [expected (<lux> (<pre> parameter) (<pre> subject))] + (expression (|>> (as Frac) (f.= expected)) + (</> (/.float (<pre> parameter)) (/.float (<pre> subject))))))] + + [/.+ f.+ |>] + [/.- f.- |>] + [/.* f.* |>] + [/./ f./ |>] + [/.% f.mod |>] + [/.pow f.pow f.abs] + )) + (,, (with_template [</> <lux>] + [(_.coverage [</>] + (let [expected (<lux> parameter subject)] + (expression (|>> (as Bit) (bit#= expected)) + (</> (/.float parameter) (/.float subject)))))] + + [/.< f.<] + [/.<= f.<=] + [/.> f.>] + [/.>= f.>=] + [/.= f.=] + )) + )))) + +(def int_16 + (-> Int Int) + (i64.and (-- (i64.left_shifted 15 1)))) + +(def test|int + Test + (do [! random.monad] + [left random.int + right random.int + + i16 (of ! each ..int_16 random.int) + shift (of ! each (n.% 16) random.nat)] + (`` (all _.and + (,, (with_template [</> <lux>] + [(_.coverage [</>] + (let [expected (<lux> left right)] + (expression (|>> (as Frac) f.int (i.= expected)) + (</> (/.int left) (/.int right)))))] + + [/.bit_or i64.or] + [/.bit_xor i64.xor] + [/.bit_and i64.and] + )) + (_.coverage [/.bit_not] + (expression (|>> (as Int) (i.= (i64.not left))) + (/.bit_not (/.int left)))) + (_.coverage [/.opposite] + (expression (|>> (as Int) (i.= (i.* -1 left))) + (/.opposite (/.int left)))) + (_.coverage [/.bit_shl] + (let [expected (i64.left_shifted shift i16)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.bit_shl (/.int (.int shift)) + (/.int i16))))) + (_.coverage [/.bit_shr] + (let [expected (i.right_shifted shift i16)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.bit_shr (/.int (.int shift)) + (/.int i16))))) + )))) + +(def test|array + Test + (do [! random.monad] + [size (of ! each (|>> (n.% 10) ++) random.nat) + index (of ! each (n.% size) random.nat) + items (random.list size random.safe_frac) + .let [expected (|> items + (list.item index) + (maybe.else f.not_a_number))] + from (of ! each (n.% size) random.nat) + plus (of ! each (n.% (n.- from size)) random.nat) + .let [to (/.int (.int (n.+ plus from))) + from (/.int (.int from))]] + (all _.and + (_.coverage [/.array /.item] + (and (expression (|>> (as Frac) (f.= expected)) + (/.item (/.int (.int index)) + (/.array (list#each /.float items)))) + (expression (|>> (as Bit)) + (|> (/.array (list#each /.float items)) + (/.item (/.int (.int size))) + (/.= /.nil))))) + (_.coverage [/.array_range] + (expression (|>> (as Int) (i.= (.int (++ plus)))) + (|> (/.array (list#each /.float items)) + (/.array_range from to) + (/.the "length")))) + ))) + +(def test|hash + Test + (do [! random.monad] + [expected random.safe_frac + field (random.upper_cased 5) + dummy (random.only (|>> (text#= field) not) + (random.upper_cased 5)) + .let [field (/.string field) + dummy (/.string dummy)]] + (all _.and + (_.coverage [/.hash] + (and (expression (|>> (as Frac) (f.= expected)) + (/.item field (/.hash (list [field (/.float expected)])))) + (expression (|>> (as Bit)) + (|> (/.hash (list [field (/.float expected)])) + (/.item dummy) + (/.= /.nil))))) + ))) + +(def test|object + Test + (do [! random.monad] + [size (of ! each (|>> (n.% 10) ++) random.nat) + index (of ! each (n.% size) random.nat) + items (random.list size random.safe_frac) + $class (of ! each (|>> %.nat (format "class_") /.local) + random.nat) + $sub_class (of ! each (|>> %.nat (format "sub_class_") /.local) + random.nat) + $method/0 (of ! each (|>> %.nat (format "method_") /.local) + random.nat) + $method/1 (|> random.nat + (of ! each (|>> %.nat (format "method_") /.local)) + (random.only (|>> (/#= $method/0) not))) + $arg/0 (of ! each (|>> %.nat (format "arg_") /.local) + random.nat) + $state (of ! each (|>> %.nat (format "instance_") /.instance) + random.nat) + single random.safe_frac + .let [double (/.function $method/0 (list $arg/0) + (/.return (/.+ $arg/0 $arg/0)))]] + (all _.and + (_.coverage [/.the] + (expression (|>> (as Int) (i.= (.int size))) + (|> (/.array (list#each /.float items)) + (/.the "length")))) + (_.coverage [/.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})))) + (_.coverage [/.class] + (expression (|>> (as Frac) (f.= (f.+ single single))) + (|> (all /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body double])) + (/.return (|> $class + (/.new (list) {.#None}) + (/.do (/.code $method/0) (list (/.float single)) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + (_.coverage [/.new /.initialize] + (expression (|>> (as Frac) (f.= single)) + (|> (all /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (all /.then + (/.function /.initialize (list $arg/0) + (/.set (list $state) $arg/0)) + (/.function $method/0 (list) + (/.return $state)) + )])) + (/.return (|> $class + (/.new (list (/.float single)) {.#None}) + (/.do (/.code $method/0) (list) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + (_.coverage [/.alias_method/2] + (expression (|>> (as Frac) (f.= (f.+ single single))) + (|> (all /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (all /.then + double + (/.statement (/.alias_method/2 (/.string (/.code $method/1)) + (/.string (/.code $method/0)))))])) + (/.return (|> $class + (/.new (list) {.#None}) + (/.do (/.code $method/1) (list (/.float single)) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + (_.for [/.module] + (all _.and + (_.coverage [/.include/1] + (expression (|>> (as Frac) (f.= (f.+ single single))) + (|> (all /.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))))) + (_.coverage [/.extend/1] + (expression (|>> (as Frac) (f.= (f.+ single single))) + (|> (all /.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 + Test + (<| (do [! random.monad] + [left (random.upper_cased 5) + right (random.upper_cased 5) + $old (of ! each /.local (random.upper_cased 1)) + $new (of ! each /.local (random.upper_cased 2)) + $it (of ! each /.local (random.upper_cased 3)) + .let [expected (format left right)]]) + (all _.and + (_.for [/.stdout] + (all _.and + (_.coverage [/.print/1] + (expression (|>> (as Text) (text#= expected)) + (|> (all /.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))))) + (_.coverage [/.print/2] + (expression (|>> (as Text) (text#= expected)) + (|> (all /.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] + (all _.and + (_.coverage [/.gets/0] + (expression (|>> (as Text) (text#= (format left text.\n))) + (|> (all /.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))))) + (_.coverage [/.last_string_read] + (expression (|>> (as Text) (text#= (format right text.\n))) + (|> (all /.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))))) + (_.coverage [/.last_line_number_read] + (expression (|>> (as Nat) (n.= 2)) + /.last_line_number_read)) + )) + ))) + +(def test|computation + Test + (do [! random.monad] + [test random.bit + then random.safe_frac + else random.safe_frac + + bool random.bit + float random.frac + string (random.upper_cased 5) + + comment (random.upper_cased 10)] + (all _.and + ..test|bool + ..test|float + ..test|int + ..test|array + ..test|hash + ..test|object + ..test|io + (_.coverage [/.?] + (let [expected (if test then else)] + (expression (|>> (as Frac) (f.= expected)) + (/.? (/.bool test) + (/.float then) + (/.float else))))) + (_.coverage [/.comment] + (expression (|>> (as Frac) (f.= then)) + (/.comment comment + (/.float then)))) + ))) + +(def test|global + Test + (do [! random.monad] + [float/0 random.safe_frac + $global (of ! each /.global (random.lower_cased 10)) + pattern (of ! each /.string (random.lower_cased 11))] + (all _.and + (_.coverage [/.global] + (expression (|>> (as Text) (text#= "global-variable")) + (|> (all /.then + (/.set (list $global) (/.float float/0)) + (/.return (/.defined?/1 $global))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + (_.coverage [/.script_name] + (expression (let [file (format (of file.default separator) packager.main_file)] + (|>> (as Text) + (text.ends_with? file))) + /.script_name)) + (_.coverage [/.input_record_separator] + (expression (|>> (as Text) + (text#= text.\n)) + /.input_record_separator)) + (_.coverage [/.output_record_separator] + (..nil /.output_record_separator)) + (_.coverage [/.process_id] + (expression (|>> (as Nat) (n.= 0) not) + /.process_id)) + (_.coverage [/.case_insensitivity_flag] + (expression (|>> (as Bit) (bit#= false)) + /.case_insensitivity_flag)) + (_.coverage [/.command_line_arguments] + (expression (|>> (as Int) (i.= +0)) + (/.the "length" /.command_line_arguments))) + (_.coverage [/.last_string_matched] + (expression (|>> (as Bit)) + (|> (all /.then + (/.statement + (|> (/.manual "Regexp") + (/.new (list pattern) {.#None}) + (/.do "match" (list pattern) {.#None}))) + (/.return (/.= pattern /.last_string_matched))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + (_.coverage [/.last_regexp_match] + (expression (|>> (as Bit)) + (|> (/.return (|> (/.manual "Regexp") + (/.new (list pattern) {.#None}) + (/.do "match" (list pattern) {.#None}) + (/.= /.last_regexp_match))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + ))) + +(def test|local_var + Test + (do [! random.monad] + [float/0 random.safe_frac + $foreign (of ! each /.local (random.lower_cased 10))] + (all _.and + (_.coverage [/.local] + (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) + (|> (/.return (/.+ $foreign $foreign)) + [(list $foreign)] (/.lambda {.#None}) + (/.apply_lambda (list (/.float float/0)))))) + (_.coverage [/.set] + (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) + (|> (all /.then + (/.set (list $foreign) (/.float float/0)) + (/.return (/.+ $foreign $foreign))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + ))) + +(def test|instance_var + Test + (do [! random.monad] + [float/0 random.safe_frac + instance (of ! each (|>> %.nat (format "instance_")) + random.nat) + .let [$instance (/.instance instance)] + $method (of ! each (|>> %.nat (format "method_") /.local) + random.nat) + $class (of ! each (|>> %.nat (format "class_") /.local) + random.nat) + $object (of ! each (|>> %.nat (format "object_") /.local) + random.nat)] + (all _.and + (_.coverage [/.instance] + (expression (|>> (as Frac) (f.= float/0)) + (|> (all /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (all /.then + (/.function /.initialize (list) + (/.set (list $instance) (/.float float/0))) + (/.function $method (list) + (/.return $instance)) + )])) + (/.return (|> $class + (/.new (list) {.#None}) + (/.do (/.code $method) (list) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + (_.coverage [/.attr_reader/*] + (expression (|>> (as Frac) (f.= float/0)) + (|> (all /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (all /.then + (/.attr_reader/* (list instance)) + (/.function /.initialize (list) + (/.set (list $instance) (/.float float/0))) + )])) + (/.return (|> $class + (/.new (list) {.#None}) + (/.the instance)))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + (_.coverage [/.attr_writer/*] + (expression (|>> (as Frac) (f.= float/0)) + (|> (all /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (all /.then + (/.attr_writer/* (list instance)) + (/.function $method (list) + (/.return $instance)) + )])) + (/.set (list $object) (|> $class + (/.new (list) {.#None}))) + (/.set (list (/.the instance $object)) (/.float float/0)) + (/.return (|> $object + (/.do (/.code $method) (list) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + (_.coverage [/.attr_accessor/*] + (expression (|>> (as Frac) (f.= float/0)) + (|> (all /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (/.attr_accessor/* (list instance))])) + (/.set (list $object) (|> $class + (/.new (list) {.#None}))) + (/.set (list (/.the instance $object)) (/.float float/0)) + (/.return (/.the instance $object))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + ))) + +(def test|static_var + Test + (do [! random.monad] + [int/0 (of ! each (|>> (n.% 10) ++ .int) + random.nat) + $static (of ! each (|>> %.nat (format "static_") /.static) + random.nat) + $arg (of ! each (|>> %.nat /.local) + random.nat) + $method (of ! each (|>> %.nat (format "method_") /.local) + random.nat) + $class (of ! each (|>> %.nat (format "class_") /.local) + random.nat)] + (all _.and + (_.coverage [/.static /.class_variable_set /.class_variable_get] + (expression (|>> (as Int) (i.= int/0)) + (|> (all /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (/.function $method (list) + (/.return (/.int +0)))])) + (/.statement (/.class_variable_set $static (/.int int/0) $class)) + (/.return (/.class_variable_get $static $class))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + ))) + +(def test|variadic + Test + (do [! random.monad] + [$inputs (of ! each /.local (random.lower_cased 10)) + arity (of ! each (n.% 10) random.nat) + vals (|> random.int + (of ! each /.int) + (random.list arity)) + keys (|> (random.lower_cased 1) + (random.set text.hash arity) + (of ! each (|>> set.list (list#each /.string))))] + (all _.and + (<| (_.for [/.LVar*]) + (all _.and + (_.coverage [/.variadic] + (expression (|>> (as Int) .nat (n.= arity)) + (|> (/.return (/.the "length" $inputs)) + [(list (/.variadic $inputs))] (/.lambda {.#None}) + (/.apply_lambda vals)))) + (_.coverage [/.splat] + (expression (|>> (as Int) .nat (n.= arity)) + (|> (/.return (/.the "length" (/.array (list (/.splat $inputs))))) + [(list (/.variadic $inputs))] (/.lambda {.#None}) + (/.apply_lambda vals)))))) + (<| (_.for [/.LVar**]) + (_.coverage [/.variadic_kv /.double_splat] + (expression (|>> (as Int) .nat (n.= arity)) + (|> (/.return (/.the "length" $inputs)) + [(list (/.variadic_kv $inputs))] (/.lambda {.#None}) + (/.apply_lambda (list (/.double_splat (/.hash (list.zipped_2 keys vals))))))))) + ))) + +(def test|var + Test + (do [! random.monad] + [float/0 random.safe_frac + $foreign (of ! each /.local (random.lower_cased 10)) + + $constant (of ! each /.constant (random.lower_cased 10))] + (all _.and + (_.coverage [/.defined?/1] + (and (expression (|>> (as Bit)) + (|> (/.defined?/1 $foreign) + (/.= /.nil))) + (expression (|>> (as Text) (text#= "local-variable")) + (|> (all /.then + (/.set (list $foreign) (/.float float/0)) + (/.return (/.defined?/1 $foreign))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list)))))) + (_.for [/.CVar] + (_.coverage [/.constant] + (expression (|>> (as Text) (text#= "constant")) + (|> (all /.then + (/.set (list $constant) (/.float float/0)) + (/.return (/.defined?/1 $constant))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list)))))) + (_.for [/.GVar] + ..test|global) + (_.for [/.LVar] + ..test|local_var) + (_.for [/.IVar] + ..test|instance_var) + (_.for [/.SVar] + ..test|static_var) + ..test|variadic + ))) + +(def test|location + Test + (do [! random.monad] + [float/0 random.safe_frac + $foreign (of ! each /.local (random.lower_cased 10)) + field (of ! each /.string (random.upper_cased 10))] + (all _.and + (<| (_.for [/.Var]) + ..test|var) + (_.coverage [/.Access] + (and (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) + (let [@ (/.item (/.int +0) $foreign)] + (|> (all /.then + (/.set (list $foreign) (/.array (list $foreign))) + (/.set (list @) (/.+ @ @)) + (/.return @)) + [(list $foreign)] (/.lambda {.#None}) + (/.apply_lambda (list (/.float float/0)))))) + (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) + (let [@ (/.item field $foreign)] + (|> (all /.then + (/.set (list $foreign) (/.hash (list [field $foreign]))) + (/.set (list @) (/.+ @ @)) + (/.return @)) + [(list $foreign)] (/.lambda {.#None}) + (/.apply_lambda (list (/.float float/0)))))) + )) + ))) + +(def test|expression + Test + (do [! random.monad] + [dummy random.safe_frac + expected random.safe_frac] + (`` (all _.and + (_.for [/.Literal] + ..test|literal) + (_.for [/.Computation] + ..test|computation) + (_.for [/.Location] + ..test|location) + )))) + +(def test|label + Test + (do [! random.monad] + [input (of ! each ..int_16 random.int) + + full_inner_iterations (of ! each (|>> (n.% 20) ++) random.nat) + expected_inner_iterations (of ! each (n.% full_inner_iterations) random.nat) + + full_outer_iterations (of ! each (|>> (n.% 10) ++) random.nat) + expected_outer_iterations (of ! each (n.% full_outer_iterations) random.nat) + + .let [$input (/.local "input") + $output (/.local "output") + $inner_index (/.local "inner_index") + $outer_index (/.local "outer_index")]] + (all _.and + (_.coverage [/.break] + (let [expected (i.* (.int expected_inner_iterations) input)] + (expression (|>> (as Frac) f.int (i.= expected)) + (|> (all /.then + (/.set (list $inner_index) (/.int +0)) + (/.set (list $output) (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + (all /.then + (/.when (/.= (/.int (.int expected_inner_iterations)) $inner_index) + /.break) + (/.set (list $output) (/.+ $input $output)) + (/.set (list $inner_index) (/.+ (/.int +1) $inner_index)) + )) + (/.return $output)) + [(list $input)] (/.lambda {.#None}) + (/.apply_lambda (list (/.int input))))))) + (_.coverage [/.next] + (let [expected (i.* (.int (n.- expected_inner_iterations full_inner_iterations)) input)] + (expression (|>> (as Frac) f.int (i.= expected)) + (|> (all /.then + (/.set (list $inner_index) (/.int +0)) + (/.set (list $output) (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + (all /.then + (/.set (list $inner_index) (/.+ (/.int +1) $inner_index)) + (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) + /.next) + (/.set (list $output) (/.+ $input $output)) + )) + (/.return $output)) + [(list $input)] (/.lambda {.#None}) + (/.apply_lambda (list (/.int input))))))) + (_.coverage [/.redo] + (let [expected (i.* (.int (n.- expected_inner_iterations full_inner_iterations)) input)] + (expression (|>> (as Frac) f.int (i.= expected)) + (|> (all /.then + (/.set (list $inner_index) (/.int +0)) + (/.set (list $output) (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + (all /.then + (/.set (list $inner_index) (/.+ (/.int +1) $inner_index)) + (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) + /.redo) + (/.set (list $output) (/.+ $input $output)) + )) + (/.return $output)) + [(list $input)] (/.lambda {.#None}) + (/.apply_lambda (list (/.int input))))))) + ))) + +(def test|loop + Test + (do [! random.monad] + [input (of ! each (i.right_shifted 32) random.int) + iterations (of ! each (n.% 10) random.nat) + .let [$input (/.local "input") + $output (/.local "output") + $index (/.local "index") + expected (i.* (.int iterations) input)]] + (all _.and + (_.coverage [/.while] + (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.set (list $index) (/.int +0)) + (/.set (list $output) (/.int +0)) + (/.while (/.< (/.int (.int iterations)) $index) + (all /.then + (/.set (list $output) (/.+ $input $output)) + (/.set (list $index) (/.+ (/.int +1) $index)) + )) + (/.return $output)) + [(list $input)] (/.lambda {.#None}) + (/.apply_lambda (list (/.int input)))))) + (_.coverage [/.for_in] + (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.set (list $output) (/.int +0)) + (/.for_in $index (/.array (list.repeated iterations (/.int input))) + (/.set (list $output) (/.+ $index $output))) + (/.return $output)) + [(list $input)] (/.lambda {.#None}) + (/.apply_lambda (list (/.int input)))))) + ..test|label + ))) + +(def random_tag + (Random Int) + (random#each (i64.and (hex "FF,FF,FF,FF")) + random.int)) + +(def test|exception + Test + (do [! random.monad] + [expected random.safe_frac + dummy (random.only (|>> (f.= expected) not) + random.safe_frac) + error (random.lower_cased 10) + $ex (of ! each /.local (random.lower_cased 10)) + + expected_tag ..random_tag + dummy_tag (random.only (|>> (i.= expected_tag) not) + ..random_tag) + .let [expected_tag (/.int expected_tag) + dummy_tag (/.int dummy_tag)]] + (all _.and + (_.coverage [/.begin] + (expression (|>> (as Frac) (f.= expected)) + (|> (/.begin (/.return (/.float expected)) + (list [(list) $ex (/.return (/.float dummy))])) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + (_.coverage [/.Rescue /.throw/1] + (expression (|>> (as Frac) (f.= expected)) + (|> (/.begin (all /.then + (/.throw/1 (/.string error)) + (/.return (/.float dummy))) + (list [(list) $ex (/.return (/.float expected))])) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + (_.coverage [/.raise] + (expression (|>> (as Frac) (f.= expected)) + (|> (/.begin (all /.then + (/.statement (/.raise (/.string error))) + (/.return (/.float dummy))) + (list [(list) $ex (/.return (/.float expected))])) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + (_.coverage [/.catch /.throw/2] + (and (expression (|>> (as Frac) (f.= expected)) + (<| (/.apply_lambda (list)) + (/.lambda {.#None}) [(list)] + /.return + (/.catch expected_tag) [(list)] + (/.throw/2 expected_tag (/.float expected)))) + (expression (|>> (as Frac) (f.= expected)) + (<| (/.apply_lambda (list)) + (/.lambda {.#None}) [(list)] + /.return + (/.catch expected_tag) [(list)] + /.statement (/.catch dummy_tag) [(list)] + (/.throw/2 expected_tag (/.float expected)))) + (expression (|>> (as Frac) (f.= expected)) + (<| (/.apply_lambda (list)) + (/.lambda {.#None}) [(list)] + /.return + (/.catch dummy_tag) [(list)] + /.statement (/.catch expected_tag) [(list)] + (/.throw/2 expected_tag (/.float expected)))))) + (_.coverage [/.latest_error_message] + (expression (|>> (as Text) (text#= error)) + (|> (/.begin (all /.then + (/.statement (/.raise (/.string error))) + (/.return (/.float dummy))) + (list [(list) $ex (/.return (/.the "message" /.latest_error_message))])) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + (_.coverage [/.latest_error_location] + (and (|> (/.return /.latest_error_location) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list)) + ..nil) + (expression (|>> (as Bit) (bit#= true)) + (|> (/.begin (all /.then + (/.statement (/.raise (/.string error))) + (/.return (/.float dummy))) + (list [(list) $ex (/.return (all /.and + (/.do "kind_of?" (list (is /.CVar (/.manual "Array"))) {.#None} /.latest_error_location) + (/.> (/.int +0) (/.the "length" /.latest_error_location))))])) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list)))))) + ))) + +(def test|function + Test + (do [! random.monad] + [iterations (of ! each (n.% 10) random.nat) + $self (of ! each /.local (random.lower_cased 1)) + field (random.lower_cased 3) + $class (of ! each /.local (random.upper_cased 4)) + + float/0 random.safe_frac + float/1 random.safe_frac + float/2 random.safe_frac + $arg/0 (of ! each /.local (random.lower_cased 10)) + $arg/1 (of ! each /.local (random.lower_cased 11)) + $arg/2 (of ! each /.local (random.lower_cased 12))] + (all _.and + (_.coverage [/.lambda /.return] + (and (expression (|>> (as Frac) (f.= float/0)) + (|> (/.return (/.float float/0)) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list)))) + (expression (|>> (as Frac) f.nat (n.= iterations)) + (|> (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) + (/.apply_lambda (list (/.+ (/.int +1) $arg/0)) $self) + $arg/0)) + [(list $arg/0)] (/.lambda {.#Some $self}) + (/.apply_lambda (list (/.int +0))))))) + (_.coverage [/.apply_lambda] + (expression (|>> (as Frac) (f.= (all f.+ float/0 float/1 float/2))) + (|> (/.return (all /.+ $arg/0 $arg/1 $arg/2)) + [(list $arg/0 $arg/1 $arg/2)] (/.lambda {.#None}) + (/.apply_lambda (list (/.float float/0) (/.float float/1) (/.float float/2)))))) + (_.coverage [/.function] + (expression (|>> (as Frac) f.nat (n.= iterations)) + (|> (all /.then + (/.function $self (list $arg/0) + (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) + (/.apply (list (/.+ (/.int +1) $arg/0)) {.#None} $self) + $arg/0))) + (/.return (/.apply (list (/.int +0)) {.#None} $self))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + (_.coverage [/.apply] + (expression (|>> (as Frac) (f.= (all f.+ float/0 float/1 float/2))) + (|> (all /.then + (/.function $self (list $arg/0 $arg/1 $arg/2) + (/.return (all /.+ $arg/0 $arg/1 $arg/2))) + (/.return (/.apply (list (/.float float/0) (/.float float/1) (/.float float/2)) {.#None} $self))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + ))) + +(def test|branching + Test + (do [! random.monad] + [float/0 random.safe_frac + float/1 random.safe_frac + float/2 random.safe_frac + arg/0 (random.lower_cased 10) + arg/1 (random.only (|>> (text#= arg/0) not) + (random.lower_cased 10)) + arg/2 (random.only (predicate.and (|>> (text#= arg/0) not) + (|>> (text#= arg/1) not)) + (random.lower_cased 10)) + .let [$arg/0 (/.local arg/0) + $arg/1 (/.local arg/1) + $arg/2 (/.local arg/2)] + ??? random.bit] + (all _.and + (_.coverage [/.if] + (expression (|>> (as Frac) (f.= (if ??? float/0 float/1))) + (|> (/.if (/.bool ???) + (/.return (/.float float/0)) + (/.return (/.float float/1))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + (_.coverage [/.when] + (expression (|>> (as Frac) (f.= (if ??? float/0 float/1))) + (|> (all /.then + (/.when (/.bool ???) + (/.return (/.float float/0))) + (/.return (/.float float/1))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda (list))))) + ))) + +(def test|statement + Test + (do [! random.monad] + [float/0 random.safe_frac + float/1 random.safe_frac + float/2 random.safe_frac + $arg/0 (of ! each /.local (random.lower_cased 10)) + $arg/1 (of ! each /.local (random.lower_cased 11)) + $arg/2 (of ! each /.local (random.lower_cased 12)) + expected (of ! each (|>> %.int (text.replaced "+" "")) + random.int)] + (all _.and + (_.coverage [/.statement] + (expression (|>> (as Frac) (f.= float/0)) + (|> (all /.then + (/.statement (/.+ $arg/0 $arg/0)) + (/.return $arg/0)) + [(list $arg/0)] (/.lambda {.#None}) + (/.apply_lambda (list (/.float float/0)))))) + (_.coverage [/.then] + (expression (|>> (as Frac) (f.= float/0)) + (|> (all /.then + (/.return $arg/0) + (/.return $arg/1)) + [(list $arg/0 $arg/1)] (/.lambda {.#None}) + (/.apply_lambda (list (/.float float/0) (/.float float/1)))))) + (_.coverage [/.require/1] + (let [$JSON (is /.CVar (/.manual "JSON"))] + (expression (|>> (as Text) (text#= expected)) + (|> (all /.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 + (_.for [/.Block] + ..test|function) + ))) + +(def random_expression + (Random /.Expression) + (let [literal (is (Random /.Literal) + (all random.either + (random#each /.bool random.bit) + (random#each /.float random.frac) + (random#each /.int random.int) + (random#each /.string (random.lower_cased 5)) + ))] + (all random.either + literal + ))) + +(def .public test + Test + (do [! random.monad] + [expected ..random_expression] + (<| (_.covering /._) + (_.for [/.Code]) + (all _.and + (_.for [/.equivalence] + (equivalenceT.spec /.equivalence ..random_expression)) + + (_.coverage [/.code /.manual] + (|> (/.manual (/.code expected)) + (is /.Expression) + (/#= expected))) + (_.for [/.Expression] + ..test|expression) + (_.for [/.Statement] + ..test|statement) + )))) |