aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test
diff options
context:
space:
mode:
authorEduardo Julian2018-04-15 02:24:27 -0400
committerEduardo Julian2018-04-15 02:24:27 -0400
commit6eb9cf17f161522d4eddf6783284952f8a84f099 (patch)
tree9158749544826d8d0940117ca5884fdd2f90c327 /new-luxc/test
parent0bba53ceb52502510e0f6ba4c53a951933532a61 (diff)
- Fixes for R back-end.
Diffstat (limited to '')
-rw-r--r--new-luxc/test/test/luxc/lang/translation/case.lux15
-rw-r--r--new-luxc/test/test/luxc/lang/translation/common.lux81
-rw-r--r--new-luxc/test/test/luxc/lang/translation/function.lux10
-rw-r--r--new-luxc/test/test/luxc/lang/translation/structure.lux21
4 files changed, 84 insertions, 43 deletions
diff --git a/new-luxc/test/test/luxc/lang/translation/case.lux b/new-luxc/test/test/luxc/lang/translation/case.lux
index 04a373e42..dc198b633 100644
--- a/new-luxc/test/test/luxc/lang/translation/case.lux
+++ b/new-luxc/test/test/luxc/lang/translation/case.lux
@@ -83,7 +83,8 @@
(:! Bool valueT)
(#e.Error error)
- false)))
+ (exec (log! error)
+ false))))
(test "Can bind values."
(|> (run (` ("lux case" (~ (code.nat to-bind))
("lux case seq" ("lux case bind" +0)
@@ -92,7 +93,17 @@
(n/= to-bind (:! Nat valueT))
(#e.Error error)
- false))))))
+ (exec (log! error)
+ false))))
+ (test "Can translate \"let\" expressions."
+ (|> (run (` ("lux let" +0 (~ (code.nat to-bind))
+ (0))))
+ (case> (#e.Success valueT)
+ (n/= to-bind (:! Nat valueT))
+
+ (#e.Error error)
+ (exec (log! error)
+ false)))))))
(context: "[JVM] Pattern-matching."
(<| (times +100)
diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux
index e29931667..4ab1b879d 100644
--- a/new-luxc/test/test/luxc/lang/translation/common.lux
+++ b/new-luxc/test/test/luxc/lang/translation/common.lux
@@ -33,7 +33,8 @@
(n/= (<reference> param subject) (:! Nat valueT))
(#e.Error error)
- false)
+ (exec (log! error)
+ false))
(let [param <param-expr>])))]
["lux bit and" bit.and param]
@@ -49,7 +50,8 @@
(n/= (bit.count subject) (:! Nat valueT))
(#e.Error error)
- false)))
+ (exec (log! error)
+ false))))
<binary>
(test "lux bit shift-right"
@@ -61,7 +63,8 @@
(:! Int valueT))
(#e.Error error)
- false)
+ (exec (log! error)
+ false))
(let [param (n/% +64 param)])))
))))
@@ -78,7 +81,8 @@
(n/= <reference> (:! Nat valueT))
(#e.Error error)
- false)))]
+ (exec (log! error)
+ false))))]
["lux nat min" nat/bottom]
["lux nat max" nat/top]
@@ -90,7 +94,8 @@
(<comp> (<prepare> subject) (:! <type> valueT))
(#e.Error error)
- false)
+ (exec (log! error)
+ false))
(let [subject <subject-expr>])))]
["lux nat to-int" Int nat-to-int i/= subject]
@@ -103,7 +108,8 @@
(<comp> (<reference> param subject) (:! <outputT> valueT))
(#e.Error error)
- false)))]
+ (exec (log! error)
+ false))))]
["lux nat +" n/+ Nat n/=]
["lux nat -" n/- Nat n/=]
@@ -130,7 +136,8 @@
(i/= <reference> (:! Int valueT))
(#e.Error error)
- false)))]
+ (exec (log! error)
+ false))))]
["lux int min" int/bottom]
["lux int max" int/top]
@@ -142,7 +149,8 @@
(<comp> (<prepare> subject) (:! <type> valueT))
(#e.Error error)
- false)))]
+ (exec (log! error)
+ false))))]
["lux int to-nat" Nat int-to-nat n/=]
["lux int to-frac" Frac int-to-frac f/=]
@@ -155,7 +163,8 @@
(<comp> (<reference> param subject) (:! <outputT> valueT))
(#e.Error error)
- false))))]
+ (exec (log! error)
+ false)))))]
["lux int +" i/+ Int i/=]
["lux int -" i/- Int i/=]
@@ -221,7 +230,8 @@
(|> valueT (:! Frac) (f/- subject) frac/abs <test>)
(#e.Error error)
- false)))]
+ (exec (log! error)
+ false))))]
["lux frac to-int" "lux int to-frac" (f/< 1.0)]
["lux frac to-deg" "lux deg to-frac" (f/<= 0.000000001)]))
@@ -295,7 +305,8 @@
(<comp> (<reference> param subject) (:! <outputT> valueT))
(#e.Error error)
- false)))]
+ (exec (log! error)
+ false))))]
["lux deg +" d/+ Deg d/=]
["lux deg -" d/- Deg d/=]
@@ -418,7 +429,8 @@
(:! Bool valueV)
(#e.Error error)
- false)))
+ (exec (log! error)
+ false))))
(test "Can replace sub-text once."
(|> (run (` ("lux text ="
(~ (code.text post-rep-once))
@@ -430,7 +442,8 @@
(:! Bool valueV)
(#e.Error error)
- false)))
+ (exec (log! error)
+ false))))
(test "Can replace sub-text all times."
(|> (run (` ("lux text ="
(~ (code.text post-rep-all))
@@ -442,7 +455,8 @@
(:! Bool valueV)
(#e.Error error)
- false)))
+ (exec (log! error)
+ false))))
(let [test-clip (function (_ from to expected)
(|> (run (` ("lux text clip"
(~ concatenatedS)
@@ -485,7 +499,8 @@
(n/= size (:! Nat valueV))
(#e.Error error)
- false)))
+ (exec (log! error)
+ false))))
(test "Can get element from array (if it exists)."
(and (|> (run (` ("lux array get" (~ array0S) (~ (code.nat idx)))))
(case> (^multi (#e.Success valueV)
@@ -527,7 +542,8 @@
true
(#e.Error error)
- false)))]
+ (exec (log! error)
+ false))))]
["lux math cos"]
["lux math sin"]
@@ -546,7 +562,8 @@
true
(#e.Error error)
- false)))]
+ (exec (log! error)
+ false))))]
["lux math pow"]))
))))
@@ -562,7 +579,8 @@
true
(#e.Error error)
- false)))
+ (exec (log! error)
+ false))))
(test "Can throw runtime errors."
(and (|> (run (` ("lux try" ("lux function" +1 []
("lux io error" (~ (code.text message)))))))
@@ -587,7 +605,8 @@
(n/>= pre post))
(#e.Error error)
- false)))
+ (exec (log! error)
+ false))))
)))
(def: (atom-spec run)
@@ -605,7 +624,8 @@
(n/= pre (:! Nat valueV))
(#e.Error error)
- false)))
+ (exec (log! error)
+ false))))
(test "Can compare-and-swap atoms."
(and (|> (run (` ("lux let" +0 (~ preS)
("lux let" +1 ("lux atom new" (0))
@@ -617,7 +637,8 @@
(n/= post current-value)))
(#e.Error error)
- false))
+ (exec (log! error)
+ false)))
(|> (run (` ("lux let" +0 (~ preS)
("lux let" +1 ("lux atom new" (0))
[("lux atom compare-and-swap" (1) (~ postS) (~ postS))
@@ -628,7 +649,8 @@
(n/= pre current-value)))
(#e.Error error)
- false))))
+ (exec (log! error)
+ false)))))
)))
(def: (box-spec run)
@@ -646,7 +668,8 @@
(n/= pre (:! Nat valueV))
(#e.Error error)
- false)))
+ (exec (log! error)
+ false))))
(test "Can write boxes."
(|> (run (` ("lux let" +0 (~ boxS)
("lux let" +1 ("lux box write" (~ postS) (0))
@@ -655,7 +678,8 @@
(n/= post (:! Nat valueV))
(#e.Error error)
- false)))
+ (exec (log! error)
+ false))))
)))
(def: (process-spec run)
@@ -667,7 +691,8 @@
(n/>= +1 (:! Nat valueV))
(#e.Error error)
- false)))
+ (exec (log! error)
+ false))))
(do r.Monad<Random>
[delay (|> r.nat (:: @ map (n/% +10)))
message (r.text +5)]
@@ -680,7 +705,8 @@
true
(#e.Error error)
- false)))
+ (exec (log! error)
+ false))))
(test "Can schedule I/O operations for future execution."
(|> (run (` ("lux process schedule"
(~ (code.nat delay))
@@ -690,7 +716,8 @@
true
(#e.Error error)
- false)))
+ (exec (log! error)
+ false))))
))))
(def: (all-specs run)
diff --git a/new-luxc/test/test/luxc/lang/translation/function.lux b/new-luxc/test/test/luxc/lang/translation/function.lux
index 105072df7..b0baaaa03 100644
--- a/new-luxc/test/test/luxc/lang/translation/function.lux
+++ b/new-luxc/test/test/luxc/lang/translation/function.lux
@@ -38,16 +38,16 @@
(do r.Monad<Random>
[[arity arg functionS] gen-function
cut-off (|> r.nat (:: @ map (n/% arity)))
- args (r.list arity r.nat)
+ args (r.list arity r.frac)
#let [arg-value (maybe.assume (list.nth arg args))
- argsS (list/map code.nat args)
+ argsS (list/map code.frac args)
last-arg (n/dec arity)
cut-off (|> cut-off (n/min (n/dec last-arg)))]]
($_ seq
(test "Can read arguments."
(|> (run (` ("lux call" (~ functionS) (~+ argsS))))
(case> (#e.Success valueT)
- (n/= arg-value (:! Nat valueT))
+ (f/= arg-value (:! Frac valueT))
(#e.Error error)
(exec (log! error)
@@ -61,7 +61,7 @@
("lux call" (~ functionS) (~+ preS))
(~+ postS))))
(case> (#e.Success valueT)
- (n/= arg-value (:! Nat valueT))
+ (f/= arg-value (:! Frac valueT))
(#e.Error error)
(exec (log! error)
@@ -80,7 +80,7 @@
((~ (code.int arg-var))))))]
(|> (run (` ("lux call" (~ functionS) (~+ argsS))))
(case> (#e.Success valueT)
- (n/= arg-value (:! Nat valueT))
+ (f/= arg-value (:! Frac valueT))
(#e.Error error)
(exec (log! error)
diff --git a/new-luxc/test/test/luxc/lang/translation/structure.lux b/new-luxc/test/test/luxc/lang/translation/structure.lux
index deb015727..cf186364c 100644
--- a/new-luxc/test/test/luxc/lang/translation/structure.lux
+++ b/new-luxc/test/test/luxc/lang/translation/structure.lux
@@ -92,15 +92,18 @@
(and (n/= +3 (array.size valueT))
(let [_tag (:! Integer (maybe.assume (array.read +0 valueT)))
_last? (array.read +1 valueT)
- _value (:! Top (maybe.assume (array.read +2 valueT)))]
- (and (n/= tag (|> _tag host.int-to-long (:! Nat)))
- (case _last?
- (#.Some _last?')
- (and last? (text/= "" (:! Text _last?')))
-
- #.None
- (not last?))
- (corresponds? [member _value])))))
+ _value (:! Top (maybe.assume (array.read +2 valueT)))
+ same-tag? (n/= tag (|> _tag host.int-to-long (:! Nat)))
+ same-flag? (case _last?
+ (#.Some _last?')
+ (and last? (text/= "" (:! Text _last?')))
+
+ #.None
+ (not last?))
+ same-value? (corresponds? [member _value])]
+ (and same-tag?
+ same-flag?
+ same-value?))))
(#e.Error error)
(exec (log! error)