diff options
Diffstat (limited to 'lux-jvm/test/test/luxc/lang/analysis/host.jvm.lux')
| -rw-r--r-- | lux-jvm/test/test/luxc/lang/analysis/host.jvm.lux | 549 |
1 files changed, 0 insertions, 549 deletions
diff --git a/lux-jvm/test/test/luxc/lang/analysis/host.jvm.lux b/lux-jvm/test/test/luxc/lang/analysis/host.jvm.lux deleted file mode 100644 index c42eddb60..000000000 --- a/lux-jvm/test/test/luxc/lang/analysis/host.jvm.lux +++ /dev/null @@ -1,549 +0,0 @@ -(.using - [lux "*" - [control - pipe - [monad {"+" do}] - ["[0]" maybe]] - [data - ["e" error] - ["[0]" product] - [text ("text/" Equivalence<Text>) - format] - [collection - ["[0]" array] - [list ("list/" Mix<List>)] - ["dict" dictionary]]] - [math - ["r" random "r/" Monad<Random>]] - ["[0]" type] - [macro {"+" Monad<Meta>} - ["[0]" code]] - [compiler - ["[0]" default - ["[0]L" init] - [phase - [analysis - ["[0]A" type]] - [extension - [analysis - ["[0]AE" host]]]]]] - test] - [/// - ["_[0]" primitive]]) - -(template [<name> <success> <failure>] - [(def: (<name> procedure params output-type) - (-> Text (List Code) Type Bit) - (|> (do Monad<Meta> - [... runtime-bytecode @runtime.translate - ] - (default.with-scope - (typeA.with-type output-type - (_primitive.analyse (` ((~ (code.text procedure)) (~+ params))))))) - (analysis.with-current-module "") - (macro.result (initL.compiler [])) - (case> {e.#Success _} - <success> - - {e.#Error error} - <failure>)))] - - [success #1 #0] - [failure #0 #1] - ) - -(template [<name> <success> <failure>] - [(def: (<name> syntax output-type) - (-> Code Type Bit) - (|> (do Monad<Meta> - [... runtime-bytecode @runtime.translate - ] - (default.with-scope - (typeA.with-type output-type - (_primitive.analyse syntax)))) - (analysis.with-current-module "") - (macro.result (initL.compiler [])) - (case> {e.#Success _} - <success> - - {e.#Error error} - <failure>)))] - - [success' #1 #0] - [failure' #0 #1] - ) - -(context: "Conversions [double + float]." - (with-expansions [<conversions> (template [<procedure> <from> <to>] - [(test (format <procedure> " SUCCESS") - (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>)) - (test (format <procedure> " FAILURE") - (failure <procedure> (list (' [])) <to>))] - - ["jvm convert double-to-float" "java.lang.Double" hostAE.Float] - ["jvm convert double-to-int" "java.lang.Double" hostAE.Integer] - ["jvm convert double-to-long" "java.lang.Double" hostAE.Long] - ["jvm convert float-to-double" "java.lang.Float" hostAE.Double] - ["jvm convert float-to-int" "java.lang.Float" hostAE.Integer] - ["jvm convert float-to-long" "java.lang.Float" hostAE.Long] - )] - ($_ seq - <conversions> - ))) - -(context: "Conversions [int]." - (with-expansions [<conversions> (template [<procedure> <from> <to>] - [(test (format <procedure> " SUCCESS") - (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>)) - (test (format <procedure> " FAILURE") - (failure <procedure> (list (' [])) <to>))] - - ["jvm convert int-to-byte" "java.lang.Integer" hostAE.Byte] - ["jvm convert int-to-char" "java.lang.Integer" hostAE.Character] - ["jvm convert int-to-double" "java.lang.Integer" hostAE.Double] - ["jvm convert int-to-float" "java.lang.Integer" hostAE.Float] - ["jvm convert int-to-long" "java.lang.Integer" hostAE.Long] - ["jvm convert int-to-short" "java.lang.Integer" hostAE.Short] - )] - ($_ seq - <conversions> - ))) - -(context: "Conversions [long]." - (with-expansions [<conversions> (template [<procedure> <from> <to>] - [(test (format <procedure> " SUCCESS") - (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>)) - (test (format <procedure> " FAILURE") - (failure <procedure> (list (' [])) <to>))] - - ["jvm convert long-to-double" "java.lang.Long" hostAE.Double] - ["jvm convert long-to-float" "java.lang.Long" hostAE.Float] - ["jvm convert long-to-int" "java.lang.Long" hostAE.Integer] - ["jvm convert long-to-short" "java.lang.Long" hostAE.Short] - ["jvm convert long-to-byte" "java.lang.Long" hostAE.Byte] - )] - ($_ seq - <conversions> - ))) - -(context: "Conversions [char + byte + short]." - (with-expansions [<conversions> (template [<procedure> <from> <to>] - [(test (format <procedure> " SUCCESS") - (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>)) - (test (format <procedure> " FAILURE") - (failure <procedure> (list (' [])) <to>))] - - ["jvm convert char-to-byte" "java.lang.Character" hostAE.Byte] - ["jvm convert char-to-short" "java.lang.Character" hostAE.Short] - ["jvm convert char-to-int" "java.lang.Character" hostAE.Integer] - ["jvm convert char-to-long" "java.lang.Character" hostAE.Long] - ["jvm convert byte-to-long" "java.lang.Byte" hostAE.Long] - ["jvm convert short-to-long" "java.lang.Short" hostAE.Long] - )] - ($_ seq - <conversions> - ))) - -(template [<domain> <boxed> <type>] - [(context: (format "Arithmetic " "[" <domain> "].") - (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>] - [(test <procedure> - (success <procedure> - (list (' ("lux coerce" (+0 <subject> (+0)) [])) - (' ("lux coerce" (+0 <param> (+0)) []))) - <output>))] - - [(format "jvm " <domain> " +") <boxed> <boxed> <type>] - [(format "jvm " <domain> " -") <boxed> <boxed> <type>] - [(format "jvm " <domain> " *") <boxed> <boxed> <type>] - [(format "jvm " <domain> " /") <boxed> <boxed> <type>] - [(format "jvm " <domain> " %") <boxed> <boxed> <type>] - )] - ($_ seq - <instructions> - ))) - - (context: (format "Order " "[" <domain> "].") - (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>] - [(test <procedure> - (success <procedure> - (list (' ("lux coerce" (+0 <subject> (+0)) [])) - (' ("lux coerce" (+0 <param> (+0)) []))) - <output>))] - - [(format "jvm " <domain> " =") <boxed> <boxed> hostAE.Boolean] - [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean] - )] - ($_ seq - <instructions> - ))) - - (context: (format "Bitwise " "[" <domain> "].") - (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>] - [(test <procedure> - (success <procedure> - (list (' ("lux coerce" (+0 <subject> (+0)) [])) - (' ("lux coerce" (+0 <param> (+0)) []))) - <output>))] - - [(format "jvm " <domain> " and") <boxed> <boxed> <type>] - [(format "jvm " <domain> " or") <boxed> <boxed> <type>] - [(format "jvm " <domain> " xor") <boxed> <boxed> <type>] - [(format "jvm " <domain> " shl") <boxed> "java.lang.Integer" <type>] - [(format "jvm " <domain> " shr") <boxed> "java.lang.Integer" <type>] - [(format "jvm " <domain> " ushr") <boxed> "java.lang.Integer" <type>] - )] - ($_ seq - <instructions> - )))] - - - ["int" "java.lang.Integer" hostAE.Integer] - ["long" "java.lang.Long" hostAE.Long] - ) - -(template [<domain> <boxed> <type>] - [(context: (format "Arithmetic " "[" <domain> "].") - (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>] - [(test <procedure> - (success <procedure> - (list (' ("lux coerce" (+0 <subject> (+0)) [])) - (' ("lux coerce" (+0 <param> (+0)) []))) - <output>))] - - [(format "jvm " <domain> " +") <boxed> <boxed> <type>] - [(format "jvm " <domain> " -") <boxed> <boxed> <type>] - [(format "jvm " <domain> " *") <boxed> <boxed> <type>] - [(format "jvm " <domain> " /") <boxed> <boxed> <type>] - [(format "jvm " <domain> " %") <boxed> <boxed> <type>] - )] - ($_ seq - <instructions> - ))) - - (context: (format "Order " "[" <domain> "].") - (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>] - [(test <procedure> - (success <procedure> - (list (' ("lux coerce" (+0 <subject> (+0)) [])) - (' ("lux coerce" (+0 <param> (+0)) []))) - <output>))] - - [(format "jvm " <domain> " =") <boxed> <boxed> hostAE.Boolean] - [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean] - )] - ($_ seq - <instructions> - )))] - - - ["float" "java.lang.Float" hostAE.Float] - ["double" "java.lang.Double" hostAE.Double] - ) - -(template [<domain> <boxed> <type>] - [(context: (format "Order " "[" <domain> "].") - (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>] - [(test <procedure> - (success <procedure> - (list (' ("lux coerce" (+0 <subject> (+0)) [])) - (' ("lux coerce" (+0 <param> (+0)) []))) - <output>))] - - [(format "jvm " <domain> " =") <boxed> <boxed> hostAE.Boolean] - [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean] - )] - ($_ seq - <instructions> - )))] - - - ["char" "java.lang.Character" hostAE.Character] - ) - -(def: array-type - (r.Random [Text Text]) - (let [entries (dict.entries hostAE.boxes) - num-entries (list.size entries)] - (do r.Monad<Random> - [choice (|> r.nat (:: @ each (n/% (++ num-entries)))) - #let [[unboxed boxed] (: [Text Text] - (|> entries - (list.nth choice) - (maybe.default ["java.lang.Object" "java.lang.Object"])))]] - (wrap [unboxed boxed])))) - -(context: "Array." - (<| (times +100) - (do @ - [#let [cap (|>> (n/% +10) (n/max +1))] - [unboxed boxed] array-type - size (|> r.nat (:: @ each cap)) - idx (|> r.nat (:: @ each (n/% size))) - level (|> r.nat (:: @ each cap)) - #let [unboxedT {.#Primitive unboxed (list)} - arrayT {.#Primitive "#Array" (list unboxedT)} - arrayC (`' ("lux check" (+0 "#Array" (+1 (+0 (~ (code.text unboxed)) (+0)) (+0))) - ("jvm array new" (~ (code.nat size))))) - boxedT {.#Primitive boxed (list)} - boxedTC (` (+0 (~ (code.text boxed)) (+0))) - multi-arrayT (list/mix (function (_ _ innerT) - (|> innerT (list) {.#Primitive "#Array"})) - boxedT - (list.n/range +1 level))]] - ($_ seq - (test "jvm array new" - (success "jvm array new" - (list (code.nat size)) - arrayT)) - (test "jvm array new (no nesting)" - (failure "jvm array new" - (list (code.nat size)) - unboxedT)) - (test "jvm array new (nested/multi-level)" - (success "jvm array new" - (list (code.nat size)) - multi-arrayT)) - (test "jvm array length" - (success "jvm array length" - (list arrayC) - Nat)) - (test "jvm array read" - (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) []))) - arrayT)) - )))) - -(def: throwables - (List Text) - (list "java.lang.Throwable" - "java.lang.Error" - "java.io.IOError" - "java.lang.VirtualMachineError" - "java.lang.Exception" - "java.io.IOException" - "java.lang.RuntimeException")) - -(context: "Object." - (<| (times +100) - (do @ - [[unboxed boxed] array-type - [!unboxed !boxed] (|> array-type - (r.filter (function (_ [!unboxed !boxed]) - (not (text/= boxed !boxed))))) - #let [boxedT {.#Primitive boxed (list)} - boxedC (`' ("lux check" (+0 (~ (code.text boxed)) (+0)) - ("jvm object null"))) - !boxedC (`' ("lux check" (+0 (~ (code.text !boxed)) (+0)) - ("jvm object null"))) - unboxedC (`' ("lux check" (+0 (~ (code.text unboxed)) (+0)) - ("jvm object null")))] - throwable (|> r.nat - (:: @ each (n/% (++ (list.size throwables)))) - (:: @ each (function (_ idx) - (|> throwables - (list.nth idx) - (maybe.default "java.lang.Object"))))) - #let [throwableC (`' ("lux check" (+0 (~ (code.text throwable)) (+0)) - ("jvm object null")))]] - ($_ seq - (test "jvm object null" - (success "jvm object null" - (list) - {.#Primitive boxed (list)})) - (test "jvm object null (no primitives)" - (or (text/= "java.lang.Object" boxed) - (failure "jvm object null" - (list) - {.#Primitive unboxed (list)}))) - (test "jvm object null?" - (success "jvm object null?" - (list boxedC) - Bit)) - (test "jvm object synchronized" - (success "jvm object synchronized" - (list boxedC boxedC) - boxedT)) - (test "jvm object synchronized (no primitives)" - (or (text/= "java.lang.Object" boxed) - (failure "jvm object synchronized" - (list unboxedC boxedC) - boxedT))) - (test "jvm object throw" - (or (text/= "java.lang.Object" throwable) - (success "jvm object throw" - (list throwableC) - Nothing))) - (test "jvm object class" - (success "jvm object class" - (list (code.text boxed)) - {.#Primitive "java.lang.Class" (list boxedT)})) - (test "jvm object instance?" - (success "jvm object instance?" - (list (code.text boxed) - boxedC) - Bit)) - (test "jvm object instance? (lineage)" - (success "jvm object instance?" - (list (' "java.lang.Object") - boxedC) - Bit)) - (test "jvm object instance? (no lineage)" - (or (text/= "java.lang.Object" boxed) - (failure "jvm object instance?" - (list (code.text boxed) - !boxedC) - Bit))) - )))) - -(context: "Member [Static Field]." - ($_ seq - (test "jvm member static get" - (success "jvm member static get" - (list (code.text "java.lang.System") - (code.text "out")) - {.#Primitive "java.io.PrintStream" (list)})) - (test "jvm member static get (inheritance out)" - (success "jvm member static get" - (list (code.text "java.lang.System") - (code.text "out")) - {.#Primitive "java.lang.Object" (list)})) - (test "jvm member static put" - (success "jvm member static put" - (list (code.text "java.awt.datatransfer.DataFlavor") - (code.text "allHtmlFlavor") - (`' ("lux check" (+0 "java.awt.datatransfer.DataFlavor" (+0)) - ("jvm object null")))) - Any)) - (test "jvm member static put (final)" - (failure "jvm member static put" - (list (code.text "java.lang.System") - (code.text "out") - (`' ("lux check" (+0 "java.io.PrintStream" (+0)) - ("jvm object null")))) - Any)) - (test "jvm member static put (inheritance in)" - (success "jvm member static put" - (list (code.text "java.awt.datatransfer.DataFlavor") - (code.text "allHtmlFlavor") - (`' ("jvm object cast" - ("lux check" (+0 "javax.activation.ActivationDataFlavor" (+0)) - ("jvm object null"))))) - Any)) - )) - -(context: "Member [Virtual Field]." - ($_ seq - (test "jvm member virtual get" - (success "jvm member virtual get" - (list (code.text "org.omg.CORBA.ValueMember") - (code.text "id") - (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0)) - ("jvm object null")))) - {.#Primitive "java.lang.String" (list)})) - (test "jvm member virtual get (inheritance out)" - (success "jvm member virtual get" - (list (code.text "org.omg.CORBA.ValueMember") - (code.text "id") - (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0)) - ("jvm object null")))) - {.#Primitive "java.lang.Object" (list)})) - (test "jvm member virtual put" - (success "jvm member virtual put" - (list (code.text "org.omg.CORBA.ValueMember") - (code.text "id") - (`' ("lux check" (+0 "java.lang.String" (+0)) - ("jvm object null"))) - (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0)) - ("jvm object null")))) - (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") - (code.text "applet") - (`' ("lux check" (+0 "javax.swing.text.html.parser.Element" (+0)) - ("jvm object null"))) - (`' ("lux check" (+0 "javax.swing.text.html.parser.DTD" (+0)) - ("jvm object null")))) - (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") - (code.text "insets") - (`' ("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"))) - )) - -(context: "Boxing/Unboxing." - ($_ seq - (test "jvm member static get" - (success "jvm member static get" - (list (code.text "java.util.GregorianCalendar") - (code.text "AD")) - {.#Primitive "java.lang.Integer" (list)})) - (test "jvm member virtual get" - (success "jvm member virtual get" - (list (code.text "javax.accessibility.AccessibleAttributeSequence") - (code.text "startIndex") - (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0)) - ("jvm object null")))) - {.#Primitive "java.lang.Integer" (list)})) - (test "jvm member virtual put" - (success "jvm member virtual put" - (list (code.text "javax.accessibility.AccessibleAttributeSequence") - (code.text "startIndex") - (`' ("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"))) - )) - -(context: "Member [Method]." - (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" ("jvm object cast" (~ intC))])))] - ($_ seq - (test "jvm member invoke static" - (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 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 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 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" - "java.util.ArrayList" - ["int" ("jvm object cast" (~ intC))])) - (All (_ a) {.#Primitive "java.util.ArrayList" (list a)}))) - ))) |