path: root/stdlib/source/test/lux/ffi.jvm.lux

(.require
 [library
  [lux (.except)
   ["[0]" debug]
   [abstract
    [monad (.only do)]]
   [control
    ["[0]" io]
    ["[0]" pipe]
    ["[0]" try (.use "[1]#[0]" functor)]
    ["[0]" exception]]
   [data
    ["[0]" bit (.use "[1]#[0]" equivalence)]
    ["[0]" text (.use "[1]#[0]" equivalence)
     ["%" \\format (.only format)]]
    [collection
     ["[0]" array (.only Array)]]]
   [math
    ["[0]" random (.only Random) (.use "[1]#[0]" monad)]
    [number (.only hex)
     ["[0]" i64]
     ["n" nat]
     ["i" int (.use "[1]#[0]" equivalence)]
     ["f" frac (.use "[1]#[0]" equivalence)]]]
   ["[0]" meta (.only)
    ["[0]" static]
    ["[0]" type (.use "[1]#[0]" equivalence)]
    ["[0]" code (.only)
     ["<[1]>" \\parser]]
    [macro
     [syntax (.only syntax)]
     ["[0]" template]
     ["[0]" expansion]]
    [compiler
     [target
      ["[0]" jvm
       ["[1]" type (.use "[1]#[0]" equivalence)]]]]]
   [test
    ["_" property (.only Test)]]]]
 [\\library
  ["[0]" /]]
 ["$[0]" /
  ["[1][0]" export]])

(/.import java/lang/Boolean
  "[1]::[0]")

(/.import java/lang/Long
  "[1]::[0]")

(/.import java/lang/String
  "[1]::[0]")

(/.import java/lang/Object
  "[1]::[0]")

(/.import (java/lang/Class a)
  "[1]::[0]"
  (getName [] java/lang/String))

