From ce7614f00a134cb61b4a6f88cfea33461a7bf478 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 7 Oct 2020 17:00:57 -0400 Subject: Test imports for circular dependencies. --- stdlib/source/test/aedifex.lux | 21 ++ stdlib/source/test/aedifex/parser.lux | 212 +++++++++++ stdlib/source/test/lux/data/identity.lux | 26 +- stdlib/source/test/lux/target/jvm.lux | 621 ++++++++++++++++--------------- 4 files changed, 556 insertions(+), 324 deletions(-) create mode 100644 stdlib/source/test/aedifex.lux create mode 100644 stdlib/source/test/aedifex/parser.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux new file mode 100644 index 000000000..7286aa50a --- /dev/null +++ b/stdlib/source/test/aedifex.lux @@ -0,0 +1,21 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [control + [io (#+ io)] + [parser + [cli (#+ program:)]]]] + ["." / #_ + ["#." parser]]) + +(def: test + Test + ($_ _.and + /parser.test + )) + +(program: args + (<| io + _.run! + (_.times 100) + ..test)) diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux new file mode 100644 index 000000000..497533fbf --- /dev/null +++ b/stdlib/source/test/aedifex/parser.lux @@ -0,0 +1,212 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + [hash (#+ Hash)]] + [control + [pipe (#+ case>)] + ["." try] + [parser + ["" code]]] + [data + ["." text + ["%" format (#+ format)]] + [number + ["n" nat]] + [collection + ["." set (#+ Set)] + ["." dictionary (#+ Dictionary)] + ["." list ("#@." functor)]]] + [math + ["." random (#+ Random) ("#@." monad)]] + [macro + ["." code]]] + {#program + ["." / + ["/#" // #_ + ["#" profile] + ["#." project (#+ Project)] + ["#." artifact (#+ Artifact)] + ["#." dependency (#+ Repository Dependency)] + ["#." format]]]}) + +(def: distribution + (Random //.Distribution) + (random.or (random@wrap []) + (random@wrap []))) + +(def: license + (Random //.License) + ($_ random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1) + ..distribution)) + +(def: scm + (Random //.SCM) + (random.ascii/alpha 1)) + +(def: organization + (Random //.Organization) + ($_ random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1))) + +(def: email + (Random //.Email) + (random.ascii/alpha 1)) + +(def: developer + (Random //.Developer) + ($_ random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1) + (random.maybe organization))) + +(def: contributor + (Random //.Contributor) + ..developer) + +(def: (list-of random) + (All [a] (-> (Random a) (Random (List a)))) + (do {@ random.monad} + [size (:: @ map (n.% 5) random.nat)] + (random.list size random))) + +(def: (set-of hash random) + (All [a] (-> (Hash a) (Random a) (Random (Set a)))) + (:: random.functor map + (set.from-list hash) + (..list-of random))) + +(def: (dictionary-of key-hash key-random value-random) + (All [k v] (-> (Hash k) (Random k) (Random v) (Random (Dictionary k v)))) + (:: random.functor map + (dictionary.from-list key-hash) + (..list-of (random.and key-random value-random)))) + +(def: info + (Random //.Info) + ($_ random.and + (random.maybe (random.ascii/alpha 1)) + (random.maybe ..scm) + (random.maybe (random.ascii/alpha 1)) + (..list-of ..license) + (random.maybe ..organization) + (..list-of ..developer) + (..list-of ..contributor) + )) + +(def: name + (Random //.Name) + (random.ascii/alpha 1)) + +(def: artifact + (Random Artifact) + ($_ random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1) + (random.ascii/alpha 1))) + +(def: repository + (Random Repository) + (random.ascii/alpha 1)) + +(def: dependency + (Random Dependency) + ($_ random.and + ..artifact + (random.ascii/alpha 1))) + +(def: source + (Random //.Source) + (random.ascii/alpha 1)) + +(def: target + (Random //.Target) + (random.ascii/alpha 1)) + +(def: profile + (Random //.Profile) + ($_ random.and + (..list-of ..name) + (random.maybe ..artifact) + (random.maybe ..info) + (..set-of text.hash ..repository) + (..set-of //dependency.hash ..dependency) + (..set-of text.hash ..source) + (random.maybe ..target) + (random.maybe (random.ascii/alpha 1)) + (random.maybe (random.ascii/alpha 1)) + (..dictionary-of text.hash (random.ascii/alpha 1) ..repository) + )) + +(def: project + (Random Project) + (..dictionary-of text.hash ..name ..profile)) + +(def: with-default-sources + (-> //.Profile //.Profile) + (update@ #//.sources + (: (-> (Set //.Source) (Set //.Source)) + (function (_ sources) + (if (set.empty? sources) + (set.from-list text.hash (list //.default-source)) + sources))))) + +(def: single-profile + Test + (do random.monad + [expected ..profile] + (_.test "Single profile." + (|> expected + //format.profile + list + (.run /.project) + (case> (#try.Success actual) + (|> expected + ..with-default-sources + [//.default] + list + (dictionary.from-list text.hash) + (:: //project.equivalence = actual)) + + (#try.Failure error) + false))))) + +(def: (with-empty-profile project) + (-> Project Project) + (if (dictionary.empty? project) + //project.empty + project)) + +(def: multiple-profiles + Test + (do random.monad + [expected ..project] + (_.test "Multiple profiles." + (|> expected + //format.project + list + (.run /.project) + (case> (#try.Success actual) + (|> expected + ..with-empty-profile + dictionary.entries + (list@map (function (_ [name profile]) + [name (..with-default-sources profile)])) + (dictionary.from-list text.hash) + (:: //project.equivalence = actual)) + + (#try.Failure error) + false))))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.project] + ($_ _.and + ..single-profile + ..multiple-profiles + )))) diff --git a/stdlib/source/test/lux/data/identity.lux b/stdlib/source/test/lux/data/identity.lux index 65d7d1a48..cc2ccf096 100644 --- a/stdlib/source/test/lux/data/identity.lux +++ b/stdlib/source/test/lux/data/identity.lux @@ -10,7 +10,8 @@ [/ ["$." functor (#+ Injection Comparison)] ["$." apply] - ["$." monad]]}] + ["$." monad] + ["$." comonad]]}] [data ["." text ("#@." monoid equivalence) ["%" format (#+ format)]]]] @@ -28,18 +29,15 @@ (def: #export test Test - (<| (_.context (%.name (name-of /.Identity))) + (<| (_.covering /._) + (_.with-cover [/.Identity]) ($_ _.and - ($functor.spec ..injection ..comparison /.functor) - ($apply.spec ..injection ..comparison /.apply) - ($monad.spec ..injection ..comparison /.monad) - - (let [(^open "/@.") /.comonad] - (_.test "CoMonad does not affect values." - (and (text@= "yololol" (/@unwrap "yololol")) - (text@= "yololol" (be /.comonad - [f text@compose - a "yolo" - b "lol"] - (f a b)))))) + (_.with-cover [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.with-cover [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.with-cover [/.monad] + ($monad.spec ..injection ..comparison /.monad)) + (_.with-cover [/.comonad] + ($comonad.spec ..injection ..comparison /.comonad)) ))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 4a5672382..f2468ab4f 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -226,8 +226,8 @@ (def: $Float::random (Random java/lang/Float) (:: random.monad map - (|>> (i.% +1024) i.frac (:coerce java/lang/Double) host.double-to-float) - random.int)) + (|>> (:coerce java/lang/Double) host.double-to-float) + random.frac)) (def: $Float::literal /.float) (def: $Float::primitive (Primitive java/lang/Float) @@ -288,27 +288,23 @@ #random ..$String::random #literal ..$String::literal}) -(with-expansions [ (for {@.old - "jvm leq" - @.jvm - "jvm long ="})] - (template [ ] - [(def: - Test - (do {@ random.monad} - [expected (:: @ map (i64.and (i64.mask )) random.nat)] - (<| (_.lift ) - (..bytecode (for {@.old - (|>> (:coerce ) ( expected)) - @.jvm - (|>> (:coerce ) "jvm object cast" ( ("jvm object cast" (:coerce java/lang/Long expected))))})) - (do /.monad - [_ ( (|> expected try.assume))] - ))))] +(template [ ] + [(def: + Test + (do {@ random.monad} + [expected (:: @ map (i64.and (i64.mask )) random.nat)] + (<| (_.lift ) + (..bytecode (for {@.old + (|>> (:coerce ) ("jvm leq" expected)) + @.jvm + (|>> (:coerce ) "jvm object cast" ("jvm long =" ("jvm object cast" (:coerce java/lang/Long expected))))})) + (do /.monad + [_ ( (|> expected try.assume))] + ))))] - [byte 7 java/lang/Byte /.bipush ..$Byte::wrap "BIPUSH" host.byte-to-long /unsigned.u1] - [short 15 java/lang/Short /.sipush ..$Short::wrap "SIPUSH" host.short-to-long /unsigned.u2] - )) + [byte 7 java/lang/Byte /.bipush ..$Byte::wrap "BIPUSH" host.byte-to-long /unsigned.u1] + [short 15 java/lang/Short /.sipush ..$Short::wrap "SIPUSH" host.short-to-long /unsigned.u2] + ) (template [ ] [(template: ( ) @@ -341,19 +337,16 @@ (def: int Test - (let [int (with-expansions [ (for {@.old "jvm ieq" - @.jvm "jvm int ="})] - (: (-> java/lang/Integer (Bytecode Any) (Random Bit)) - (function (_ expected bytecode) - (<| (..bytecode (for {@.old - (|>> (:coerce java/lang/Integer) ( expected)) - - @.jvm - (|>> (:coerce java/lang/Integer) "jvm object cast" - ( ("jvm object cast" expected)))})) - (do /.monad - [_ bytecode] - ..$Integer::wrap))))) + (let [int (: (-> java/lang/Integer (Bytecode Any) (Random Bit)) + (function (_ expected bytecode) + (<| (..bytecode (for {@.old + (|>> (:coerce java/lang/Integer) ("jvm ieq" expected)) + + @.jvm + (|>> (:coerce java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" expected)))})) + (do /.monad + [_ bytecode] + ..$Integer::wrap)))) unary (: (-> (-> java/lang/Integer java/lang/Integer) (Bytecode Any) (Random Bit)) (function (_ reference instruction) (do random.monad @@ -425,290 +418,296 @@ (def: long Test - (with-expansions [ (for {@.old "jvm leq" - @.jvm "jvm long ="})] - (let [long (: (-> java/lang/Long (Bytecode Any) (Random Bit)) + (let [long (: (-> java/lang/Long (Bytecode Any) (Random Bit)) + (function (_ expected bytecode) + (<| (..bytecode (for {@.old + (|>> (:coerce Int) (i.= expected)) + + @.jvm + (|>> (:coerce java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))})) + (do /.monad + [_ bytecode] + ..$Long::wrap)))) + unary (: (-> (-> 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 (: (-> (-> 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 (: (-> (-> java/lang/Integer java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit)) + (function (_ reference instruction) + (do {@ random.monad} + [parameter (:: @ map (|>> (n.% 64) (:coerce java/lang/Long)) random.nat) + subject ..$Long::random] + (long (reference (host.long-to-int parameter) subject) + (do /.monad + [_ (..$Long::literal subject) + _ (..$Integer::literal (host.long-to-int parameter))] + instruction))))) + literal ($_ _.and + (_.lift "LCONST_0" (long (:coerce java/lang/Long +0) /.lconst-0)) + (_.lift "LCONST_1" (long (:coerce java/lang/Long +1) /.lconst-1)) + (_.lift "LDC2_W/LONG" + (do random.monad + [expected ..$Long::random] + (long expected (..$Long::literal expected))))) + arithmetic ($_ _.and + (_.lift "LADD" (binary (long/2 "jvm ladd" "jvm long +") /.ladd)) + (_.lift "LSUB" (binary (long/2 "jvm lsub" "jvm long -") /.lsub)) + (_.lift "LMUL" (binary (long/2 "jvm lmul" "jvm long *") /.lmul)) + (_.lift "LDIV" (binary (long/2 "jvm ldiv" "jvm long /") /.ldiv)) + (_.lift "LREM" (binary (long/2 "jvm lrem" "jvm long %") /.lrem)) + (_.lift "LNEG" (unary (function (_ value) + ((long/2 "jvm lsub" "jvm long -") + value + (:coerce java/lang/Long +0))) + /.lneg))) + bitwise ($_ _.and + (_.lift "LAND" (binary (long/2 "jvm land" "jvm long and") /.land)) + (_.lift "LOR" (binary (long/2 "jvm lor" "jvm long or") /.lor)) + (_.lift "LXOR" (binary (long/2 "jvm lxor" "jvm long xor") /.lxor)) + (_.lift "LSHL" (shift (int+long/2 "jvm lshl" "jvm long shl") /.lshl)) + (_.lift "LSHR" (shift (int+long/2 "jvm lshr" "jvm long shr") /.lshr)) + (_.lift "LUSHR" (shift (int+long/2 "jvm lushr" "jvm long ushr") /.lushr))) + comparison (_.lift "LCMP" + (do random.monad + [reference ..$Long::random + subject ..$Long::random + #let [expected (cond (i.= (:coerce Int reference) (:coerce Int subject)) + (:coerce java/lang/Long +0) + + (i.> (:coerce Int reference) (:coerce Int subject)) + (:coerce java/lang/Long +1) + + ## (i.< (:coerce Int reference) (:coerce Int subject)) + (:coerce java/lang/Long -1))]] + (<| (..bytecode (for {@.old + (|>> (:coerce Int) (i.= expected)) + + @.jvm + (|>> (:coerce java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))})) + (do /.monad + [_ (..$Long::literal subject) + _ (..$Long::literal reference) + _ /.lcmp + _ /.i2l] + ..$Long::wrap))))] + ($_ _.and + (<| (_.context "literal") + literal) + (<| (_.context "arithmetic") + arithmetic) + (<| (_.context "bitwise") + bitwise) + (<| (_.context "comparison") + comparison) + ))) + +(def: float + Test + (let [float (: (-> java/lang/Float (Bytecode Any) (Random Bit)) + (function (_ expected bytecode) + (<| (..bytecode (for {@.old + (function (_ actual) + (or (|> actual (:coerce java/lang/Float) ("jvm feq" expected)) + (and (f.not-a-number? (:coerce Frac (host.float-to-double expected))) + (f.not-a-number? (:coerce Frac (host.float-to-double (:coerce java/lang/Float actual))))))) + + @.jvm + (function (_ actual) + (or (|> actual (:coerce java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" expected))) + (and (f.not-a-number? (:coerce Frac (host.float-to-double expected))) + (f.not-a-number? (:coerce Frac (host.float-to-double (:coerce java/lang/Float actual)))))))})) + (do /.monad + [_ bytecode] + ..$Float::wrap)))) + unary (: (-> (-> 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 (: (-> (-> 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 ($_ _.and + (_.lift "FCONST_0" (float (host.double-to-float (:coerce java/lang/Double +0.0)) /.fconst-0)) + (_.lift "FCONST_1" (float (host.double-to-float (:coerce java/lang/Double +1.0)) /.fconst-1)) + (_.lift "FCONST_2" (float (host.double-to-float (:coerce java/lang/Double +2.0)) /.fconst-2)) + (_.lift "LDC_W/FLOAT" + (do random.monad + [expected ..$Float::random] + (float expected (..$Float::literal expected))))) + arithmetic ($_ _.and + (_.lift "FADD" (binary (float/2 "jvm fadd" "jvm float +") /.fadd)) + (_.lift "FSUB" (binary (float/2 "jvm fsub" "jvm float -") /.fsub)) + (_.lift "FMUL" (binary (float/2 "jvm fmul" "jvm float *") /.fmul)) + (_.lift "FDIV" (binary (float/2 "jvm fdiv" "jvm float /") /.fdiv)) + (_.lift "FREM" (binary (float/2 "jvm frem" "jvm float %") /.frem)) + (_.lift "FNEG" (unary (function (_ value) + ((float/2 "jvm fsub" "jvm float -") + value + (host.double-to-float (:coerce java/lang/Double +0.0)))) + /.fneg))) + comparison (: (-> (Bytecode Any) (-> java/lang/Float java/lang/Float Bit) (Random Bit)) + (function (_ instruction standard) + (do random.monad + [reference ..$Float::random + subject ..$Float::random + #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 (|>> (:coerce Int) (i.= expected))) + (do /.monad + [_ (..$Float::literal subject) + _ (..$Float::literal reference) + _ instruction + _ /.i2l] + ..$Long::wrap))))) + comparison-standard (: (-> 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 ($_ _.and + (_.lift "FCMPL" (comparison /.fcmpl comparison-standard)) + (_.lift "FCMPG" (comparison /.fcmpg comparison-standard)))] + ($_ _.and + (<| (_.context "literal") + literal) + (<| (_.context "arithmetic") + arithmetic) + (<| (_.context "comparison") + comparison) + ))) + +(def: double + Test + (let [double (: (-> java/lang/Double (Bytecode Any) (Random Bit)) (function (_ expected bytecode) (<| (..bytecode (for {@.old - (|>> (:coerce Int) (i.= expected)) + (function (_ actual) + (or (|> actual (:coerce java/lang/Double) ("jvm deq" expected)) + (and (f.not-a-number? (:coerce Frac expected)) + (f.not-a-number? (:coerce Frac actual))))) @.jvm - (|>> (:coerce java/lang/Long) "jvm object cast" ( ("jvm object cast" expected)))})) + (function (_ actual) + (or (|> actual (:coerce java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected))) + (and (f.not-a-number? (:coerce Frac expected)) + (f.not-a-number? (:coerce Frac actual)))))})) (do /.monad [_ bytecode] - ..$Long::wrap)))) - unary (: (-> (-> java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit)) - (function (_ reference instruction) - (do random.monad - [subject ..$Long::random] - (long (reference subject) + ..$Double::wrap)))) + unary (: (-> (-> java/lang/Double java/lang/Double) (Bytecode Any) (Random Bit)) + (function (_ reference instruction) + (do random.monad + [subject ..$Double::random] + (double (reference subject) (do /.monad - [_ (..$Long::literal subject)] + [_ (..$Double::literal subject)] instruction))))) - binary (: (-> (-> 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) + binary (: (-> (-> 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 - [_ (..$Long::literal subject) - _ (..$Long::literal parameter)] + [_ (..$Double::literal subject) + _ (..$Double::literal parameter)] instruction))))) - shift (: (-> (-> java/lang/Integer java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit)) - (function (_ reference instruction) - (do {@ random.monad} - [parameter (:: @ map (|>> (n.% 64) (:coerce java/lang/Long)) random.nat) - subject ..$Long::random] - (long (reference (host.long-to-int parameter) subject) - (do /.monad - [_ (..$Long::literal subject) - _ (..$Integer::literal (host.long-to-int parameter))] - instruction))))) - literal ($_ _.and - (_.lift "LCONST_0" (long (:coerce java/lang/Long +0) /.lconst-0)) - (_.lift "LCONST_1" (long (:coerce java/lang/Long +1) /.lconst-1)) - (_.lift "LDC2_W/LONG" - (do random.monad - [expected ..$Long::random] - (long expected (..$Long::literal expected))))) - arithmetic ($_ _.and - (_.lift "LADD" (binary (long/2 "jvm ladd" "jvm long +") /.ladd)) - (_.lift "LSUB" (binary (long/2 "jvm lsub" "jvm long -") /.lsub)) - (_.lift "LMUL" (binary (long/2 "jvm lmul" "jvm long *") /.lmul)) - (_.lift "LDIV" (binary (long/2 "jvm ldiv" "jvm long /") /.ldiv)) - (_.lift "LREM" (binary (long/2 "jvm lrem" "jvm long %") /.lrem)) - (_.lift "LNEG" (unary (function (_ value) - ((long/2 "jvm lsub" "jvm long -") - value - (:coerce java/lang/Long +0))) - /.lneg))) - bitwise ($_ _.and - (_.lift "LAND" (binary (long/2 "jvm land" "jvm long and") /.land)) - (_.lift "LOR" (binary (long/2 "jvm lor" "jvm long or") /.lor)) - (_.lift "LXOR" (binary (long/2 "jvm lxor" "jvm long xor") /.lxor)) - (_.lift "LSHL" (shift (int+long/2 "jvm lshl" "jvm long shl") /.lshl)) - (_.lift "LSHR" (shift (int+long/2 "jvm lshr" "jvm long shr") /.lshr)) - (_.lift "LUSHR" (shift (int+long/2 "jvm lushr" "jvm long ushr") /.lushr))) - comparison (_.lift "LCMP" - (do random.monad - [reference ..$Long::random - subject ..$Long::random - #let [expected (cond (i.= (:coerce Int reference) (:coerce Int subject)) - (:coerce java/lang/Long +0) - - (i.> (:coerce Int reference) (:coerce Int subject)) - (:coerce java/lang/Long +1) - - ## (i.< (:coerce Int reference) (:coerce Int subject)) - (:coerce java/lang/Long -1))]] - (<| (..bytecode (for {@.old - (|>> (:coerce Int) (i.= expected)) - - @.jvm - (|>> (:coerce java/lang/Long) "jvm object cast" ( ("jvm object cast" expected)))})) - (do /.monad - [_ (..$Long::literal subject) - _ (..$Long::literal reference) - _ /.lcmp - _ /.i2l] - ..$Long::wrap))))] - ($_ _.and - (<| (_.context "literal") - literal) - (<| (_.context "arithmetic") - arithmetic) - (<| (_.context "bitwise") - bitwise) - (<| (_.context "comparison") - comparison) - )))) - -(def: float - Test - (with-expansions [ (for {@.old "jvm feq" - @.jvm "jvm float ="})] - (let [float (: (-> java/lang/Float (Bytecode Any) (Random Bit)) - (function (_ expected bytecode) - (<| (..bytecode (for {@.old - (|>> (:coerce java/lang/Float) ("jvm feq" expected)) - - @.jvm - (|>> (:coerce java/lang/Float) "jvm object cast" ( ("jvm object cast" expected)))})) - (do /.monad - [_ bytecode] - ..$Float::wrap)))) - unary (: (-> (-> java/lang/Float java/lang/Float) - (Bytecode Any) - (Random Bit)) - (function (_ reference instruction) - (do random.monad - [subject ..$Float::random] - (float (reference subject) + literal ($_ _.and + (_.lift "DCONST_0" (double (:coerce java/lang/Double +0.0) /.dconst-0)) + (_.lift "DCONST_1" (double (:coerce java/lang/Double +1.0) /.dconst-1)) + (_.lift "LDC2_W/DOUBLE" + (do random.monad + [expected ..$Double::random] + (double expected (..$Double::literal expected))))) + arithmetic ($_ _.and + (_.lift "DADD" (binary (double/2 "jvm dadd" "jvm double +") /.dadd)) + (_.lift "DSUB" (binary (double/2 "jvm dsub" "jvm double -") /.dsub)) + (_.lift "DMUL" (binary (double/2 "jvm dmul" "jvm double *") /.dmul)) + (_.lift "DDIV" (binary (double/2 "jvm ddiv" "jvm double /") /.ddiv)) + (_.lift "DREM" (binary (double/2 "jvm drem" "jvm double %") /.drem)) + (_.lift "DNEG" (unary (function (_ value) + ((double/2 "jvm dsub" "jvm double -") + value + (:coerce java/lang/Double +0.0))) + /.dneg))) + comparison (: (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit)) + (function (_ instruction standard) + (do random.monad + [reference ..$Double::random + subject ..$Double::random + #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 (|>> (:coerce Int) (i.= expected))) (do /.monad - [_ (..$Float::literal subject)] - instruction))))) - binary (: (-> (-> 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 ($_ _.and - (_.lift "FCONST_0" (float (host.double-to-float (:coerce java/lang/Double +0.0)) /.fconst-0)) - (_.lift "FCONST_1" (float (host.double-to-float (:coerce java/lang/Double +1.0)) /.fconst-1)) - (_.lift "FCONST_2" (float (host.double-to-float (:coerce java/lang/Double +2.0)) /.fconst-2)) - (_.lift "LDC_W/FLOAT" - (do random.monad - [expected ..$Float::random] - (float expected (..$Float::literal expected))))) - arithmetic ($_ _.and - (_.lift "FADD" (binary (float/2 "jvm fadd" "jvm float +") /.fadd)) - (_.lift "FSUB" (binary (float/2 "jvm fsub" "jvm float -") /.fsub)) - (_.lift "FMUL" (binary (float/2 "jvm fmul" "jvm float *") /.fmul)) - (_.lift "FDIV" (binary (float/2 "jvm fdiv" "jvm float /") /.fdiv)) - (_.lift "FREM" (binary (float/2 "jvm frem" "jvm float %") /.frem)) - (_.lift "FNEG" (unary (function (_ value) - ((float/2 "jvm fsub" "jvm float -") - value - (host.double-to-float (:coerce java/lang/Double +0.0)))) - /.fneg))) - comparison (: (-> (Bytecode Any) (-> java/lang/Float java/lang/Float Bit) (Random Bit)) - (function (_ instruction standard) - (do random.monad - [reference ..$Float::random - subject ..$Float::random - #let [expected (if (for {@.old - ("jvm feq" reference subject) - - @.jvm - ( ("jvm object cast" reference) ("jvm object cast" subject))}) - +0 - (if (standard reference subject) - +1 - -1))]] - (<| (..bytecode (|>> (:coerce Int) (i.= expected))) - (do /.monad - [_ (..$Float::literal subject) - _ (..$Float::literal reference) - _ instruction - _ /.i2l] - ..$Long::wrap))))) - comparison-standard (: (-> 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 ($_ _.and - (_.lift "FCMPL" (comparison /.fcmpl comparison-standard)) - (_.lift "FCMPG" (comparison /.fcmpg comparison-standard)))] - ($_ _.and - (<| (_.context "literal") - literal) - (<| (_.context "arithmetic") - arithmetic) - (<| (_.context "comparison") - comparison) - )))) - -(def: double - Test - (with-expansions [ (for {@.old "jvm deq" - @.jvm "jvm double ="})] - (let [double (: (-> java/lang/Double (Bytecode Any) (Random Bit)) - (function (_ expected bytecode) - (<| (..bytecode (for {@.old - (|>> (:coerce java/lang/Double) ("jvm deq" expected)) - - @.jvm - (|>> (:coerce java/lang/Double) "jvm object cast" ( ("jvm object cast" expected)))})) - (do /.monad - [_ bytecode] - ..$Double::wrap)))) - unary (: (-> (-> 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 (: (-> (-> 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 ($_ _.and - (_.lift "DCONST_0" (double (:coerce java/lang/Double +0.0) /.dconst-0)) - (_.lift "DCONST_1" (double (:coerce java/lang/Double +1.0) /.dconst-1)) - (_.lift "LDC2_W/DOUBLE" - (do random.monad - [expected ..$Double::random] - (double expected (..$Double::literal expected))))) - arithmetic ($_ _.and - (_.lift "DADD" (binary (double/2 "jvm dadd" "jvm double +") /.dadd)) - (_.lift "DSUB" (binary (double/2 "jvm dsub" "jvm double -") /.dsub)) - (_.lift "DMUL" (binary (double/2 "jvm dmul" "jvm double *") /.dmul)) - (_.lift "DDIV" (binary (double/2 "jvm ddiv" "jvm double /") /.ddiv)) - (_.lift "DREM" (binary (double/2 "jvm drem" "jvm double %") /.drem)) - (_.lift "DNEG" (unary (function (_ value) - ((double/2 "jvm dsub" "jvm double -") - value - (:coerce java/lang/Double +0.0))) - /.dneg))) - comparison (: (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit)) - (function (_ instruction standard) - (do random.monad - [reference ..$Double::random - subject ..$Double::random - #let [expected (if (for {@.old - ("jvm deq" reference subject) - - @.jvm - ( ("jvm object cast" reference) ("jvm object cast" subject))}) - +0 - (if (standard reference subject) - +1 - -1))]] - (<| (..bytecode (|>> (:coerce 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 (: (-> 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 ($_ _.and - (_.lift "DCMPL" (comparison /.dcmpl comparison-standard)) - (_.lift "DCMPG" (comparison /.dcmpg comparison-standard)))] - ($_ _.and - (<| (_.context "literal") - literal) - (<| (_.context "arithmetic") - arithmetic) - (<| (_.context "comparison") - comparison) - )))) + [_ (..$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 (: (-> 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 ($_ _.and + (_.lift "DCMPL" (comparison /.dcmpl comparison-standard)) + (_.lift "DCMPG" (comparison /.dcmpg comparison-standard)))] + ($_ _.and + (<| (_.context "literal") + literal) + (<| (_.context "arithmetic") + arithmetic) + (<| (_.context "comparison") + comparison) + ))) (def: primitive Test @@ -773,7 +772,8 @@ ($_ _.and (<| (_.lift "INVOKESTATIC") (do random.monad - [expected ..$Double::random]) + [expected (random.filter (|>> (:coerce Frac) f.not-a-number? not) + ..$Double::random)]) (..bytecode (for {@.old (|>> (:coerce java/lang/Double) ("jvm deq" expected)) @@ -793,7 +793,8 @@ ..$Boolean::wrap)) (<| (_.lift "INVOKESPECIAL") (do random.monad - [expected ..$Double::random]) + [expected (random.filter (|>> (:coerce Frac) f.not-a-number? not) + ..$Double::random)]) (..bytecode (for {@.old (|>> (:coerce java/lang/Double) ("jvm deq" expected)) -- cgit v1.2.3