diff options
Diffstat (limited to 'new-luxc/test')
-rw-r--r-- | new-luxc/test/test/luxc/analyser/function.lux | 5 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux | 8 | ||||
-rw-r--r-- | new-luxc/test/test/luxc/generator/procedure/host.jvm.lux | 132 |
3 files changed, 106 insertions, 39 deletions
diff --git a/new-luxc/test/test/luxc/analyser/function.lux b/new-luxc/test/test/luxc/analyser/function.lux index baef5c42c..6fbafd1eb 100644 --- a/new-luxc/test/test/luxc/analyser/function.lux +++ b/new-luxc/test/test/luxc/analyser/function.lux @@ -100,11 +100,6 @@ (@;analyse-function analyse func-name arg-name (code;symbol ["" func-name]))) (meta;run (init-compiler [])) succeeds?)) - (test "Can infer recursive types for functions." - (|> (@common;with-unknown-type - (@;analyse-function analyse func-name arg-name (code;symbol ["" func-name]))) - (meta;run (init-compiler [])) - (check-type (type (Rec self (All [a] (-> a self))))))) )))) (context: "Function application." diff --git a/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux b/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux index ad5670cbe..d1520e5b7 100644 --- a/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux +++ b/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux @@ -434,7 +434,7 @@ ("jvm object null"))) (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0)) ("jvm object null")))) - Unit)) + (primitive org.omg.CORBA.ValueMember))) (test "jvm member virtual put (final)" (failure "jvm member virtual put" (list (code;text "javax.swing.text.html.parser.DTD") @@ -443,7 +443,7 @@ ("jvm object null"))) (`' ("lux check" (+0 "javax.swing.text.html.parser.DTD" (+0)) ("jvm object null")))) - Unit)) + (primitive javax.swing.text.html.parser.DTD))) (test "jvm member virtual put (inheritance in)" (success "jvm member virtual put" (list (code;text "java.awt.GridBagConstraints") @@ -452,7 +452,7 @@ ("jvm object null"))) (`' ("lux check" (+0 "java.awt.GridBagConstraints" (+0)) ("jvm object null")))) - Unit)) + (primitive java.awt.GridBagConstraints))) )) (context: "Boxing/Unboxing." @@ -477,7 +477,7 @@ ("jvm object null"))) (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0)) ("jvm object null")))) - Unit)) + (primitive javax.accessibility.AccessibleAttributeSequence))) )) (context: "Member [Method]." diff --git a/new-luxc/test/test/luxc/generator/procedure/host.jvm.lux b/new-luxc/test/test/luxc/generator/procedure/host.jvm.lux index 5b22bc2a1..c5aad2cae 100644 --- a/new-luxc/test/test/luxc/generator/procedure/host.jvm.lux +++ b/new-luxc/test/test/luxc/generator/procedure/host.jvm.lux @@ -389,8 +389,11 @@ #let [num-instances (list;size instances)] class-idx (|> r;nat (:: @ map (n.% num-classes))) instance-idx (|> r;nat (:: @ map (n.% num-instances))) + exception-message (r;text +5) #let [class (maybe;assume (list;nth class-idx classes)) - [instance-class instance-gen] (maybe;assume (list;nth instance-idx instances))] + [instance-class instance-gen] (maybe;assume (list;nth instance-idx instances)) + exception-message$ (|> (#ls;Text exception-message) + (list (#ls;Text "java.lang.String")) #ls;Tuple)] sample r;int monitor r;int instance instance-gen] @@ -430,7 +433,25 @@ (#e;Error error) false))) (test "jvm object throw" - false) + (|> (do meta;Monad<Meta> + [_ @runtime;generate + sampleI (@;generate (|> (#ls;Procedure "jvm member invoke constructor" (list (#ls;Text "java.lang.Throwable") + exception-message$)) + (list) (#ls;Procedure "jvm object throw") + (#ls;Function +1 (list)) + (list) (#ls;Procedure "lux try")))] + (@eval;eval sampleI)) + (meta;run (init-compiler [])) + (case> (#e;Success outputG) + (case (:! (e;Error Top) outputG) + (#e;Error error) + (text/= exception-message error) + + (#e;Success outputG) + false) + + (#e;Error error) + false))) (test "jvm object class" (|> (do meta;Monad<Meta> [sampleI (@;generate (#ls;Procedure "jvm object class" (list (#ls;Text class))))] @@ -458,34 +479,85 @@ (#static AD int)) (context: "Member [Field]" - ($_ seq - (test "jvm member static get" - (|> (do meta;Monad<Meta> - [sampleI (@;generate (|> (#ls;Procedure "jvm member static get" (list (#ls;Text "java.util.GregorianCalendar") (#ls;Text "AD") (#ls;Text "int"))) - (list) (#ls;Procedure "jvm convert int-to-long")))] - (@eval;eval sampleI)) - (meta;run (init-compiler [])) - (case> (#e;Success outputG) - (i.= GregorianCalendar.AD (:! Int outputG)) - - (#e;Error error) - false))) - (test "jvm member static put" - (|> (do meta;Monad<Meta> - [sampleI (@;generate (#ls;Procedure "jvm member static put" (list (#ls;Text "java.awt.datatransfer.DataFlavor") (#ls;Text "allHtmlFlavor") (#ls;Text "java.awt.datatransfer.DataFlavor") - (#ls;Procedure "jvm member static get" (list (#ls;Text "java.awt.datatransfer.DataFlavor") (#ls;Text "allHtmlFlavor") (#ls;Text "java.awt.datatransfer.DataFlavor"))))))] - (@eval;eval sampleI)) - (meta;run (init-compiler [])) - (case> (#e;Success outputG) - (is @runtime;unit (:! Text outputG)) - - (#e;Error error) - false))) - (test "jvm member virtual get" - false) - (test "jvm member virtual put" - false) - )) + (<| (times +100) + (do @ + [sample-short (|> r;int (:: @ map (|>. int/abs (i.% 100)))) + sample-string (r;text +5) + other-sample-string (r;text +5) + #let [shortS (|> (#ls;Int sample-short) + (list) (#ls;Procedure "jvm convert long-to-short") + (list (#ls;Text "short")) #ls;Tuple) + stringS (|> (#ls;Text sample-string) + (list (#ls;Text "java.lang.String")) #ls;Tuple) + type-codeS (|> (#ls;Procedure "jvm object null" (list)) + (list (#ls;Text "org.omg.CORBA.TypeCode")) #ls;Tuple) + idl-typeS (|> (#ls;Procedure "jvm object null" (list)) + (list (#ls;Text "org.omg.CORBA.IDLType")) #ls;Tuple) + value-member$ (#ls;Procedure "jvm member invoke constructor" (list (#ls;Text "org.omg.CORBA.ValueMember") + stringS + stringS + stringS + stringS + type-codeS + idl-typeS + shortS))]] + ($_ seq + (test "jvm member static get" + (|> (do meta;Monad<Meta> + [sampleI (@;generate (|> (#ls;Procedure "jvm member static get" (list (#ls;Text "java.util.GregorianCalendar") (#ls;Text "AD") (#ls;Text "int"))) + (list) (#ls;Procedure "jvm convert int-to-long")))] + (@eval;eval sampleI)) + (meta;run (init-compiler [])) + (case> (#e;Success outputG) + (i.= GregorianCalendar.AD (:! Int outputG)) + + (#e;Error error) + false))) + (test "jvm member static put" + (|> (do meta;Monad<Meta> + [sampleI (@;generate (#ls;Procedure "jvm member static put" (list (#ls;Text "java.awt.datatransfer.DataFlavor") (#ls;Text "allHtmlFlavor") (#ls;Text "java.awt.datatransfer.DataFlavor") + (#ls;Procedure "jvm member static get" (list (#ls;Text "java.awt.datatransfer.DataFlavor") (#ls;Text "allHtmlFlavor") (#ls;Text "java.awt.datatransfer.DataFlavor"))))))] + (@eval;eval sampleI)) + (meta;run (init-compiler [])) + (case> (#e;Success outputG) + (is @runtime;unit (:! Text outputG)) + + (#e;Error error) + false))) + (test "jvm member virtual get" + (|> (do meta;Monad<Meta> + [sampleI (@;generate (|> value-member$ + (list (#ls;Text "org.omg.CORBA.ValueMember") + (#ls;Text "name") + (#ls;Text "java.lang.String")) + (#ls;Procedure "jvm member virtual get")))] + (@eval;eval sampleI)) + (meta;run (init-compiler [])) + (case> (#e;Success outputG) + (text/= sample-string (:! Text outputG)) + + (#e;Error error) + false))) + (test "jvm member virtual put" + (|> (do meta;Monad<Meta> + [sampleI (@;generate (|> value-member$ + (list (#ls;Text "org.omg.CORBA.ValueMember") + (#ls;Text "name") + (#ls;Text "java.lang.String") + (#ls;Text other-sample-string)) + (#ls;Procedure "jvm member virtual put") + (list (#ls;Text "org.omg.CORBA.ValueMember") + (#ls;Text "name") + (#ls;Text "java.lang.String")) + (#ls;Procedure "jvm member virtual get")))] + (@eval;eval sampleI)) + (meta;run (init-compiler [])) + (case> (#e;Success outputG) + (text/= other-sample-string (:! Text outputG)) + + (#e;Error error) + false))) + )))) (host;import java.lang.Object) |