(with_template [<name> <type> <conversion> <lux> <=>]
  [(def (<name> left right)
     (-> <type> <type> Bit)
     (<=> (as <lux> (<conversion> left))
          (as <lux> (<conversion> right))))]

  [boolean#= /.Boolean <| Bit bit#=]
  [byte#= /.Byte /.byte_to_long Int i#=]
  [short#= /.Short /.short_to_long Int i#=]
  [integer#= /.Integer /.int_to_long Int i#=]
  [long#= /.Long <| Int i#=]
  [float#= /.Float /.float_to_double Frac f#=]
  [double#= /.Double <| Frac f#=]
  [character#= /.Character /.char_to_long Int i#=]
  )

(def macro_error
  (syntax (_ [expression <code>.any])
    (function (_ lux)
      (|> (expansion.single expression)
          (meta.result lux)
          (pipe.when
            {try.#Success expansion}
            {try.#Failure "OOPS!"}
            
            {try.#Failure error}
            {try.#Success [lux (list (code.text error))]})))))

(def for_conversions
  Test
  (do [! random.monad]
    [long (of ! each (|>> /.as_long) random.int)
     integer (of ! each (|>> /.as_int) random.int)
     byte (of ! each (|>> /.as_byte) random.int)
     short (of ! each (|>> /.as_short) random.int)
     float (|> random.frac
               (random.only (|>> f.not_a_number? not))
               (of ! each (|>> /.as_float)))]
    (`` (all _.and
             (,, (with_template [<sample> <=> <to> <from>]
                   [(_.coverage [<to> <from>]
                      (or (|> <sample> <to> <from> (<=> <sample>))
                          (let [capped (|> <sample> <to> <from>)]
                            (|> capped <to> <from> (<=> capped)))))]

                   [long long#= /.long_to_byte /.byte_to_long]
                   [long long#= /.long_to_short /.short_to_long]
                   [long long#= /.long_to_int /.int_to_long]
                   [long long#= /.long_to_float /.float_to_long]
                   [long long#= /.long_to_double /.double_to_long]
                   [long long#= /.long_to_char /.char_to_long]

                   [integer integer#= /.int_to_double /.double_to_int]
                   [integer integer#= /.int_to_float /.float_to_int]
                   [integer integer#= /.int_to_char /.char_to_int]

                   [byte byte#= /.byte_to_int /.int_to_byte]
                   [short short#= /.short_to_int /.int_to_short]
                   [byte byte#= /.byte_to_char /.char_to_byte]
                   [short short#= /.short_to_char /.char_to_short]
                   [float float#= /.float_to_double /.double_to_float]
                   ))))))

(def for_arrays
  Test
  (do [! random.monad]
    [size (|> random.nat (of ! each (|>> (n.% 100) (n.max 1))))
     idx (|> random.nat (of ! each (n.% size)))
     value (of ! each (|>> /.as_long) random.int)]
    (all _.and
         (_.coverage [/.array /.length]
           (|> size
               (/.array java/lang/Long)
               /.length
               (n.= size)))
         (_.coverage [/.write! /.read!]
           (|> (/.array java/lang/Long size)
               (/.write! idx value)
               (/.read! idx)
               /.of_long
               (i.= (/.of_long value))))
         (_.coverage [/.cannot_convert_to_jvm_type]
           (let [array (as (Array Nothing)
                           (array.empty 1))]
             (|> array
                 /.length
                 ..macro_error
                 (text.contains? (the exception.#label /.cannot_convert_to_jvm_type))))))))

(def for_miscellaneous
  Test
  (`` (do [! random.monad]
        [sample (of ! each (|>> (as java/lang/Object))
                    (random.ascii 1))
         boolean (of ! each (|>> /.as_boolean) random.bit)
         byte (of ! each (|>> /.as_byte) random.int)
         short (of ! each (|>> /.as_short) random.int)
         integer (of ! each (|>> /.as_int) random.int)
         long (of ! each (|>> /.as_long) random.int)
         float (|> random.frac
                   (random.only (|>> f.not_a_number? not))
                   (of ! each (|>> /.as_float)))
         double (|> random.frac
                    (random.only (|>> f.not_a_number? not))
                    (of ! each (|>> /.as_double)))
         character (of ! each (|>> /.as_int /.int_to_char) random.int)
         string (of ! each (|>> /.as_string)
                    (random.ascii 1))

         bit/0 random.bit]
        (all _.and
             (_.coverage [/.as]
               (and (when (/.as java/lang/String sample) {.#Some _} true {.#None} false)
                    (when (/.as java/lang/Long sample) {.#Some _} false {.#None} true)
                    (when (/.as java/lang/Object sample) {.#Some _} true {.#None} false)
                    (when (/.as java/lang/Object (/.null)) {.#Some _} false {.#None} true)))
             (_.coverage [/.synchronized]
               (/.synchronized sample true))
             (_.coverage [/.class_for]
               (text#= "java.lang.Class" (/.of_string (java/lang/Class::getName (/.class_for java/lang/Class)))))
             (_.coverage [/.null /.null?]
               (and (/.null? (/.null))
                    (not (/.null? sample))))
             (_.coverage [/.???]
               (and (|> (/.??? (/.null))
                        (is (Maybe java/lang/Object))
                        (pipe.when
                          {.#None}
                          true
                          
                          {.#Some _}
                          false))
                    (|> (/.??? sample)
                        (is (Maybe java/lang/Object))
                        (pipe.when
                          {.#Some _}
                          true
                          
                          {.#None}
                          false))))
             (_.coverage [/.!!!]
               (and (|> (/.??? (/.null))
                        /.!!!
                        /.null?)
                    (|> (/.??? sample)
                        /.!!!
                        /.null?
                        not)))
             (,, (with_template [<object> <primitive> <jvm#value> <jvm#=>
                                 <lux#value> <as> <of> <lux#=>]
                   [(_.coverage [<object> <primitive>]
                      (|> <jvm#value>
                          (is <object>)
                          .jvm_object_cast#
                          (is <primitive>)
                          .jvm_object_cast#
                          (is <object>)
                          (<jvm#=> <jvm#value>)))
                    (_.coverage [<as> <of>]
                      (|> <lux#value>
                          <as>
                          <of>
                          (<lux#=> <lux#value>)))]

                   [/.Boolean /.boolean boolean boolean#=
                    bit/0 /.as_boolean /.of_boolean bit#=]
                   [/.Byte /.byte byte byte#=
                    (/.of_byte byte) /.as_byte /.of_byte i#=]
                   [/.Short /.short short short#=
                    (/.of_short short) /.as_short /.of_short i#=]
                   [/.Integer /.int integer integer#=
                    (/.of_int integer) /.as_int /.of_int i#=]
                   [/.Long /.long long long#=
                    (/.of_long long) /.as_long /.of_long i#=]
                   [/.Float /.float float float#=
                    (/.of_float float) /.as_float /.of_float f#=]
                   [/.Double /.double double double#=
                    (/.of_double double) /.as_double /.of_double f#=]
                   [/.Character /.char character character#=
                    (/.of_char character) /.as_char /.of_char i#=]
                   ))
             (_.coverage [/.as_string /.of_string]
               (let [it (/.of_string string)]
                 (|> it
                     /.as_string
                     /.of_string
                     (text#= it))))
             (_.coverage [/.cannot_cast_to_non_object]
               (text.contains? (the exception.#label /.cannot_cast_to_non_object)
                               (macro_error (/.is boolean (is /.Boolean boolean)))))
             (_.coverage [/.is]
               (|> string
                   (/.is java/lang/Object)
                   (same? (as java/lang/Object string))))
             (_.coverage [/.type]
               (and (and (type#= /.Boolean (/.type java/lang/Boolean))
                         (type#= /.Boolean (/.type boolean)))
                    (and (type#= /.Byte (/.type java/lang/Byte))
                         (type#= /.Byte (/.type byte)))
                    (and (type#= /.Short (/.type java/lang/Short))
                         (type#= /.Short (/.type short)))
                    (and (type#= /.Integer (/.type java/lang/Integer))
                         (type#= /.Integer (/.type int)))
                    (and (type#= /.Long (/.type java/lang/Long))
                         (type#= /.Long (/.type long)))
                    (and (type#= /.Float (/.type java/lang/Float))
                         (type#= /.Float (/.type float)))
                    (and (type#= /.Double (/.type java/lang/Double))
                         (type#= /.Double (/.type double)))
                    (and (type#= /.Character (/.type java/lang/Character))
                         (type#= /.Character (/.type char)))))
             ))))

(/.interface test/TestInterface0
  ([] actual0 [] java/lang/Long))

(/.import test/TestInterface0
  "[1]::[0]"
  (actual0 [] java/lang/Long))

(/.interface test/TestInterface1
  ([] actual1 [java/lang/Boolean] java/lang/Long "throws" [java/lang/Throwable]))

(/.import test/TestInterface1
  "[1]::[0]"
  (actual1 [java/lang/Boolean] "try" java/lang/Long))

(/.interface test/TestInterface2
  ([a] actual2 [a] a))

(/.import test/TestInterface2
  "[1]::[0]"
  ([a] actual2 [a] a))

(/.interface (test/TestInterface3 a)
  ([] actual3 [] a))

(/.import (test/TestInterface3 a)
  "[1]::[0]"
  (actual3 [] a))

(/.interface test/TestInterface4
  ([] actual4 [long long] long))

(/.import test/TestInterface4
  "[1]::[0]"
  (actual4 [long long] long))

(def for_interface
  Test
  (do random.monad
    [expected random.nat
     left random.int
     right random.int
     .let [object/0 (/.object [] [test/TestInterface0]
                      []
                      (test/TestInterface0
                       [] (actual0 self [])
                       java/lang/Long
                       (/.as_long (.int expected))))
           example/0!
           (same? (is Any expected)
                  (is Any (test/TestInterface0::actual0 object/0)))

           object/1 (/.object [] [test/TestInterface1]
                      []
                      (test/TestInterface1
                       [] (actual1 self [throw? java/lang/Boolean])
                       java/lang/Long
                       "throws" [java/lang/Throwable]
                       (if (not (/.of_boolean throw?))
                         (/.as_long (.int expected))
                         (panic! "YOLO"))))
           example/1!
           (and (when (test/TestInterface1::actual1 (/.as_boolean false) object/1)
                  {try.#Success actual}
                  (same? (is Any expected)
                         (is Any actual))
                  
                  {try.#Failure error}
                  false)
                (when (test/TestInterface1::actual1 (/.as_boolean true) object/1)
                  {try.#Success actual}
                  false
                  
                  {try.#Failure error}
                  true))

           object/2 (/.object [] [test/TestInterface2]
                      []
                      (test/TestInterface2
                       [a] (actual2 self [input a])
                       a
                       input))
           example/2!
           (same? (is Any expected)
                  (is Any (test/TestInterface2::actual2 (/.as_long (.int expected)) object/2)))

           object/3 (/.object [] [(test/TestInterface3 java/lang/Long)]
                      []
                      ((test/TestInterface3 a)
                       [] (actual3 self [])
                       a
                       (/.as_long (.int expected))))
           example/3!
           (same? (is Any expected)
                  (is Any (test/TestInterface3::actual3 object/3)))

           example/4!
           (let [expected (i.+ left right)
                 object/4 (/.object [] [test/TestInterface4]
                            []
                            (test/TestInterface4
                             [] (actual4 self [actual_left long
                                               actual_right long])
                             long
                             (/.as_long (i.+ (/.of_long actual_left)
                                             (/.of_long actual_right)))))]
             (i.= expected
                  (/.of_long (test/TestInterface4::actual4 left right object/4))))]]
    (_.coverage [/.interface /.object]
      (and example/0!
           example/1!
           example/2!
           example/3!
           example/4!))))

(/.class "final" test/TestClass0 [test/TestInterface0]
  ... Fields
  ("private" value java/lang/Long)
  ... Constructors
  ("public" [] (new self [value java/lang/Long]) []
   (/.set value value self))
  ... Methods
  (test/TestInterface0 [] (actual0 self [])
                       java/lang/Long
                       (/.get value self)))

(/.import test/TestClass0
  "[1]::[0]"
  (new [java/lang/Long]))

(/.class "final" test/TestClass1 [test/TestInterface1]
  ... Fields
  ("private" value java/lang/Long)
  ... Constructors
  ("public" [] (new self [value java/lang/Long]) []
   (/.set value value self))
  ... Methods
  (test/TestInterface1 [] (actual1 self [throw? java/lang/Boolean])
                       java/lang/Long
                       "throws" [java/lang/Throwable]
                       (if (not (/.of_boolean throw?))
                         (/.get value self)
                         (panic! "YOLO"))))

(/.import test/TestClass1
  "[1]::[0]"
  (new [java/lang/Long]))

(/.class "final" test/TestClass2 [test/TestInterface2]
  ... Constructors
  ("public" [] (new self []) []
   [])
  ... Methods
  (test/TestInterface2
   [a] (actual2 self [input a])
   a
   input))

(/.import test/TestClass2
  "[1]::[0]"
  (new []))

(/.class "final" (test/TestClass3 a) [(test/TestInterface3 a)]
  ... Fields
  ("private" value a)
  ... Constructors
  ("public" [] (new self [value a]) []
   (/.set value value self))
  ... Methods
  ((test/TestInterface3 a)
   [] (actual3 self [])
   a
   (/.get value self)))

(/.import (test/TestClass3 a)
  "[1]::[0]"
  (new [a]))

(/.class "final" test/TestClass4 []
  ... Constructors
  ("public" [] (new self []) []
   [])
  ... Methods
  ("public" (actual4 self [value java/lang/Long]) java/lang/Long
   value))

(/.import test/TestClass4
  "[1]::[0]"
  (new [])
  (actual4 [java/lang/Long] java/lang/Long))

(/.class "final" test/TestClass5 []
  ... Constructors
  ("public" [] (new self []) []
   [])
  ... Methods
  ("public" "static" (actual5 [value java/lang/Long])
   java/lang/Long
   value))

(/.import test/TestClass5
  "[1]::[0]"
  ("static" actual5 [java/lang/Long] java/lang/Long))

(/.class "abstract" test/TestClass6 []
  ... Constructors
  ("public" [] (new self []) []
   [])
  ... Methods
  ("public" "abstract" (actual6 [value java/lang/Long])
   java/lang/Long))

(/.import test/TestClass6
  "[1]::[0]"
  (actual6 [java/lang/Long] java/lang/Long))

(/.class "final" test/TestClass7 test/TestClass6 []
  ... Constructors
  ("public" [] (new self []) []
   [])
  ... Methods
  (test/TestClass6
   [] (actual6 self [input java/lang/Long])
   java/lang/Long
   input))

(/.import test/TestClass7
  "[1]::[0]"
  (new []))

(/.class "final" test/TestClass8 [test/TestInterface4]
  ... Constructors
  ("public" [] (new self []) []
   [])
  ... Methods
  (test/TestInterface4
   [] (actual4 self [actual_left long
                     actual_right long])
   long
   (/.as_long
    (i.+ (/.of_long actual_left)
         (/.of_long actual_right)))))

(/.import test/TestClass8
  "[1]::[0]"
  (new []))

(/.class "final" (test/TestClass9 a) []
  ... Fields
  ("private" value9 a)
  ... Constructors
  ("public" [] (new self [value a]) []
   (/.set value9 value self))
  ... Methods
  ("public" (set_actual9 self [value a]) void
   (/.set value9 value self))
  ("public" (get_actual9 self []) a
   (/.get value9 self)))

(/.import (test/TestClass9 a)
  "[1]::[0]"
  (new [a])
  (set_actual9 [a] void)
  (get_actual9 [] a))

(/.class "final" (test/TestClass10 a) []
  ... Fields
  ("public" value10 a)
  ... Constructors
  ("public" [] (new self [init a]) []
   (/.set value10 init self)))

(/.import (test/TestClass10 a)
  "[1]::[0]"
  (new [a])
  (value10 a))

(/.class "final" (test/TestClass11 a) []
  ... Fields
  ("public" value11 a)
  ... Constructors
  ("public" [] (new self [init a]) []
   (/.set value11 init self)))

(/.import (test/TestClass11 a)
  "[1]::[0]"
  (new [a])
  ("read_only" value11 a))

(def for_class
  Test
  (do [! random.monad]
    [expected random.nat
     left random.int
     right random.int

     .let [object/0 (test/TestClass0::new (/.as_long (.int expected)))
           example/0!
           (n.= expected
                (.nat (/.of_long (test/TestInterface0::actual0 object/0))))

           object/1 (test/TestClass1::new (/.as_long (.int expected)))
           example/1!
           (and (when (test/TestInterface1::actual1 (/.as_boolean false) object/1)
                  {try.#Success actual}
                  (n.= expected
                       (.nat (/.of_long actual)))
                  
                  {try.#Failure error}
                  false)
                (when (test/TestInterface1::actual1 (/.as_boolean true) object/1)
                  {try.#Success actual}
                  false
                  
                  {try.#Failure error}
                  true))

           object/2 (test/TestClass2::new)
           example/2!
           (n.= expected
                (.nat (/.of_long (test/TestInterface2::actual2 (/.as_long (.int expected)) object/2))))

           object/3 (is (test/TestClass3 java/lang/Long)
                        (test/TestClass3::new (/.as_long (.int expected))))
           example/3!
           (n.= expected
                (.nat (/.of_long (test/TestInterface3::actual3 object/3))))

           object/4 (test/TestClass4::new)
           example/4!
           (n.= expected
                (.nat (/.of_long (test/TestClass4::actual4 (/.as_long (.int expected)) object/4))))

           example/5!
           (n.= expected
                (.nat (/.of_long (test/TestClass5::actual5 (/.as_long (.int expected))))))

           object/7 (test/TestClass7::new)
           example/7!
           (n.= expected
                (.nat (/.of_long (test/TestClass6::actual6 (/.as_long (.int expected)) object/7))))

           example_8!
           (let [expected (i.+ left right)
                 object_8 (test/TestClass8::new)]
             (i.= expected
                  (/.of_long (test/TestInterface4::actual4 (/.as_long left) (/.as_long right) object_8))))]

     .let [random_long (is (Random java/lang/Long)
                           (of ! each (|>> /.as_long)
                               random.int))]
     dummy/0 random_long
     dummy/1 random_long
     dummy/2 random_long
     .let [object/9 (/.to (is (test/TestClass9 java/lang/Long)
                              (test/TestClass9::new dummy/0))
                          (test/TestClass9::set_actual9 dummy/1)
                          (test/TestClass9::set_actual9 dummy/2))
           example/9!
           (|> object/9
               test/TestClass9::get_actual9
               /.as_long
               (same? dummy/2))

           object/10 (is (test/TestClass10 java/lang/Long)
                         (test/TestClass10::new dummy/0))
           example/10!
           (and (|> object/10
                    test/TestClass10::value10
                    io.run!
                    (same? dummy/0))
                (|> object/10
                    (test/TestClass10::value10 dummy/1)
                    io.run!
                    test/TestClass10::value10
                    io.run!
                    (same? dummy/1)))

           object/11 (is (test/TestClass11 java/lang/Long)
                         (test/TestClass11::new dummy/0))
           example/11!
           (and (|> object/11
                    test/TestClass11::value11
                    (same? dummy/0))
                (|> object/11
                    (test/TestClass11::value11 dummy/1)
                    macro_error
                    (text.contains? (the exception.#label /.cannot_write_to_field))))]]
    (all _.and
         (_.coverage [/.class /.import]
           (and example/0!
                example/1!
                example/2!
                example/3!
                example/4!
                example/5!
                example/7!
                example_8!
                example/10!
                ))
         (_.coverage [/.cannot_write_to_field]
           example/11!)
         (_.coverage [/.to]
           example/9!)
         )))

(def expands?
  (syntax (_ [expression <code>.any])
    (function (_ lux)
      (|> (expansion.single expression)
          (meta.result lux)
          (pipe.when
            {try.#Success expansion}
            true
            
            {try.#Failure error}
            false)
          code.bit
          list
          [lux]
          {try.#Success}))))

(def for_exception
  Test
  (do [! random.monad]
    [var/0 (random.lower_cased 1)
     var/1 (random.lower_cased 2)
     var/2 (random.lower_cased 3)]
    (all _.and
         (_.coverage [/.class_names_cannot_contain_periods]
           (with_expansions [<class> (template.symbol ["java.lang.Float"])]
             (not (expands? (/.import <class>)))))
         (_.coverage [/.class_name_cannot_be_a_type_variable]
           (and (not (expands? (/.import (java/lang/Double a)
                                 "[1]::[0]"
                                 (invalid [] (a java/lang/String)))))
                (not (expands? (/.import java/lang/Double
                                 "[1]::[0]"
                                 ([a] invalid [] (a java/lang/String)))))))
         (_.coverage [/.unknown_type_variable]
           (let [type_variable ((debug.private /.type_variable) (list (jvm.var var/0) (jvm.var var/1)))]
             (and (|> (list (code.local var/0))
                      (<code>.result type_variable)
                      (try#each (|>> (jvm#= (jvm.var var/0))))
                      (try.else false))
                  (|> (list (code.local var/1))
                      (<code>.result type_variable)
                      (try#each (|>> (jvm#= (jvm.var var/1))))
                      (try.else false))
                  (|> (list (code.local var/2))
                      (<code>.result type_variable)
                      (pipe.when
                        {try.#Failure error}
                        (exception.match? /.unknown_type_variable error)
                        
                        _
                        false)))))
         )))

(def .public test
  (<| (_.covering /._)
      (all _.and
           ..for_conversions
           ..for_arrays
           ..for_miscellaneous
           ..for_interface
           ..for_class
           ..for_exception

           $/export.test
           )))