aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2019-11-10 23:59:58 -0400
committerEduardo Julian2019-11-10 23:59:58 -0400
commit2a878363e00865c5c34a2f9fcc57e85ce1d4f771 (patch)
treeef5b21d610746a9958846c17df2a1f0e1f524047 /stdlib/source
parentff2ce5f74ead3b0aafd1ffd15a512e4c8aab6df4 (diff)
WIP: Tests for JVM bytecode machinery. [Part 2]
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/lux/target/jvm.lux407
1 files changed, 369 insertions, 38 deletions
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index cfd756e98..13be558e5 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -54,7 +54,7 @@
[limit
[registry (#+ Register)]]]]
["#." type (#+ Type)
- [category (#+ Value)]]]})
+ ["." category (#+ Value)]]]})
## (def: (write-class! name bytecode)
## (-> Text Binary (IO Text))
@@ -71,6 +71,20 @@
## (#try.Failure error)
## error)))))
+(def: method-modifier
+ ($_ /modifier@compose
+ /method.public
+ /method.static))
+
+(import: #long java/lang/Boolean)
+(import: #long java/lang/Byte)
+(import: #long java/lang/Short)
+(import: #long java/lang/Integer)
+(import: #long java/lang/Long)
+(import: #long java/lang/Float)
+(import: #long java/lang/Double
+ (#static compare [double double] int))
+(import: #long java/lang/Character)
(import: #long java/lang/String)
(import: #long java/lang/reflect/Method
@@ -83,15 +97,6 @@
(getClass [] (java/lang/Class java/lang/Object))
(toString [] java/lang/String))
-(import: #long java/lang/Boolean)
-(import: #long java/lang/Byte)
-(import: #long java/lang/Short)
-(import: #long java/lang/Integer)
-(import: #long java/lang/Long)
-(import: #long java/lang/Float)
-(import: #long java/lang/Double)
-(import: #long java/lang/Character)
-
(def: class-name
(Random Text)
(do random.monad
@@ -138,29 +143,24 @@
(-> (-> Any Bit) (Bytecode Any) (Random Bit))
(do random.monad
[class-name ..class-name
- method-name (random.ascii/upper-alpha 10)
- #let [inputsJT (list)
- outputJT ..$Object
- bytecode (|> (/class.class /version.v6_0 /class.public
- (/name.internal class-name)
- (/name.internal "java.lang.Object")
- (list)
- (list)
- (list (/method.method ($_ /modifier@compose
- /method.public
- /method.static)
- method-name
- (/type.method [inputsJT outputJT (list)])
- (list)
- (do /.monad
- [_ bytecode]
- /.areturn)))
- (row.row))
- try.assume
- (format.run /class.writer))
- loader (/loader.memory (/loader.new-library []))]]
+ method-name (random.ascii/upper-alpha 10)]
(wrap (case (do try.monad
- [_ (/loader.define class-name bytecode loader)
+ [class (/class.class /version.v6_0 /class.public
+ (/name.internal class-name)
+ (/name.internal "java.lang.Object")
+ (list)
+ (list)
+ (list (/method.method ..method-modifier
+ method-name
+ (/type.method [(list) ..$Object (list)])
+ (list)
+ (do /.monad
+ [_ bytecode]
+ /.areturn)))
+ (row.row))
+ #let [bytecode (format.run /class.writer class)
+ loader (/loader.memory (/loader.new-library []))]
+ _ (/loader.define class-name bytecode loader)
class (io.run (/loader.load class-name loader))
method (host.try (get-method method-name class))]
(java/lang/reflect/Method::invoke (host.null) (host.array java/lang/Object 0) method))
@@ -170,6 +170,13 @@
(#try.Failure error)
false))))
+(type: (Primitive a)
+ {#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
@@ -182,6 +189,13 @@
(if 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)))
@@ -193,6 +207,13 @@
(def: $Byte::literal
(-> java/lang/Byte (Bytecode Any))
(|>> host.byte-to-long .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)))
@@ -204,6 +225,13 @@
(def: $Short::literal
(-> java/lang/Short (Bytecode Any))
(|>> host.short-to-long .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)))
@@ -215,11 +243,25 @@
(def: $Integer::literal
(-> java/lang/Integer (Bytecode Any))
(|>> host.int-to-long .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 /type.long) ..$Long (list)])))
(def: $Long::random (Random java/lang/Long) random.int)
(def: $Long::literal (-> java/lang/Long (Bytecode Any)) /.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 /type.float) ..$Float (list)])))
@@ -229,11 +271,25 @@
(|>> (i.% +1024) i.frac host.double-to-float)
random.int))
(def: $Float::literal /.float)
+(def: $Float::primitive
+ (Primitive java/lang/Float)
+ {#unboxed /type.float
+ #boxed ..$Float
+ #wrap ..$Float::wrap
+ #random ..$Float::random
+ #literal ..$Float::literal})
(def: $Double (/type.class "java.lang.Double" (list)))
(def: $Double::wrap (/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)])))
(def: $Double::random random.frac)
(def: $Double::literal /.double)
+(def: $Double::primitive
+ (Primitive java/lang/Double)
+ {#unboxed /type.double
+ #boxed ..$Double
+ #wrap ..$Double::wrap
+ #random ..$Double::random
+ #literal ..$Double::literal})
(def: $Character
(/type.class "java.lang.Character" (list)))
@@ -245,10 +301,39 @@
(def: $Character::literal
(-> java/lang/Character (Bytecode Any))
(|>> host.char-to-long .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 (random.unicode 10))
+(def: $String::random (random.ascii/alpha 10))
(def: $String::literal /.string)
+(def: $String::primitive
+ (Primitive java/lang/String)
+ {#unboxed ..$String
+ #boxed ..$String
+ #wrap /.nop
+ #random ..$String::random
+ #literal ..$String::literal})
+
+(template [<name> <bits> <type> <push> <wrap> <message> <to-long> <unsigned>]
+ [(def: <name>
+ Test
+ (do random.monad
+ [expected (:: @ map (i64.and (i64.mask <bits>)) random.nat)]
+ (<| (_.lift <message>)
+ (..bytecode (|>> (:coerce <type>) <to-long> ("jvm leq" expected)))
+ (do /.monad
+ [_ (<push> (|> expected <unsigned> try.assume))]
+ <wrap>))))]
+
+ [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: (int/2 <extension>)
(: (-> java/lang/Integer java/lang/Integer java/lang/Integer)
@@ -386,7 +471,26 @@
(_.lift "LXOR" (binary i64.xor /.lxor))
(_.lift "LSHL" (shift i64.left-shift /.lshl))
(_.lift "LSHR" (shift i64.arithmetic-right-shift /.lshr))
- (_.lift "LUSHR" (shift i64.logic-right-shift /.lushr)))]
+ (_.lift "LUSHR" (shift i64.logic-right-shift /.lushr)))
+ comparison (_.lift "LCMP"
+ (do random.monad
+ [reference ..$Long::random
+ subject ..$Long::random
+ #let [expected (cond (i.= reference subject)
+ +0
+
+ (i.> reference subject)
+ +1
+
+ ## (i.< reference subject)
+ -1)]]
+ (<| (..bytecode (|>> (:coerce Int) (i.= expected)))
+ (do /.monad
+ [_ (..$Long::literal subject)
+ _ (..$Long::literal reference)
+ _ /.lcmp
+ _ /.i2l]
+ ..$Long::wrap))))]
($_ _.and
(<| (_.context "literal")
literal)
@@ -394,6 +498,8 @@
arithmetic)
(<| (_.context "bitwise")
bitwise)
+ (<| (_.context "comparison")
+ comparison)
)))
(template: (float/2 <extension>)
@@ -447,12 +553,36 @@
(_.lift "FREM" (binary (float/2 "jvm frem") /.frem))
(_.lift "FNEG" (unary (function (_ value)
((float/2 "jvm fsub") value (host.double-to-float +0.0)))
- /.fneg)))]
+ /.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 ("jvm feq" reference 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 ($_ _.and
+ (_.lift "FCMPL" (comparison /.fcmpl (function (_ reference subject)
+ ("jvm fgt" subject reference))))
+ (_.lift "FCMPG" (comparison /.fcmpg (function (_ reference subject)
+ ("jvm fgt" subject reference)))))]
($_ _.and
(<| (_.context "literal")
literal)
(<| (_.context "arithmetic")
arithmetic)
+ (<| (_.context "comparison")
+ comparison)
)))
(def: double
@@ -494,17 +624,45 @@
(_.lift "DMUL" (binary f.* /.dmul))
(_.lift "DDIV" (binary f./ /.ddiv))
(_.lift "DREM" (binary f.% /.drem))
- (_.lift "DNEG" (unary (function (_ value) (f.- value +0.0)) /.dneg)))]
+ (_.lift "DNEG" (unary (function (_ value) (f.- value +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 ("jvm deq" reference 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)))))
+ comparison ($_ _.and
+ (_.lift "DCMPL" (comparison /.dcmpl (function (_ reference subject)
+ ("jvm dgt" subject reference))))
+ (_.lift "DCMPG" (comparison /.dcmpg (function (_ reference subject)
+ ("jvm dgt" subject reference)))))]
($_ _.and
(<| (_.context "literal")
literal)
(<| (_.context "arithmetic")
arithmetic)
+ (<| (_.context "comparison")
+ comparison)
)))
(def: primitive
Test
($_ _.and
+ (<| (_.context "byte")
+ ..byte)
+ (<| (_.context "short")
+ ..short)
(<| (_.context "int")
..int)
(<| (_.context "long")
@@ -554,6 +712,45 @@
_ /.dup _ /.monitorexit
_ (/.instanceof ..$String)]
..$Boolean::wrap))
+ (<| (_.lift "INVOKESTATIC")
+ (do random.monad
+ [expected ..$Double::random])
+ (..bytecode (|>> (:coerce java/lang/Double) ("jvm deq" expected)))
+ (do /.monad
+ [_ (/.double expected)]
+ (/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)]))))
+ (<| (_.lift "INVOKEVIRTUAL")
+ (do random.monad
+ [expected ..$Double::random])
+ (..bytecode (|>> (:coerce java/lang/Boolean) (bit@= (f.not-a-number? expected))))
+ (do /.monad
+ [_ (/.double expected)
+ _ ..$Double::wrap
+ _ (/.invokevirtual ..$Double "isNaN" (/type.method [(list) /type.boolean (list)]))]
+ ..$Boolean::wrap))
+ (<| (_.lift "INVOKESPECIAL")
+ (do random.monad
+ [expected ..$Double::random])
+ (..bytecode (|>> (:coerce java/lang/Double) ("jvm deq" expected)))
+ (do /.monad
+ [_ (/.new ..$Double)
+ _ /.dup
+ _ (/.double expected)]
+ (/.invokespecial ..$Double "<init>" (/type.method [(list /type.double) /type.void (list)]))))
+ (<| (_.lift "INVOKEINTERFACE")
+ (do random.monad
+ [parameter ..$Double::random
+ subject ..$Double::random])
+ (..bytecode (|>> (:coerce java/lang/Long)
+ ("jvm leq" (java/lang/Double::compare parameter subject))))
+ (do /.monad
+ [_ (/.double subject) _ ..$Double::wrap
+ _ (/.double parameter) _ ..$Double::wrap
+ _ (/.invokeinterface (/type.class "java.lang.Comparable" (list))
+ "compareTo​"
+ (/type.method [(list ..$Object) /type.int (list)]))
+ _ /.i2l]
+ ..$Long::wrap))
)))
(def: array
@@ -634,6 +831,60 @@
(function (_ expected) (|>> (:coerce Text) (text@= expected)))))
)))
+(def: conversion
+ Test
+ (let [conversion (: (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 (get@ #random from)
+ #let [expected (convert input)]]
+ (..bytecode (test expected)
+ (do /.monad
+ [_ ((get@ #literal from) input)
+ _ instruction]
+ (get@ #wrap to))))))]
+ ($_ _.and
+ (<| (_.context "int")
+ ($_ _.and
+ (_.lift "I2L" (conversion ..$Integer::primitive ..$Long::primitive /.i2l (|>> host.int-to-long)
+ (function (_ expected) (|>> (:coerce java/lang/Long) ("jvm leq" expected)))))
+ (_.lift "I2F" (conversion ..$Integer::primitive ..$Float::primitive /.i2f (|>> host.int-to-float)
+ (function (_ expected) (|>> (:coerce java/lang/Float) ("jvm feq" expected)))))
+ (_.lift "I2D" (conversion ..$Integer::primitive ..$Double::primitive /.i2d (|>> host.int-to-double)
+ (function (_ expected) (|>> (:coerce java/lang/Double) ("jvm deq" expected)))))
+ (_.lift "I2B" (conversion ..$Integer::primitive ..$Byte::primitive /.i2b (|>> host.int-to-byte)
+ (function (_ expected) (|>> (:coerce java/lang/Byte) host.byte-to-long ("jvm leq" (host.byte-to-long expected))))))
+ (_.lift "I2C" (conversion ..$Integer::primitive ..$Character::primitive /.i2c (|>> host.int-to-char)
+ (function (_ expected) (|>> (:coerce java/lang/Character) ("jvm ceq" expected)))))
+ (_.lift "I2S" (conversion ..$Integer::primitive ..$Short::primitive /.i2s (|>> host.int-to-short)
+ (function (_ expected) (|>> (:coerce java/lang/Short) host.short-to-long ("jvm leq" (host.short-to-long expected))))))))
+ (<| (_.context "long")
+ ($_ _.and
+ (_.lift "L2I" (conversion ..$Long::primitive ..$Integer::primitive /.l2i (|>> host.long-to-int)
+ (function (_ expected) (|>> (:coerce java/lang/Integer) ("jvm ieq" expected)))))
+ (_.lift "L2F" (conversion ..$Long::primitive ..$Float::primitive /.l2f (|>> host.long-to-float)
+ (function (_ expected) (|>> (:coerce java/lang/Float) ("jvm feq" expected)))))
+ (_.lift "L2D" (conversion ..$Long::primitive ..$Double::primitive /.l2d (|>> host.long-to-double)
+ (function (_ expected) (|>> (:coerce java/lang/Double) ("jvm deq" expected)))))))
+ (<| (_.context "float")
+ ($_ _.and
+ (_.lift "F2I" (conversion ..$Float::primitive ..$Integer::primitive /.f2i (|>> host.float-to-int)
+ (function (_ expected) (|>> (:coerce java/lang/Integer) ("jvm ieq" expected)))))
+ (_.lift "F2L" (conversion ..$Float::primitive ..$Long::primitive /.f2l (|>> host.float-to-long)
+ (function (_ expected) (|>> (:coerce java/lang/Long) ("jvm leq" expected)))))
+ (_.lift "F2D" (conversion ..$Float::primitive ..$Double::primitive /.f2d (|>> host.float-to-double)
+ (function (_ expected) (|>> (:coerce java/lang/Double) ("jvm deq" expected)))))))
+ (<| (_.context "double")
+ ($_ _.and
+ (_.lift "D2I" (conversion ..$Double::primitive ..$Integer::primitive /.d2i (|>> host.double-to-int)
+ (function (_ expected) (|>> (:coerce java/lang/Integer) ("jvm ieq" expected)))))
+ (_.lift "D2L" (conversion ..$Double::primitive ..$Long::primitive /.d2l (|>> host.double-to-long)
+ (function (_ expected) (|>> (:coerce java/lang/Long) ("jvm leq" expected)))))
+ (_.lift "D2F" (conversion ..$Double::primitive ..$Float::primitive /.d2f (|>> host.double-to-float)
+ (function (_ expected) (|>> (:coerce java/lang/Float) ("jvm feq" expected)))))))
+ )))
+
(def: value
Test
($_ _.and
@@ -643,6 +894,8 @@
..object)
(<| (_.context "array")
..array)
+ (<| (_.context "conversion")
+ ..conversion)
))
(def: registry
@@ -766,13 +1019,13 @@
[expected/1 $String::random
dummy/1 $String::random
#let [single ($_ _.and
- (<| (_.lift "DUP/POP")
+ (<| (_.lift "DUP & POP")
(..bytecode (|>> (:coerce Text) (text@= expected/1)))
(do /.monad
[_ ($String::literal expected/1)
_ /.dup]
/.pop))
- (<| (_.lift "DUP_X1/POP2")
+ (<| (_.lift "DUP_X1 & POP2")
(..bytecode (|>> (:coerce Text) (text@= expected/1)))
(do /.monad
[_ ($String::literal dummy/1)
@@ -841,6 +1094,82 @@
..stack)
))
+(def: return
+ Test
+ (let [primitive-return (: (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.ascii/upper-alpha 10)
+ #let [primitive-method-type (/type.method [(list) (get@ #unboxed primitive) (list)])]
+ object-method-name (|> (random.ascii/upper-alpha 10)
+ (random.filter (|>> (text@= primitive-method-name) not)))
+ expected (get@ #random primitive)
+ #let [$Self (/type.class class-name (list))]]
+ (wrap (case (do try.monad
+ [class (/class.class /version.v6_0 /class.public
+ (/name.internal class-name)
+ (/name.internal "java.lang.Object")
+ (list)
+ (list)
+ (list (/method.method ..method-modifier
+ primitive-method-name
+ primitive-method-type
+ (list)
+ (do /.monad
+ [_ ((get@ #literal primitive) expected)]
+ return))
+ (/method.method ..method-modifier
+ object-method-name
+ (/type.method [(list) (get@ #boxed primitive) (list)])
+ (list)
+ (do /.monad
+ [_ (/.invokestatic $Self primitive-method-name primitive-method-type)
+ _ (case substitute
+ #.None
+ (wrap [])
+
+ (#.Some substitute)
+ (substitute expected))
+ _ (get@ #wrap primitive)]
+ /.areturn)))
+ (row.row))
+ #let [bytecode (format.run /class.writer class)
+ loader (/loader.memory (/loader.new-library []))]
+ _ (/loader.define class-name bytecode loader)
+ class (io.run (/loader.load class-name loader))
+ method (host.try (get-method object-method-name class))]
+ (java/lang/reflect/Method::invoke (host.null) (host.array java/lang/Object 0) method))
+ (#try.Success actual)
+ (test expected actual)
+
+ (#try.Failure error)
+ false)
+ ))))]
+ ($_ _.and
+ (_.lift "IRETURN" (primitive-return ..$Integer::primitive /.ireturn #.None (function (_ expected actual) ("jvm ieq" expected (:coerce java/lang/Integer actual)))))
+ (_.lift "LRETURN" (primitive-return ..$Long::primitive /.lreturn #.None (function (_ expected actual) ("jvm leq" expected (:coerce java/lang/Long actual)))))
+ (_.lift "FRETURN" (primitive-return ..$Float::primitive /.freturn #.None (function (_ expected actual) ("jvm feq" expected (:coerce java/lang/Float actual)))))
+ (_.lift "DRETURN" (primitive-return ..$Double::primitive /.dreturn #.None (function (_ expected actual) ("jvm deq" expected (:coerce java/lang/Double actual)))))
+ (_.lift "ARETURN" (primitive-return ..$String::primitive /.areturn #.None (function (_ expected actual) (text@= expected (:coerce java/lang/String actual)))))
+ (_.lift "RETURN" (primitive-return (: (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@= expected (:coerce java/lang/String actual)))))
+ )))
+
+(def: code
+ Test
+ ($_ _.and
+ (<| (_.context "return")
+ ..return)
+ ))
+
(def: instruction
Test
($_ _.and
@@ -848,6 +1177,8 @@
..value)
(<| (_.context "resource")
..resource)
+ (<| (_.context "code")
+ ..code)
))
(def: method