aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux/target/jvm.lux265
1 files changed, 132 insertions, 133 deletions
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index f0e6b2b91..e6d48aa21 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -2,7 +2,7 @@
[lux (#- Type type primitive int)
["." host (#+ import:)]
[abstract
- [monad (#+ do)]]
+ ["." monad (#+ do)]]
[control
["." function]
["." io (#+ IO)]
@@ -58,7 +58,7 @@
[limit
[registry (#+ Register)]]]]
["#." type (#+ Type)
- ["." category (#+ Value)]]]})
+ ["." category (#+ Value Object)]]]})
## (def: (write-class! name bytecode)
## (-> Text Binary (IO Text))
@@ -111,30 +111,6 @@
/name.external-separator package
/name.external-separator name))))
-(def: type
- (Random (Type Value))
- (random.rec
- (function (_ type)
- ($_ random.either
- (random@wrap /type.boolean)
- (random@wrap /type.byte)
- (random@wrap /type.short)
- (random@wrap /type.int)
- (random@wrap /type.long)
- (random@wrap /type.float)
- (random@wrap /type.double)
- (random@wrap /type.char)
- (random@map (function (_ name) (/type.class name (list))) ..class-name)
- (random@map /type.array type)
- ))))
-
-(def: field
- (Random [Text (Type Value)])
- ($_ random.and
- (random.ascii/lower-alpha 10)
- ..type
- ))
-
(def: (get-method name class)
(-> Text (java/lang/Class java/lang/Object) java/lang/reflect/Method)
(java/lang/Class::getDeclaredMethod name
@@ -716,43 +692,113 @@
_ /.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
- [subject ..$String::random])
- (..bytecode (|>> (:coerce java/lang/Long)
- ("jvm leq" (text.size subject))))
- (do /.monad
- [_ (/.string subject)
- _ (/.invokeinterface (/type.class "java.lang.CharSequence" (list)) "length" (/type.method [(list) /type.int (list)]))
- _ /.i2l]
- ..$Long::wrap))
)))
+(def: method
+ Test
+ ($_ _.and
+ (<| (_.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
+ [subject ..$String::random])
+ (..bytecode (|>> (:coerce java/lang/Long)
+ ("jvm leq" (text.size subject))))
+ (do /.monad
+ [_ (/.string subject)
+ _ (/.invokeinterface (/type.class "java.lang.CharSequence" (list)) "length" (/type.method [(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 (i.+ part0 part1)
+ $Self (/type.class class-name (list))
+ class-field "instances"
+ object-field "value"
+ constructor "<init>"
+ constructor::type (/type.method [(list /type.long) /type.void (list)])
+ static-method "procedure"
+ bytecode (|> (/class.class /version.v6_0 /class.public
+ (/name.internal class-name)
+ (/name.internal "java.lang.Object")
+ (list)
+ (list (/field.field /field.static class-field /type.long (row.row))
+ (/field.field /field.public object-field /type.long (row.row)))
+ (list (/method.method /method.private
+ constructor
+ constructor::type
+ (list)
+ (do /.monad
+ [_ /.aload-0
+ _ (/.invokespecial ..$Object "<init>" (/type.method [(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 ($_ /modifier@compose
+ /method.public
+ /method.static)
+ static-method
+ (/type.method [(list) ..$Long (list)])
+ (list)
+ (do /.monad
+ [_ (/.new $Self)
+ _ /.dup
+ _ (..$Long::literal part1)
+ _ (/.invokespecial $Self "<init>" constructor::type)
+ _ (/.getfield $Self object-field /type.long)
+ _ (/.getstatic $Self class-field /type.long)
+ _ /.ladd
+ _ ..$Long::wrap]
+ /.areturn)))
+ (row.row))
+ try.assume
+ (format.run /class.writer))
+ loader (/loader.memory (/loader.new-library []))]]
+ (_.test "PUTSTATIC & PUTFIELD & GETFIELD & GETSTATIC"
+ (case (do try.monad
+ [_ (/loader.define class-name bytecode loader)
+ class (io.run (/loader.load class-name loader))
+ method (host.try (get-method static-method class))
+ output (java/lang/reflect/Method::invoke (host.null) (host.array java/lang/Object 0) method)]
+ (wrap (:coerce Int output)))
+ (#try.Success actual)
+ (i.= expected actual)
+
+ (#try.Failure error)
+ false))))
+
(def: array
Test
(let [!length (: (-> Nat (Bytecode Any))
@@ -829,6 +875,27 @@
(_.context "object"
(array (/.anewarray ..$String) $String::random $String::literal [/.aastore /.aaload /.nop]
(function (_ expected) (|>> (:coerce Text) (text@= expected)))))
+ (<| (_.context "multi")
+ (do random.monad
+ [#let [size (:: @ map (|>> (n.% 10) (n.+ 1))
+ random.nat)]
+ dimensions size
+ sizesH size
+ sizesT (monad.seq @ (list.repeat (dec dimensions) size))
+ #let [type (loop [dimensions dimensions
+ type (: (Type Object)
+ ..$Object)]
+ (case dimensions
+ 0 type
+ _ (recur (dec dimensions) (/type.array type))))]]
+ (<| (_.lift "MULTIANEWARRAY")
+ (..bytecode (|>> (:coerce java/lang/Long) ("jvm leq" (.int sizesH))))
+ (do /.monad
+ [_ (monad.map @ (|>> host.long-to-int ..$Integer::literal)
+ (#.Cons sizesH sizesT))
+ _ (/.multianewarray type (|> dimensions /unsigned.u1 try.assume))
+ _ ?length]
+ $Long::wrap))))
)))
(def: conversion
@@ -892,6 +959,10 @@
..primitive)
(<| (_.context "object")
..object)
+ (<| (_.context "method")
+ ..method)
+ (<| (_.context "field")
+ ..field)
(<| (_.context "array")
..array)
(<| (_.context "conversion")
@@ -1370,81 +1441,9 @@
..code)
))
-(def: method
- Test
- (do random.monad
- [class-name ..class-name
- method-name (random.ascii/upper-alpha 10)
- expected ..$Long::random
- #let [inputsJT (list)
- outputJT ..$Object]]
- (_.test "Can compile a method."
- (let [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
- [_ (..$Long::literal expected)
- _ ..$Long::wrap]
- /.areturn)))
- (row.row))
- try.assume
- (format.run /class.writer))
- loader (/loader.memory (/loader.new-library []))]
- (case (do try.monad
- [_ (/loader.define class-name bytecode loader)
- class (io.run (/loader.load class-name loader))
- method (host.try (get-method method-name class))
- output (java/lang/reflect/Method::invoke (host.null) (host.array java/lang/Object 0) method)]
- (wrap (:coerce Int output)))
- (#try.Success actual)
- (i.= expected actual)
-
- (#try.Failure error)
- false)))))
-
-(def: class
- Test
- (do random.monad
- [class-name ..class-name
- [field0 type0] ..field
- [field1 type1] ..field
- #let [bytecode (|> (/class.class /version.v6_0 /class.public
- (/name.internal class-name)
- (/name.internal "java.lang.Object")
- (list (/name.internal "java.io.Serializable")
- (/name.internal "java.lang.Runnable"))
- (list (/field.field /field.public field0 type0 (row.row))
- (/field.field /field.public field1 type1 (row.row)))
- (list)
- (row.row))
- try.assume
- (format.run /class.writer))
- loader (/loader.memory (/loader.new-library []))]]
- ($_ _.and
- (_.test "Can generate a class."
- (case (do try.monad
- [_ (/loader.define class-name bytecode loader)]
- (io.run (/loader.load class-name loader)))
- (#try.Success definition)
- true
-
- (#try.Failure error)
- false))
- )))
-
(def: #export test
Test
(<| (_.context (%.name (name-of .._)))
($_ _.and
..instruction
- ..method
- ..class
)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 18:33:09 +0000