diff options
Diffstat (limited to 'new-luxc/test/test')
| -rw-r--r-- | new-luxc/test/test/luxc/lang/analysis/procedure/common.lux | 324 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux | 546 |
2 files changed, 0 insertions, 870 deletions
diff --git a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux b/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux deleted file mode 100644 index fba355a79..000000000 --- a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux +++ /dev/null @@ -1,324 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (concurrency [atom]) - (data text/format - ["e" error] - [product] - (coll [array])) - ["r" math/random "r/" Monad<Random>] - [macro #+ Monad<Meta>] - (macro [code]) - (lang [type "type/" Eq<Type>]) - test) - (luxc ["&" lang] - (lang ["&." scope] - ["&." module] - ["~" analysis] - (analysis [".A" expression] - ["@." common]) - [".L" eval])) - (/// common) - (test/luxc common)) - -(do-template [<name> <success> <failure>] - [(def: (<name> procedure params output-type) - (-> Text (List Code) Type Bool) - (|> (&.with-scope - (&.with-type output-type - (analyse (` ((~ (code.text procedure)) (~+ params)))))) - (macro.run (io.run init-jvm)) - (case> (#e.Success _) - <success> - - (#e.Error error) - <failure>)))] - - [check-success+ true false] - [check-failure+ false true] - ) - -(context: "Lux procedures" - (<| (times +100) - (do @ - [[primT primC] gen-primitive - [antiT antiC] (|> gen-primitive - (r.filter (|>> product.left (type/= primT) not)))] - ($_ seq - (test "Can test for reference equality." - (check-success+ "lux is" (list primC primC) Bool)) - (test "Reference equality must be done with elements of the same type." - (check-failure+ "lux is" (list primC antiC) Bool)) - (test "Can 'try' risky IO computations." - (check-success+ "lux try" - (list (` ("lux function" (~' _) (~' _) (~ primC)))) - (type (Either Text primT)))) - )))) - -(context: "Bit procedures" - (<| (times +100) - (do @ - [subjectC (|> r.nat (:: @ map code.nat)) - signedC (|> r.int (:: @ map code.int)) - paramC (|> r.nat (:: @ map code.nat))] - ($_ seq - (test "Can count the number of 1 bits in a bit pattern." - (check-success+ "lux bit count" (list subjectC) Nat)) - (test "Can perform bit 'and'." - (check-success+ "lux bit and" (list subjectC paramC) Nat)) - (test "Can perform bit 'or'." - (check-success+ "lux bit or" (list subjectC paramC) Nat)) - (test "Can perform bit 'xor'." - (check-success+ "lux bit xor" (list subjectC paramC) Nat)) - (test "Can shift bit pattern to the left." - (check-success+ "lux bit left-shift" (list subjectC paramC) Nat)) - (test "Can shift bit pattern to the right." - (check-success+ "lux bit logical-right-shift" (list subjectC paramC) Nat)) - (test "Can shift signed bit pattern to the right." - (check-success+ "lux bit arithmetic-right-shift" (list signedC paramC) Int)) - )))) - -(context: "Int procedures" - (<| (times +100) - (do @ - [subjectC (|> r.int (:: @ map code.int)) - paramC (|> r.int (:: @ map code.int))] - ($_ seq - (test "Can add integers." - (check-success+ "lux int +" (list subjectC paramC) Int)) - (test "Can subtract integers." - (check-success+ "lux int -" (list subjectC paramC) Int)) - (test "Can multiply integers." - (check-success+ "lux int *" (list subjectC paramC) Int)) - (test "Can divide integers." - (check-success+ "lux int /" (list subjectC paramC) Int)) - (test "Can calculate remainder of integers." - (check-success+ "lux int %" (list subjectC paramC) Int)) - (test "Can test equality of integers." - (check-success+ "lux int =" (list subjectC paramC) Bool)) - (test "Can compare integers." - (check-success+ "lux int <" (list subjectC paramC) Bool)) - (test "Can obtain minimum integer." - (check-success+ "lux int min" (list) Int)) - (test "Can obtain maximum integer." - (check-success+ "lux int max" (list) Int)) - (test "Can convert integer to natural number." - (check-success+ "lux int to-nat" (list subjectC) Nat)) - (test "Can convert integer to frac number." - (check-success+ "lux int to-frac" (list subjectC) Frac)) - (test "Can convert integer to text." - (check-success+ "lux int char" (list subjectC) Text)) - )))) - -(context: "Frac procedures" - (<| (times +100) - (do @ - [subjectC (|> r.frac (:: @ map code.frac)) - paramC (|> r.frac (:: @ map code.frac)) - encodedC (|> (r.text +5) (:: @ map code.text))] - ($_ seq - (test "Can add frac numbers." - (check-success+ "lux frac +" (list subjectC paramC) Frac)) - (test "Can subtract frac numbers." - (check-success+ "lux frac -" (list subjectC paramC) Frac)) - (test "Can multiply frac numbers." - (check-success+ "lux frac *" (list subjectC paramC) Frac)) - (test "Can divide frac numbers." - (check-success+ "lux frac /" (list subjectC paramC) Frac)) - (test "Can calculate remainder of frac numbers." - (check-success+ "lux frac %" (list subjectC paramC) Frac)) - (test "Can test equality of frac numbers." - (check-success+ "lux frac =" (list subjectC paramC) Bool)) - (test "Can compare frac numbers." - (check-success+ "lux frac <" (list subjectC paramC) Bool)) - (test "Can obtain minimum frac number." - (check-success+ "lux frac min" (list) Frac)) - (test "Can obtain maximum frac number." - (check-success+ "lux frac max" (list) Frac)) - (test "Can obtain smallest frac number." - (check-success+ "lux frac smallest" (list) Frac)) - (test "Can obtain not-a-number." - (check-success+ "lux frac not-a-number" (list) Frac)) - (test "Can obtain positive infinity." - (check-success+ "lux frac positive-infinity" (list) Frac)) - (test "Can obtain negative infinity." - (check-success+ "lux frac negative-infinity" (list) Frac)) - (test "Can convert frac number to integer." - (check-success+ "lux frac to-int" (list subjectC) Int)) - (test "Can convert frac number to text." - (check-success+ "lux frac encode" (list subjectC) Text)) - (test "Can convert text to frac number." - (check-success+ "lux frac decode" (list encodedC) (type (Maybe Frac)))) - )))) - -(context: "Text procedures" - (<| (times +100) - (do @ - [subjectC (|> (r.text +5) (:: @ map code.text)) - paramC (|> (r.text +5) (:: @ map code.text)) - replacementC (|> (r.text +5) (:: @ map code.text)) - fromC (|> r.nat (:: @ map code.nat)) - toC (|> r.nat (:: @ map code.nat))] - ($_ seq - (test "Can test text equality." - (check-success+ "lux text =" (list subjectC paramC) Bool)) - (test "Compare texts in lexicographical order." - (check-success+ "lux text <" (list subjectC paramC) Bool)) - (test "Can concatenate one text to another." - (check-success+ "lux text concat" (list subjectC paramC) Text)) - (test "Can find the index of a piece of text inside a larger one that (may) contain it." - (check-success+ "lux text index" (list subjectC paramC fromC) (type (Maybe Nat)))) - (test "Can query the size/length of a text." - (check-success+ "lux text size" (list subjectC) Nat)) - (test "Can calculate a hash code for text." - (check-success+ "lux text hash" (list subjectC) Nat)) - (test "Can replace a text inside of a larger one (once)." - (check-success+ "lux text replace-once" (list subjectC paramC replacementC) Text)) - (test "Can replace a text inside of a larger one (all times)." - (check-success+ "lux text replace-all" (list subjectC paramC replacementC) Text)) - (test "Can obtain the character code of a text at a given index." - (check-success+ "lux text char" (list subjectC fromC) (type (Maybe Nat)))) - (test "Can clip a piece of text between 2 indices." - (check-success+ "lux text clip" (list subjectC fromC toC) (type (Maybe Text)))) - )))) - -(context: "Array procedures" - (<| (times +100) - (do @ - [[elemT elemC] gen-primitive - sizeC (|> r.nat (:: @ map code.nat)) - idxC (|> r.nat (:: @ map code.nat)) - var-name (r.text +5) - #let [arrayT (type (Array elemT)) - g!array (code.local-symbol var-name) - array-operation (function (_ output-type code) - (|> (&scope.with-scope "" - (&scope.with-local [var-name arrayT] - (&.with-type output-type - (analyse code)))) - (macro.run (io.run init-jvm)) - (case> (#e.Success _) - true - - (#e.Error error) - false)))]] - ($_ seq - (test "Can create arrays." - (check-success+ "lux array new" (list sizeC) arrayT)) - (test "Can get a value inside an array." - (array-operation (type (Maybe elemT)) - (` ("lux array get" (~ g!array) (~ idxC))))) - (test "Can put a value inside an array." - (array-operation arrayT - (` ("lux array put" (~ g!array) (~ idxC) (~ elemC))))) - (test "Can remove a value from an array." - (array-operation arrayT - (` ("lux array remove" (~ g!array) (~ idxC))))) - (test "Can query the size of an array." - (array-operation Nat - (` ("lux array size" (~ g!array))))) - )))) - -(context: "Math procedures" - (<| (times +100) - (do @ - [subjectC (|> r.frac (:: @ map code.frac)) - paramC (|> r.frac (:: @ map code.frac))] - (with-expansions [<unary> (do-template [<proc> <desc>] - [(test (format "Can calculate " <desc> ".") - (check-success+ <proc> (list subjectC) Frac))] - - ["lux math cos" "cosine"] - ["lux math sin" "sine"] - ["lux math tan" "tangent"] - ["lux math acos" "inverse/arc cosine"] - ["lux math asin" "inverse/arc sine"] - ["lux math atan" "inverse/arc tangent"] - ["lux math cosh" "hyperbolic cosine"] - ["lux math sinh" "hyperbolic sine"] - ["lux math tanh" "hyperbolic tangent"] - ["lux math exp" "exponentiation"] - ["lux math log" "logarithm"] - ["lux math ceil" "ceiling"] - ["lux math floor" "floor"] - ["lux math round" "rounding"]) - <binary> (do-template [<proc> <desc>] - [(test (format "Can calculate " <desc> ".") - (check-success+ <proc> (list subjectC paramC) Frac))] - - ["lux math atan2" "inverse/arc tangent (with 2 arguments)"] - ["lux math pow" "power"])] - ($_ seq - <unary> - <binary>))))) - -(context: "Atom procedures" - (<| (times +100) - (do @ - [[elemT elemC] gen-primitive - sizeC (|> r.nat (:: @ map code.nat)) - idxC (|> r.nat (:: @ map code.nat)) - var-name (r.text +5) - #let [atomT (type (atom.Atom elemT))]] - ($_ seq - (test "Can create atomic reference." - (check-success+ "lux atom new" (list elemC) atomT)) - (test "Can read the value of an atomic reference." - (|> (&scope.with-scope "" - (&scope.with-local [var-name atomT] - (&.with-type elemT - (analyse (` ("lux atom read" (~ (code.symbol ["" var-name])))))))) - (macro.run (io.run init-jvm)) - (case> (#e.Success _) - true - - (#e.Error _) - false))) - (test "Can swap the value of an atomic reference." - (|> (&scope.with-scope "" - (&scope.with-local [var-name atomT] - (&.with-type Bool - (analyse (` ("lux atom compare-and-swap" - (~ (code.symbol ["" var-name])) - (~ elemC) - (~ elemC))))))) - (macro.run (io.run init-jvm)) - (case> (#e.Success _) - true - - (#e.Error _) - false))) - )))) - -(context: "Process procedures" - (<| (times +100) - (do @ - [[primT primC] gen-primitive - timeC (|> r.nat (:: @ map code.nat))] - ($_ seq - (test "Can query the level of concurrency." - (check-success+ "lux process parallelism-level" (list) Nat)) - (test "Can schedule an IO computation to run concurrently at some future time." - (check-success+ "lux process schedule" - (list timeC - (` ("lux function" (~' _) (~' _) (~ primC)))) - Any)) - )))) - -(context: "IO procedures" - (<| (times +100) - (do @ - [logC (|> (r.text +5) (:: @ map code.text)) - exitC (|> r.int (:: @ map code.int))] - ($_ seq - (test "Can log messages to standard output." - (check-success+ "lux io log" (list logC) Any)) - (test "Can throw a run-time error." - (check-success+ "lux io error" (list logC) Nothing)) - (test "Can exit the program." - (check-success+ "lux io exit" (list exitC) Nothing)) - (test "Can query the current time (as milliseconds since epoch)." - (check-success+ "lux io current-time" (list) Int)) - )))) 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 deleted file mode 100644 index 3d0c76777..000000000 --- a/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux +++ /dev/null @@ -1,546 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (concurrency [atom]) - (data ["e" error] - [product] - [maybe] - [text "text/" Eq<Text>] - text/format - (coll [array] - [list "list/" Fold<List>] - (dictionary ["dict" unordered]))) - ["r" math/random "r/" Monad<Random>] - [macro #+ Monad<Meta>] - (macro [code]) - (lang [type]) - test) - (luxc ["&" lang] - (lang ["&." scope] - ["&." module] - ["~" analysis] - (analysis [".A" expression] - ["@." common]) - (translation (jvm ["@." runtime])) - (extension (analysis ["@." host])) - [".L" eval])) - (/// common) - (test/luxc common)) - -(do-template [<name> <success> <failure>] - [(def: (<name> procedure params output-type) - (-> Text (List Code) Type Bool) - (|> (do Monad<Meta> - [runtime-bytecode @runtime.translate] - (&.with-scope - (&.with-type output-type - ((expressionA.analyser evalL.eval) - (` ((~ (code.text procedure)) (~+ params))))))) - (&.with-current-module "") - (macro.run (io.run init-jvm)) - (case> (#e.Success _) - <success> - - (#e.Error error) - <failure>)))] - - [success true false] - [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 (io.run init-jvm)) - (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") - (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" @host.Float] - ["jvm convert double-to-int" "java.lang.Double" @host.Integer] - ["jvm convert double-to-long" "java.lang.Double" @host.Long] - ["jvm convert float-to-double" "java.lang.Float" @host.Double] - ["jvm convert float-to-int" "java.lang.Float" @host.Integer] - ["jvm convert float-to-long" "java.lang.Float" @host.Long] - )] - ($_ seq - <conversions> - ))) - -(context: "Conversions [int]." - (with-expansions [<conversions> (do-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" @host.Byte] - ["jvm convert int-to-char" "java.lang.Integer" @host.Character] - ["jvm convert int-to-double" "java.lang.Integer" @host.Double] - ["jvm convert int-to-float" "java.lang.Integer" @host.Float] - ["jvm convert int-to-long" "java.lang.Integer" @host.Long] - ["jvm convert int-to-short" "java.lang.Integer" @host.Short] - )] - ($_ seq - <conversions> - ))) - -(context: "Conversions [long]." - (with-expansions [<conversions> (do-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" @host.Double] - ["jvm convert long-to-float" "java.lang.Long" @host.Float] - ["jvm convert long-to-int" "java.lang.Long" @host.Integer] - ["jvm convert long-to-short" "java.lang.Long" @host.Short] - ["jvm convert long-to-byte" "java.lang.Long" @host.Byte] - )] - ($_ seq - <conversions> - ))) - -(context: "Conversions [char + byte + short]." - (with-expansions [<conversions> (do-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" @host.Byte] - ["jvm convert char-to-short" "java.lang.Character" @host.Short] - ["jvm convert char-to-int" "java.lang.Character" @host.Integer] - ["jvm convert char-to-long" "java.lang.Character" @host.Long] - ["jvm convert byte-to-long" "java.lang.Byte" @host.Long] - ["jvm convert short-to-long" "java.lang.Short" @host.Long] - )] - ($_ seq - <conversions> - ))) - -(do-template [<domain> <boxed> <type>] - [(context: (format "Arithmetic " "[" <domain> "].") - (with-expansions [<instructions> (do-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> (do-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> @host.Boolean] - [(format "jvm " <domain> " <") <boxed> <boxed> @host.Boolean] - )] - ($_ seq - <instructions> - ))) - - (context: (format "Bitwise " "[" <domain> "].") - (with-expansions [<instructions> (do-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" @host.Integer] - ["long" "java.lang.Long" @host.Long] - ) - -(do-template [<domain> <boxed> <type>] - [(context: (format "Arithmetic " "[" <domain> "].") - (with-expansions [<instructions> (do-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> (do-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> @host.Boolean] - [(format "jvm " <domain> " <") <boxed> <boxed> @host.Boolean] - )] - ($_ seq - <instructions> - )))] - - - ["float" "java.lang.Float" @host.Float] - ["double" "java.lang.Double" @host.Double] - ) - -(do-template [<domain> <boxed> <type>] - [(context: (format "Order " "[" <domain> "].") - (with-expansions [<instructions> (do-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> @host.Boolean] - [(format "jvm " <domain> " <") <boxed> <boxed> @host.Boolean] - )] - ($_ seq - <instructions> - )))] - - - ["char" "java.lang.Character" @host.Character] - ) - -(def: array-type - (r.Random [Text Text]) - (let [entries (dict.entries @host.boxes) - num-entries (list.size entries)] - (do r.Monad<Random> - [choice (|> r.nat (:: @ map (n/% (n/inc 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 (:: @ map cap)) - idx (|> r.nat (:: @ map (n/% size))) - level (|> r.nat (:: @ map 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/fold (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 - (:: @ map (n/% (n/inc (list.size throwables)))) - (:: @ map (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) - Bool)) - (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) - Bool)) - (test "jvm object instance? (lineage)" - (success "jvm object instance?" - (list (' "java.lang.Object") - boxedC) - Bool)) - (test "jvm object instance? (no lineage)" - (or (text/= "java.lang.Object" boxed) - (failure "jvm object instance?" - (list (code.text boxed) - !boxedC) - Bool))) - )))) - -(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))))) - ))) |