Proof of concept: allow Debug.log in fuzz tests

src/Test.elm

@@ -23,7 +23,7 @@ module Test exposing
 import Expect exposing (Expectation)
 import Fuzz exposing (Fuzzer)
 import Set
-import Test.Fuzz
+import Test.Fuzz exposing (Meta)
 import Test.Internal as Internal
 import Test.Runner.Failure exposing (InvalidReason(..), Reason(..))
 
@@ -301,7 +301,7 @@ for example like this:
                     |> Expect.equal (List.member target nums)
 
 -}
-fuzzWith : FuzzOptions -> Fuzzer a -> String -> (a -> Expectation) -> Test
+fuzzWith : FuzzOptions -> Fuzzer a -> String -> (Meta x -> a -> Expectation) -> Test
 fuzzWith options fuzzer desc getTest =
     if options.runs < 1 then
         Internal.failNow
@@ -368,7 +368,7 @@ You may find them elsewhere called [property-based tests](http://blog.jessitron.
 fuzz :
     Fuzzer a
     -> String
-    -> (a -> Expectation)
+    -> (Meta x -> a -> Expectation)
     -> Test
 fuzz =
     Test.Fuzz.fuzzTest
@@ -394,14 +394,14 @@ fuzz2 :
     Fuzzer a
     -> Fuzzer b
     -> String
-    -> (a -> b -> Expectation)
+    -> (Meta x -> a -> b -> Expectation)
     -> Test
 fuzz2 fuzzA fuzzB desc =
     let
         fuzzer =
             Fuzz.pair ( fuzzA, fuzzB )
     in
-    (\f ( a, b ) -> f a b) >> fuzz fuzzer desc
+    (\f meta ( a, b ) -> f meta a b) >> fuzz fuzzer desc
 
 
 {-| Run a [fuzz test](#fuzz) using three random inputs.
@@ -414,20 +414,11 @@ fuzz3 :
     -> Fuzzer b
     -> Fuzzer c
     -> String
-    -> (a -> b -> c -> Expectation)
+    -> (Meta x -> a -> b -> c -> Expectation)
     -> Test
 fuzz3 fuzzA fuzzB fuzzC desc =
     let
         fuzzer =
             Fuzz.triple ( fuzzA, fuzzB, fuzzC )
     in
-    uncurry3 >> fuzz fuzzer desc
-
-
-
--- INTERNAL HELPERS --
-
-
-uncurry3 : (a -> b -> c -> d) -> ( a, b, c ) -> d
-uncurry3 fn ( a, b, c ) =
-    fn a b c
+    (\f meta ( a, b, c ) -> f meta a b c) >> fuzz fuzzer desc

src/Test/Fuzz.elm

@@ -1,4 +1,4 @@
-module Test.Fuzz exposing (fuzzTest)
+module Test.Fuzz exposing (Meta, fuzzTest)
 
 import Dict exposing (Dict)
 import Fuzz exposing (Fuzzer)
@@ -11,9 +11,19 @@ import Test.Internal as Internal exposing (Test(..), blankDescriptionFailure, fa
 import Test.Runner.Failure exposing (InvalidReason(..), Reason(..))
 
 
+type alias Meta a =
+    { log : String -> a -> a }
+
+
+noopMeta : Meta a
+noopMeta =
+    { log = \_ a -> a
+    }
+
+
 {-| Reject always-failing tests because of bad names or invalid fuzzers.
 -}
-fuzzTest : Fuzzer a -> String -> (a -> Expectation) -> Test
+fuzzTest : Fuzzer a -> String -> (Meta x -> a -> Expectation) -> Test
 fuzzTest fuzzer untrimmedDesc getExpectation =
     let
         desc =
@@ -37,7 +47,7 @@ fuzzTest fuzzer untrimmedDesc getExpectation =
 
 {-| Knowing that the fuzz test isn't obviously invalid, run the test and package up the results.
 -}
-validatedFuzzTest : ValidFuzzer a -> (a -> Expectation) -> Test
+validatedFuzzTest : ValidFuzzer a -> (Meta x -> a -> Expectation) -> Test
 validatedFuzzTest fuzzer getExpectation =
     FuzzTest
         (\seed runs ->
@@ -56,33 +66,39 @@ type alias Failures =
 
 {-| Runs the specified number of fuzz tests and returns a dictionary of simplified failures.
 -}
-runAllFuzzIterations : ValidFuzzer a -> (a -> Expectation) -> Random.Seed -> Int -> Failures
+runAllFuzzIterations : ValidFuzzer a -> (Meta x -> a -> Expectation) -> Random.Seed -> Int -> Failures
 runAllFuzzIterations fuzzer getExpectation initialSeed totalRuns =
-    runOneFuzzIteration fuzzer getExpectation
-        |> foldUntil totalRuns ( Dict.empty, initialSeed )
-        -- throw away the random seed
-        |> Tuple.first
+    let
+        ( failures, _ ) =
+            runOneFuzzIteration totalRuns fuzzer getExpectation ( Dict.empty, initialSeed )
+    in
+    failures
 
 
 {-| Generate a fuzzed value, test it, and record the simplified test failure if any.
 -}
-runOneFuzzIteration : ValidFuzzer a -> (a -> Expectation) -> ( Failures, Random.Seed ) -> ( Failures, Random.Seed )
-runOneFuzzIteration fuzzer getExpectation ( failures, currentSeed ) =
-    let
-        ( rosetree, nextSeed ) =
-            Random.step fuzzer currentSeed
-
-        newFailures =
-            case testGeneratedValue rosetree getExpectation of
-                Nothing ->
-                    -- test passed, nothing to change
-                    failures
-
-                Just ( k, v ) ->
-                    -- record test failure
-                    Dict.insert k v failures
-    in
-    ( newFailures, nextSeed )
+runOneFuzzIteration : Int -> ValidFuzzer a -> (Meta x -> a -> Expectation) -> ( Failures, Random.Seed ) -> ( Failures, Random.Seed )
+runOneFuzzIteration runsLeft fuzzer getExpectation ( failures, currentSeed ) =
+    if Dict.isEmpty failures == False || runsLeft <= 1 then
+        -- short-circuit on failure so we don't spam 100 copies of all Debug.log messages if they all hit an error
+        ( failures, currentSeed )
+
+    else
+        let
+            ( rosetree, nextSeed ) =
+                Random.step fuzzer currentSeed
+
+            newFailures =
+                case testGeneratedValue rosetree getExpectation of
+                    Nothing ->
+                        -- test passed, nothing to change
+                        failures
+
+                    Just ( k, v ) ->
+                        -- record test failure
+                        Dict.insert k v failures
+        in
+        runOneFuzzIteration (runsLeft - 1) fuzzer getExpectation ( newFailures, nextSeed )
 
 
 {-| Run a function whose inputs are the same as its outputs a given number of times. Requires the initial state to pass
@@ -99,9 +115,9 @@ foldUntil remainingRuns initialState f =
 
 {-| Given a rosetree -- a root to test and branches of simplifications -- run the test and perform simplification if it fails.
 -}
-testGeneratedValue : RoseTree a -> (a -> Expectation) -> Maybe ( String, Expectation )
+testGeneratedValue : RoseTree a -> (Meta x -> a -> Expectation) -> Maybe ( String, Expectation )
 testGeneratedValue rosetree getExpectation =
-    case getExpectation (RoseTree.root rosetree) of
+    case getExpectation noopMeta (RoseTree.root rosetree) of
         Pass ->
             Nothing
 
@@ -111,11 +127,11 @@ testGeneratedValue rosetree getExpectation =
 
 {-| Knowing that the rosetree's root already failed, finds the key and value of the simplest failure.
 -}
-findSimplestFailure : RoseTree a -> (a -> Expectation) -> Expectation -> ( String, Expectation )
+findSimplestFailure : RoseTree a -> (Meta x -> a -> Expectation) -> Expectation -> ( String, Expectation )
 findSimplestFailure (Rose failingValue branches) getExpectation oldExpectation =
     case Lazy.List.headAndTail branches of
         Just ( (Rose possiblyFailingValue _) as firstChild, otherChildren ) ->
-            case getExpectation possiblyFailingValue of
+            case getExpectation noopMeta possiblyFailingValue of
                 -- recurse "horizontally" on other simplifications of the last known failing value
                 -- discard simplifications of the passing value (the _)
                 Pass ->
@@ -128,6 +144,10 @@ findSimplestFailure (Rose failingValue branches) getExpectation oldExpectation =
 
         -- base case: we cannot simplify any more
         Nothing ->
+            let
+                _ =
+                    getExpectation { log = Debug.log } failingValue
+            in
             ( Internal.toString failingValue, oldExpectation )
 
 

src/Test/Internal.elm

@@ -1,6 +1,7 @@
 module Test.Internal exposing (Test(..), blankDescriptionFailure, duplicatedName, failNow, toString)
 
-import Elm.Kernel.Debug
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- import Elm.Kernel.Debug
+
 import Random exposing (Generator)
 import Set exposing (Set)
 import Test.Expectation exposing (Expectation(..))

tests/src/DebugLogTests.elm

@@ -0,0 +1,26 @@
+module DebugLogTests exposing (all)
+
+import Expect exposing (FloatingPointTolerance(..))
+import Fuzz exposing (..)
+import Helpers exposing (..)
+import Test exposing (..)
+
+
+all : Test
+all =
+    describe "Meta Debug.log"
+        [ fuzz fuzzer "debug log for 1-arg fuzzer" <|
+            \meta a ->
+                meta.log (Debug.toString { desc = "fuzz1-meta-log", a = a }) <|
+                    (a |> Expect.notEqual 5)
+        , fuzz2 fuzzer fuzzer "debug log for 2-arg fuzzer" <|
+            \meta a b ->
+                meta.log (Debug.toString { desc = "fuzz2-meta-log", a = a, b = b }) <|
+                    (( a, b ) |> Expect.notEqual ( 2, 5 ))
+        , fuzz3 fuzzer fuzzer fuzzer "debug log for 3-arg fuzzer" <|
+            \meta a b c ->
+                meta.log (Debug.toString { desc = "fuzz3-meta-log", a = a, b = b, c = c }) <|
+                    (( a, b, c ) |> Expect.notEqual ( 2, 3, 5 ))
+        ]
+
+fuzzer = intRange 2 5

tests/src/FloatWithinTests.elm

@@ -11,14 +11,14 @@ floatWithinTests =
     describe "Expect.within"
         [ describe "use-cases"
             [ fuzz float "pythagorean identity" <|
-                \x ->
+                \_ x ->
                     sin x ^ 2 + cos x ^ 2 |> Expect.within (AbsoluteOrRelative 0.000001 0.00001) 1.0
             , test "floats known to not add exactly" <|
                 \_ -> 0.1 + 0.2 |> Expect.within (Absolute 0.000000001) 0.3
             , test "approximation of pi" <|
                 \_ -> 3.14 |> Expect.within (Absolute 0.01) pi
             , fuzz (floatRange 0.000001 100000) "relative tolerance of circle circumference using pi approximation" <|
-                \radius ->
+                \_ radius ->
                     (radius * pi)
                         |> Expect.within (Relative 0.001) (radius * 3.14)
             , test "approximation of pi is not considered too accurate" <|
@@ -30,14 +30,14 @@ floatWithinTests =
                 \() ->
                     expectTestToFail <|
                         fuzz (floatRange 0.000001 100000) "x" <|
-                            \radius ->
+                            \_ radius ->
                                 (radius * pi)
                                     |> Expect.within (Absolute 0.001) (radius * 3.14)
             , test "too high relative tolerance of circle circumference using pi approximation" <|
                 \() ->
                     expectTestToFail <|
                         fuzz (floatRange 0.000001 100000) "x" <|
-                            \radius ->
+                            \_ radius ->
                                 (radius * pi)
                                     |> Expect.within (Relative 0.0001) (radius * 3.14)
             ]
@@ -71,7 +71,7 @@ floatWithinTests =
             ]
         , describe "edge-cases"
             [ fuzz2 float float "self equality" <|
-                \epsilon value ->
+                \_ epsilon value ->
                     let
                         eps =
                             if epsilon /= 0 then
@@ -82,35 +82,35 @@ floatWithinTests =
                     in
                     value |> Expect.within (Relative (abs eps)) value
             , fuzz float "NaN inequality" <|
-                \epsilon ->
+                \_ epsilon ->
                     let
                         nan =
                             0.0 / 0.0
                     in
                     nan |> Expect.notWithin (Relative (abs epsilon)) nan
             , fuzz2 float float "NaN does not equal anything" <|
-                \epsilon a ->
+                \_ epsilon a ->
                     let
                         nan =
                             0.0 / 0.0
                     in
                     nan |> Expect.notWithin (Relative (abs epsilon)) a
             , fuzz float "Infinity equality" <|
-                \epsilon ->
+                \_ epsilon ->
                     let
                         infinity =
                             1.0 / 0.0
                     in
                     infinity |> Expect.within (Relative (abs epsilon)) infinity
             , fuzz float "Negative infinity equality" <|
-                \epsilon ->
+                \_ epsilon ->
                     let
                         negativeInfinity =
                             -1.0 / 0.0
                     in
                     negativeInfinity |> Expect.within (Relative (abs epsilon)) negativeInfinity
             , fuzz3 float float float "within and notWithin should never agree on relative tolerance" <|
-                \epsilon a b ->
+                \_ epsilon a b ->
                     let
                         withinTest =
                             a |> Expect.within (Relative (abs epsilon)) b
@@ -120,7 +120,7 @@ floatWithinTests =
                     in
                     different withinTest notWithinTest
             , fuzz3 float float float "within and notWithin should never agree on absolute tolerance" <|
-                \epsilon a b ->
+                \_ epsilon a b ->
                     let
                         withinTest =
                             a |> Expect.within (Absolute (abs epsilon)) b
@@ -130,7 +130,7 @@ floatWithinTests =
                     in
                     different withinTest notWithinTest
             , fuzz2 (pair ( float, float )) (pair ( float, float )) "within and notWithin should never agree on absolute or relative tolerance" <|
-                \( absoluteEpsilon, relativeEpsilon ) ( a, b ) ->
+                \_ ( absoluteEpsilon, relativeEpsilon ) ( a, b ) ->
                     let
                         withinTest =
                             a |> Expect.within (AbsoluteOrRelative (abs absoluteEpsilon) (abs relativeEpsilon)) b
@@ -140,24 +140,24 @@ floatWithinTests =
                     in
                     different withinTest notWithinTest
             , fuzz float "Zero equality" <|
-                \epsilon -> 0.0 |> Expect.within (Relative (abs epsilon)) 0.0
+                \_ epsilon -> 0.0 |> Expect.within (Relative (abs epsilon)) 0.0
             , fuzz3 float float float "within absolute commutativity" <|
-                \epsilon a b ->
+                \_ epsilon a b ->
                     same (Expect.within (Absolute (abs epsilon)) a b) (Expect.within (Absolute (abs epsilon)) b a)
             , fuzz3 float float float "notWithin absolute commutativity" <|
-                \epsilon a b ->
+                \_ epsilon a b ->
                     same (Expect.notWithin (Absolute (abs epsilon)) a b) (Expect.notWithin (Absolute (abs epsilon)) b a)
             , fuzz2 float float "within absolute reflexive" <|
-                \epsilon a ->
+                \_ epsilon a ->
                     Expect.within (Absolute (abs epsilon)) a a
             , fuzz3 float float float "within relative commutativity" <|
-                \epsilon a b ->
+                \_ epsilon a b ->
                     same (Expect.within (Relative (abs epsilon)) a b) (Expect.within (Relative (abs epsilon)) b a)
             , fuzz3 float float float "notWithin relative commutativity" <|
-                \epsilon a b ->
+                \_ epsilon a b ->
                     same (Expect.notWithin (Relative (abs epsilon)) a b) (Expect.notWithin (Relative (abs epsilon)) b a)
             , fuzz2 float float "within relative reflexive" <|
-                \epsilon a ->
+                \_ epsilon a ->
                     Expect.within (Relative (abs epsilon)) a a
             ]
         ]