Skip to content

Commit

Permalink
Add property args structure.
Browse files Browse the repository at this point in the history
  • Loading branch information
Adam Becker authored and adam-becker committed Feb 14, 2021
1 parent 3ff1fba commit e1f87f3
Show file tree
Hide file tree
Showing 4 changed files with 72 additions and 23 deletions.
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

0 comments on commit e1f87f3

Please sign in to comment.