From 867a1915f1daa7942ffd3fe07bec80467996dd49 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 21 Dec 2016 00:21:22 -0400
Subject: - Can specify how many times a property-based/generative test is
 supposed to run.

---
 stdlib/source/lux/test.lux | 40 +++++++++++++++++++++++++---------------
 1 file changed, 25 insertions(+), 15 deletions(-)

(limited to 'stdlib/source')

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))))))))
-- 
cgit v1.2.3