Skip to content

Commit 2bd3f23

Browse files
TheAngryByrdTheAngryByrd
committed
More while loop verification
1 parent 22dc83f commit 2bd3f23

File tree

17 files changed

+404
-161
lines changed

17 files changed

+404
-161
lines changed

‎src/FsToolkit.ErrorHandling.JobResult/JobOptionCE.fs

Lines changed: 12 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -85,10 +85,18 @@ module JobOptionCE =
8585
job.Using(resource, binder)
8686

8787
member this.While(guard: unit -> bool, computation: Job<_ option>) : Job<_ option> =
88-
if not (guard ()) then
89-
this.Zero()
90-
else
91-
this.Bind(computation, (fun () -> this.While(guard, computation)))
88+
job {
89+
let mutable doContinue = true
90+
let mutable result = Some ()
91+
while doContinue && guard () do
92+
match! computation with
93+
| Some () -> ()
94+
| None ->
95+
doContinue <- false
96+
result <- None
97+
return result
98+
99+
}
92100

93101
member inline this.For
94102
(

‎src/FsToolkit.ErrorHandling.JobResult/JobResultCE.fs

Lines changed: 13 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -80,15 +80,19 @@ module JobResultCE =
8080
) : Job<Result<'U, 'TError>> =
8181
job.Using(resource, binder)
8282

83-
member this.While
84-
(
85-
guard: unit -> bool,
86-
computation: Job<Result<unit, 'TError>>
87-
) : Job<Result<unit, 'TError>> =
88-
if not (guard ()) then
89-
this.Zero()
90-
else
91-
this.Bind(computation, (fun () -> this.While(guard, computation)))
83+
member this.While(guard: unit -> bool, computation: Job<Result<unit, 'TError>>) : Job<Result<unit, 'TError>> =
84+
job {
85+
let mutable doContinue = true
86+
let mutable result = Ok ()
87+
while doContinue && guard () do
88+
match! computation with
89+
| Ok () -> ()
90+
| Error e ->
91+
doContinue <- false
92+
result <- Error e
93+
return result
94+
95+
}
9296

9397
member inline this.For
9498
(

‎src/FsToolkit.ErrorHandling.TaskResult/TaskOption.fs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ module TaskOption =
2222
}
2323

2424
let inline retn x = task { return Some x }
25+
let inline some x = task { return Some x }
2526

2627
let inline apply f x =
2728
bind (fun f' -> bind (fun x' -> retn (f' x')) x) f

‎src/FsToolkit.ErrorHandling/AsyncOption.fs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -21,10 +21,11 @@ module AsyncOption =
2121
)
2222
input
2323

