diff options
| -rw-r--r-- | stdlib/source/lux/test.lux | 40 |
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)))))))) |