WIP: Tests for JVM bytecode machinery. [Part 4]

2 files changed, 141 insertions, 135 deletions

diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux
index 4175cc572..7db2d8e4b 100644
--- a/stdlib/source/lux/target/jvm/bytecode.lux
+++ b/stdlib/source/lux/target/jvm/bytecode.lux
@@ -795,10 +795,17 @@
   (-> Register U1 (Bytecode Any))
   (..bytecode $0 $0 (/registry.for register) _.iinc [register increase]))
 
+(exception: #export (multiarray-cannot-be-zero-dimensional {class (Type Object)})
+  (exception.report ["Class" (..reflection class)]))
+
 (def: #export (multianewarray class dimensions)
-  (-> (Type Class) U1 (Bytecode Any))
+  (-> (Type Object) U1 (Bytecode Any))
   (do ..monad
-    [index (..lift (//constant/pool.class (//name.internal (..reflection class))))]
+    [_ (: (Bytecode Any)
+          (case (|> dimensions //unsigned.value)
+            0 (..throw ..multiarray-cannot-be-zero-dimensional [class])
+            _ (wrap [])))
+     index (..lift (//constant/pool.class (//name.internal (..reflection class))))]
     (..bytecode (//unsigned.lift/2 dimensions) $1 @_ _.multianewarray [index dimensions])))
 
 (def: (type-size type)
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
           )))