24-
let inline lol (value: 'value) : Async<'value option> = Async.singleton (Some value)
25-
2624
let inline retn (value: 'value) : Async<'value option> = Async.singleton (Some value)
2725

26+
27+
let inline some (value: 'value) : Async<'value option> = Async.singleton (Some value)
28+
2829
let inline apply
2930
(applier: Async<('input -> 'output) option>)
3031
(input: Async<'input option>)

‎src/FsToolkit.ErrorHandling/ResultCE.fs

Lines changed: 0 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -84,28 +84,6 @@ module ResultCE =
8484
doContinue <- false
8585
result <- Error e
8686
result
87-
// let rec whileBuilder () =
88-
// if guard () then
89-
// this.Bind(this.Run(fun () -> generator ()), (fun () -> this.Run(fun () -> whileBuilder ())))
90-
// else
91-
// this.Zero()
92-
93-
// this.Run(fun () -> whileBuilder ())
94-
95-
// if guard () then
96-
// let mutable whileBuilder = Unchecked.defaultof<_>
97-
98-
// whileBuilder <-
99-
// fun () ->
100-
// this.Bind(
101-
// this.Run generator,
102-
// (fun () -> if guard () then this.Run whileBuilder else this.Zero())
103-
// )
104-
105-
// this.Run whileBuilder
106-
// else
107-
// this.Zero()
108-
10987

11088
member inline this.For
11189
(

‎tests/FsToolkit.ErrorHandling.JobResult.Tests/JobOptionCE.fs

Lines changed: 46 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -226,19 +226,58 @@ let ceTests =
226226

227227
Expect.equal actual (Some data) "Should be ok"
228228
}
229-
testCaseJob "While"
229+
yield! [
230+
let maxIndices = [10; 1000000]
231+
for maxIndex in maxIndices do
232+
testCaseJob <| sprintf "While - %i" maxIndex
233+
<| job {
234+
let data = 42
235+
let mutable index = 0
236+
237+
let! actual = jobOption {
238+
while index < maxIndex do
239+
index <- index + 1
240+
241+
return data
242+
}
243+
244+
Expect.equal index maxIndex "Index should reach maxIndex"
245+
Expect.equal actual (Some data) "Should be ok"
246+
}
247+
]
248+
249+
testCaseJob "while fail"
230250
<| job {
231-
let data = 42
232-
let mutable index = 0
251+
252+
let mutable loopCount = 0
253+
let mutable wasCalled = false
254+
255+
let sideEffect () =
256+
wasCalled <- true
257+
"ok"
258+
259+
let expected = None
260+
261+
let data = [
262+
Some "42"
263+
Some "1024"
264+
expected
265+
Some "1M"
266+
Some "1M"
267+
Some "1M"
268+
]
233269

234270
let! actual = jobOption {
235-
while index < 10 do
236-
index <- index + 1
271+
while loopCount < data.Length do
272+
let! x = data.[loopCount]
273+
loopCount <- loopCount + 1
237274

238-
return data
275+
return sideEffect ()
239276
}
240277

241-
Expect.equal actual (Some data) "Should be ok"
278+
Expect.equal loopCount 2 "Should only loop twice"
279+
Expect.equal actual expected "Should be an error"
280+
Expect.isFalse wasCalled "No additional side effects should occur"
242281
}
243282
testCaseJob "For in"
244283
<| job {

‎tests/FsToolkit.ErrorHandling.JobResult.Tests/JobResultCE.fs

Lines changed: 46 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -289,19 +289,58 @@ let ``JobResultCE using Tests`` =
289289
[<Tests>]
290290
let ``JobResultCE loop Tests`` =
291291
testList "JobResultCE loop Tests" [
292-
testCaseJob "while"
292+
yield! [
293+
let maxIndices = [10; 1000000]
294+
for maxIndex in maxIndices do
295+
testCaseJob <| sprintf "While - %i" maxIndex
296+
<| job {
297+
let data = 42
298+
let mutable index = 0
299+
300+
let! actual = jobResult {
301+
while index < maxIndex do
302+
index <- index + 1
303+
304+
return data
305+
}
306+
307+
Expect.equal index maxIndex "Index should reach maxIndex"
308+
Expect.equal actual (Ok data) "Should be ok"
309+
}
310+
]
311+
312+
testCaseJob "while fail"
293313
<| job {
294-
let data = 42
295-
let mutable index = 0
314+
315+
let mutable loopCount = 0
316+
let mutable wasCalled = false
317+
318+
let sideEffect () =
319+
wasCalled <- true
320+
"ok"
321+
322+
let expected = Error "NOPE"
323+
324+
let data = [
325+
Ok "42"
326+
Ok "1024"
327+
expected
328+
Ok "1M"
329+
Ok "1M"
330+
Ok "1M"
331+
]
296332

297333
let! actual = jobResult {
298-
while index < 10 do
299-
index <- index + 1
334+
while loopCount < data.Length do
335+
let! x = data.[loopCount]
336+
loopCount <- loopCount + 1
300337

301-
return data
338+
return sideEffect ()
302339
}
303340

304-
Expect.equal actual (Result.Ok data) "Should be ok"
341+
Expect.equal loopCount 2 "Should only loop twice"
342+
Expect.equal actual expected "Should be an error"
343+
Expect.isFalse wasCalled "No additional side effects should occur"
305344
}
306345
testCaseJob "for in"
307346
<| job {

‎tests/FsToolkit.ErrorHandling.TaskResult.Tests/BackgroundTaskOptionCE.fs

Lines changed: 0 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -277,15 +277,6 @@ let ceTests =
277277
}
278278
testCaseTask "while fail"
279279
<| fun () -> backgroundTask {
280-
let data = 42
281-
let mutable index = 0
282-
283-
let! actual = taskResult {
284-
while index < 10 do
285-
index <- index + 1
286-
287-
return data
288-
}
289280

290281
let mutable loopCount = 0
291282
let mutable wasCalled = false

‎tests/FsToolkit.ErrorHandling.TaskResult.Tests/BackgroundTaskResultCE.fs

Lines changed: 19 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -348,31 +348,28 @@ let ``BackgroundTaskResultCE using Tests`` =
348348
[<Tests>]
349349
let ``BackgroundTaskResultCE loop Tests`` =
350350
testList "BackgroundTaskResultCE loop Tests" [
351-
testCaseTask "while"
352-
<| fun () -> backgroundTask {
353-
let data = 42
354-
let mutable index = 0
355-
356-
let! actual = backgroundTaskResult {
357-
while index < 10 do
358-
index <- index + 1
359-
360-
return data
361-
}
362-
363-
Expect.equal actual (Result.Ok data) "Should be ok"
364-
}
351+
yield! [
352+
let maxIndices = [10; 1000000]
353+
for maxIndex in maxIndices do
354+
testCaseTask <| sprintf "While - %i" maxIndex
355+
<| fun () -> backgroundTask {
356+
let data = 42
357+
let mutable index = 0
358+
359+
let! actual = backgroundTaskResult {
360+
while index < maxIndex do
361+
index <- index + 1
362+
363+
return data
364+
}
365+
366+
Expect.equal index maxIndex "Index should reach maxIndex"
367+
Expect.equal actual (Ok data) "Should be ok"
368+
}
369+
]
365370
testCaseTask "while fail"
366371
<| fun () -> backgroundTask {
367-
let data = 42
368-
let mutable index = 0
369372

370-
let! actual = backgroundTaskResult {
371-
while index < 10 do
372-
index <- index + 1
373-
374-
return data
375-
}
376373

377374
let mutable loopCount = 0
378375
let mutable wasCalled = false

‎tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskOptionCE.fs

Lines changed: 29 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -281,31 +281,43 @@ let ceTests =
281281

282282
Expect.equal actual (Some data) "Should be ok"
283283
}
284-
testCaseTask "While"
285-
<| fun () -> task {
286-
let data = 42
287-
let mutable index = 0
284+
yield! [
285+
let maxIndices = [10; 1000000]
286+
for maxIndex in maxIndices do
287+
testCaseTask <| sprintf "While - %i" maxIndex
288+
<| fun () -> task {
289+
let data = 42
290+
let mutable index = 0
288291

289-
let! actual = taskOption {
290-
while index < 10 do
291-
index <- index + 1
292+
let! actual = taskOption {
293+
while index < maxIndex do
294+
index <- index + 1
292295

293-
return data
294-
}
296+
return data
297+
}
298+
299+
Expect.equal index maxIndex "Index should reach maxIndex"
300+
Expect.equal actual (Some data) "Should be ok"
301+
}
302+
]
303+
304+
testCaseTask "while bind error" <| fun () -> task {
305+
let items = [TaskOption.some 3 ; TaskOption.some 4; Task.singleton (None)]
295306

296-
Expect.equal actual (Some data) "Should be ok"
297-
}
298-
testCaseTask "while fail"
299-
<| fun () -> task {
300-
let data = 42
301307
let mutable index = 0
302308

303-
let! actual = taskResult {
304-
while index < 10 do
309+
let! actual = taskOption {
310+
while index < items.Length do
311+
let! _ = items[index]
305312
index <- index + 1
306313

307-
return data
314+
return index
308315
}
316+
Expect.equal index (items.Length - 1) "Index should reach maxIndex"
317+
Expect.equal actual (None) "Should be NOPE"
318+
}
319+
testCaseTask "while fail"
320+
<| fun () -> task {
309321

310322
let mutable loopCount = 0
311323
let mutable wasCalled = false

0 commit comments

Comments
 (0)