diff --git a/src/Hedgehog/Property.fs b/src/Hedgehog/Property.fs index c178cb27..0c585044 100644 --- a/src/Hedgehog/Property.fs +++ b/src/Hedgehog/Property.fs @@ -175,7 +175,7 @@ module Property = let applyWithExceptionHandling (j, outcome) = try (j, outcome |> Outcome.map f) - with + with | :? TestReturnedFalseException -> // Don't include internal exception in journal - it's just a signal. (j, Failure) @@ -210,12 +210,12 @@ module Property = let private bindGen (f : 'a -> Gen>>) (m : Gen>>) : Gen>> = - + // Use GenLazy.bind pattern (like before async was introduced) but handle PropertyResult. m |> GenLazy.bind (fun propertyResultA -> // This function is called with the FORCED PropertyResult (lazy was forced by GenLazy.bind). // This happens during tree construction for proper shrinking via Gen.bind. - + match propertyResultA with | PropertyResult.Sync (journalA, outcomeA) -> // Synchronous case: pattern match and continue (original behavior). @@ -243,7 +243,7 @@ module Property = #else // Block to get the result (this happens during generation phase). let journalA, outcomeA = Async.RunSynchronously asyncResultA - + // Now handle just like the sync case. match outcomeA with | Failure -> shortCircuit journalA Failure @@ -277,10 +277,10 @@ module Property = /// the failure output with information about the generated input values. let bindWith (journalFrom : 'a -> Journal) (k : 'a -> Property<'b>) (m : Gen<'a>) : Property<'b> = m - |> Gen.bind (fun a -> + |> Gen.bind (fun a -> let customJournal = journalFrom a let innerProperty = k a - innerProperty + innerProperty |> toGenInternal |> Gen.map (fun lazyResult -> lazy ( @@ -329,7 +329,7 @@ module Property = /// Module containing shrinking logic for property test failures. module private Shrinking = - + /// Shrink a failing test synchronously, finding the smallest input that still fails. let shrinkSync (language: Language) @@ -394,7 +394,7 @@ module Property = } return! loop () } - + let! found = xs |> Seq.indexed |> findFirstFailure match found with | None -> return! getFailed () @@ -476,7 +476,8 @@ module Property = /// The report includes the number of tests run, discards, and failure information with shrunk counterexamples. /// This blocks until all tests complete. let reportWith (config : IPropertyConfig) (p : Property) : Report = - p |> reportWith' (PropertyArgs.init ()) config + let seed = SeedConfig.init config.SeedConfig + p |> reportWith' (PropertyArgs.init seed) config /// Runs a property test with default configuration and returns a detailed report. /// By default, runs 100 tests. This blocks until all tests complete. @@ -625,7 +626,8 @@ module Property = /// This is non-blocking and properly handles async properties without blocking threads. /// Use this when testing async code or when you need non-blocking test execution. let reportAsyncWith (config : IPropertyConfig) (p : Property) : Async = - p |> reportWithAsync' (PropertyArgs.init ()) config + let seed = SeedConfig.init config.SeedConfig + p |> reportWithAsync' (PropertyArgs.init seed) config /// Runs a property test asynchronously with default configuration, returning an F# Async that produces a report. /// This is non-blocking and properly handles async properties without blocking threads. diff --git a/src/Hedgehog/PropertyArgs.fs b/src/Hedgehog/PropertyArgs.fs index 2347cc44..9d76733f 100644 --- a/src/Hedgehog/PropertyArgs.fs +++ b/src/Hedgehog/PropertyArgs.fs @@ -8,11 +8,11 @@ type PropertyArgs = internal { module PropertyArgs = - let init () = { + let init (seed : Seed) = { Language = Language.FSharp RecheckData = { Size = 0 - Seed = Seed.random () + Seed = seed ShrinkPath = [] } } diff --git a/src/Hedgehog/PropertyConfig.fs b/src/Hedgehog/PropertyConfig.fs index 88d3714d..20d24e65 100644 --- a/src/Hedgehog/PropertyConfig.fs +++ b/src/Hedgehog/PropertyConfig.fs @@ -1,17 +1,32 @@ namespace Hedgehog +type SeedConfig = + internal + | FixedSeed of Seed + | RandomSeed + type IPropertyConfig = internal { TestLimit : int ShrinkLimit : int option + SeedConfig : SeedConfig } +[] +module SeedConfig = + + let init (seedConfig : SeedConfig) : Seed = + match seedConfig with + | FixedSeed seed -> seed + | RandomSeed -> Seed.random () + module PropertyConfig = /// The default configuration for a property test. [] let defaults: IPropertyConfig = { TestLimit = 100 - ShrinkLimit = None } + ShrinkLimit = None + SeedConfig = RandomSeed } /// Set the number of times a property is allowed to shrink before the test /// runner gives up and displays the counterexample. @@ -26,3 +41,11 @@ module PropertyConfig = /// considered successful. let withTests (testLimit : int) (config : IPropertyConfig) : IPropertyConfig = { config with TestLimit = testLimit } + + /// Set the seed to a random value for each run. + let withRandomSeed (config : IPropertyConfig) : IPropertyConfig = + { config with SeedConfig = RandomSeed } + + /// Set the seed to a fixed value for all runs. + let withSeed (seed : Seed) (config : IPropertyConfig) : IPropertyConfig = + { config with SeedConfig = FixedSeed seed } diff --git a/src/Hedgehog/Random.fs b/src/Hedgehog/Random.fs index 128ac316..24611343 100644 --- a/src/Hedgehog/Random.fs +++ b/src/Hedgehog/Random.fs @@ -94,3 +94,7 @@ module Random = let (lo, hi) = Range.bounds size range let x, _ = Seed.nextDouble lo hi seed x) + + /// A random value that always matches the seed. Useful for testing. + let seed : Random = + Random (fun seed _ -> seed) diff --git a/tests/Hedgehog.Tests/GenTests.fs b/tests/Hedgehog.Tests/GenTests.fs index ed623f38..103611e4 100644 --- a/tests/Hedgehog.Tests/GenTests.fs +++ b/tests/Hedgehog.Tests/GenTests.fs @@ -65,7 +65,7 @@ let genTests = testList "Gen tests" [ |> List.distinct |> List.length =! actual.Length - + #if !FABLE_COMPILER // See production code yield! testCases "timeSpan creates TimeSpan instances" @@ -135,7 +135,7 @@ let genTests = testList "Gen tests" [ if List.isEmpty generatedValues then failwith "Should have generated values in journal" - + let actual = generatedValues.[0] :?> DateTime actual =! DateTime (2000, 1, 1) @@ -337,23 +337,104 @@ let genTests = testList "Gen tests" [ let firstValues = System.Collections.Generic.HashSet() let secondValues = System.Collections.Generic.HashSet() let thirdValues = System.Collections.Generic.HashSet() - + property { let! x = Gen.int32 (Range.linear 1 100) let! y = Gen.int32 (Range.linear 1 100) let! z = Gen.int32 (Range.linear 1 100) - + firstValues.Add(x) |> ignore secondValues.Add(y) |> ignore thirdValues.Add(z) |> ignore - + return true } |> Property.checkBoolWith (PropertyConfig.withTests 100 PropertyConfig.defaults) - + // Each generator should produce multiple different values // If the seed wasn't threaded properly, they would all produce the same value firstValues.Count > 10 |> Expect.isTrue secondValues.Count > 10 |> Expect.isTrue thirdValues.Count > 10 |> Expect.isTrue + + // The concrete value of the snapshot is unimportant. + // However, if this value changes it may be because you may have broken determinism. + let snapshot = { + Value = 14141672759607663454UL + Gamma = 16294208416658607535UL + } + + testCase "Seed is deterministic" <| fun () -> + // `checkBoolWith` should always produce the same result for the same starting seed. + let config = + PropertyConfig.defaults + |> PropertyConfig.withSeed (Seed.from 0UL) + |> PropertyConfig.withTests 1 + + Property.checkBoolWith config <| property { + let! x = + Random.seed + |> Random.map Tree.singleton + |> Gen.ofRandom + + return x = snapshot + } + + testCaseAsync "Seed is deterministic async" <| async { + // `checkBoolAsyncWith` should always produce the same result for the same starting seed. + let config = + PropertyConfig.defaults + |> PropertyConfig.withSeed (Seed.from 0UL) + |> PropertyConfig.withTests 1 + + do! + Property.checkBoolAsyncWith config <| property { + let! x = + Random.seed + |> Random.map Tree.singleton + |> Gen.ofRandom + + return x = snapshot + } + } + + testCase "withRandomSeed differs from fixed-seed behavior" <| fun () -> + let config = + PropertyConfig.defaults + |> PropertyConfig.withRandomSeed + |> PropertyConfig.withTests 10 + + Property.checkBoolWith config <| property { + let! x = + Random.seed + |> Random.map Tree.singleton + |> Gen.ofRandom + + return x <> snapshot + } + + testCase "recheck path preserves configured seed semantics" <| fun () -> + let config = + PropertyConfig.defaults + |> PropertyConfig.withSeed (Seed.from 123UL) + |> PropertyConfig.withTests 1 + + // The concrete value of the snapshot is unimportant. + // However, if this value changes it may be because you may have broken determinism. + let snapshot = { + Value = 16826716191977273598UL + Gamma = 13032462758197477675UL + } + + let p = property { + let! x = + Random.seed + |> Random.map Tree.singleton + |> Gen.ofRandom + + return x = snapshot + } + + Property.checkBoolWith config p + Property.recheckBoolWith "0_9208534749291869864_13032462758197477675_" config p ]