Add syntax for exceptions (#19)

README.md

@@ -17,7 +17,7 @@ An [expect-testing](https://blog.janestreet.com/the-joy-of-expect-tests/) librar
 
 The basic mechanism works.
 Snapshot updating is vibe-coded with Opus 4 and is purely text-based; I didn't want to use the F# compiler services because that's a pretty heavyweight dependency which should be confined to a separate test runner entity.
-It's not very well tested, and I expect it to be kind of brittle.
+It's fairly well tested, but you will certainly be able to find ways to break it; try not to be too fancy with your syntax around the `snapshot` statement.
 
 # How to use
 
@@ -44,6 +44,13 @@ let ``This test fails: plain text comparison of ToString`` () =
         snapshot "  123  "
         return 123
     }
+
+[<Test>]
+let ``With return! and snapshotThrows, you can see exceptions too`` () =
+    expect {
+        snapshotThrows @"System.Exception: oh no"
+        return! (fun () -> failwith<int> "oh no")
+    }
 ```
 
 You can adjust the formatting:

WoofWare.Expect.Test/TestExceptionThrowing.fs

@@ -0,0 +1,14 @@
+namespace WoofWare.Expect.Test
+
+open NUnit.Framework
+open WoofWare.Expect
+
+[<TestFixture>]
+module TestExceptionThrowing =
+
+    [<Test>]
+    let ``Can throw an exception`` () =
+        expect {
+            snapshotThrows @"System.Exception: oh no"
+            return! (fun () -> failwith<int> "oh no")
+        }

WoofWare.Expect.Test/WoofWare.Expect.Test.fsproj

@@ -13,6 +13,7 @@
       <Compile Include="Assembly.fs" />
       <Compile Include="BulkUpdateExample.fs" />
       <Compile Include="SimpleTest.fs" />
+      <Compile Include="TestExceptionThrowing.fs" />
       <Compile Include="TestSurface.fs" />
       <Compile Include="TestSnapshotFinding\TestSnapshotFinding.fs" />
       <Compile Include="TestSnapshotFinding\TestUnicodeCharacters.fs" />

WoofWare.Expect/Builder.fs

@@ -23,8 +23,6 @@ type Mode =
 /// <param name="applyChanges">When running the tests, instead of throwing an exception on failure, update the snapshot.</param>
 /// <param name="sourceOverride">Override the file path and line numbers reported in snapshots, so that your tests can be fully stable even on failure. (You almost certainly don't want to set this.)</param>
 type ExpectBuilder (mode : Mode) =
-    member private this.Mode = Unchecked.defaultof<Mode>
-
     new (sourceOverride : string * int) = ExpectBuilder (Mode.AssertMockingSource sourceOverride)
 
     new (update : bool)
@@ -144,6 +142,51 @@ type ExpectBuilder (mode : Mode) =
                 Actual = None
             }
 
+    /// <summary>
+    /// Expresses that the given expression throws during evaluation.
+    /// </summary>
+    /// <example>
+    /// <code>
+    /// expect {
+    ///     snapshotThrows @"System.Exception: oh no"
+    ///     return! (fun () -> failwith "oh no")
+    /// }
+    /// </code>
+    /// </example>
+    [<CustomOperation("snapshotThrows", MaintainsVariableSpaceUsingBind = true)>]
+    member _.SnapshotThrows<'a>
+        (
+            state : ExpectState<'a>,
+            snapshot : string,
+            [<CallerMemberName>] ?memberName : string,
+            [<CallerLineNumber>] ?callerLine : int,
+            [<CallerFilePath>] ?filePath : string
+        )
+        : ExpectState<'a>
+        =
+        match state.Snapshot with
+        | Some _ -> failwith "snapshot can only be specified once"
+        | None ->
+
+            let memberName = defaultArg memberName "<unknown method>"
+            let filePath = defaultArg filePath "<unknown file>"
+            let lineNumber = defaultArg callerLine -1
+
+            let callerInfo =
+                {
+                    MemberName = memberName
+                    FilePath = filePath
+                    LineNumber = lineNumber
+                }
+
+            {
+                Formatter = None
+                JsonSerialiserOptions = state.JsonSerialiserOptions
+                JsonDocOptions = state.JsonDocOptions
+                Snapshot = Some (SnapshotValue.ThrowsException snapshot, callerInfo)
+                Actual = None
+            }
+
     /// <summary>
     /// Express that the <c>return</c> value of this builder should be formatted using this function, before
     /// comparing to the snapshot.
@@ -158,7 +201,7 @@ type ExpectBuilder (mode : Mode) =
         | Some _ -> failwith "Please don't supply withFormat more than once"
         | None ->
             { state with
-                Formatter = Some formatter
+                Formatter = Some (fun f -> f () |> formatter)
             }
 
     /// <summary>
@@ -226,6 +269,17 @@ type ExpectBuilder (mode : Mode) =
 
     /// Expresses the "actual value" component of the assertion "expected snapshot = actual value".
     member _.Return (value : 'T) : ExpectState<'T> =
+        {
+            Snapshot = None
+            Formatter = None
+            JsonDocOptions = None
+            JsonSerialiserOptions = None
+            Actual = Some (fun () -> value)
+        }
+
+    /// Expresses the "actual value" component of the assertion "expected snapshot = actual value", but delayed behind
+    /// a function (by contrast with `Return`).
+    member _.ReturnFrom (value : unit -> 'T) : ExpectState<'T> =
         {
             Snapshot = None
             Formatter = None
@@ -254,7 +308,7 @@ type ExpectBuilder (mode : Mode) =
                 |> ExpectException
                 |> raise
             | Mode.Assert ->
-                if GlobalBuilderConfig.bulkUpdate.Value > 0 then
+                if GlobalBuilderConfig.isBulkUpdateMode () then
                     GlobalBuilderConfig.registerTest state
                 else
                     sprintf
@@ -275,9 +329,9 @@ type ExpectBuilder (mode : Mode) =
 
         match CompletedSnapshotGeneric.passesAssertion state with
         | None ->
-            match mode, GlobalBuilderConfig.bulkUpdate.Value with
+            match mode, GlobalBuilderConfig.isBulkUpdateMode () with
             | Mode.Update, _
-            | _, 1 ->
+            | _, true ->
                 failwith
                     "Snapshot assertion passed, but we are in snapshot-updating mode. Use the `expect` builder instead of `expect'` to assert the contents of a single snapshot; disable `GlobalBuilderConfig.bulkUpdate` to move back to assertion-checking mode."
             | _ -> ()

WoofWare.Expect/Config.fs

@@ -1,12 +1,19 @@
 namespace WoofWare.Expect
 
-open System.Threading
-
 /// Module holding global mutable state controlling the behaviour of WoofWare.Expect
 /// when running in bulk-update mode.
 [<RequireQualifiedAccess>]
 module GlobalBuilderConfig =
-    let internal bulkUpdate = ref 0
+    /// All access to the global mutable state locks on this.
+    let private locker = obj ()
+
+    // Global mutable state ensuring there is at most one `enterBulkUpdateMode`/`updateAllSnapshots` pair running at once.
+    let private bulkUpdate = ref 0
+
+    let private allTests : ResizeArray<CompletedSnapshot> = ResizeArray ()
+
+    let internal isBulkUpdateMode () : bool =
+        lock locker (fun () -> bulkUpdate.Value > 0)
 
     /// <summary>
     /// Call this to make the <c>expect</c> builder register all tests for bulk update as it runs.
@@ -16,11 +23,15 @@ module GlobalBuilderConfig =
     /// The implied global mutable state is liable to interfere with other expect builders in other fixtures otherwise.
     /// </remarks>
     let enterBulkUpdateMode () =
-        if Interlocked.Increment bulkUpdate <> 1 then
-            failwith
-                "WoofWare.Expect requires bulk updates to happen serially: for example, make the test fixture `[<NonParallelizable>]` if you're using NUnit."
+        lock
+            locker
+            (fun () ->
+                if bulkUpdate.Value <> 0 then
+                    failwith
+                        "WoofWare.Expect requires bulk updates to happen serially: for example, make the test fixture `[<NonParallelizable>]` if you're using NUnit."
 
-    let private allTests : ResizeArray<CompletedSnapshot> = ResizeArray ()
+                bulkUpdate.Value <- bulkUpdate.Value + 1
+            )
 
     /// <summary>
     /// Clear the set of failing tests registered by any previous bulk-update runs.
@@ -30,23 +41,31 @@ module GlobalBuilderConfig =
     /// You probably don't need to do this, because your test runner is probably tearing down
     /// anyway after the tests have failed; this is mainly here for WoofWare.Expect's own internal testing.
     /// </remarks>
-    let clearTests () = lock allTests allTests.Clear
+    let clearTests () = lock locker allTests.Clear
 
     let internal registerTest (s : CompletedSnapshotGeneric<'T>) : unit =
         let toAdd = s |> CompletedSnapshot.make
-        lock allTests (fun () -> allTests.Add toAdd)
+        lock locker (fun () -> allTests.Add toAdd)
 
     /// <summary>
     /// For all tests whose failures have already been registered,
     /// transform the files on disk so that the failing snapshots now pass.
     /// </summary>
     let updateAllSnapshots () =
-        let bulkUpdate' = Interlocked.Decrement bulkUpdate
+        // It's OK for this to be called when `enterBulkUpdateMode` has not been called, i.e. when `bulkUpdate` has
+        // value 0. That just means we aren't in bulk-update mode, so we expect the following simply to do nothing.
+        // (This is an expected workflow: we expect users to run `updateAllSnapshots` unconditionally in a
+        // one-time tear-down of the test suite, and they use the one-time setup to control whether any work is actually
+        // performed here.)
+        lock
+            locker
+            (fun () ->
+                let allTests = Seq.toArray allTests
 
-        try
-            if bulkUpdate' = 0 then
-                let allTests = lock allTests (fun () -> Seq.toArray allTests)
-                SnapshotUpdate.updateAll allTests
-
-        finally
-            clearTests ()
+                try
+                    SnapshotUpdate.updateAll allTests
+                finally
+                    // double acquiring of reentrant lock is OK, we're not switching threads
+                    clearTests ()
+                    bulkUpdate.Value <- 0
+            )

WoofWare.Expect/Domain.fs

@@ -17,20 +17,21 @@ type CallerInfo =
 type private SnapshotValue =
     | Json of expected : string
     | Formatted of expected : string
+    | ThrowsException of expected : string
 
 type private CompletedSnapshotValue<'T> =
     | Json of expected : string * JsonSerializerOptions * JsonDocumentOptions
-    | Formatted of expected : string * format : ('T -> string)
+    | Formatted of expected : string * format : ((unit -> 'T) -> string)
 
 /// The state accumulated by the `expect` builder. You should never find yourself interacting with this type.
 type ExpectState<'T> =
     private
         {
-            Formatter : ('T -> string) option
+            Formatter : ((unit -> 'T) -> string) option
             JsonSerialiserOptions : JsonSerializerOptions option
             JsonDocOptions : JsonDocumentOptions option
             Snapshot : (SnapshotValue * CallerInfo) option
-            Actual : 'T option
+            Actual : (unit -> 'T) option
         }
 
 /// The state accumulated by the `expect` builder. You should never find yourself interacting with this type.
@@ -39,7 +40,7 @@ type internal CompletedSnapshotGeneric<'T> =
         {
             SnapshotValue : CompletedSnapshotValue<'T>
             Caller : CallerInfo
-            Actual : 'T
+            Actual : unit -> 'T
         }
 
 [<RequireQualifiedAccess>]
@@ -68,11 +69,22 @@ module internal CompletedSnapshotGeneric =
                 | SnapshotValue.Formatted expected ->
                     let formatter =
                         match state.Formatter with
-                        | None -> fun x -> x.ToString ()
+                        | None -> fun x -> x().ToString ()
                         | Some f -> f
 
                     CompletedSnapshotValue.Formatted (expected, formatter)
 
+                | SnapshotValue.ThrowsException expected ->
+                    CompletedSnapshotValue.Formatted (
+                        expected,
+                        fun x ->
+                            try
+                                x () |> ignore
+                                "<no exception raised>"
+                            with e ->
+                                e.GetType().FullName + ": " + e.Message
+                    )
+
             {
                 SnapshotValue = snapshot
                 Caller = source
@@ -84,7 +96,7 @@ module internal CompletedSnapshotGeneric =
     let internal replacement (s : CompletedSnapshotGeneric<'T>) =
         match s.SnapshotValue with
         | CompletedSnapshotValue.Json (_existing, options, _) ->
-            JsonSerializer.Serialize (s.Actual, options)
+            JsonSerializer.Serialize (s.Actual (), options)
             |> JsonDocument.Parse
             |> _.RootElement
             |> _.ToString()
@@ -104,7 +116,7 @@ module internal CompletedSnapshotGeneric =
                     None
 
             let canonicalActual =
-                JsonSerializer.Serialize (state.Actual, jsonSerOptions) |> JsonDocument.Parse
+                JsonSerializer.Serialize (state.Actual (), jsonSerOptions) |> JsonDocument.Parse
 
             match canonicalSnapshot with
             | None -> Some ("[JSON failed to parse:] " + snapshot, canonicalActual.RootElement.ToString ())

WoofWare.Expect/SnapshotUpdate.fs

@@ -147,7 +147,8 @@ module internal SnapshotUpdate =
             let searchText = String.concat "\n" relevantLines
 
             // Find snapshot keyword
-            let snapshotMatch = Regex.Match (searchText, @"\b(snapshot|snapshotJson)\b")
+            let snapshotMatch =
+                Regex.Match (searchText, @"\b(snapshot|snapshotJson|snapshotThrows)\b")
 
             if not snapshotMatch.Success then
                 None

WoofWare.Expect/SurfaceBaseline.txt

@@ -16,9 +16,11 @@ WoofWare.Expect.ExpectBuilder.Bind [method]: ('U WoofWare.Expect.ExpectState, un
 WoofWare.Expect.ExpectBuilder.Delay [method]: (unit -> 'T WoofWare.Expect.ExpectState) -> (unit -> 'T WoofWare.Expect.ExpectState)
 WoofWare.Expect.ExpectBuilder.Return [method]: 'T -> 'T WoofWare.Expect.ExpectState
 WoofWare.Expect.ExpectBuilder.Return [method]: unit -> 'T WoofWare.Expect.ExpectState
+WoofWare.Expect.ExpectBuilder.ReturnFrom [method]: (unit -> 'T) -> 'T WoofWare.Expect.ExpectState
 WoofWare.Expect.ExpectBuilder.Run [method]: (unit -> 'T WoofWare.Expect.ExpectState) -> unit
 WoofWare.Expect.ExpectBuilder.Snapshot [method]: ('a WoofWare.Expect.ExpectState, string, string option, int option, string option) -> 'a WoofWare.Expect.ExpectState
 WoofWare.Expect.ExpectBuilder.SnapshotJson [method]: (unit WoofWare.Expect.ExpectState, string, string option, int option, string option) -> 'a WoofWare.Expect.ExpectState
+WoofWare.Expect.ExpectBuilder.SnapshotThrows [method]: ('a WoofWare.Expect.ExpectState, string, string option, int option, string option) -> 'a WoofWare.Expect.ExpectState
 WoofWare.Expect.ExpectBuilder.WithFormat [method]: ('T WoofWare.Expect.ExpectState, 'T -> string) -> 'T WoofWare.Expect.ExpectState
 WoofWare.Expect.ExpectBuilder.WithJsonDocOptions [method]: ('T WoofWare.Expect.ExpectState, System.Text.Json.JsonDocumentOptions) -> 'T WoofWare.Expect.ExpectState
 WoofWare.Expect.ExpectBuilder.WithJsonSerializerOptions [method]: ('T WoofWare.Expect.ExpectState, System.Text.Json.JsonSerializerOptions) -> 'T WoofWare.Expect.ExpectState

WoofWare.Expect/version.json

@@ -1,5 +1,5 @@
 {
-  "version": "0.4",
+  "version": "0.5",
   "publicReleaseRefSpec": [
     "^refs/heads/main$"
   ],
@@ -10,4 +10,4 @@
     ":/Directory.Build.props",
     ":/LICENSE"
   ]
-}
+}