aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux/math/number/ratio.lux30
-rw-r--r--stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux5
-rw-r--r--stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/field/variable/count.lux139
-rw-r--r--stdlib/source/test/lux/world/time/series.lux2
4 files changed, 170 insertions, 6 deletions
diff --git a/stdlib/source/test/lux/math/number/ratio.lux b/stdlib/source/test/lux/math/number/ratio.lux
index 9ace5ca49..f350168d6 100644
--- a/stdlib/source/test/lux/math/number/ratio.lux
+++ b/stdlib/source/test/lux/math/number/ratio.lux
@@ -43,10 +43,24 @@
..part)]
(in (/.ratio numerator denominator))))
+(def (identical? reference exemplar)
+ (-> /.Ratio /.Ratio
+ Bit)
+ (and (n.= (the /.#numerator reference)
+ (the /.#numerator exemplar))
+ (n.= (the /.#denominator reference)
+ (the /.#denominator exemplar))))
+
+(def (normal? it)
+ (-> /.Ratio
+ Bit)
+ (identical? it (/.normal it)))
+
(def .public test
Test
(<| (_.covering /._)
- (_.for [/.Ratio])
+ (_.for [/.Ratio
+ /.#numerator /.#denominator])
(`` (all _.and
(_.for [/.equivalence /.=]
(equivalenceT.spec /.equivalence ..random))
@@ -65,12 +79,20 @@
(arithmeticT.spec /.equivalence /.arithmetic ..random))
(do random.monad
- [.let [(open "#[0]") /.equivalence]
+ [.let [(open "/#[0]") /.equivalence]
denom/0 ..part
denom/1 ..part]
(_.coverage [/.ratio]
- (#= (/.ratio 0 denom/0)
- (/.ratio 0 denom/1))))
+ (/#= (/.ratio 0 denom/0)
+ (/.ratio 0 denom/1))))
+ (do [! random.monad]
+ [.let [(open "/#[0]") /.equivalence]
+ before_normal (random.and ..part ..part)]
+ (_.coverage [/.normal]
+ (or (normal? before_normal)
+ (let [it (/.normal before_normal)]
+ (and (normal? it)
+ (/#= before_normal it))))))
(do random.monad
[numerator ..part
denominator (random.only (|>> (n#= 1) not)
diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux
index 4571d75d3..81cfb675e 100644
--- a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux
+++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function.lux
@@ -40,7 +40,9 @@
[/
[field
[constant
- ["[0]T" arity]]]
+ ["[0]T" arity]]
+ [variable
+ ["[0]T" count]]]
[//
["[0]T" complex]]])
@@ -143,4 +145,5 @@
multiple_applications!)))
arityT.test
+ countT.test
)))
diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/field/variable/count.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/field/variable/count.lux
new file mode 100644
index 000000000..974851bfd
--- /dev/null
+++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/field/variable/count.lux
@@ -0,0 +1,139 @@
+... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/.
+
+(.require
+ [library
+ [lux (.except)
+ [abstract
+ [monad (.only do)]]
+ [control
+ ["[0]" io]
+ ["[0]" try (.use "[1]#[0]" functor)]
+ ["[0]" function]]
+ [data
+ ["[0]" bit (.use "[1]#[0]" equivalence)]
+ [collection
+ ["[0]" list]]]
+ [math
+ ["[0]" random (.only Random)]
+ [number
+ ["n" nat (.use "[1]#[0]" equivalence)]]]
+ [meta
+ ["[0]" location]
+ [compiler
+ [target
+ [jvm
+ ["!" bytecode]
+ ["[0]" type]]]
+ [meta
+ ["[0]" archive]]]]
+ [test
+ ["_" property (.only Test)]]]]
+ [\\library
+ ["[0]" / (.only)
+ [///
+ [constant
+ ["[0]" arity]]
+ [//
+ ["[0]" abstract]
+ [///
+ ["[0]" jvm (.only)
+ ["[0]" host]
+ ["[0]" runtime]
+ ["[0]" value]
+ ["[0]" complex
+ ["[1]T" \\test]]
+ [///
+ ["[0]" extension]
+ [//
+ ["[0]" phase]
+ ["[0]" synthesis]
+ ["[0]" translation]]]]]]]]])
+
+(def .public test
+ Test
+ (<| (_.covering /._)
+ (do [! random.monad]
+ [module (random.lower_cased 1)
+
+ expected_bit random.bit
+ expected_i64 random.i64
+
+ .let [extender (is extension.Extender
+ (function (_ _)
+ (undefined)))
+ next (jvm.translate extender complexT.lux)
+ @ [module 0 0]
+ $unit [(-- 0) (-- 0)]]
+
+ arity (of ! each (|>> (n.% arity.maximum) (n.max arity.minimum)) random.nat)
+ partial_application (of ! each (n.% arity) random.nat)])
+ (all _.and
+ (_.coverage [/.field]
+ (when /.field
+ "" false
+ _ true))
+ (_.coverage [/.type]
+ (same? arity.type /.type))
+ (_.coverage [/.initial]
+ (let [[_ host] (io.run! host.host)]
+ (|> (all !.composite
+ /.initial
+ !.i2l
+ (value.boxed type.long))
+ [{.#None}]
+ (of host evaluate $unit)
+ (try#each (|>> (as Nat) (n#= 0)))
+ (try.else false))))
+ (_.coverage [/.value]
+ (let [fresh_abstraction!
+ (|> (do try.monad
+ [[_ archive] (archive.reserve "" archive.empty)
+ [_ archive] (archive.reserve module archive)
+ .let [[_ host] (io.run! host.host)
+ state (is runtime.State
+ (translation.state host module))]]
+ (<| (phase.result state)
+ (do phase.monad
+ [_ (translation.set_buffer translation.empty_buffer)
+ it (next archive (<| (synthesis.function/abstraction @)
+ [(list) arity (synthesis.i64 @ expected_i64)]))]
+ (in (|> (all !.composite
+ it
+ /.value
+ !.i2l
+ (value.boxed type.long))
+ [{.#None}]
+ (of host evaluate $unit)
+ (try#each (|>> (as Nat) (n#= 0)))
+ (try.else false))))))
+ (try.else false))
+
+ partial_application!
+ (|> (do try.monad
+ [[_ archive] (archive.reserve "" archive.empty)
+ [_ archive] (archive.reserve module archive)
+ .let [[_ host] (io.run! host.host)
+ state (is runtime.State
+ (translation.state host module))]]
+ (<| (phase.result state)
+ (do phase.monad
+ [_ (translation.set_buffer translation.empty_buffer)
+ it (next archive (<| (synthesis.function/apply @)
+ [(<| (synthesis.function/abstraction @)
+ [(list) arity (synthesis.i64 @ expected_i64)])
+ (list.repeated partial_application (synthesis.bit @ expected_bit))]))]
+ (in (|> (all !.composite
+ it
+ (!.checkcast abstract.class)
+ /.value
+ !.i2l
+ (value.boxed type.long))
+ [{.#None}]
+ (of host evaluate $unit)
+ (try#each (|>> (as Nat) (n#= partial_application)))
+ (try.else false))))))
+ (try.else false))]
+ (and fresh_abstraction!
+ partial_application!)))
+ )))
diff --git a/stdlib/source/test/lux/world/time/series.lux b/stdlib/source/test/lux/world/time/series.lux
index f0aa57216..248403d75 100644
--- a/stdlib/source/test/lux/world/time/series.lux
+++ b/stdlib/source/test/lux/world/time/series.lux
@@ -66,7 +66,7 @@
Test
(<| (_.covering /._)
(do [! random.monad]
- [expected_size (of ! each (|>> (n.% 10) ++) random.nat)
+ [expected_size (of ! each (|>> (n.% 10) (n.+ 2)) random.nat)
expected_series (..random expected_size random.nat)
before random.nat