Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add property args structure. #312

Merged
1 commit merged into from Feb 14, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions src/Hedgehog/Hedgehog.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,7 @@ https://github.com/hedgehogqa/fsharp-hedgehog/blob/master/doc/index.md
<Compile Include="GenTuple.fs" />
<Compile Include="Outcome.fs" />
<Compile Include="Report.fs" />
<Compile Include="PropertyArgs.fs" />
<Compile Include="PropertyConfig.fs" />
<Compile Include="Property.fs" />
<Compile Include="Linq\Gen.fs" />
Expand Down
53 changes: 34 additions & 19 deletions src/Hedgehog/Property.fs
Original file line number Diff line number Diff line change
Expand Up @@ -99,21 +99,19 @@ module Property =
//

let rec private takeSmallest
(renderRecheck : bool)
(size : Size)
(seed : Seed)
(args : PropertyArgs)
(Node ((journal, x), xs) : Tree<Journal * Outcome<'a>>)
(nshrinks : int<shrinks>)
(shrinkLimit : int<shrinks> Option) : Status =
let failed =
Failed {
Size = size
Seed = seed
Size = args.Size
Seed = args.Seed
Shrinks = nshrinks
Journal = journal
RenderRecheck = renderRecheck
RecheckType = args.RecheckType
}
let takeSmallest tree = takeSmallest renderRecheck size seed tree (nshrinks + 1<shrinks>) shrinkLimit
let takeSmallest tree = takeSmallest args tree (nshrinks + 1<shrinks>) shrinkLimit
match x with
| Failure ->
match Seq.tryFind (Outcome.isFailure << snd << Tree.outcome) xs with
Expand All @@ -130,7 +128,7 @@ module Property =
| Success _ ->
OK

let private reportWith' (renderRecheck : bool) (size0 : Size) (seed : Seed) (config : PropertyConfig) (p : Property<unit>) : Report =
let private reportWith' (args : PropertyArgs) (config : PropertyConfig) (p : Property<unit>) : Report =
let random = toGen p |> Gen.toRandom

let nextSize size =
Expand All @@ -139,7 +137,7 @@ module Property =
else
size + 1

let rec loop seed size tests discards =
let rec loop args tests discards =
if tests = config.TestLimit then
{ Tests = tests
Discards = discards
Expand All @@ -149,24 +147,29 @@ module Property =
Discards = discards
Status = GaveUp }
else
let seed1, seed2 = Seed.split seed
let result = Random.run seed1 size random
let seed1, seed2 = Seed.split args.Seed
let result = Random.run seed1 args.Size random
let nextArgs = {
args with
Seed = seed2
Size = nextSize args.Size
}

match snd (Tree.outcome result) with
| Failure ->
{ Tests = tests + 1<tests>
Discards = discards
Status = takeSmallest renderRecheck size seed result 0<shrinks> config.ShrinkLimit}
Status = takeSmallest args result 0<shrinks> config.ShrinkLimit}
| Success () ->
loop seed2 (nextSize size) (tests + 1<tests>) discards
loop nextArgs (tests + 1<tests>) discards
| Discard ->
loop seed2 (nextSize size) tests (discards + 1<discards>)
loop nextArgs tests (discards + 1<discards>)

loop seed size0 0<tests> 0<discards>
loop args 0<tests> 0<discards>

let reportWith (config : PropertyConfig) (p : Property<unit>) : Report =
let seed = Seed.random ()
p |> reportWith' true 1 seed config
let args = PropertyArgs.init
p |> reportWith' args config

let report (p : Property<unit>) : Report =
p |> reportWith PropertyConfig.defaultConfig
Expand Down Expand Up @@ -201,10 +204,22 @@ module Property =
| _ -> failure

let reportRecheckWith (size : Size) (seed : Seed) (config : PropertyConfig) (p : Property<unit>) : Report =
reportWith' false size seed config p
let args = {
PropertyArgs.init with
RecheckType = RecheckType.None
Seed = seed
Size = size
}
reportWith' args config p

let reportRecheck (size : Size) (seed : Seed) (p : Property<unit>) : Report =
reportWith' false size seed PropertyConfig.defaultConfig p
let args = {
PropertyArgs.init with
RecheckType = RecheckType.None
Seed = seed
Size = size
}
reportWith' args PropertyConfig.defaultConfig p

let reportRecheckBoolWith (size : Size) (seed : Seed) (config : PropertyConfig) (p : Property<bool>) : Report =
p |> bind ofBool |> reportRecheckWith size seed config
Expand Down
16 changes: 16 additions & 0 deletions src/Hedgehog/PropertyArgs.fs
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@
namespace Hedgehog

[<Struct>]
type PropertyArgs = private {
RecheckType : RecheckType
Size : Size
Seed : Seed
}

module PropertyArgs =

let init = {
RecheckType = RecheckType.FSharp
Size = 0
Seed = Seed.random ()
}
25 changes: 21 additions & 4 deletions src/Hedgehog/Report.fs
Original file line number Diff line number Diff line change
Expand Up @@ -4,12 +4,18 @@ namespace Hedgehog
[<Measure>] type discards
[<Measure>] type shrinks

[<RequireQualifiedAccess>]
type RecheckType =
| None
| CSharp
| FSharp

type FailureData = {
Size : Size
Seed : Seed
Shrinks : int<shrinks>
Journal : Journal
RenderRecheck : bool
RecheckType : RecheckType
}

type Status =
Expand Down Expand Up @@ -80,14 +86,25 @@ module Report =

Seq.iter (appendLine sb) (Journal.eval failure.Journal)

if failure.RenderRecheck then
match failure.RecheckType with
| RecheckType.None ->
()

| RecheckType.FSharp ->
appendLinef sb "This failure can be reproduced by running:"
appendLinef sb "> Property.recheck %d ({ Value = %A; Gamma = %A }) <property>"
failure.Size
failure.Seed.Value
failure.Seed.Gamma

| RecheckType.CSharp ->
appendLinef sb "This failure can be reproduced by running:"
appendLinef sb "> Property.recheck (%d : Size) ({ Value = %A; Gamma = %A }) <property>"
appendLinef sb "> property.Recheck(%d, new Seed { Value = %A; Gamma = %A })"
failure.Size
failure.Seed.Value
failure.Seed.Gamma

sb.ToString (0, sb.Length - 1) // Exclude extra newline.
sb.ToString().Trim() // Exclude extra newline.

let render (report : Report) : string =
match report.Status with
Expand Down