From 75a02fc2df03a21df044d35115ac72149524ca7a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 6 Dec 2016 21:39:26 -0400 Subject: - 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. --- stdlib/source/lux/host.lux | 39 ++++++----- stdlib/test/test/lux/host.lux | 151 +++++++++++++++++++++++++++++++----------- stdlib/test/tests.lux | 2 +- 3 files changed, 133 insertions(+), 59 deletions(-) (limited to 'stdlib') 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]) (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% [ (do-template [ ] - [(match (|> ))] - - [123 l2d d2l] - [123 l2f f2l] - [123 l2i i2l] - [123.0 d2l l2d] - [123.0 d2f f2d] - [123.0 d2i i2d] - ) - (do-template [ ] - [(match 123 (|> 123 l2i 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)))) - - - ))) +(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% [ (do-template [ ] + [(assert + (or (|> sample (i.= sample)) + (let [capped-sample (|> sample )] + (|> capped-sample (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 + + ))) + +(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] -- cgit v1.2.3