aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/test')
-rw-r--r--new-luxc/test/test/luxc/lang/translation/common.lux471
1 files changed, 458 insertions, 13 deletions
diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux
index 7e46abfda..d3f1e9cf4 100644
--- a/new-luxc/test/test/luxc/lang/translation/common.lux
+++ b/new-luxc/test/test/luxc/lang/translation/common.lux
@@ -17,7 +17,7 @@
[host]
test)
(luxc [lang]
- (lang ["ls" synthesis]
+ (lang [synthesis #+ Synthesis]
(translation (jvm [".T_jvm" eval]
[".T_jvm" expression]
[".T_jvm" runtime])
@@ -28,7 +28,7 @@
(def: (bit-spec translate-expression eval translate-runtime init)
(All [a]
- (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
+ (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
Test))
(do r.Monad<Random>
[param r.nat
@@ -90,7 +90,7 @@
(def: (nat-spec translate-expression eval translate-runtime init)
(All [a]
- (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
+ (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
Test))
(do r.Monad<Random>
[param (|> r.nat (r.filter (|>> (n/= +0) not)))
@@ -157,7 +157,7 @@
(def: (int-spec translate-expression eval translate-runtime init)
(All [a]
- (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
+ (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
Test))
(do r.Monad<Random>
[param (|> r.int (r.filter (|>> (i/= 0) not)))
@@ -226,7 +226,7 @@
(def: (frac-spec|0 translate-expression eval translate-runtime init)
(All [a]
- (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
+ (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
Test))
(do r.Monad<Random>
[param (|> r.frac (r.filter (|>> (f/= 0.0) not)))
@@ -259,7 +259,7 @@
(def: (frac-spec|1 translate-expression eval translate-runtime init)
(All [a]
- (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
+ (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
Test))
(do r.Monad<Random>
[param (|> r.frac (r.filter (|>> (f/= 0.0) not)))
@@ -321,7 +321,7 @@
(def: (frac-spec translate-expression eval translate-runtime init)
(All [a]
- (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
+ (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
Test))
($_ seq
(frac-spec|0 translate-expression eval translate-runtime init)
@@ -346,7 +346,7 @@
(def: (deg-spec translate-expression eval translate-runtime init)
(All [a]
- (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
+ (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
Test))
(do r.Monad<Random>
[param (|> r.deg (:: @ map above-threshold))
@@ -427,6 +427,387 @@
))
))))
+(def: lower-alpha
+ (r.Random Nat)
+ (|> r.nat (:: r.Functor<Random> map (|>> (n/% +26) (n/+ +97)))))
+
+(def: upper-alpha
+ (r.Random Nat)
+ (|> r.nat (:: r.Functor<Random> map (|>> (n/% +26) (n/+ +65)))))
+
+(def: alpha
+ (r.Random Nat)
+ (r.either lower-alpha
+ upper-alpha))
+
+(def: (text-spec run)
+ (-> (-> Synthesis (e.Error Top)) Test)
+ (do r.Monad<Random>
+ [sample-size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
+ sample0 (r.text' lower-alpha sample-size)
+ sample1 (r.text' upper-alpha sample-size)
+ sample2 (|> (r.text' alpha sample-size)
+ (r.filter (|>> (text/= sample1) not)))
+ char-idx (|> r.nat (:: @ map (n/% sample-size)))
+ #let [sample0S (code.text sample0)
+ sample1S (code.text sample1)
+ sample2S (code.text sample2)
+ concatenatedS (` ("lux text concat" (~ sample0S) (~ sample1S)))
+ pre-rep-once (format sample0 sample1)
+ post-rep-once (format sample0 sample2)
+ pre-rep-all (|> (list.repeat sample-size sample0) (text.join-with sample1))
+ post-rep-all (|> (list.repeat sample-size sample0) (text.join-with sample2))]]
+ ($_ seq
+ (test "Can compare texts for equality."
+ (and (|> (run (` ("lux text =" (~ sample0S) (~ sample0S))))
+ (case> (#e.Success valueV)
+ (:! Bool valueV)
+
+ _
+ false))
+ (|> (run (` ("lux text =" (~ sample0S) (~ sample1S))))
+ (case> (#e.Success valueV)
+ (not (:! Bool valueV))
+
+ _
+ false))))
+ (test "Can compare texts for order."
+ (|> (run (` ("lux text <" (~ sample1S) (~ sample0S))))
+ (case> (#e.Success valueV)
+ (:! Bool valueV)
+
+ _
+ false)))
+ (test "Can change case of text."
+ (and (|> (run (` ("lux text =" (~ sample0S) ("lux text upper" (~ sample0S)))))
+ (case> (#e.Success valueV)
+ (not (:! Bool valueV))
+
+ _
+ false))
+ (|> (run (` ("lux text =" (~ sample0S) ("lux text lower" ("lux text upper" (~ sample0S))))))
+ (case> (#e.Success valueV)
+ (:! Bool valueV)
+
+ _
+ false))))
+ (test "Can get length of text."
+ (|> (run (` ("lux text size" (~ sample0S))))
+ (case> (#e.Success valueV)
+ (n/= sample-size (:! Nat valueV))
+
+ _
+ false)))
+ (test "Can concatenate text."
+ (|> (run (` ("lux text size" (~ concatenatedS))))
+ (case> (#e.Success valueV)
+ (n/= (n/* +2 sample-size) (:! Nat valueV))
+
+ _
+ false)))
+ (test "Can find index of sub-text."
+ (and (|> (run (` ("lux text index" (~ concatenatedS) (~ sample0S) +0)))
+ (case> (^multi (#e.Success valueV)
+ [(:! (Maybe Nat) valueV) (#.Some valueV)])
+ (n/= +0 valueV)
+
+ _
+ false))
+ (|> (run (` ("lux text index" (~ concatenatedS) (~ sample1S) +0)))
+ (case> (^multi (#e.Success valueV)
+ [(:! (Maybe Nat) valueV) (#.Some valueV)])
+ (n/= sample-size valueV)
+
+ _
+ false))))
+ (test "Text hashing is consistent."
+ (|> (run (` ("lux nat =" ("lux text hash" (~ sample0S)) ("lux text hash" (~ sample0S)))))
+ (case> (#e.Success valueV)
+ (:! Bool valueV)
+
+ _
+ false)))
+ (test "Can replace sub-text once."
+ (|> (run (` ("lux text ="
+ (~ (code.text post-rep-once))
+ ("lux text replace-once"
+ (~ (code.text pre-rep-once))
+ (~ sample1S)
+ (~ sample2S)))))
+ (case> (#e.Success valueV)
+ (:! Bool valueV)
+
+ _
+ false)))
+ (test "Can replace sub-text all times."
+ (|> (run (` ("lux text ="
+ (~ (code.text post-rep-all))
+ ("lux text replace-all"
+ (~ (code.text pre-rep-all))
+ (~ sample1S)
+ (~ sample2S)))))
+ (case> (#e.Success valueV)
+ (:! Bool valueV)
+
+ _
+ false)))
+ (let [test-clip (function [from to expected]
+ (|> (run (` ("lux text clip"
+ (~ concatenatedS)
+ (~ (code.nat from))
+ (~ (code.nat to)))))
+ (case> (^multi (#e.Success valueV)
+ [(:! (Maybe Text) valueV) (#.Some valueV)])
+ (text/= expected valueV)
+
+ _
+ false)))]
+ (test "Can clip text to extract sub-text."
+ (and (test-clip +0 sample-size sample0)
+ (test-clip sample-size (n/* +2 sample-size) sample1))))
+ (test "Can extract individual characters from text."
+ (|> (run (` ("lux text char"
+ (~ sample0S)
+ (~ (code.nat char-idx)))))
+ (case> (^multi (#e.Success valueV)
+ [(:! (Maybe Nat) valueV) (#.Some valueV)])
+ (text.contains? ("lux nat char" valueV)
+ sample0)
+
+ _
+ false)))
+ )))
+
+(def: (array-spec run)
+ (-> (-> Synthesis (e.Error Top)) Test)
+ (do r.Monad<Random>
+ [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
+ idx (|> r.nat (:: @ map (n/% size)))
+ value r.nat
+ #let [array0S (` ("lux array new" (~ (code.nat size))))
+ array1S (` ("lux array put" (~ array0S) (~ (code.nat idx)) (~ (code.nat value))))]]
+ ($_ seq
+ (test "Can get size of array."
+ (|> (run (` ("lux array size" (~ array0S))))
+ (case> (#e.Success valueV)
+ (n/= size (:! Nat valueV))
+
+ _
+ false)))
+ (test "Can get element from array (if it exists)."
+ (and (|> (run (` ("lux array get" (~ array0S) (~ (code.nat idx)))))
+ (case> (^multi (#e.Success valueV)
+ [(:! (Maybe Nat) valueV) #.None])
+ true
+
+ _
+ false))
+ (|> (run (` ("lux array get" (~ array1S) (~ (code.nat idx)))))
+ (case> (^multi (#e.Success valueV)
+ [(:! (Maybe Nat) valueV) (#.Some valueV)])
+ (n/= value valueV)
+
+ _
+ false))))
+ (test "Can remove element from array."
+ (|> (run (` ("lux array get"
+ ("lux array remove" (~ array1S)
+ (~ (code.nat idx)))
+ (~ (code.nat idx)))))
+ (case> (^multi (#e.Success valueV)
+ [(:! (Maybe Nat) valueV) #.None])
+ true
+
+ _
+ false)))
+ )))
+
+(def: (math-spec run)
+ (-> (-> Synthesis (e.Error Top)) Test)
+ (do r.Monad<Random>
+ [subject r.frac
+ param r.frac]
+ (`` ($_ seq
+ (~~ (do-template [<name>]
+ [(test (format "Can apply '" <name> "' procedure.")
+ (|> (run (` (<name> (~ (code.frac subject)))))
+ (case> (#e.Success valueV)
+ true
+
+ (#e.Error error)
+ false)))]
+
+ ["lux math cos"]
+ ["lux math sin"]
+ ["lux math tan"]
+ ["lux math acos"]
+ ["lux math asin"]
+ ["lux math atan"]
+ ["lux math cosh"]
+ ["lux math sinh"]
+ ["lux math tanh"]
+ ["lux math exp"]
+ ["lux math log"]
+ ["lux math root2"]
+ ["lux math root3"]
+ ["lux math ceil"]
+ ["lux math floor"]
+ ["lux math round"]))
+ (~~ (do-template [<name>]
+ [(test (format "Can apply '" <name> "' procedure.")
+ (|> (run (` (<name> (~ (code.frac subject)) (~ (code.frac param)))))
+ (case> (#e.Success valueV)
+ true
+
+ (#e.Error error)
+ false)))]
+
+ ["lux math atan2"]
+ ["lux math pow"]))
+ ))))
+
+(def: (io-spec run)
+ (-> (-> Synthesis (e.Error Top)) Test)
+ (do r.Monad<Random>
+ [message (r.text +5)]
+ ($_ seq
+ (test "Can log messages."
+ (|> (run (` ("lux io log" (~ (code.text (format "LOG: " message))))))
+ (case> (#e.Success valueV)
+ true
+
+ (#e.Error error)
+ false)))
+ (test "Can throw runtime errors."
+ (and (|> (run (` ("lux try" ("lux function" +1 []
+ ("lux io error" (~ (code.text message)))))))
+ (case> (^multi (#e.Success valueV)
+ [(:! (e.Error Text) valueV) (#e.Error error)])
+ (text.contains? message error)
+
+ _
+ false))
+ (|> (run (` ("lux try" ("lux function" +1 []
+ (~ (code.text message))))))
+ (case> (^multi (#e.Success valueV)
+ [(:! (e.Error Text) valueV) (#e.Success valueV)])
+ (text/= message valueV)
+
+ _
+ false))))
+ (test "Can obtain current time in milli-seconds."
+ (|> (run (` [("lux io current-time") ("lux io current-time")]))
+ (case> (#e.Success valueV)
+ (let [[pre post] (:! [Nat Nat] valueV)]
+ (n/>= pre post))
+
+ (#e.Error error)
+ false)))
+ )))
+
+(def: (atom-spec run)
+ (-> (-> Synthesis (e.Error Top)) Test)
+ (do r.Monad<Random>
+ [pre r.nat
+ post (|> r.nat (r.filter (|>> (n/= pre) not)))
+ #let [preS (code.nat pre)
+ postS (code.nat post)
+ atomS (` ("lux atom new" (~ preS)))]]
+ ($_ seq
+ (test "Can read atoms."
+ (|> (run (` ("lux atom read" (~ atomS))))
+ (case> (#e.Success valueV)
+ (n/= pre (:! Nat valueV))
+
+ (#e.Error error)
+ false)))
+ (test "Can compare-and-swap atoms."
+ (and (|> (run (` ("lux let" +0 (~ preS)
+ ("lux let" +1 ("lux atom new" (0))
+ [("lux atom compare-and-swap" (1) (0) (~ postS))
+ ("lux atom read" (1))]))))
+ (case> (#e.Success valueV)
+ (let [[swapped? current-value] (:! [Bool Nat] valueV)]
+ (and swapped?
+ (n/= post current-value)))
+
+ (#e.Error error)
+ false))
+ (|> (run (` ("lux let" +0 (~ preS)
+ ("lux let" +1 ("lux atom new" (0))
+ [("lux atom compare-and-swap" (1) (~ postS) (~ postS))
+ ("lux atom read" (1))]))))
+ (case> (#e.Success valueV)
+ (let [[swapped? current-value] (:! [Bool Nat] valueV)]
+ (and (not swapped?)
+ (n/= pre current-value)))
+
+ (#e.Error error)
+ false))))
+ )))
+
+(def: (box-spec run)
+ (-> (-> Synthesis (e.Error Top)) Test)
+ (do r.Monad<Random>
+ [pre r.nat
+ post (|> r.nat (r.filter (|>> (n/= pre) not)))
+ #let [preS (code.nat pre)
+ postS (code.nat post)
+ boxS (` ("lux box new" (~ preS)))]]
+ ($_ seq
+ (test "Can read boxes."
+ (|> (run (` ("lux box read" (~ boxS))))
+ (case> (#e.Success valueV)
+ (n/= pre (:! Nat valueV))
+
+ (#e.Error error)
+ false)))
+ (test "Can write boxes."
+ (|> (run (` ("lux let" +0 (~ boxS)
+ ("lux let" +1 ("lux box write" (~ postS) (0))
+ ("lux box read" (0))))))
+ (case> (#e.Success valueV)
+ (n/= post (:! Nat valueV))
+
+ (#e.Error error)
+ false)))
+ )))
+
+(def: (process-spec run)
+ (-> (-> Synthesis (e.Error Top)) Test)
+ ($_ seq
+ (test "Can query the concurrency level of the machine."
+ (|> (run (` ("lux process concurrency-level")))
+ (case> (#e.Success valueV)
+ (n/>= +1 (:! Nat valueV))
+
+ (#e.Error error)
+ false)))
+ (do r.Monad<Random>
+ [delay (|> r.nat (:: @ map (n/% +10)))
+ message (r.text +5)]
+ ($_ seq
+ (test "Can execute I/O operations in parallel."
+ (|> (run (` ("lux process future"
+ ("lux function" +1 []
+ ("lux io log" (~ (code.text (format "EXECUTE: " message))))))))
+ (case> (#e.Success valueV)
+ true
+
+ (#e.Error error)
+ false)))
+ (test "Can schedule I/O operations for future execution."
+ (|> (run (` ("lux process schedule"
+ (~ (code.nat delay))
+ ("lux function" +1 []
+ ("lux io log" (~ (code.text (format "SCHEDULE: " message))))))))
+ (case> (#e.Success valueV)
+ true
+
+ (#e.Error error)
+ false)))
+ ))))
+
## Bit
(context: "[JVM] Bit procedures"
(<| (times +100)
@@ -454,6 +835,15 @@
(<| (times +100)
(int-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js)))
+## Deg
+(context: "[JVM] Deg procedures"
+ (<| (times +100)
+ (deg-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm)))
+
+(context: "[JS] Deg procedures"
+ (<| (times +100)
+ (deg-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js)))
+
## Frac
(context: "[JVM] Frac procedures"
(<| (times +100)
@@ -463,11 +853,66 @@
(<| (times +100)
(frac-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js)))
-## Deg
-(context: "[JVM] Deg procedures"
+## Text
+(context: "[JVM] Text procedures"
+ (<| (seed +4439612689198907401)
+ ## (times +100)
+ (text-spec run-jvm)))
+
+(context: "[JS] Text procedures"
(<| (times +100)
- (deg-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm)))
+ (text-spec run-js)))
-(context: "[JS] Deg procedures"
+## Array
+(context: "[JVM] Array procedures"
(<| (times +100)
- (deg-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js)))
+ (array-spec run-jvm)))
+
+(context: "[JS] Array procedures"
+ (<| (times +100)
+ (array-spec run-js)))
+
+## Math
+(context: "[JVM] Math procedures"
+ (<| (times +100)
+ (math-spec run-jvm)))
+
+(context: "[JS] Math procedures"
+ (<| (times +100)
+ (math-spec run-js)))
+
+## I/O
+(context: "[JVM] I/O procedures"
+ (<| (times +100)
+ (io-spec run-jvm)))
+
+(context: "[JS] I/O procedures"
+ (<| (times +100)
+ (io-spec run-js)))
+
+## Atom
+(context: "[JVM] Atom procedures"
+ (<| (times +100)
+ (atom-spec run-jvm)))
+
+(context: "[JS] Atom procedures"
+ (<| (times +100)
+ (atom-spec run-js)))
+
+## Box
+(context: "[JVM] Box procedures"
+ (<| (times +100)
+ (box-spec run-jvm)))
+
+(context: "[JS] Box procedures"
+ (<| (times +100)
+ (box-spec run-js)))
+
+## Process
+(context: "[JVM] Process procedures"
+ (<| (times +100)
+ (process-spec run-jvm)))
+
+(context: "[JS] Process procedures"
+ (<| (times +100)
+ (process-spec run-js)))