diff options
Diffstat (limited to '')
3 files changed, 83 insertions, 61 deletions
diff --git a/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux b/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux index 382ad87e2..7b2b993d2 100644 --- a/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux +++ b/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux @@ -50,6 +50,26 @@ [failure false true] ) +(do-template [<name> <success> <failure>] + [(def: (<name> syntax output-type) + (-> Code Type Bool) + (|> (do Monad<Meta> + [runtime-bytecode @runtime.translate] + (&.with-scope + (&.with-type output-type + (expressionA.analyser evalL.eval syntax)))) + (&.with-current-module "") + (macro.run (init-compiler [])) + (case> (#e.Success _) + <success> + + (#e.Error error) + <failure>)))] + + [success' true false] + [failure' false true] + ) + (context: "Conversions [double + float]." (with-expansions [<conversions> (do-template [<procedure> <from> <to>] [(test (format <procedure> " SUCCESS") @@ -286,9 +306,9 @@ (list arrayC) Nat)) (test "jvm array read" - (success "jvm array read" - (list arrayC (code.nat idx)) - boxedT)) + (success' (` ("jvm object cast" + ("jvm array read" (~ arrayC) (~ (code.nat idx))))) + boxedT)) (test "jvm array write" (success "jvm array write" (list arrayC (code.nat idx) (`' ("lux coerce" (~ boxedTC) []))) @@ -407,8 +427,9 @@ (success "jvm member static put" (list (code.text "java.awt.datatransfer.DataFlavor") (code.text "allHtmlFlavor") - (`' ("lux check" (+0 "javax.activation.ActivationDataFlavor" (+0)) - ("jvm object null")))) + (`' ("jvm object cast" + ("lux check" (+0 "javax.activation.ActivationDataFlavor" (+0)) + ("jvm object null"))))) Unit)) )) @@ -450,8 +471,9 @@ (success "jvm member virtual put" (list (code.text "java.awt.GridBagConstraints") (code.text "insets") - (`' ("lux check" (+0 "javax.swing.plaf.InsetsUIResource" (+0)) - ("jvm object null"))) + (`' ("jvm object cast" + ("lux check" (+0 "javax.swing.plaf.InsetsUIResource" (+0)) + ("jvm object null")))) (`' ("lux check" (+0 "java.awt.GridBagConstraints" (+0)) ("jvm object null")))) (primitive "java.awt.GridBagConstraints"))) @@ -475,8 +497,9 @@ (success "jvm member virtual put" (list (code.text "javax.accessibility.AccessibleAttributeSequence") (code.text "startIndex") - (`' ("lux check" (+0 "java.lang.Integer" (+0)) - ("jvm object null"))) + (`' ("jvm object cast" + ("lux check" (+0 "java.lang.Integer" (+0)) + ("jvm object null")))) (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0)) ("jvm object null")))) (primitive "javax.accessibility.AccessibleAttributeSequence"))) @@ -486,45 +509,38 @@ (let [longC (' ("lux coerce" (+0 "java.lang.Long" (+0)) +123)) intC (`' ("jvm convert long-to-int" (~ longC))) + stringC (' ("lux coerce" (+0 "java.lang.String" (+0)) + "YOLO")) objectC (`' ("lux check" (+0 "java.util.ArrayList" (+1 (+0 "java.lang.Long" (+0)) (+0))) ("jvm member invoke constructor" "java.util.ArrayList" - ["int" (~ intC)])))] + ["int" ("jvm object cast" (~ intC))])))] ($_ seq (test "jvm member invoke static" - (success "jvm member invoke static" - (list (code.text "java.lang.Long") - (code.text "decode") - (code.tuple (list (' "java.lang.String") - (' ("lux coerce" (+0 "java.lang.String" (+0)) - "YOLO"))))) - (#.Primitive "java.lang.Long" (list)))) + (success' (` ("jvm member invoke static" + "java.lang.Long" "decode" + ["java.lang.String" (~ stringC)])) + (#.Primitive "java.lang.Long" (list)))) (test "jvm member invoke virtual" - (success "jvm member invoke virtual" - (list (code.text "java.lang.Object") - (code.text "equals") - longC - (code.tuple (list (' "java.lang.Object") - longC))) - (#.Primitive "java.lang.Boolean" (list)))) + (success' (` ("jvm object cast" + ("jvm member invoke virtual" + "java.lang.Object" "equals" + ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))]))) + (#.Primitive "java.lang.Boolean" (list)))) (test "jvm member invoke special" - (success "jvm member invoke special" - (list (code.text "java.lang.Long") - (code.text "equals") - longC - (code.tuple (list (' "java.lang.Object") - longC))) - (#.Primitive "java.lang.Boolean" (list)))) + (success' (` ("jvm object cast" + ("jvm member invoke special" + "java.lang.Long" "equals" + ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))]))) + (#.Primitive "java.lang.Boolean" (list)))) (test "jvm member invoke interface" - (success "jvm member invoke interface" - (list (code.text "java.util.Collection") - (code.text "add") - objectC - (code.tuple (list (' "java.lang.Object") - longC))) - (#.Primitive "java.lang.Boolean" (list)))) + (success' (` ("jvm object cast" + ("jvm member invoke interface" + "java.util.Collection" "add" + ("jvm object cast" (~ objectC)) ["java.lang.Object" ("jvm object cast" (~ longC))]))) + (#.Primitive "java.lang.Boolean" (list)))) (test "jvm member invoke constructor" - (success "jvm member invoke constructor" - (list (code.text "java.util.ArrayList") - (code.tuple (list (' "int") intC))) - (All [a] (#.Primitive "java.util.ArrayList" (list a))))) + (success' (` ("jvm member invoke constructor" + "java.util.ArrayList" + ["int" ("jvm object cast" (~ intC))])) + (All [a] (#.Primitive "java.util.ArrayList" (list a))))) ))) diff --git a/new-luxc/test/test/luxc/lang/translation/jvm/procedure/host.jvm.lux b/new-luxc/test/test/luxc/lang/translation/jvm/procedure/host.jvm.lux index a8e53e79e..0db10f82a 100644 --- a/new-luxc/test/test/luxc/lang/translation/jvm/procedure/host.jvm.lux +++ b/new-luxc/test/test/luxc/lang/translation/jvm/procedure/host.jvm.lux @@ -520,7 +520,8 @@ [sample-short (|> r.int (:: @ map (|>> int/abs (i/% 100)))) sample-string (r.text +5) other-sample-string (r.text +5) - #let [shortS (` ["short" ("jvm convert long-to-short" (~ (code.int sample-short)))]) + #let [shortS (` ["short" ("jvm object cast" "java.lang.Short" "short" + ("jvm convert long-to-short" (~ (code.int sample-short))))]) stringS (` ["java.lang.String" (~ (code.text sample-string))]) type-codeS (` ["org.omg.CORBA.TypeCode" ("jvm object null")]) idl-typeS (` ["org.omg.CORBA.IDLType" ("jvm object null")]) @@ -587,13 +588,16 @@ (do @ [sample (|> r.int (:: @ map (|>> int/abs (i/% 100)))) #let [object-longS (` ["java.lang.Object" (~ (code.int sample))]) - intS (` ["int" ("jvm convert long-to-int" (~ (code.int sample)))]) + intS (` ["int" ("jvm object cast" "java.lang.Integer" "int" + ("jvm convert long-to-int" (~ (code.int sample))))]) coded-intS (` ["java.lang.String" (~ (code.text (int/encode sample)))]) array-listS (` ("jvm member invoke constructor" "java.util.ArrayList" (~ intS)))]] ($_ seq (test "jvm member invoke static" (|> (do macro.Monad<Meta> - [sampleI (expressionT.translate (` ("jvm member invoke static" "java.lang.Long" "decode" "java.lang.Long" (~ coded-intS))))] + [sampleI (expressionT.translate (` ("jvm member invoke static" "java.lang.Long" + "decode" "java.lang.Long" + (~ coded-intS))))] (@eval.eval sampleI)) (lang.with-current-module "") (macro.run (init-compiler [])) @@ -604,8 +608,9 @@ false))) (test "jvm member invoke virtual" (|> (do macro.Monad<Meta> - [sampleI (expressionT.translate (` ("jvm member invoke virtual" "java.lang.Object" "equals" "boolean" - (~ (code.int sample)) (~ object-longS))))] + [sampleI (expressionT.translate (` ("jvm object cast" "boolean" "java.lang.Boolean" + ("jvm member invoke virtual" "java.lang.Object" "equals" "boolean" + (~ (code.int sample)) (~ object-longS)))))] (@eval.eval sampleI)) (lang.with-current-module "") (macro.run (init-compiler [])) @@ -616,8 +621,9 @@ false))) (test "jvm member invoke interface" (|> (do macro.Monad<Meta> - [sampleI (expressionT.translate (` ("jvm member invoke interface" "java.util.Collection" "add" "boolean" - (~ array-listS) (~ object-longS))))] + [sampleI (expressionT.translate (` ("jvm object cast" "boolean" "java.lang.Boolean" + ("jvm member invoke interface" "java.util.Collection" "add" "boolean" + (~ array-listS) (~ object-longS)))))] (@eval.eval sampleI)) (lang.with-current-module "") (macro.run (init-compiler [])) diff --git a/new-luxc/test/test/luxc/lang/translation/jvm/reference.lux b/new-luxc/test/test/luxc/lang/translation/jvm/reference.lux index ddbefd8d9..8de6c4fa5 100644 --- a/new-luxc/test/test/luxc/lang/translation/jvm/reference.lux +++ b/new-luxc/test/test/luxc/lang/translation/jvm/reference.lux @@ -21,21 +21,19 @@ [".T" runtime])))) (test/luxc common)) -(def: nilI $.Inst runtimeT.noneI) - -(def: cursorI - $.Inst - (|>> ($i.int 3) - ($i.array runtimeT.$Tuple) - $i.DUP ($i.int 0) ($i.string "") $i.AASTORE - $i.DUP ($i.int 1) ($i.long 0) ($i.wrap #$.Long) $i.AASTORE - $i.DUP ($i.int 2) ($i.long 0) ($i.wrap #$.Long) $i.AASTORE)) +(def: ident-part + (r.Random Text) + (|> (r.text +5) + (r.filter (function [sample] + (not (or (text.contains? "/" sample) + (text.contains? "[" sample) + (text.contains? "]" sample))))))) (context: "Definitions." (<| (times +100) (do @ - [module-name (|> (r.text +5) (r.filter (|>> (text.contains? "/") not))) - def-name (r.text +5) + [module-name ident-part + def-name ident-part def-value r.int #let [valueI (|>> ($i.long def-value) ($i.wrap #$.Long))]] ($_ seq @@ -57,7 +55,8 @@ (context: "Variables." (<| (times +100) (do @ - [register (|> r.nat (:: @ map (n/% +100))) + [module-name (|> (r.text +5) (r.filter (|>> (text.contains? "/") not))) + register (|> r.nat (:: @ map (n/% +100))) value r.int] ($_ seq (test "Can refer to local variables/registers." @@ -67,6 +66,7 @@ (code.int value) (` ((~ (code.int (nat-to-int register))))))] (evalT.eval sampleI)) + (lang.with-current-module "") (macro.run (init-compiler [])) (case> (#e.Success outputT) (i/= value (:! Int outputT)) |