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

(.module:
  [library
   [lux #*
    ["_" test (#+ Test)]
    ["." type ("#\." equivalence)]
    ["." meta]
    [abstract
     [monad (#+ do)]]
    [control
     [pipe (#+ case>)]
     ["." try]
     ["." exception]]
    [data
     ["." bit ("#\." equivalence)]
     ["." text ("#\." equivalence)]
     [collection
      ["." array (#+ Array)]]]
    ["." macro
     [syntax (#+ syntax:)]
     ["." code]]
    [math
     ["." random (#+ Random)]
     [number
      ["n" nat]
      ["i" int ("#\." equivalence)]
      ["f" frac ("#\." equivalence)]]]]]
  [\\library
   ["." /]])

(/.import: java/lang/Boolean)
(/.import: java/lang/Long)

(/.import: java/lang/String)

(/.import: java/lang/Object)

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

(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\=]
  )

(syntax: (macro_error expression)
  (function (_ lux)
    (|> (macro.single_expansion expression)
        (meta.run lux)
        (case> (#try.Success expansion)
               (#try.Failure "OOPS!")
               
               (#try.Failure error)
               (#try.Success [lux (list (code.text error))])))))

(def: for_conversions
  Test
  (do {! random.monad}
    [long (\ ! map (|>> (:as /.Long)) random.int)
     integer (\ ! map (|>> (:as /.Long) /.long_to_int) random.int)
     byte (\ ! map (|>> (:as /.Long) /.long_to_byte) random.int)
     short (\ ! map (|>> (:as /.Long) /.long_to_short) random.int)
     float (|> random.frac
               (random.only (|>> f.not_a_number? not))
               (\ ! map (|>> (:as /.Double) /.double_to_float)))]
    (`` ($_ _.and
            (~~ (template [<sample> <=> <to> <from>]
                  [(_.cover [<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 (\ ! map (|>> (n.% 100) (n.max 1))))
     idx (|> random.nat (\ ! map (n.% size)))
     value (\ ! map (|>> (:as java/lang/Long)) random.int)]
    ($_ _.and
        (_.cover [/.array /.array_length]
                 (|> size
                     (/.array java/lang/Long)
                     /.array_length
                     (n.= size)))
        (_.cover [/.array_write /.array_read]
                 (|> (/.array java/lang/Long size)
                     (/.array_write idx value)
                     (/.array_read idx)
                     (:as Int)
                     (i.= (:as Int value))))
        (_.cover [/.cannot_convert_to_jvm_type]
                 (let [array (:as (Array Nothing)
                                  (array.new 1))]
                   (|> array
                       /.array_length
                       ..macro_error
                       (text.contains? (get@ #exception.label /.cannot_convert_to_jvm_type))))))))

(def: for_miscellaneous
  Test
  (`` (do {! random.monad}
        [sample (\ ! map (|>> (:as java/lang/Object))
                   (random.ascii 1))
         boolean (\ ! map (|>> (:as /.Boolean)) random.bit)
         byte (\ ! map (|>> (:as /.Long) /.long_to_byte) random.int)
         short (\ ! map (|>> (:as /.Long) /.long_to_short) random.int)
         integer (\ ! map (|>> (:as /.Long) /.long_to_int) random.int)
         long (\ ! map (|>> (:as /.Long)) random.int)
         float (|> random.frac
                   (random.only (|>> f.not_a_number? not))
                   (\ ! map (|>> (:as /.Double) /.double_to_float)))
         double (|> random.frac
                    (random.only (|>> f.not_a_number? not))
                    (\ ! map (|>> (:as /.Double))))
         character (\ ! map (|>> (:as /.Long) /.long_to_int /.int_to_char) random.int)
         string (\ ! map (|>> (:as java/lang/String))
                   (random.ascii 1))]
        ($_ _.and
            (_.cover [/.check]
                     (and (case (/.check java/lang/String sample) (#.Some _) true #.None false)
                          (case (/.check java/lang/Long sample) (#.Some _) false #.None true)
                          (case (/.check java/lang/Object sample) (#.Some _) true #.None false)
                          (case (/.check java/lang/Object (/.null)) (#.Some _) false #.None true)))
            (_.cover [/.synchronized]
                     (/.synchronized sample #1))
            (_.cover [/.class_for]
                     (text\= "java.lang.Class" (java/lang/Class::getName (/.class_for java/lang/Class))))
            (_.cover [/.null /.null?]
                     (and (/.null? (/.null))
                          (not (/.null? sample))))
            (_.cover [/.???]
                     (and (|> (/.??? (/.null))
                              (: (Maybe java/lang/Object))
                              (case> #.None #1
                                     (#.Some _) #0))
                          (|> (/.??? sample)
                              (: (Maybe java/lang/Object))
                              (case> (#.Some _) #1
                                     #.None #0))))
            (_.cover [/.!!!]
                     (and (|> (/.??? (/.null))
                              /.!!!
                              /.null?)
                          (|> (/.??? sample)
                              /.!!!
                              /.null?
                              not)))
            (~~ (template [<object> <primitive> <value> <=>]
                  [(|> <value>
                       (: <object>)
                       "jvm object cast"
                       (: <primitive>)
                       "jvm object cast"
                       (: <object>)
                       (<=> <value>)
                       (_.cover [<object> <primitive>]))]

                  [/.Boolean /.boolean boolean boolean\=]
                  [/.Byte /.byte byte byte\=]
                  [/.Short /.short short short\=]
                  [/.Integer /.int integer integer\=]
                  [/.Long /.long long long\=]
                  [/.Float /.float float float\=]
                  [/.Double /.double double double\=]
                  [/.Character /.char character character\=]
                  ))
            (_.cover [/.cannot_cast_to_non_object]
                     (text.contains? (get@ #exception.label /.cannot_cast_to_non_object)
                                     (macro_error (/.:cast boolean (: /.Boolean boolean)))))
            (_.cover [/.:cast]
                     (|> string
                         (/.:cast java/lang/Object)
                         (is? (:as java/lang/Object string))))
            (_.cover [/.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
  ["#::."
   (actual0 [] java/lang/Long)])

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

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

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

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

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

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

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

(/.import: test/TestInterface4
  ["#::."
   (actual4 [long 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 java/lang/Long
                            expected)))
           example/0!
           (is? (: Any expected)
                (: 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 (:as Bit throw?)
                         (error! "YOLO")
                         (:as java/lang/Long
                              expected))))
           example/1!
           (and (case (test/TestInterface1::actual1 false object/1)
                  (#try.Success actual)
                  (is? (: Any expected)
                       (: Any actual))
                  
                  (#try.Failure error)
                  false)
                (case (test/TestInterface1::actual1 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!
           (is? (: Any expected)
                (: Any (test/TestInterface2::actual2 (:as java/lang/Long expected) object/2)))

           object/3 (/.object [] [(test/TestInterface3 java/lang/Long)]
                      []
                      ((test/TestInterface3 a)
                       [] (actual3 self)
                       a
                       (:as java/lang/Long
                            expected)))
           example/3!
           (is? (: Any expected)
                (: 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})
                             long
                             (:as java/lang/Long
                                  (i.+ (:as Int actual_left)
                                       (:as Int actual_right)))))]
             (i.= expected
                  (test/TestInterface4::actual4 left right right object/4)))]]
    (_.cover [/.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}) []
           (:= ::value value))
  ## Methods
  (test/TestInterface0 [] (actual0 self) java/lang/Long
                       ::value))

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

(/.class: #final test/TestClass1 [test/TestInterface1]
  ## Fields
  (#private value java/lang/Long)
  ## Constructors
  (#public [] (new self {value java/lang/Long}) []
           (:= ::value value))
  ## Methods
  (test/TestInterface1 [] (actual1 self {throw? java/lang/Boolean}) java/lang/Long #throws [java/lang/Throwable]
                       (if (:as Bit throw?)
                         (error! "YOLO")
                         ::value)))

(/.import: test/TestClass1
  ["#::."
   (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
  ["#::."
   (new [])])

(/.class: #final (test/TestClass3 a) [(test/TestInterface3 a)]
  ## Fields
  (#private value a)
  ## Constructors
  (#public [] (new self {value a}) []
           (:= ::value value))
  ## Methods
  ((test/TestInterface3 a)
   [] (actual3 self)
   a
   ::value))

(/.import: (test/TestClass3 a)
  ["#::."
   (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
  ["#::."
   (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
  ["#::."
   (#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
  ["#::."
   (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
  ["#::."
   (new [])])

(/.class: #final test/TestClass8 [test/TestInterface4]
  ## Constructors
  (#public [] (new self) []
           [])
  ## Methods
  (test/TestInterface4
   [] (actual4 self {actual_left long} {actual_right long} {_ long})
   long
   (:as java/lang/Long
        (i.+ (:as Int actual_left)
             (:as Int actual_right)))))

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

(/.class: #final (test/TestClass9 a) []
  ## Fields
  (#private value9 a)
  ## Constructors
  (#public [] (new self {value a}) []
           (:= ::value9 value))
  ## Methods
  (#public (set_actual9 self {value a}) void
           (:= ::value9 value))
  (#public (get_actual9 self) a
           ::value9))

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

(def: for_class
  Test
  (do {! random.monad}
    [expected random.nat
     left random.int
     right random.int

     #let [object/0 (test/TestClass0::new (.int expected))
           example/0!
           (n.= expected
                (:as Nat (test/TestInterface0::actual0 object/0)))

           object/1 (test/TestClass1::new (.int expected))
           example/1!
           (and (case (test/TestInterface1::actual1 false object/1)
                  (#try.Success actual)
                  (n.= expected
                       (:as Nat actual))
                  
                  (#try.Failure error)
                  false)
                (case (test/TestInterface1::actual1 true object/1)
                  (#try.Success actual)
                  false
                  
                  (#try.Failure error)
                  true))

           object/2 (test/TestClass2::new)
           example/2!
           (n.= expected
                (: Nat (test/TestInterface2::actual2 (:as java/lang/Long expected) object/2)))

           object/3 (: (test/TestClass3 java/lang/Long)
                       (test/TestClass3::new (:as java/lang/Long expected)))
           example/3!
           (n.= expected
                (: Nat (test/TestInterface3::actual3 object/3)))

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

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

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

           example/8!
           (let [expected (i.+ left right)
                 object/8 (test/TestClass8::new)]
             (i.= expected
                  (test/TestInterface4::actual4 left right right object/8)))]

     #let [random_long (: (Random java/lang/Long)
                          (\ ! map (|>> (:as java/lang/Long))
                             random.int))]
     dummy/0 random_long
     dummy/1 random_long
     dummy/2 random_long
     #let [object/9 (/.do_to (: (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 java/lang/Long)
               (is? dummy/2))]]
    ($_ _.and
        (_.cover [/.class: /.import:]
                 (and example/0!
                      example/1!
                      example/2!
                      example/3!
                      example/4!
                      example/5!
                      example/7!
                      example/8!))
        (_.cover [/.do_to]
                 example/9!)
        )))

(def: #export test
  (<| (_.covering /._)
      ($_ _.and
          ..for_conversions
          ..for_arrays
          ..for_miscellaneous
          ..for_interface
          ..for_class
          )))