aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/test.lux40
1 files changed, 25 insertions, 15 deletions
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index 46bdb22f8..26da71865 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -112,8 +112,12 @@
random-test))
## [Syntax]
+(type: Test-Config
+ (#Seed Nat)
+ (#Times Nat))
+
(type: Property-Test
- {#seed (Maybe Nat)
+ {#seed (Maybe Test-Config)
#bindings (List [AST AST])
#body AST})
@@ -121,16 +125,19 @@
(#Property Property-Test)
(#Simple AST))
-(def: seed^
- (Syntax Nat)
- (do s;Monad<Syntax>
- [_ (s;tag! ["" "seed"])]
- s;nat))
+(def: config^
+ (Syntax Test-Config)
+ (s;alt (do s;Monad<Syntax>
+ [_ (s;tag! ["" "seed"])]
+ s;nat)
+ (do s;Monad<Syntax>
+ [_ (s;tag! ["" "times"])]
+ s;nat)))
(def: property-test^
(Syntax Property-Test)
($_ s;seq
- (s;opt seed^)
+ (s;opt config^)
(s;tuple (s;some (s;seq s;any s;any)))
s;any))
@@ -167,16 +174,19 @@
[(_> -1)])))
)))}
(let [body (case body
- (#Property seed bindings body)
- (let [=seed (case seed
- #;None
- (` #;None)
-
- (#;Some value)
- (` (#;Some (~ (ast;nat value)))))
+ (#Property config bindings body)
+ (let [[=seed =times] (case config
+ #;None
+ [(` #;None) +100]
+
+ (#;Some (#Seed value))
+ [(` (#;Some (~ (ast;nat value)))) +100]
+
+ (#;Some (#Times value))
+ [(` #;None) value])
bindings' (|> bindings (List/map pair-to-list) List/join)]
(` (repeat (~ =seed)
- +100
+ (~ (ast;nat =times))
(do R;Monad<Random>
[(~@ bindings')]
((~' wrap) (;;try-body (io;io (~ body))))))))