aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test/test/luxc/lang/translation/common.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/test/test/luxc/lang/translation/common.lux352
1 files changed, 0 insertions, 352 deletions
diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux
deleted file mode 100644
index 1e671aa96..000000000
--- a/new-luxc/test/test/luxc/lang/translation/common.lux
+++ /dev/null
@@ -1,352 +0,0 @@
-(.module:
- [lux #*
- [control
- [monad (#+ do)]
- pipe]
- [data
- ["." error (#+ Error)]
- [bit ("bit/." Equivalence<Bit>)]
- [number ("frac/." Number<Frac> Interval<Frac>)
- ["." i64]]
- ["." text ("text/." Equivalence<Text>)
- format]
- [collection
- ["." list]]]
- [math
- ["r" random (#+ Random)]]
- [compiler
- [default
- ["." reference]
- [phase
- ["." synthesis]]]]
- test]
- [test
- [luxc
- ["." common (#+ Runner)]]]
- [//
- ["&" function]])
-
-(def: (bit-spec run)
- (-> Runner Test)
- (do r.Monad<Random>
- [param r.i64
- subject r.i64]
- (with-expansions [<binary> (template [<name> <reference> <param-expr>]
- [(test <name>
- (|> (run (#synthesis.Extension <name> (list (synthesis.i64 subject)
- (synthesis.i64 param))))
- (case> (#error.Success valueT)
- (n/= (<reference> param subject) (:coerce Nat valueT))
-
- (#error.Error error)
- #0)
- (let [param <param-expr>])))]
-
- ["lux bit and" i64.and param]
- ["lux bit or" i64.or param]
- ["lux bit xor" i64.xor param]
- ["lux bit left-shift" i64.left-shift (n/% 64 param)]
- ["lux bit logical-right-shift" i64.logical-right-shift (n/% 64 param)]
- )]
- ($_ seq
- <binary>
- (test "lux bit arithmetic-right-shift"
- (|> (run (#synthesis.Extension "lux bit arithmetic-right-shift"
- (list (synthesis.i64 subject)
- (synthesis.i64 param))))
- (case> (#error.Success valueT)
- ("lux i64 ="
- (i64.arithmetic-right-shift param subject)
- (:coerce I64 valueT))
-
- (#error.Error error)
- #0)
- (let [param (n/% 64 param)])))
- ))))
-
-(def: (i64-spec run)
- (-> Runner Test)
- (do r.Monad<Random>
- [param (|> r.i64 (r.filter (|>> ("lux i64 =" 0) not)))
- subject r.i64]
- (`` ($_ seq
- (~~ (template [<name> <type> <prepare> <comp> <subject-expr>]
- [(test <name>
- (|> (run (#synthesis.Extension <name> (list (synthesis.i64 subject))))
- (case> (#error.Success valueT)
- (<comp> (<prepare> subject) (:coerce <type> valueT))
-
- (#error.Error error)
- #0)
- (let [subject <subject-expr>])))]
-
- ["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))]
- ))
- (~~ (template [<name> <reference> <outputT> <comp>]
- [(test <name>
- (|> (run (#synthesis.Extension <name> (list (synthesis.i64 subject)
- (synthesis.i64 param))))
- (case> (#error.Success valueT)
- (<comp> (<reference> param subject) (:coerce <outputT> valueT))
-
- (#error.Error error)
- #0)))]
-
- ["lux i64 +" i/+ Int i/=]
- ["lux i64 -" i/- Int i/=]
- ["lux i64 *" i/* Int i/=]
- ["lux i64 /" i// Int i/=]
- ["lux i64 %" i/% Int i/=]
- ["lux i64 =" i/= Bit bit/=]
- ["lux i64 <" i/< Bit bit/=]
- ))
- ))))
-
-(def: simple-frac
- (Random Frac)
- (|> r.nat (:: r.Monad<Random> map (|>> (n/% 1000) .int int-to-frac))))
-
-(def: (f64-spec run)
- (-> Runner Test)
- (do r.Monad<Random>
- [param (|> ..simple-frac (r.filter (|>> (f/= +0.0) not)))
- subject ..simple-frac]
- (`` ($_ seq
- (~~ (template [<name> <reference> <comp>]
- [(test <name>
- (|> (run (#synthesis.Extension <name> (list (synthesis.f64 subject)
- (synthesis.f64 param))))
- (&.check (<reference> param subject))))]
-
- ["lux f64 +" f/+ f/=]
- ["lux f64 -" f/- f/=]
- ["lux f64 *" f/* f/=]
- ["lux f64 /" f// f/=]
- ["lux f64 %" f/% f/=]
- ))
- (~~ (template [<name> <text>]
- [(test <name>
- (|> (run (#synthesis.Extension <name> (list (synthesis.f64 subject)
- (synthesis.f64 param))))
- (case> (#error.Success valueV)
- (bit/= (<text> param subject)
- (:coerce Bit valueV))
-
- _
- #0)))]
-
- ["lux f64 =" f/=]
- ["lux f64 <" f/<]
- ))
- (~~ (template [<name> <reference>]
- [(test <name>
- (|> (run (#synthesis.Extension <name> (list)))
- (&.check <reference>)))]
-
- ["lux f64 min" frac/bottom]
- ["lux f64 max" frac/top]
- ["lux f64 smallest" ("lux frac smallest")]
- ))
- (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")))
- (&.check subject)))
- ))))
-
-(def: (text-spec run)
- (-> Runner Test)
- (do r.Monad<Random>
- [sample-size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))
- sample-lower (r.ascii/lower-alpha sample-size)
- sample-upper (r.ascii/upper-alpha sample-size)
- sample-alpha (|> (r.ascii/alpha sample-size)
- (r.filter (|>> (text/= sample-upper) not)))
- char-idx (|> r.nat (:: @ map (n/% sample-size)))
- #let [sample-lowerS (synthesis.text sample-lower)
- sample-upperS (synthesis.text sample-upper)
- sample-alphaS (synthesis.text sample-alpha)
- concatenatedS (#synthesis.Extension "lux text concat" (list sample-lowerS sample-upperS))
- pre-rep-once (format sample-lower sample-upper)
- post-rep-once (format sample-lower sample-alpha)
- pre-rep-all (|> (list.repeat sample-size sample-lower) (text.join-with sample-upper))
- post-rep-all (|> (list.repeat sample-size sample-lower) (text.join-with sample-alpha))]]
- ($_ seq
- (test "Can compare texts for equality."
- (and (|> (run (#synthesis.Extension "lux text =" (list sample-lowerS sample-lowerS)))
- (case> (#error.Success valueV)
- (:coerce Bit valueV)
-
- _
- #0))
- (|> (run (#synthesis.Extension "lux text =" (list sample-lowerS sample-upperS)))
- (case> (#error.Success valueV)
- (not (:coerce Bit valueV))
-
- _
- #0))))
- (test "Can compare texts for order."
- (|> (run (#synthesis.Extension "lux text <" (list sample-upperS sample-lowerS)))
- (case> (#error.Success valueV)
- (:coerce Bit valueV)
-
- (#error.Error error)
- #0)))
- (test "Can get length of text."
- (|> (run (#synthesis.Extension "lux text size" (list sample-lowerS)))
- (case> (#error.Success valueV)
- (n/= sample-size (:coerce Nat valueV))
-
- _
- #0)))
- (test "Can concatenate text."
- (|> (run (#synthesis.Extension "lux text size" (list concatenatedS)))
- (case> (#error.Success valueV)
- (n/= (n/* 2 sample-size) (:coerce Nat valueV))
-
- _
- #0)))
- (test "Can find index of sub-text."
- (and (|> (run (#synthesis.Extension "lux text index"
- (list concatenatedS sample-lowerS
- (synthesis.i64 +0))))
- (case> (^multi (#error.Success valueV)
- [(:coerce (Maybe Nat) valueV) (#.Some valueV)])
- (n/= 0 valueV)
-
- _
- #0))
- (|> (run (#synthesis.Extension "lux text index"
- (list concatenatedS sample-upperS
- (synthesis.i64 +0))))
- (case> (^multi (#error.Success valueV)
- [(:coerce (Maybe Nat) valueV) (#.Some valueV)])
- (n/= sample-size valueV)
-
- _
- #0))))
- (let [test-clip (: (-> (I64 Any) (I64 Any) Text Bit)
- (function (_ from to expected)
- (|> (run (#synthesis.Extension "lux text clip"
- (list concatenatedS
- (synthesis.i64 from)
- (synthesis.i64 to))))
- (case> (^multi (#error.Success valueV)
- [(:coerce (Maybe Text) valueV) (#.Some valueV)])
- (text/= expected valueV)
-
- _
- #0))))]
- (test "Can clip text to extract sub-text."
- (and (test-clip 0 sample-size sample-lower)
- (test-clip sample-size (n/* 2 sample-size) sample-upper))))
- (test "Can extract individual characters from text."
- (|> (run (#synthesis.Extension "lux text char"
- (list sample-lowerS
- (synthesis.i64 char-idx))))
- (case> (^multi (#error.Success valueV)
- [(:coerce (Maybe Int) valueV) (#.Some valueV)])
- (text.contains? ("lux int char" valueV)
- sample-lower)
-
- _
- #0)))
- )))
-
-(def: (io-spec run)
- (-> Runner Test)
- (do r.Monad<Random>
- [message (r.ascii/alpha 5)]
- ($_ seq
- (test "Can log messages."
- (|> (run (#synthesis.Extension "lux io log"
- (list (synthesis.text (format "LOG: " message)))))
- (case> (#error.Success valueV)
- #1
-
- (#error.Error error)
- #0)))
- (test "Can throw runtime errors."
- (and (|> (run (#synthesis.Extension "lux try"
- (list (synthesis.function/abstraction
- {#synthesis.environment (list)
- #synthesis.arity 1
- #synthesis.body (#synthesis.Extension "lux io error"
- (list (synthesis.text message)))}))))
- (case> (^multi (#error.Success valueV)
- [(:coerce (Error Text) valueV) (#error.Error error)])
- (text.contains? message error)
-
- _
- #0))
- (|> (run (#synthesis.Extension "lux try"
- (list (synthesis.function/abstraction
- {#synthesis.environment (list)
- #synthesis.arity 1
- #synthesis.body (synthesis.text message)}))))
- (case> (^multi (#error.Success valueV)
- [(:coerce (Error Text) valueV) (#error.Success valueV)])
- (text/= message valueV)
-
- _
- #0))))
- (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> (#error.Success valueV)
- (let [[pre post] (:coerce [Nat Nat] valueV)]
- (n/>= pre post))
-
- (#error.Error error)
- #0)))
- )))
-
-(def: (all-specs run)
- (-> Runner Test)
- ($_ seq
- (bit-spec run)
- (i64-spec run)
- (f64-spec run)
- (text-spec run)
- (io-spec run)
- ))
-
-(context: "[JVM] Common extensions."
- (<| (times 100)
- (all-specs common.run-jvm)))
-
-## (context: "[JS] Common extensions."
-## (<| (times 100)
-## (all-specs common.run-js)))
-
-## (context: "[Lua] Common extensions."
-## (<| (times 100)
-## (all-specs common.run-lua)))
-
-## (context: "[Ruby] Common extensions."
-## (<| (times 100)
-## (all-specs common.run-ruby)))
-
-## (context: "[Python] Common extensions."
-## (<| (times 100)
-## (all-specs common.run-python)))
-
-## (context: "[R] Common extensions."
-## (<| (times 100)
-## (all-specs common.run-r)))
-
-## (context: "[Scheme] Common extensions."
-## (<| (times 100)
-## (all-specs common.run-scheme)))
-
-## (context: "[Common Lisp] Common extensions."
-## (<| (times 100)
-## (all-specs common.run-common-lisp)))
-
-## (context: "[PHP] Common extensions."
-## (<| (times 100)
-## (all-specs common.run-php)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-16 22:25:49 +0000