From 6eb9cf17f161522d4eddf6783284952f8a84f099 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 15 Apr 2018 02:24:27 -0400 Subject: - Fixes for R back-end. --- new-luxc/test/test/luxc/lang/translation/case.lux | 15 +++- .../test/test/luxc/lang/translation/common.lux | 81 ++++++++++++++-------- .../test/test/luxc/lang/translation/function.lux | 10 +-- .../test/test/luxc/lang/translation/structure.lux | 21 +++--- 4 files changed, 84 insertions(+), 43 deletions(-) (limited to 'new-luxc/test') 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/= ( param subject) (:! Nat valueT)) (#e.Error error) - false) + (exec (log! error) + false)) (let [param ])))] ["lux bit and" bit.and param] @@ -49,7 +50,8 @@ (n/= (bit.count subject) (:! Nat valueT)) (#e.Error error) - false))) + (exec (log! error) + false)))) (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/= (:! Nat valueT)) (#e.Error error) - false)))] + (exec (log! error) + false))))] ["lux nat min" nat/bottom] ["lux nat max" nat/top] @@ -90,7 +94,8 @@ ( ( subject) (:! valueT)) (#e.Error error) - false) + (exec (log! error) + false)) (let [subject ])))] ["lux nat to-int" Int nat-to-int i/= subject] @@ -103,7 +108,8 @@ ( ( param subject) (:! valueT)) (#e.Error error) - false)))] + (exec (log! error) + false))))] ["lux nat +" n/+ Nat n/=] ["lux nat -" n/- Nat n/=] @@ -130,7 +136,8 @@ (i/= (:! Int valueT)) (#e.Error error) - false)))] + (exec (log! error) + false))))] ["lux int min" int/bottom] ["lux int max" int/top] @@ -142,7 +149,8 @@ ( ( subject) (:! 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 @@ ( ( param subject) (:! 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 ) (#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 @@ ( ( param subject) (:! 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 [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 [[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) -- cgit v1.2.3