Prop.throws now fails on unexpected exception.

fscheck · Jan 8, 2022 · b96a996 · b96a996
1 parent 101cdbf
commit b96a996
Show file tree

Hide file tree

Showing 2 changed files with 31 additions and 5 deletions.
diff --git a/src/FsCheck/Prop.fs b/src/FsCheck/Prop.fs
@@ -93,7 +93,15 @@ module Prop =
     ///and a failure otherwise.
     [<CompiledName("Throws")>]
     let throws<'Exception, 'Testable when 'Exception :> exn> (p : Lazy<'Testable>) = 
-       property <| try ignore p.Value; Res.failed with :? 'Exception -> Res.succeeded
+        try 
+            ignore p.Value
+            Res.failed 
+        with 
+            | :? 'Exception -> 
+                Res.succeeded
+            | e ->
+                Res.exc e
+        |> property
 
     let private stamp str = 
         let add res = { res with Stamp = str :: res.Stamp } 

diff --git a/tests/FsCheck.Test/Property.fs b/tests/FsCheck.Test/Property.fs
@@ -140,14 +140,17 @@ module Property =
             override __.OnFinished(_,testResult) = 
                 result <- Some testResult
 
+    let private checkResult (prop:Property) =
+        let resultRunner = GetResultRunner()
+        let config = { Config.Quick with Runner = resultRunner; MaxTest = 2  }
+        Check.One(config, prop)
+        resultRunner.Result
+
     [<Property>]
     let DSL() = 
         Prop.forAll (Arb.fromGen symPropGen) (fun symprop ->
             let expected = determineResult symprop
-            let resultRunner = GetResultRunner()
-            let config = { Config.Quick with Runner = resultRunner; MaxTest = 2  }
-            Check.One(config,toProperty symprop)
-            let actual = resultRunner.Result
+            let actual = checkResult (toProperty symprop)
             areSame expected actual
             |> Prop.label (sprintf "expected = %A - actual = %A" expected actual)
             |> Prop.collect (depth symprop)
@@ -158,3 +161,18 @@ module Property =
         let a = Prop.ofTestable <| lazy failwith "crash"
         let b =  Prop.ofTestable true
         a .|. b
+
+    [<Fact>]
+    let ``throws should fail on unexpected exception``() =
+        let test() =
+            (lazy invalidOp "boom")
+            |> Prop.throws<ArgumentException, _>
+            |> Prop.label "Expected ArgumentException"
+        let actual = checkResult (Prop.ofTestable test)
+        match actual with
+        | TestResult.False (td,_,_,Outcome.Exception e,_) when (e :? InvalidOperationException) -> 
+            if not (td.Labels.Contains("Expected ArgumentException")) then
+                failwith "Expected label to be applied"
+        | t -> failwithf "Expected failing test with exception, got %A" t
+
+