From 64ac2f552ec9e19131fc9671f14d14b0651cd988 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 26 Oct 2017 19:21:17 -0400
Subject: - Fixed some compiler tests.
---
new-luxc/test/test/luxc/analyser/function.lux | 5 -
.../test/test/luxc/analyser/procedure/host.jvm.lux | 8 +-
.../test/luxc/generator/procedure/host.jvm.lux | 132 ++++++++++++++++-----
3 files changed, 106 insertions(+), 39 deletions(-)
(limited to 'new-luxc/test')
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
+ [_ @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
[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
- [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
- [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
+ [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
+ [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
+ [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
+ [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)
--
cgit v1.2.3