From 425148d29846ba507599b220d4df05c805e8d38a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 11 Aug 2018 19:46:17 -0400 Subject: Fixed various JVM translation tests. --- new-luxc/test/test/luxc/common.lux | 58 +++++------ .../test/test/luxc/lang/translation/common.lux | 114 ++++++++++----------- .../test/test/luxc/lang/translation/primitive.lux | 15 ++- .../test/test/luxc/lang/translation/reference.lux | 9 +- new-luxc/test/tests.lux | 12 +-- 5 files changed, 101 insertions(+), 107 deletions(-) (limited to 'new-luxc/test') diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux index 7b370ab21..f694d81bd 100644 --- a/new-luxc/test/test/luxc/common.lux +++ b/new-luxc/test/test/luxc/common.lux @@ -5,15 +5,10 @@ ["." io (#+ IO)] [data [error (#+ Error)]] - ["." macro - ["." code]] [compiler - ["." default + [default ["." reference] - ["." init] ["." phase - ["." analysis - ["." module]] ["." synthesis (#+ Synthesis)] ["." translation] [extension @@ -26,40 +21,32 @@ ["." jvm ["._jvm" runtime] ["._jvm" expression] - ## ["._jvm" statement] - ] + [procedure + ["._jvm" common]]] ## [js] ## (js ["._js" expression] - ## ["._js" runtime] - ## ["._js" statement]) + ## ["._js" runtime]) ## [lua] ## (lua ["._lua" expression] - ## ["._lua" runtime] - ## ["._lua" statement]) + ## ["._lua" runtime]) ## [ruby] ## (ruby ["._ruby" expression] - ## ["._ruby" runtime] - ## ["._ruby" statement]) + ## ["._ruby" runtime]) ## [python] ## (python ["._python" expression] - ## ["._python" runtime] - ## ["._python" statement]) + ## ["._python" runtime]) ## [r] ## (r ["._r" expression] - ## ["._r" runtime] - ## ["._r" statement]) + ## ["._r" runtime]) ## [scheme] ## (scheme ["._scheme" expression] - ## ["._scheme" runtime] - ## ["._scheme" statement]) + ## ["._scheme" runtime]) ## [common-lisp] ## (common-lisp ["._common-lisp" expression] - ## ["._common-lisp" runtime] - ## ["._common-lisp" statement]) + ## ["._common-lisp" runtime]) ## [php] ## (php ["._php" expression] - ## ["._php" runtime] - ## ["._php" statement]) + ## ["._php" runtime]) ]]]) (type: #export Runner (-> Synthesis (Error Any))) @@ -84,26 +71,29 @@ (def: (runner generate-runtime translate bundle state) (-> (Operation Any) Phase Bundle (IO State) Runner) - (function (_ synthesis) + (function (_ valueS) (|> (do phase.Monad [_ generate-runtime - program (translate synthesis)] - (translation.evaluate! program)) + program (translate valueS)] + (translation.evaluate! "runner" program)) + translation.with-buffer (phase.run [bundle (io.run state)])))) (def: (definer generate-runtime translate bundle state) (-> (Operation Any) Phase Bundle (IO State) Definer) - (function (_ name synthesis) + (function (_ lux-name valueS) (|> (do phase.Monad [_ generate-runtime - valueS (translate synthesis) - _ (translation.define! name valueS) - program (translate (synthesis.constant name))] - (translation.evaluate! program)) + valueH (translate valueS) + [host-name host-value] (translation.define! lux-name valueH) + _ (translation.learn lux-name host-name) + program (translate (synthesis.constant lux-name))] + (translation.evaluate! "definer" program)) + translation.with-buffer (phase.run [bundle (io.run state)])))) -(def: #export run-jvm (runner runtime_jvm.translate expression_jvm.translate bundle.empty init-jvm)) -(def: #export def-jvm (definer runtime_jvm.translate expression_jvm.translate bundle.empty init-jvm)) +(def: #export run-jvm (runner runtime_jvm.translate expression_jvm.translate common_jvm.bundle init-jvm)) +(def: #export def-jvm (definer runtime_jvm.translate expression_jvm.translate common_jvm.bundle init-jvm)) ## (def: #export run-js (runner runtime_js.translate expression_js.translate bundle.empty init-js)) ## (def: #export def-js (definer runtime_js.translate expression_js.translate bundle.empty init-js)) diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux index f03965de2..246598072 100644 --- a/new-luxc/test/test/luxc/lang/translation/common.lux +++ b/new-luxc/test/test/luxc/lang/translation/common.lux @@ -4,7 +4,7 @@ [monad (#+ do)] pipe] [data - ["e" error] + ["." error (#+ Error)] [bit ("bit/." Equivalence)] [number ("frac/." Number Interval) ["." i64]] @@ -33,10 +33,10 @@ [(test (|> (run (#synthesis.Extension (list (synthesis.i64 subject) (synthesis.i64 param)))) - (case> (#e.Success valueT) + (case> (#error.Success valueT) (n/= ( param subject) (:coerce Nat valueT)) - (#e.Error error) + (#error.Error error) (exec (log! error) #0)) (let [param ])))] @@ -53,12 +53,12 @@ (|> (run (#synthesis.Extension "lux bit arithmetic-right-shift" (list (synthesis.i64 subject) (synthesis.i64 param)))) - (case> (#e.Success valueT) + (case> (#error.Success valueT) ("lux i64 =" (i64.arithmetic-right-shift param subject) (:coerce I64 valueT)) - (#e.Error error) + (#error.Error error) (exec (log! error) #0)) (let [param (n/% 64 param)]))) @@ -73,31 +73,30 @@ (~~ (do-template [ ] [(test (|> (run (#synthesis.Extension (list (synthesis.i64 subject)))) - (case> (#e.Success valueT) + (case> (#error.Success valueT) ( ( subject) (:coerce valueT)) - (#e.Error error) + (#error.Error error) (exec (log! error) #0)) (let [subject ])))] - ["lux i64 to-frac" Frac int-to-frac f/= subject] - ["lux i64 char" Text (|>> (:coerce Nat) text.from-code) text/= (|> subject - (:coerce Nat) - (n/% (i64.left-shift 8 1)) - (:coerce Int))] + ["lux i64 to-f64" Frac int-to-frac f/= subject] + ["lux i64 char" Text (|>> (:coerce Nat) text.from-code) text/= (|> subject + (:coerce Nat) + (n/% (i64.left-shift 8 1)) + (:coerce Int))] )) (~~ (do-template [ ] [(test - (exec (log! ) - (|> (run (#synthesis.Extension (list (synthesis.i64 subject) - (synthesis.i64 param)))) - (case> (#e.Success valueT) - ( ( param subject) (:coerce valueT)) + (|> (run (#synthesis.Extension (list (synthesis.i64 subject) + (synthesis.i64 param)))) + (case> (#error.Success valueT) + ( ( param subject) (:coerce valueT)) - (#e.Error error) - (exec (log! error) - #0)))))] + (#error.Error error) + (exec (log! error) + #0))))] ["lux i64 +" i/+ Int i/=] ["lux i64 -" i/- Int i/=] @@ -118,7 +117,7 @@ [(test (|> (run (#synthesis.Extension (list (synthesis.f64 subject) (synthesis.f64 param)))) - (case> (#e.Success valueT) + (case> (#error.Success valueT) ( ( param subject) (:coerce valueT)) _ @@ -139,12 +138,12 @@ (def: (f64-spec/1 run) (-> Runner Test) (do r.Monad - [subject r.frac] + [subject (|> r.nat (:: @ map (|>> (n/% 1000) .int int-to-frac)))] (`` ($_ seq (~~ (do-template [ ] [(test (|> (run (#synthesis.Extension (list))) - (case> (#e.Success valueT) + (case> (#error.Success valueT) ( (:coerce Frac valueT)) _ @@ -154,19 +153,16 @@ ["lux f64 max" (f/= frac/top)] ["lux f64 smallest" (f/= ("lux frac smallest"))] )) - (~~ (do-template [ ] - [(test - (|> (run (|> subject synthesis.f64 - (list) (#synthesis.Extension ) - (list) (#synthesis.Extension ))) - (case> (#e.Success valueT) - (|> valueT (:coerce Frac) (f/- subject) frac/abs ) - - (#e.Error error) - (exec (log! error) - #0))))] - - ["lux f64 to-int" "lux i64 to-frac" (f/< +1.0)])) + (test "\"lux f64 to-i64\" && \"lux i64 to-f64\"" + (|> (run (|> subject synthesis.f64 + (list) (#synthesis.Extension "lux f64 to-i64") + (list) (#synthesis.Extension "lux i64 to-f64"))) + (case> (#error.Success valueT) + (f/= subject (:coerce Frac valueT)) + + (#error.Error error) + (exec (log! error) + #0)))) )))) (def: (f64-spec run) @@ -195,34 +191,35 @@ ($_ seq (test "Can compare texts for equality." (and (|> (run (#synthesis.Extension "lux text =" (list sample0S sample0S))) - (case> (#e.Success valueV) + (case> (#error.Success valueV) (:coerce Bit valueV) _ #0)) (|> (run (#synthesis.Extension "lux text =" (list sample0S sample1S))) - (case> (#e.Success valueV) + (case> (#error.Success valueV) (not (:coerce Bit valueV)) _ #0)))) (test "Can compare texts for order." (|> (run (#synthesis.Extension "lux text <" (list sample1S sample0S))) - (case> (#e.Success valueV) + (case> (#error.Success valueV) (:coerce Bit valueV) - _ - #0))) + (#error.Error error) + (exec (log! error) + #0)))) (test "Can get length of text." (|> (run (#synthesis.Extension "lux text size" (list sample0S))) - (case> (#e.Success valueV) + (case> (#error.Success valueV) (n/= sample-size (:coerce Nat valueV)) _ #0))) (test "Can concatenate text." (|> (run (#synthesis.Extension "lux text size" (list concatenatedS))) - (case> (#e.Success valueV) + (case> (#error.Success valueV) (n/= (n/* 2 sample-size) (:coerce Nat valueV)) _ @@ -230,8 +227,8 @@ (test "Can find index of sub-text." (and (|> (run (#synthesis.Extension "lux text index" (list concatenatedS sample0S - (synthesis.i64 0)))) - (case> (^multi (#e.Success valueV) + (synthesis.i64 +0)))) + (case> (^multi (#error.Success valueV) [(:coerce (Maybe Nat) valueV) (#.Some valueV)]) (n/= 0 valueV) @@ -239,8 +236,8 @@ #0)) (|> (run (#synthesis.Extension "lux text index" (list concatenatedS sample1S - (synthesis.i64 0)))) - (case> (^multi (#e.Success valueV) + (synthesis.i64 +0)))) + (case> (^multi (#error.Success valueV) [(:coerce (Maybe Nat) valueV) (#.Some valueV)]) (n/= sample-size valueV) @@ -252,7 +249,7 @@ (list concatenatedS (synthesis.i64 from) (synthesis.i64 to)))) - (case> (^multi (#e.Success valueV) + (case> (^multi (#error.Success valueV) [(:coerce (Maybe Text) valueV) (#.Some valueV)]) (text/= expected valueV) @@ -265,7 +262,7 @@ (|> (run (#synthesis.Extension "lux text char" (list sample0S (synthesis.i64 char-idx)))) - (case> (^multi (#e.Success valueV) + (case> (^multi (#error.Success valueV) [(:coerce (Maybe Int) valueV) (#.Some valueV)]) (text.contains? ("lux int char" valueV) sample0) @@ -282,10 +279,10 @@ (test "Can log messages." (|> (run (#synthesis.Extension "lux io log" (list (synthesis.text (format "LOG: " message))))) - (case> (#e.Success valueV) + (case> (#error.Success valueV) #1 - (#e.Error error) + (#error.Error error) (exec (log! error) #0)))) (test "Can throw runtime errors." @@ -295,8 +292,8 @@ #synthesis.arity 1 #synthesis.body (#synthesis.Extension "lux io error" (list (synthesis.text message)))})))) - (case> (^multi (#e.Success valueV) - [(:coerce (e.Error Text) valueV) (#e.Error error)]) + (case> (^multi (#error.Success valueV) + [(:coerce (Error Text) valueV) (#error.Error error)]) (text.contains? message error) _ @@ -305,10 +302,9 @@ (list (synthesis.function/abstraction {#synthesis.environment (list) #synthesis.arity 1 - #synthesis.body (#synthesis.Extension "lux io error" - (list (synthesis.text message)))})))) - (case> (^multi (#e.Success valueV) - [(:coerce (e.Error Text) valueV) (#e.Success valueV)]) + #synthesis.body (synthesis.text message)})))) + (case> (^multi (#error.Success valueV) + [(:coerce (Error Text) valueV) (#error.Success valueV)]) (text/= message valueV) _ @@ -316,11 +312,11 @@ (test "Can obtain current time in milli-seconds." (|> (run (synthesis.tuple (list (#synthesis.Extension "lux io current-time" (list)) (#synthesis.Extension "lux io current-time" (list))))) - (case> (#e.Success valueV) + (case> (#error.Success valueV) (let [[pre post] (:coerce [Nat Nat] valueV)] (n/>= pre post)) - (#e.Error error) + (#error.Error error) (exec (log! error) #0)))) ))) diff --git a/new-luxc/test/test/luxc/lang/translation/primitive.lux b/new-luxc/test/test/luxc/lang/translation/primitive.lux index 08fab78aa..ee8e53d5e 100644 --- a/new-luxc/test/test/luxc/lang/translation/primitive.lux +++ b/new-luxc/test/test/luxc/lang/translation/primitive.lux @@ -6,6 +6,7 @@ [data ["." error] [bit ("bit/." Equivalence)] + ["." number] [text ("text/." Equivalence) format]] [math @@ -19,6 +20,12 @@ [luxc common]]) +(def: (f/=' reference subject) + (-> Frac Frac Bit) + (or (f/= reference subject) + (and (number.not-a-number? reference) + (number.not-a-number? subject)))) + (def: (spec run) (-> Runner Test) (do r.Monad @@ -38,13 +45,13 @@ ["bit" Bit synthesis.bit |bit| bit/=] ["int" Int synthesis.i64 |i64| i/=] - ["frac" Frac synthesis.f64 |f64| f/=] - ["text" Text synthesis.text |text| text/=])) + ["frac" Frac synthesis.f64 |f64| f/='] + ["text" Text synthesis.text |text| text/=] + )) )))) (context: "[JVM] Primitives." - (<| (seed 7147645721729046766) - ## (times 100) + (<| (times 100) (spec run-jvm))) ## (context: "[JS] Primitives." diff --git a/new-luxc/test/test/luxc/lang/translation/reference.lux b/new-luxc/test/test/luxc/lang/translation/reference.lux index a10e98ae6..c1a348f76 100644 --- a/new-luxc/test/test/luxc/lang/translation/reference.lux +++ b/new-luxc/test/test/luxc/lang/translation/reference.lux @@ -20,14 +20,15 @@ [// ["&" function]]) -(def: name-part - (r.Random Text) - (r.ascii/alpha 5)) +(def: name^ + (r.Random Name) + (let [name-part (r.ascii/upper-alpha 5)] + [(r.and name-part name-part)])) (def: (definitions-spec define) (-> Definer Test) (do r.Monad - [name (r.and name-part name-part) + [name name^ value r.frac] (test "Can refer to definitions." (|> (define name (synthesis.f64 value)) diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux index 09b95c6b2..04362d4d1 100644 --- a/new-luxc/test/tests.lux +++ b/new-luxc/test/tests.lux @@ -1,17 +1,17 @@ (.module: [lux [cli (#+ program:)] - [test]] + ["." test]] [test [luxc [lang [translation ["_.T" primitive] - ## ["_.T" structure] - ## ["_.T" function] - ## ["_.T" reference] - ## ["_.T" case] - ## ["_.T" common] + ["_.T" structure] + ["_.T" function] + ["_.T" reference] + ["_.T" case] + ["_.T" common] ## ["_.T" jvm] ## ["_.T" js] ## ["_.T" lua] -- cgit v1.2.3