- Updated lux/host tests.

- Fixed a bug in the way the [jvm l2b] and [jvm l2s] procedures worked.
- Fixed a bug in interface definition.
- Relaxed the syntacting requirements of class/interface/anonymous-class definition macros.

3 files changed, 133 insertions, 59 deletions

diff --git a/stdlib/source/lux/host.lux b/stdlib/source/lux/host.lux
index 7149cab94..92ff61d92 100644
--- a/stdlib/source/lux/host.lux
+++ b/stdlib/source/lux/host.lux
@@ -1327,8 +1327,10 @@
                           imports (add-import [(short-class-name full-class-name) full-class-name]
                                               (class-imports *compiler*))]}
                    {#let [class-vars (product;right class-decl)]}
-                   {super (s;opt (super-class-decl^ imports class-vars))}
-                   {interfaces (s;tuple (s;some (super-class-decl^ imports class-vars)))}
+                   {super (s;default object-super-class
+                            (super-class-decl^ imports class-vars))}
+                   {interfaces (s;default (list)
+                                 (s;tuple (s;some (super-class-decl^ imports class-vars))))}
                    {annotations (annotations^ imports)}
                    {fields (s;some (field-decl^ imports class-vars))}
                    {methods (s;some (method-def^ imports class-vars))})
@@ -1340,11 +1342,11 @@
                 (#private datum A)
                 (#private waitingList (java.util.List lux.Function))
                 ## Methods
-                (#public new [] [] []
+                (#public [] new [] []
                          (exec (:= .resolved false)
                            (:= .waitingList (ArrayList.new []))
                            []))
-                (#public resolve [] [{value A}] boolean
+                (#public [] resolve [{value A}] boolean
                          (let [container (.new! [])]
                            (synchronized _jvm_this
                              (if .resolved
@@ -1360,18 +1362,18 @@
                                         (i.range 0 (i.dec (i2l sleepers-count)))))
                                  (:= .waitingList (null))
                                  true)))))
-                (#public poll [] [] A
+                (#public [] poll [] A
                          .datum)
-                (#public wasResolved [] [] boolean
+                (#public [] wasResolved [] boolean
                          (synchronized _jvm_this
                            .resolved))
-                (#public waitOn [] [{callback lux.Function}] void
+                (#public [] waitOn [{callback lux.Function}] void
                          (synchronized _jvm_this
                            (exec (if .resolved
                                    (lux.Function.apply [(:! Object .datum)] callback)
                                    (:! Object (java.util.List.add [callback] .waitingList)))
                              [])))
-                (#public #static make [A] [{value A}] (lux.concurrency.promise.JvmPromise A)
+                (#public #static [A] make [{value A}] (lux.concurrency.promise.JvmPromise A)
                          (let [container (.new! [])]
                            (exec (.resolve! (:! (host lux.concurrency.promise.JvmPromise [Unit]) container) [(:! Unit value)])
                              container))))
@@ -1393,15 +1395,14 @@
            replacer (parser->replacer (fold s;either
                                             (s;fail "")
                                             (List/append field-parsers method-parsers)))
-           super-class (default object-super-class super)
            def-code (format "class:"
                             (spaced (list (class-decl$ class-decl)
-                                          (super-class-decl$ super-class)
+                                          (super-class-decl$ super)
                                           (with-brackets (spaced (map super-class-decl$ interfaces)))
                                           (inheritance-modifier$ im)
                                           (with-brackets (spaced (map annotation$ annotations)))
                                           (with-brackets (spaced (map field-decl$ fields)))
-                                          (with-brackets (spaced (map (method-def$ replacer super-class) methods))))))]]
+                                          (with-brackets (spaced (map (method-def$ replacer super) methods))))))]]
     (wrap (list (` (;_lux_proc ["jvm" (~ (ast;text def-code))] []))))))
 
 (syntax: #export (interface: {#let [imports (class-imports *compiler*)]}
@@ -1410,7 +1411,8 @@
                           imports (add-import [(short-class-name full-class-name) full-class-name]
                                               (class-imports *compiler*))]}
                    {#let [class-vars (product;right class-decl)]}
-                   {supers (s;tuple (s;some (super-class-decl^ imports class-vars)))}
+                   {supers (s;default (list)
+                             (s;tuple (s;some (super-class-decl^ imports class-vars))))}
                    {annotations (annotations^ imports)}
                    {members (s;some (method-decl^ imports class-vars))})
   (let [def-code (format "interface:"
@@ -1423,8 +1425,10 @@
 
 (syntax: #export (object {#let [imports (class-imports *compiler*)]}
                    {#let [class-vars (list)]}
-                   {super (s;opt (super-class-decl^ imports class-vars))}
-                   {interfaces (s;tuple (s;some (super-class-decl^ imports class-vars)))}
+                   {super (s;default object-super-class
+                            (super-class-decl^ imports class-vars))}
+                   {interfaces (s;default (list)
+                                 (s;tuple (s;some (super-class-decl^ imports class-vars))))}
                    {constructor-args (constructor-args^ imports class-vars)}
                    {methods (s;some (overriden-method-def^ imports))})
   {#;doc (doc "Allows defining anonymous classes."
@@ -1437,12 +1441,11 @@
                                     (exec (do-something some-input)
                                       [])))
               )}
-  (let [super-class (default object-super-class super)
-        def-code (format "anon-class:"
-                         (spaced (list (super-class-decl$ super-class)
+  (let [def-code (format "anon-class:"
+                         (spaced (list (super-class-decl$ super)
                                        (with-brackets (spaced (map super-class-decl$ interfaces)))
                                        (with-brackets (spaced (map constructor-arg$ constructor-args)))
-                                       (with-brackets (spaced (map (method-def$ id super-class) methods))))))]
+                                       (with-brackets (spaced (map (method-def$ id super) methods))))))]
     (wrap (list (` (;_lux_proc ["jvm" (~ (ast;text def-code))] []))))))
 
 (syntax: #export (null)
diff --git a/stdlib/test/test/lux/host.lux b/stdlib/test/test/lux/host.lux
index 109d8dfed..9cb9dac23 100644
--- a/stdlib/test/test/lux/host.lux
+++ b/stdlib/test/test/lux/host.lux
@@ -1,54 +1,125 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
 (;module:
   lux
   (lux (control monad)
        (data text/format
              [number]
-             [product])
+             [product]
+             [text "Text/" Eq<Text>])
        (codata function
                [io])
-       host)
+       ["&" host #+ jvm-import class: interface: object]
+       (math ["R" random])
+       pipe)
   lux/test)
 
