1 files changed, 160 insertions, 0 deletions
diff --git a/new-luxc/test/test/luxc/lang/translation/js.lux b/new-luxc/test/test/luxc/lang/translation/js.lux
new file mode 100644
index 000000000..68bc227f2
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/translation/js.lux
@@ -0,0 +1,160 @@
+(.module:
+  lux
+  (lux [io #+ IO]
+       (control [monad #+ do]
+                pipe)
+       (data ["e" error]
+             text/format
+             [number]
+             (coll [list "list/" Functor<List>]
+                   [set]))
+       [math]
+       ["r" math/random]
+       (macro [code])
+       test)
+  (luxc (lang [synthesis #+ Synthesis]))
+  (test/luxc common))
+
+(def: upper-alpha-ascii
+  (r.Random Nat)
+  (|> r.nat (:: r.Functor<Random> map (|>> (n/% +91) (n/max +65)))))
+
+(def: (test-primitive-identity synthesis)
+  (-> Synthesis Bool)
+  (|> (run-js (` ("lux is" (~ synthesis) (~ synthesis))))
+      (case> (#e.Success valueV)
+             (:! Bool valueV)
+
+             _
+             false)))
+
+(type: Check (-> (e.Error Top) Bool))
+
+(do-template [<name> <type> <pre> <=>]
+  [(def: (<name> angle)
+     (-> <type> Check)
+     (|>> (case> (#e.Success valueV)
+                 (<=> (<pre> angle) (:! <type> valueV))
+                 
+                 (#e.Error error)
+                 false)))]
+
+  [sin-check    Frac math.sin f/=]
+  [length-check Nat  id       n/=]
+  )
+
+(context: "[JS] Primitives."
+  ($_ seq
+      (test "Null is equal to itself."
+            (test-primitive-identity (` ("js null"))))
+      (test "Undefined is equal to itself."
+            (test-primitive-identity (` ("js undefined"))))
+      (test "Object comparison is by reference, not by value."
+            (not (test-primitive-identity (` ("js object")))))
+      (test "Values are equal to themselves."
+            (test-primitive-identity (` ("js global" "Math"))))
+      (<| (times +100)
+          (do @
+            [value r.int
+             #let [frac-value (int-to-frac value)]]
+            (test "Can call primitive functions."
+                  (|> (run-js (` ("js call" ("js global" "Math.sin") (~ (code.text (%f frac-value))))))
+                      (sin-check frac-value)))))
+      ))
+
+(context: "[JS] Objects."
+  (<| (times +100)
+      (do @
+        [field (:: @ map code.text (r.text' upper-alpha-ascii +5))
+         value r.int
+         #let [empty-object (` ("js object"))
+               object (` ("js object set" (~ field) (~ (code.int value)) (~ empty-object)))
+               frac-value (int-to-frac value)]]
+        ($_ seq
+            (test "Cannot get non-existing fields from objects."
+                  (|> (run-js (` ("js object get" (~ field) (~ empty-object))))
+                      (case> (^multi (#e.Success valueV)
+                                     [(:! (Maybe Int) valueV) #.None])
+                             true
+
+                             _
+                             false)))
+            (test "Can get fields from objects."
+                  (|> (run-js (` ("js object get" (~ field) (~ object))))
+                      (case> (^multi (#e.Success valueV)
+                                     [(:! (Maybe Int) valueV) (#.Some valueV)])
+                             (i/= value (:! Int valueV))
+
+                             _
+                             false)))
+            (test "Can delete fields from objects."
+                  (|> (run-js (let [post-delete (` ("js object delete" (~ field) (~ object)))]
+                                (` ("js object get" (~ field) (~ post-delete)))))
+                      (case> (^multi (#e.Success valueV)
+                                     [(:! (Maybe Int) valueV) #.None])
+                             true
+
+                             _
+                             false)))
+            (test "Can instance new objects."
+                  (let [base (` ("js object new" ("js global" "Number") (~ (code.text (%f frac-value)))))]
+                    (|> (run-js (` ("lux frac +" (~ base) 0.0)))
+                        (case> (#e.Success valueV)
+                               (f/= frac-value (:! Frac valueV))
+
+                               (#e.Error error)
+                               false))))
+            (test "Can call methods on objects."
+                  (|> (run-js (` ("js object call" ("js global" "Math") "sin" (~ (code.text (%f frac-value))))))
+                      (sin-check frac-value)))
+            ))))
+
+(context: "[JS] Arrays."
+  (<| (times +100)
+      (do @
+        [length (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
+         idx (|> r.nat (:: @ map (n/% length)))
+         overwrite r.nat
+         elems (|> (r.set number.Hash<Nat> length r.nat)
+                   (:: @ map set.to-list))
+         #let [arrayS (` ("js array literal" (~+ (list/map code.nat elems))))]]
+        ($_ seq
+            (test "Can get the length of an array."
+                  (|> (run-js (` ("js array length" (~ arrayS))))
+                      (length-check length)))
+            (test "Can get an element from an array."
+                  (|> (run-js (` ("js array read" (~ (code.nat idx)) (~ arrayS))))
+                      (case> (^multi (#e.Success elemV)
+                                     [[(list.nth idx elems) (:! (Maybe Nat) elemV)]
+                                      [(#.Some reference) (#.Some sample)]])
+                             (n/= reference sample)
+
+                             _
+                             false)))
+            (test "Can write an element into an array."
+                  (let [idxS (code.nat idx)
+                        overwriteS (code.nat overwrite)]
+                    (|> (run-js (` ("js array read" (~ idxS)
+                                    ("js array write" (~ idxS) (~ overwriteS) (~ arrayS)))))
+                        (case> (^multi (#e.Success elemV)
+                                       [(:! (Maybe Nat) elemV)
+                                        (#.Some sample)])
+                               (n/= overwrite sample)
+
+                               _
+                               false))))
+            (test "Can delete an element from an array."
+                  (let [idxS (code.nat idx)
+                        deleteS (` ("js array delete" (~ idxS) (~ arrayS)))]
+                    (and (|> (run-js (` ("js array length" (~ deleteS))))
+                             (length-check length))
+                         (|> (run-js (` ("js array read" (~ idxS) (~ deleteS))))
+                             (case> (^multi (#e.Success elemV)
+                                            [(:! (Maybe Nat) elemV)
+                                             #.None])
+                                    true
+
+                                    _
+                                    false))
+                         )))
+            ))))