Merge pull request #470 from hedgehogqa/tagged-journal

Tagged journal

Author: AlexeyRaga

src/Hedgehog.Xunit/AutoGenConfig.fs

@@ -22,7 +22,7 @@ type %s{configType.Name} =
         let methodInfo =
           if methodInfo.IsGenericMethod then
             methodInfo.GetParameters()
-            |> Array.map (_.ParameterType.IsGenericParameter)
+            |> Array.map _.ParameterType.IsGenericParameter
             |> Array.zip configArgs
             |> Array.filter snd
             |> Array.map (fun (arg, _) -> arg.GetType())

src/Hedgehog.Xunit/Exceptions.fs

@@ -2,12 +2,6 @@ namespace Hedgehog.Xunit
 
 open Xunit.Sdk
 
-// This exists to make it clear to users that the exception is in the return of their test.
-// Raising System.Exception isn't descriptive enough.
-// Using Xunit.Assert.True could be confusing since it may resemble a user's assertion.
-type internal TestReturnedFalseException() =
-  inherit System.Exception("Test returned `false`.")
-
 /// Exception for property test failures that produces clean output
 type PropertyFailedException(message: string) =
     inherit XunitException(message)

src/Hedgehog.Xunit/InternalLogic.fs

@@ -5,8 +5,6 @@ open Hedgehog.FSharp
 open Hedgehog.Xunit
 open System
 open System.Reflection
-open System.Runtime.ExceptionServices
-open System.Threading
 open System.Threading.Tasks
 
 // ========================================
@@ -110,7 +108,6 @@ let rec wrapReturnValue (x: obj) : Property<unit> =
 
         | _ -> Property.success ()
 
-
 // ========================================
 // Resource Management
 // ========================================
@@ -120,33 +117,6 @@ let dispose (o: obj) =
     | :? IDisposable as d -> d.Dispose()
     | _ -> ()
 
-// ========================================
-// Value Formatting & Display
-// ========================================
-
-let printValue (value: obj) : string =
-    let prepareForPrinting (value: obj) : obj =
-        if isNull value then
-            value
-        else
-            let typeInfo = IntrospectionExtensions.GetTypeInfo(value.GetType())
-            let isResizeArray = typeInfo.IsGenericType && typeInfo.GetGenericTypeDefinition() = typedefof<ResizeArray<_>>
-            if isResizeArray then
-                value :?> System.Collections.IEnumerable
-                |> Seq.cast<obj>
-                |> List.ofSeq
-                :> obj
-            else
-                value
-
-    value |> prepareForPrinting |> sprintf "%A"
-
-let formatParametersWithNames (parameters: ParameterInfo[]) (values: obj list) : string =
-    Array.zip parameters (List.toArray values)
-    |> Array.map (fun (param, value) ->
-        $"%s{param.Name} = %s{printValue value}")
-    |> String.concat Environment.NewLine
-
 // ========================================
 // Configuration Helpers
 // ========================================
@@ -219,16 +189,8 @@ module private PropertyBuilder =
             else
                 testMethod
 
-        try
-            methodToInvoke.Invoke(testClassInstance, args |> Array.ofList)
-        with
-        | :? TargetInvocationException as tie when not (isNull tie.InnerException) ->
-            // Unwrap reflection exception to show the actual user exception instead of TargetInvocationException.
-            // We use ExceptionDispatchInfo.Capture().Throw() to preserve the original stack trace.
-            // Note: This adds a "--- End of stack trace from previous location ---" marker
-            // and appends additional frames as the exception propagates, which we filter out later.
-            ExceptionDispatchInfo.Capture(tie.InnerException).Throw()
-            failwith "unreachable"
+        methodToInvoke.Invoke(testClassInstance, args |> Array.ofList)
+
 
     /// Creates a property based on the test method's return type
     let createProperty
@@ -243,23 +205,23 @@ module private PropertyBuilder =
                     invokeTestMethod testMethod testClassInstance args
                 finally
                     List.iter dispose args
-            with e ->
-                // If the test method throws an exception, we need to handle it
-                // For Property<_> return types, the exception will be caught by Property.map
-                // For other return types, we need to wrap it in a failing property
-                // We return a special marker that wrapReturnValue will recognize
-                box e
+            with
+                // Unwrap TargetInvocationException to get the actual exception.
+                // It is safe to do it because invokeTestMethod uses reflection that adds this wrapper.
+                | :? TargetInvocationException as e when not (isNull e.InnerException) ->
+                    box e.InnerException
+                | e -> box e
 
         let createJournal args =
-            let formattedParams = formatParametersWithNames parameters args
-            Journal.singleton (fun () -> formattedParams)
+            args
+            |> Seq.zip parameters
+            |> Seq.map (fun (param, value) -> fun () -> TestParameter (param.Name, value))
+            |> Array.ofSeq // not sure if journal will do multiple enumerations
+            |> Journal.ofSeq
 
         let wrapWithExceptionHandling (result: obj) : Property<unit> =
             match result with