-(jvm-import java.lang.Object
-  (new []))
+(jvm-import java.lang.Exception
+  (new [String]))
 
-(jvm-import java.lang.String)
+(jvm-import java.lang.Object)
 
 (jvm-import (java.lang.Class a)
   (getName [] String))
 
-(test: "lux/host exports"
-  (let% [<conversions-0> (do-template [<value> <forward> <backward>]
-                           [(match <value> (|> <value> <forward> <backward>))]
-
-                           [123   l2d d2l]
-                           [123   l2f f2l]
-                           [123   l2i i2l]
-                           [123.0 d2l l2d]
-                           [123.0 d2f f2d]
-                           [123.0 d2i i2d]
-                           )
-         <conversions-1> (do-template [<forward> <backward>]
-                           [(match 123 (|> 123 l2i <forward> <backward> i2l))]
-
-                           [i2c c2i]
-                           )]
-    (test-all (match "java.lang.Class" (Class.getName [] (class-for java.lang.Class)))
-              (match "java.lang.Class" (Class.getName [] (class-for Class)))
-              (match true (null? (: Object (null))))
-              (match false (null? (Object.new [])))
-              (match #;None (: (Maybe Object) (??? (null))))
-              (match (#;Some _) (: (Maybe Object) (??? (Object.new []))))
-              (match true (null? (!!! (: (Maybe Object) (??? (null))))))
-              (match false (null? (!!! (: (Maybe Object) (??? (Object.new []))))))
-              (match true (instance? Object (Object.new [])))
-              (match false (instance? String (Object.new [])))
-              (match 123 (synchronized (Object.new [])
-                           123))
-              (match +10 (array-length (array String +10)))
-              (match "YOLO" (let [array (array String +10)] 
-                              (exec (array-store +0 "YOLO" array)
-                                (array-load +0 array))))
-              <conversions-0>
-              <conversions-1>
-              )))
+(jvm-import java.lang.System
+  (#static out java.io.PrintStream)
+  (#static currentTimeMillis [] #io long)
+  (#static getenv [String] #io #? String))
+
+(class: #final (TestClass A) [Runnable]
+  ## Fields
+  (#private foo boolean)
+  (#private bar A)
+  (#private baz java.lang.Object)
+  ## Methods
+  (#public [] (new {value A}) []
+           (exec (:= .foo true)
+             (:= .bar value)
+             (:= .baz "")
+             []))
+  (#public (virtual) java.lang.Object
+           "")
+  (#public #static (static) java.lang.Object
+           "")
+  (Runnable [] (run) void
+            [])
+  )
+
+(def: test-runnable
+  (object [Runnable]
+    []
+    (Runnable [] (run) void
+              [])))
+
+(interface: TestInterface
+  ([] foo [boolean String] void #throws [Exception]))
+
+(test: "Conversions"
+  [sample R;int]
+  (let% [<int-convs> (do-template [<to> <from> <message>]
+                       [(assert <message>
+                                (or (|> sample <to> <from> (i.= sample))
+                                    (let [capped-sample (|> sample <to> <from>)]
+                                      (|> capped-sample <to> <from> (i.= sample)))))]
+
+                       [&;l2b &;b2l "Can succesfully convert to/from byte."]
+                       [&;l2s &;s2l "Can succesfully convert to/from short."]
+                       [&;l2i &;i2l "Can succesfully convert to/from int."]
+                       [&;l2f &;f2l "Can succesfully convert to/from float."]
+                       [&;l2d &;d2l "Can succesfully convert to/from double."]
+                       [(<| &;i2c &;l2i) (<| &;i2l &;c2i) "Can succesfully convert to/from char."]
+                       )]
+    ($_ seq
+        <int-convs>
+        )))
+
+(test: "Miscellaneous"
+  ($_ seq
+      (assert "Can check if an object is of a certain class."
+              (and (&;instance? String "")
+                   (not (&;instance? Long ""))
+                   (&;instance? Object (&;null))))
+
+      (assert "Can run code in a \"synchronized\" block."
+              (&;synchronized "" true))
+
+      ## (assert "Can safely try risky code."
+      ##         (and (case (&;try [])
+      ##                (#;Right _) true
+      ##                (#;Left _) false)
+      ##              (case (&;try (_lux_proc ["jvm" "throw"] [(Exception.new "Uh, oh...")]))
+      ##                (#;Right _) false
+      ##                (#;Left _) true)))
+
+      (assert "Can access Class instances."
+              (Text/= "java.lang.Class" (Class.getName [] (&;class-for java.lang.Class))))
+
+      (assert "Can check if a value is null."
+              (and (&;null? (&;null))
+                   (not (&;null? ""))))
+
+      (assert "Can safely convert nullable references into Maybe values."
+              (and (|> (: (Maybe Object) (&;??? (&;null)))
+                       (case> #;None true
+                              _ false))
+                   (|> (: (Maybe Object) (&;??? ""))
+                       (case> (#;Some _) true
+                              _ false))))
+      ))
+
+(test: "Arrays"
+  [size (|> R;nat (:: @ map (|>. (n.% +100) (n.max +1))))
+   idx (|> R;nat (:: @ map (n.% size)))
+   value R;int]
+  ($_ seq
+      (assert "Can create arrays of some length."
+              (n.= size (&;array-length (&;array Long size))))
+
+      (assert "Can set and get array values."
+              (let [arr (&;array Long size)]
+                (exec (&;array-store idx value arr)
+                  (i.= value (&;array-load idx arr)))))))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index de1487b34..2a373a872 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -12,6 +12,7 @@
        [test])
   (test lux
         (lux ["_;" cli]
+             ["_;" host]
              (codata ["_;" io]
                      [env]
                      [state]
@@ -50,7 +51,6 @@
              ##              [stm]
              ##              [actor]
              ##              )
-             ## [host]
              ## [math]
              ## [pipe]
              ## [lexer]