Skip to content

Commit e1f87f3

Browse files
Adam Beckeradam-becker
authored andcommitted
Add property args structure.
1 parent 3ff1fba commit e1f87f3

File tree

4 files changed

+72
-23
lines changed

4 files changed

+72
-23
lines changed

src/Hedgehog/Hedgehog.fsproj

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ https://github.com/hedgehogqa/fsharp-hedgehog/blob/master/doc/index.md
4141
<Compile Include="GenTuple.fs" />
4242
<Compile Include="Outcome.fs" />
4343
<Compile Include="Report.fs" />
44+
<Compile Include="PropertyArgs.fs" />
4445
<Compile Include="PropertyConfig.fs" />
4546
<Compile Include="Property.fs" />
4647
<Compile Include="Linq\Gen.fs" />

src/Hedgehog/Property.fs

Lines changed: 34 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -99,21 +99,19 @@ module Property =
9999
//
100100

101101
let rec private takeSmallest
102-
(renderRecheck : bool)
103-
(size : Size)
104-
(seed : Seed)
102+
(args : PropertyArgs)
105103
(Node ((journal, x), xs) : Tree<Journal * Outcome<'a>>)
106104
(nshrinks : int<shrinks>)
107105
(shrinkLimit : int<shrinks> Option) : Status =
108106
let failed =
109107
Failed {
110-
Size = size
111-
Seed = seed
108+
Size = args.Size
109+
Seed = args.Seed
112110
Shrinks = nshrinks
113111
Journal = journal
114-
RenderRecheck = renderRecheck
112+
RecheckType = args.RecheckType
115113
}
116-
let takeSmallest tree = takeSmallest renderRecheck size seed tree (nshrinks + 1<shrinks>) shrinkLimit
114+
let takeSmallest tree = takeSmallest args tree (nshrinks + 1<shrinks>) shrinkLimit
117115
match x with
118116
| Failure ->
119117
match Seq.tryFind (Outcome.isFailure << snd << Tree.outcome) xs with
@@ -130,7 +128,7 @@ module Property =
130128
| Success _ ->
131129
OK
132130

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

136134
let nextSize size =
@@ -139,7 +137,7 @@ module Property =
139137
else
140138
size + 1
141139

142-
let rec loop seed size tests discards =
140+
let rec loop args tests discards =
143141
if tests = config.TestLimit then
144142
{ Tests = tests
145143
Discards = discards
@@ -149,24 +147,29 @@ module Property =
149147
Discards = discards
150148
Status = GaveUp }
151149
else
152-
let seed1, seed2 = Seed.split seed
153-
let result = Random.run seed1 size random
150+
let seed1, seed2 = Seed.split args.Seed
151+
let result = Random.run seed1 args.Size random
152+
let nextArgs = {
153+
args with
154+
Seed = seed2
155+
Size = nextSize args.Size
156+
}
154157

155158
match snd (Tree.outcome result) with
156159
| Failure ->
157160
{ Tests = tests + 1<tests>
158161
Discards = discards
159-
Status = takeSmallest renderRecheck size seed result 0<shrinks> config.ShrinkLimit}
162+
Status = takeSmallest args result 0<shrinks> config.ShrinkLimit}
160163
| Success () ->
161-
loop seed2 (nextSize size) (tests + 1<tests>) discards
164+
loop nextArgs (tests + 1<tests>) discards
162165
| Discard ->
163-
loop seed2 (nextSize size) tests (discards + 1<discards>)
166+
loop nextArgs tests (discards + 1<discards>)
164167

165-
loop seed size0 0<tests> 0<discards>
168+
loop args 0<tests> 0<discards>
166169

167170
let reportWith (config : PropertyConfig) (p : Property<unit>) : Report =
168-
let seed = Seed.random ()
169-
p |> reportWith' true 1 seed config
171+
let args = PropertyArgs.init
172+
p |> reportWith' args config
170173

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

203206
let reportRecheckWith (size : Size) (seed : Seed) (config : PropertyConfig) (p : Property<unit>) : Report =
204-
reportWith' false size seed config p
207+
let args = {
208+
PropertyArgs.init with
209+
RecheckType = RecheckType.None
210+
Seed = seed
211+
Size = size
212+
}
213+
reportWith' args config p
205214

206215
let reportRecheck (size : Size) (seed : Seed) (p : Property<unit>) : Report =
207-
reportWith' false size seed PropertyConfig.defaultConfig p
216+
let args = {
217+
PropertyArgs.init with
218+
RecheckType = RecheckType.None
219+
Seed = seed
220+
Size = size
221+
}
222+
reportWith' args PropertyConfig.defaultConfig p
208223

209224
let reportRecheckBoolWith (size : Size) (seed : Seed) (config : PropertyConfig) (p : Property<bool>) : Report =
210225
p |> bind ofBool |> reportRecheckWith size seed config

src/Hedgehog/PropertyArgs.fs

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
namespace Hedgehog
2+
3+
[<Struct>]
4+
type PropertyArgs = private {
5+
RecheckType : RecheckType
6+
Size : Size
7+
Seed : Seed
8+
}
9+
10+
module PropertyArgs =
11+
12+
let init = {
13+
RecheckType = RecheckType.FSharp
14+
Size = 0
15+
Seed = Seed.random ()
16+
}

src/Hedgehog/Report.fs

Lines changed: 21 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -4,12 +4,18 @@ namespace Hedgehog
44
[<Measure>] type discards
55
[<Measure>] type shrinks
66

7+
[<RequireQualifiedAccess>]
8+
type RecheckType =
9+
| None
10+
| CSharp
11+
| FSharp
12+
713
type FailureData = {
814
Size : Size
915
Seed : Seed
1016
Shrinks : int<shrinks>
1117
Journal : Journal
12-
RenderRecheck : bool
18+
RecheckType : RecheckType
1319
}
1420

1521
type Status =
@@ -80,14 +86,25 @@ module Report =
8086

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

83-
if failure.RenderRecheck then
89+
match failure.RecheckType with
90+
| RecheckType.None ->
91+
()
92+
93+
| RecheckType.FSharp ->
94+
appendLinef sb "This failure can be reproduced by running:"
95+
appendLinef sb "> Property.recheck %d ({ Value = %A; Gamma = %A }) <property>"
96+
failure.Size
97+
failure.Seed.Value
98+
failure.Seed.Gamma
99+
100+
| RecheckType.CSharp ->
84101
appendLinef sb "This failure can be reproduced by running:"
85-
appendLinef sb "> Property.recheck (%d : Size) ({ Value = %A; Gamma = %A }) <property>"
102+
appendLinef sb "> property.Recheck(%d, new Seed { Value = %A; Gamma = %A })"
86103
failure.Size
87104
failure.Seed.Value
88105
failure.Seed.Gamma
89106

90-
sb.ToString (0, sb.Length - 1) // Exclude extra newline.
107+
sb.ToString().Trim() // Exclude extra newline.
91108

92109
let render (report : Report) : string =
93110
match report.Status with

0 commit comments

Comments
 (0)