-            | :? exn as e -> 
-                // Exception was thrown - create a failing property
-                Property.counterexample (fun () -> string e)
-                |> Property.bind (fun () -> Property.failure)
+            | :? exn as e -> Property.exn e
             | _ -> wrapReturnValue result
 
 

src/Hedgehog.Xunit/Prelude.fs

@@ -23,9 +23,6 @@ module Array =
         (first, middle, Some last)
 
 module Seq =
-  let inline tryMin xs =
-    if Seq.isEmpty xs then None else Some (Seq.min xs)
-
   // https://github.com/dotnet/fsharp/blob/b9942004e8ba19bf73862b69b2d71151a98975ba/src/FSharp.Core/seqcore.fs#L172-L174
   let inline private checkNonNull argName arg =
     if isNull arg then
@@ -51,25 +48,3 @@ module internal Type =
         |> Seq.tryFind (fun attr -> attr :? 'T)
         |> Option.map (fun attr -> attr :?> 'T))
     |> Seq.toList
-
-[<AutoOpen>]
-module StringBuilder =
-  open System.Text
-
-  type StringBuilder with
-    /// Appends each string in the sequence with indentation
-    member this.AppendIndentedLine(indent: string, lines: #seq<string>) =
-      lines |> Seq.iter (fun line -> this.Append(indent).AppendLine(line) |> ignore)
-      this
-
-    /// Splits text into lines and appends each with indentation
-    member this.AppendIndentedLine(indent: string, text: string) =
-      let lines = text.Split([|'\n'; '\r'|], StringSplitOptions.None)
-      this.AppendIndentedLine(indent, lines)
-
-    member this.AppendLines(lines: #seq<string>) =
-      this.AppendJoin(Environment.NewLine, lines)
-
-    /// Returns the string content with trailing whitespace removed
-    member this.ToStringTrimmed() =
-      this.ToString().TrimEnd()

src/Hedgehog.Xunit/ReportFormatter.fs

@@ -4,96 +4,8 @@ module internal ReportFormatter
 
 open Hedgehog
 open Hedgehog.Xunit
-open System
-open System.Text
-
-// ========================================
-// Report Formatting
-// ========================================
-
-/// Filters exception string to show only user code stack trace.
-/// When we rethrow using ExceptionDispatchInfo.Capture().Throw() to preserve the original stack trace,
-/// it adds a "--- End of stack trace from previous location ---" marker and appends Hedgehog's
-/// internal frames as the exception propagates. We remove everything from that marker onwards
-/// to show only the user's code in the test failure report.
-let private filterExceptionStackTrace (exceptionEntry: string) : string =
-    match exceptionEntry.IndexOf("--- End of stack trace from previous location ---") with
-    | -1 -> exceptionEntry  // No marker found, return as-is
-    | idx -> exceptionEntry.Substring(0, idx).TrimEnd()
-
-let private formatFailureForXunit (failure: FailureData) (report: Report) : string =
-    let sb = StringBuilder()
-    let indent = "  " // 2 spaces to align with xUnit's output format
-
-    let renderTests (tests: int<tests>) =
-        sprintf "%d test%s" (int tests) (if int tests = 1 then "" else "s")
-
-    let renderAndShrinks (shrinks: int<shrinks>) =
-        if int shrinks = 0 then
-            ""
-        else
-            sprintf " and %d shrink%s" (int shrinks) (if int shrinks = 1 then "" else "s")
-
-    let renderAndDiscards (discards: int<discards>) =
-        if int discards = 0 then
-            ""
-        else
-            sprintf " and %d discard%s" (int discards) (if int discards = 1 then "" else "s")
-
-    // Header
-    sb.AppendIndentedLine(
-        indent,
-        sprintf
-            "*** Failed! Falsifiable (after %s%s%s):"
-            (renderTests report.Tests)
-            (renderAndShrinks failure.Shrinks)
-            (renderAndDiscards report.Discards)
-    )
-    |> ignore
-
-    // Journal structure: first=parameters, middle=entries (optional), last=exception (always present on failure)
-    let journalEntries = Journal.eval failure.Journal |> Array.ofSeq
-
-    let parametersEntry, entries, exceptionEntryOpt =
-        Array.splitFirstMiddleLast journalEntries
-
-    // Parameters section
-    sb.AppendLine() |> ignore
-
-    if String.IsNullOrWhiteSpace(parametersEntry) then
-        sb.AppendLine("Test doesn't take parameters") |> ignore
-    else
-        sb.AppendLine("Input parameters:").AppendIndentedLine(indent, parametersEntry)
-        |> ignore
-
-    // Middle entries section (user's debug info from Property.counterexample, etc.)
-    if entries.Length > 0 then
-        sb.AppendLine().AppendLines(entries) |> ignore
-
-    // Recheck seed (if available)
-    match failure.RecheckInfo with
-    | Some recheckInfo ->
-        let serialized = RecheckData.serialize recheckInfo.Data
-        sb.AppendLine().AppendLine($"Recheck seed: \"%s{serialized}\"") |> ignore
-    | None -> ()
-
-    // Exception section (filtered to show only user code)
-    match exceptionEntryOpt with
-    | Some exceptionEntry ->
-        let filteredEntry = filterExceptionStackTrace exceptionEntry
-
-        sb.AppendLine().AppendLine("Actual exception:").AppendLine(filteredEntry)
-        |> ignore
-    | None -> ()
-
-    sb.ToStringTrimmed()
-
-let private formatReportForXunit (report: Report) : string =
-    match report.Status with
-    | Failed failure -> formatFailureForXunit failure report
-    | _ -> Report.render report
 
 let tryRaise (report: Report) : unit =
     match report.Status with
-    | Failed _ -> report |> formatReportForXunit |> PropertyFailedException |> raise
+    | Failed _ -> report |> Report.render |> PropertyFailedException |> raise
     | _ -> Report.tryRaise report

src/Hedgehog/Exceptions.fs

@@ -2,18 +2,15 @@
 module Hedgehog.Exceptions
 
 open System
-open System.Reflection
 
 /// Recursively unwraps wrapper exceptions to get to the actual meaningful exception.
-/// Unwraps TargetInvocationException (from reflection) and single-inner AggregateException (from async/tasks).
+/// Unwraps single-inner AggregateException (from async/tasks).
 let rec unwrap (e : exn) : exn =
 #if FABLE_COMPILER
     e
 #else
     match e with
-    | :? TargetInvocationException as tie when not (isNull tie.InnerException) ->
-        unwrap tie.InnerException
     | :? AggregateException as ae when ae.InnerExceptions.Count = 1 ->
-        unwrap ae.InnerExceptions.[0]
+        unwrap ae.InnerExceptions[0]
     | _ -> e
 #endif

src/Hedgehog/Hedgehog.fsproj

@@ -30,6 +30,7 @@ Failures are automatically simplified, giving developers coherent, intelligible
   <ItemGroup>
     <Compile Include="AutoOpen.fs" />
     <Compile Include="Exceptions.fs" />
+    <Compile Include="ValueFormatting.fs" />
     <Compile Include="Numeric.fs" />
     <Compile Include="Seed.fs" />
     <Compile Include="Seq.fs" />

src/Hedgehog/Journal.fs

@@ -1,37 +1,46 @@
 namespace Hedgehog
 
+/// Represents a single line in a property test journal with semantic meaning
+type JournalLine =
+    | TestParameter of name: string * value: obj     // Individual test method parameter
+    | GeneratedValue of value: obj                   // forAll generated values (no name)
+    | Counterexample of message: string              // Property.counterexample user messages
+    | Exception of exn: exn                          // Original exception, unwrap at render
+    | Cancellation of message: string                // OperationCanceledException messages
+    | Text of message: string                        // Plane text messages (info, etc.)
+
 [<Struct>]
 type Journal =
-    | Journal of seq<unit -> string>
+    | Journal of seq<unit -> JournalLine>
 
 module Journal =
 
     /// Creates a journal from a sequence of entries.
-    let ofSeq (entries : seq<unit -> string>) : Journal =
+    let ofSeq (entries : seq<unit -> JournalLine>) : Journal =
         Journal entries
 
-    /// Evaluates a single entry, returning it's message.
-    let private evalEntry (f : unit -> string) : string =
+    /// Evaluates a single entry, returning the journal line.
+    let private evalEntry (f : unit -> JournalLine) : JournalLine =
         f()
 
-    /// Evaluates all entries in the journal, returning their messages.
-    let eval (Journal entries : Journal) : seq<string> =
+    /// Evaluates all entries in the journal, returning their journal lines.
+    let eval (Journal entries : Journal) : seq<JournalLine> =
         Seq.map evalEntry entries
 
     /// Represents a journal with no entries.
     let empty : Journal =
         ofSeq []
 
-    /// Creates a single entry journal from a given message.
+    /// Creates a single entry journal from a given message as Text.
     let singletonMessage (message : string) : Journal =
-        ofSeq [ fun () -> message ]
+        ofSeq [ fun () -> Text message ]
 
     /// Adds exception to the journal as a single entry.
     let exn (error: exn): Journal =
-        singletonMessage (string (Exceptions.unwrap error))
+        ofSeq [ fun () -> Exception error ]
 
     /// Creates a single entry journal from a given entry.
-    let singleton (entry : unit -> string) : Journal =
+    let singleton (entry : unit -> JournalLine) : Journal =
         ofSeq [ entry ]
 
     /// Creates a journal composed of entries from two journals.