From e0b3538721a71f6e8c016b12c8c257b8cebd3981 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 26 Apr 2019 18:01:12 -0400 Subject: WIP: Turning compiler tests into a re-usable specification. --- .../test/test/luxc/lang/translation/primitive.lux | 87 --------------- .../test/test/luxc/lang/translation/structure.lux | 122 --------------------- 2 files changed, 209 deletions(-) delete mode 100644 new-luxc/test/test/luxc/lang/translation/primitive.lux delete mode 100644 new-luxc/test/test/luxc/lang/translation/structure.lux (limited to 'new-luxc/test') diff --git a/new-luxc/test/test/luxc/lang/translation/primitive.lux b/new-luxc/test/test/luxc/lang/translation/primitive.lux deleted file mode 100644 index f3c6c8fc3..000000000 --- a/new-luxc/test/test/luxc/lang/translation/primitive.lux +++ /dev/null @@ -1,87 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - pipe] - [data - ["." error] - [bit ("bit/." Equivalence)] - ["." number] - [text ("text/." Equivalence) - format]] - [math - ["r" random]] - [compiler - [default - [phase - ["." synthesis]]]] - test] - [test - [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 - [|bit| r.bit - |i64| r.i64 - |f64| r.frac - |text| (r.ascii 5)] - (`` ($_ seq - (~~ (template [ ] - [(test (format "Can translate " ".") - (|> (run ( )) - (case> (#error.Success valueT) - ( (:coerce valueT)) - - (#error.Error error) - false)))] - - ["bit" Bit synthesis.bit |bit| bit/=] - ["int" Int synthesis.i64 |i64| i/=] - ["frac" Frac synthesis.f64 |f64| f/='] - ["text" Text synthesis.text |text| text/=] - )) - )))) - -(context: "[JVM] Primitives." - (<| (times 100) - (spec run-jvm))) - -## (context: "[JS] Primitives." -## (<| (times 100) -## (spec run-js))) - -## (context: "[Lua] Primitives." -## (<| (times 100) -## (spec run-lua))) - -## (context: "[Ruby] Primitives." -## (<| (times 100) -## (spec run-ruby))) - -## (context: "[Python] Primitives." -## (<| (times 100) -## (spec run-python))) - -## (context: "[R] Primitives." -## (<| (times 100) -## (spec run-r))) - -## (context: "[Scheme] Primitives." -## (<| (times 100) -## (spec run-scheme))) - -## (context: "[Common Lisp] Primitives." -## (<| (times 100) -## (spec run-common-lisp))) - -## (context: "[PHP] Primitives." -## (<| (times 100) -## (spec run-php))) diff --git a/new-luxc/test/test/luxc/lang/translation/structure.lux b/new-luxc/test/test/luxc/lang/translation/structure.lux deleted file mode 100644 index c92b132e2..000000000 --- a/new-luxc/test/test/luxc/lang/translation/structure.lux +++ /dev/null @@ -1,122 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - pipe] - [data - ["." error] - ["." maybe] - [text ("text/." Equivalence) - format] - [collection - ["." array (#+ Array)] - ["." list ("list/." Functor)]]] - [math - ["r" random]] - ["." host (#+ import:)] - [compiler - [default - [phase - ["." analysis] - ["." synthesis]]]] - test] - [test - [luxc - common]]) - -(import: java/lang/Integer) - -(def: (tuples-spec run) - (-> Runner Test) - (do r.Monad - [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) - tuple-in (r.list size r.i64)] - (test "Can translate tuple." - (|> (run (synthesis.tuple (list/map (|>> synthesis.i64) tuple-in))) - (case> (#error.Success tuple-out) - (let [tuple-out (:coerce (Array Any) tuple-out)] - (and (n/= size (array.size tuple-out)) - (list.every? (function (_ [left right]) - (i/= left (:coerce Int right))) - (list.zip2 tuple-in (array.to-list tuple-out))))) - - (#error.Error error) - (exec (log! error) - #0)))))) - -(def: (variants-spec run) - (-> Runner Test) - (do r.Monad - [num-tags (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) - tag-in (|> r.nat (:: @ map (n/% num-tags))) - #let [last?-in (|> num-tags dec (n/= tag-in))] - value-in r.i64] - (test "Can translate variant." - (|> (run (synthesis.variant {#analysis.lefts (if last?-in - (dec tag-in) - tag-in) - #analysis.right? last?-in - #analysis.value (synthesis.i64 value-in)})) - (case> (#error.Success valueT) - (let [valueT (:coerce (Array Any) valueT)] - (and (n/= 3 (array.size valueT)) - (let [tag-out (:coerce Integer (maybe.assume (array.read 0 valueT))) - last?-out (array.read 1 valueT) - value-out (:coerce Any (maybe.assume (array.read 2 valueT))) - same-tag? (|> tag-out host.int-to-long (:coerce Nat) (n/= tag-in)) - same-flag? (case last?-out - (#.Some last?-out') - (and last?-in (text/= "" (:coerce Text last?-out'))) - - #.None - (not last?-in)) - same-value? (|> value-out (:coerce Int) (i/= value-in))] - (and same-tag? - same-flag? - same-value?)))) - - (#error.Error error) - (exec (log! error) - #0)))))) - -(def: (structure-spec run) - (-> Runner Test) - ($_ seq - (tuples-spec run) - (variants-spec run))) - -(context: "[JVM] Structures." - (<| (times 100) - (structure-spec run-jvm))) - -## (context: "[JS] Structures." -## (<| (times 100) -## (structure-spec run-js))) - -## (context: "[Lua] Structures." -## (<| (times 100) -## (structure-spec run-lua))) - -## (context: "[Ruby] Structures." -## (<| (times 100) -## (structure-spec run-ruby))) - -## (context: "[Python] Structures." -## (<| (times 100) -## (structure-spec run-python))) - -## (context: "[R] Structures." -## (<| (times 100) -## (structure-spec run-r))) - -## (context: "[Scheme] Structures." -## (<| (times 100) -## (structure-spec run-scheme))) - -## (context: "[Common Lisp] Structures." -## (<| (times 100) -## (structure-spec run-common-lisp))) - -## (context: "[PHP] Structures." -## (<| (times 100) -## (structure-spec run-php))) -- cgit v1.2.3