diff --git a/src/Hedgehog.Xunit/AutoGenConfig.fs b/src/Hedgehog.Xunit/AutoGenConfig.fs index c4f2df22..10ba8200 100644 --- a/src/Hedgehog.Xunit/AutoGenConfig.fs +++ b/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()) diff --git a/src/Hedgehog.Xunit/Exceptions.fs b/src/Hedgehog.Xunit/Exceptions.fs index 04298b7a..7501c6f1 100644 --- a/src/Hedgehog.Xunit/Exceptions.fs +++ b/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) diff --git a/src/Hedgehog.Xunit/InternalLogic.fs b/src/Hedgehog.Xunit/InternalLogic.fs index 0982f4b9..e9238673 100644 --- a/src/Hedgehog.Xunit/InternalLogic.fs +++ b/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 = | _ -> 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> - if isResizeArray then - value :?> System.Collections.IEnumerable - |> Seq.cast - |> 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 = 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 diff --git a/src/Hedgehog.Xunit/Prelude.fs b/src/Hedgehog.Xunit/Prelude.fs index 65fa34e4..13ba3656 100644 --- a/src/Hedgehog.Xunit/Prelude.fs +++ b/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 - -[] -module StringBuilder = - open System.Text - - type StringBuilder with - /// Appends each string in the sequence with indentation - member this.AppendIndentedLine(indent: string, lines: #seq) = - 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) = - this.AppendJoin(Environment.NewLine, lines) - - /// Returns the string content with trailing whitespace removed - member this.ToStringTrimmed() = - this.ToString().TrimEnd() diff --git a/src/Hedgehog.Xunit/ReportFormatter.fs b/src/Hedgehog.Xunit/ReportFormatter.fs index 371dba7b..297317b7 100644 --- a/src/Hedgehog.Xunit/ReportFormatter.fs +++ b/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) = - sprintf "%d test%s" (int tests) (if int tests = 1 then "" else "s") - - let renderAndShrinks (shrinks: int) = - if int shrinks = 0 then - "" - else - sprintf " and %d shrink%s" (int shrinks) (if int shrinks = 1 then "" else "s") - - let renderAndDiscards (discards: int) = - 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 diff --git a/src/Hedgehog/Exceptions.fs b/src/Hedgehog/Exceptions.fs index e344522f..db507eec 100644 --- a/src/Hedgehog/Exceptions.fs +++ b/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 diff --git a/src/Hedgehog/Hedgehog.fsproj b/src/Hedgehog/Hedgehog.fsproj index 3914a4f7..131e117a 100644 --- a/src/Hedgehog/Hedgehog.fsproj +++ b/src/Hedgehog/Hedgehog.fsproj @@ -30,6 +30,7 @@ Failures are automatically simplified, giving developers coherent, intelligible + diff --git a/src/Hedgehog/Journal.fs b/src/Hedgehog/Journal.fs index 43490b43..d162d152 100644 --- a/src/Hedgehog/Journal.fs +++ b/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.) + [] type Journal = - | Journal of seq string> + | Journal of seq JournalLine> module Journal = /// Creates a journal from a sequence of entries. - let ofSeq (entries : seq string>) : Journal = + let ofSeq (entries : seq 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 = + /// Evaluates all entries in the journal, returning their journal lines. + let eval (Journal entries : Journal) : seq = 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. diff --git a/src/Hedgehog/Property.fs b/src/Hedgehog/Property.fs index d5ccf115..2963a047 100644 --- a/src/Hedgehog/Property.fs +++ b/src/Hedgehog/Property.fs @@ -90,8 +90,8 @@ module Property = let! result = Async.AwaitTask inputTask return (Journal.empty, Success result) with - | :? System.OperationCanceledException -> - return (Journal.singletonMessage "Task was canceled", Failure) + | :? OperationCanceledException -> + return (Journal.singleton (fun () -> Cancellation "Task was canceled"), Failure) | ex -> return (Journal.exn ex, Failure) }))) @@ -106,8 +106,8 @@ module Property = do! Async.AwaitTask inputTask return (Journal.empty, Success ()) with - | :? System.OperationCanceledException -> - return (Journal.singletonMessage "Task was canceled", Failure) + | :? OperationCanceledException -> + return (Journal.singleton (fun () -> Cancellation "Task was canceled"), Failure) | ex -> return (Journal.exn ex, Failure) }))) @@ -135,6 +135,10 @@ module Property = let failure : Property = Failure |> ofOutcome + // A failed property with a given exception recorded in the journal. + let exn (ex: exn) : Property = + (Journal.exn ex, Failure) |> GenLazy.constant |> ofGen + /// A property that discards the current test case, causing a new one to be generated. /// Use sparingly to avoid "gave up" results. let discard : Property = @@ -157,7 +161,7 @@ module Property = /// Use this to provide context about generated values or intermediate results that led to a failure. /// The message function is only evaluated if the test fails. let counterexample (msg : unit -> string) : Property = - (Journal.singleton msg, Success ()) |> GenLazy.constant |> ofGen + (Journal.singleton (fun () -> Counterexample (msg ())), Success ()) |> GenLazy.constant |> ofGen /// Transforms the successful result of a property using the provided function. /// If the function throws an exception, the property fails with the exception message. @@ -291,32 +295,13 @@ module Property = let falseToFailure p = p |> map (fun b -> if not b then raise (TestReturnedFalseException())) - let internal printValue value : string = - // sprintf "%A" is not prepared for printing ResizeArray<_> (C# List) so we prepare the value instead. - let prepareForPrinting (value: obj) : obj = - #if FABLE_COMPILER - value - #else - if value = null then - value - else - let t = value.GetType() - let t = System.Reflection.IntrospectionExtensions.GetTypeInfo(t) - let isList = t.IsGenericType && t.GetGenericTypeDefinition() = typedefof> - if isList - then value :?> System.Collections.IEnumerable |> Seq.cast |> List.ofSeq :> obj - else value - #endif - - value |> prepareForPrinting |> sprintf "%A" - /// Creates a property that tests whether a condition holds for all values generated by the given generator. /// Generated values are automatically added to the test journal and will be shown if the test fails. /// This is the primary way to introduce generated test data into your properties. let forAll (k : 'a -> Property<'b>) (gen : Gen<'a>) : Property<'b> = let prepend (x : 'a) = - counterexample (fun () -> printValue x) - |> set x + let journalEntry = Journal.singleton (fun () -> GeneratedValue (box x)) + (journalEntry, Success x) |> GenLazy.constant |> ofGen |> bind k |> toGenInternal @@ -610,7 +595,7 @@ module Property = Size = nextSize data.Size } - let! journal, outcome = PropertyResult.unwrapAsync (Tree.outcome result) + let! _, outcome = PropertyResult.unwrapAsync (Tree.outcome result) match outcome with | Failure -> let! status = Shrinking.shrinkAsync args.Language data config.ShrinkLimit result @@ -778,7 +763,7 @@ module PropertyBuilder = member __.BindReturn(m : Gen<'a>, f: 'a -> 'b) = m - |> Gen.map (fun a -> Lazy.constant ((Journal.singleton (fun () -> Property.printValue a)), Success a)) + |> Gen.map (fun a -> Lazy.constant ((Journal.singleton (fun () -> GeneratedValue (box a))), Success a)) |> Property.ofGen |> Property.map f diff --git a/src/Hedgehog/PropertyResult.fs b/src/Hedgehog/PropertyResult.fs index 793814b2..f2c66381 100644 --- a/src/Hedgehog/PropertyResult.fs +++ b/src/Hedgehog/PropertyResult.fs @@ -26,7 +26,7 @@ module internal PropertyResult = with #if !FABLE_COMPILER | :? System.OperationCanceledException -> - return (Journal.singletonMessage "Async computation was canceled", Failure) + return (Journal.singleton (fun () -> Cancellation "Async computation was canceled"), Failure) #endif | ex -> return (Journal.exn ex, Failure) diff --git a/src/Hedgehog/Report.fs b/src/Hedgehog/Report.fs index 80f7e5fa..272f965c 100644 --- a/src/Hedgehog/Report.fs +++ b/src/Hedgehog/Report.fs @@ -84,17 +84,134 @@ module Report = open System open System.Text + let private printValue = Hedgehog.FSharp.ValueFormatting.printValue + let private indent = " " // 2 spaces for indentation + + // ======================================== + // StringBuilder Extensions + // ======================================== + + type private StringBuilder with + /// Appends each string in the sequence with indentation + member this.AppendIndentedLine(indent: string, lines: #seq) = + 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) + + // ======================================== + // Consecutive Grouping + // ======================================== + + /// Groups consecutive elements by a classifier function, preserving order. + /// Returns a list of (key * items list) tuples where items with the same consecutive key are grouped together. + let private groupConsecutiveBy (classifier: 'T -> 'Key) (source: 'T seq) : ('Key * 'T list) list = + let folder (groups, currentKey, currentGroup) item = + let key = classifier item + match currentKey with + | None -> (groups, Some key, [item]) + | Some prevKey when key = prevKey -> (groups, currentKey, item :: currentGroup) + | Some prevKey -> ((prevKey, List.rev currentGroup) :: groups, Some key, [item]) + + let groups, finalKey, finalGroup = + source |> Seq.fold folder ([], None, []) + + match finalKey with + | None -> [] + | Some key -> (key, List.rev finalGroup) :: groups + |> List.rev + + // ======================================== + // Journal Entry Groups + // ======================================== + + type private JournalEntryGroup = + | ParametersGroup of (string * obj) list + | GeneratedGroup of obj list + | CounterexamplesGroup of string list + | TextsGroup of string list + | CancellationsGroup of string list + | ExceptionsGroup of exn list + + let private classifyJournalLine (line: JournalLine) : JournalEntryGroup = + match line with + | TestParameter (name, value) -> ParametersGroup [(name, value)] + | GeneratedValue value -> GeneratedGroup [value] + | Counterexample msg -> CounterexamplesGroup [msg] + | Text msg -> TextsGroup [msg] + | Cancellation msg -> CancellationsGroup [msg] + | Exception exn -> ExceptionsGroup [exn] + + let private groupKey (group: JournalEntryGroup) : int = + match group with + | ParametersGroup _ -> 0 + | GeneratedGroup _ -> 1 + | CounterexamplesGroup _ -> 2 + | TextsGroup _ -> 3 + | CancellationsGroup _ -> 4 + | ExceptionsGroup _ -> 5 + + let private mergeGroups (groups: JournalEntryGroup list) : JournalEntryGroup = + match groups with + | [] -> failwith "Cannot merge empty group list" + | ParametersGroup _ :: _ -> + groups |> List.collect (function ParametersGroup items -> items | _ -> []) |> ParametersGroup + | GeneratedGroup _ :: _ -> + groups |> List.collect (function GeneratedGroup items -> items | _ -> []) |> GeneratedGroup + | CounterexamplesGroup _ :: _ -> + groups |> List.collect (function CounterexamplesGroup items -> items | _ -> []) |> CounterexamplesGroup + | TextsGroup _ :: _ -> + groups |> List.collect (function TextsGroup items -> items | _ -> []) |> TextsGroup + | CancellationsGroup _ :: _ -> + groups |> List.collect (function CancellationsGroup items -> items | _ -> []) |> CancellationsGroup + | ExceptionsGroup _ :: _ -> + groups |> List.collect (function ExceptionsGroup items -> items | _ -> []) |> ExceptionsGroup + + // ======================================== + // Group Rendering Functions + // ======================================== + + let private renderParameters (sb: StringBuilder) (parameters: (string * obj) list) : unit = + sb.AppendLine().AppendLine("Test parameters:") |> ignore + parameters |> List.iter (fun (name, value) -> + sb.AppendIndentedLine(indent, $"%s{name} = %s{printValue value}") |> ignore) + + let private renderGenerated (sb: StringBuilder) (values: obj list) : unit = + sb.AppendLine().AppendLine("Generated values:") |> ignore + values |> List.iter (fun value -> + sb.AppendIndentedLine(indent, printValue value) |> ignore) + + let private renderCounterexamples (sb: StringBuilder) (messages: string list) : unit = + sb.AppendLine().AppendLine("Counterexamples:") |> ignore + messages |> List.iter (fun msg -> sb.AppendIndentedLine(indent, msg) |> ignore) + + let private renderTexts (sb: StringBuilder) (messages: string list) : unit = + sb.AppendLine() |> ignore + messages |> List.iter (fun msg -> sb.AppendLine(msg) |> ignore) + + let private renderCancellations (sb: StringBuilder) (messages: string list) : unit = + sb.AppendLine() |> ignore + messages |> List.iter (fun msg -> sb.AppendLine(msg) |> ignore) + + let private renderExceptions (sb: StringBuilder) (exceptions: exn list) : unit = + exceptions |> List.iter (fun exn -> + let exceptionString = string (Exceptions.unwrap exn) + sb.AppendLine().AppendLine("Actual exception:").AppendLine(exceptionString) |> ignore) + let private renderTests : int -> string = function | 1 -> "1 test" | n -> - sprintf "%d tests" n + $"%d{n} tests" let private renderDiscards : int -> string = function | 1 -> "1 discard" | n -> - sprintf "%d discards" n + $"%d{n} discards" let private renderAndDiscards : int -> string = function | 0 -> @@ -102,7 +219,7 @@ module Report = | 1 -> " and 1 discard" | n -> - sprintf " and %d discards" n + $" and %d{n} discards" let private renderAndShrinks : int -> string = function | 0 -> @@ -110,13 +227,7 @@ module Report = | 1 -> " and 1 shrink" | n -> - sprintf " and %d shrinks" n - - let private appendLine (sb : StringBuilder) (msg : string) : unit = - sb.AppendLine msg |> ignore - - let private appendLinef (sb : StringBuilder) (fmt : Printf.StringFormat<'a, unit>) : 'a = - Printf.ksprintf (appendLine sb) fmt + $" and %d{n} shrinks" let private renderOK (report : Report) : string = sprintf "+++ OK, passed %s." (renderTests report.Tests) @@ -129,35 +240,46 @@ module Report = let private renderFailed (failure : FailureData) (report : Report) : string = let sb = StringBuilder () - appendLinef sb "*** Failed! Falsifiable (after %s%s%s):" - (renderTests report.Tests) - (renderAndShrinks failure.Shrinks) - (renderAndDiscards report.Discards) - - // Split journal entries into parameters and exceptions - let journalEntries = Journal.eval failure.Journal |> List.ofSeq - let parameters, exceptions = - journalEntries |> List.partition (fun entry -> - not (entry.Contains("Exception") || entry.Contains(" at "))) - - // Render parameters - Seq.iter (appendLine sb) parameters + sb.AppendIndentedLine( + indent, + sprintf + "*** Failed! Falsifiable (after %s%s%s):" + (renderTests report.Tests) + (renderAndShrinks failure.Shrinks) + (renderAndDiscards report.Discards) + ) + |> ignore - // Then render recheck info + // Recheck seed (if available) - render after journal entries match failure.RecheckInfo with - | None -> - () | Some { Data = recheckData } -> - appendLinef sb "" - appendLinef sb "Recheck seed: \"%s\"" (RecheckData.serialize recheckData) + let serialized = RecheckData.serialize recheckData + sb.AppendLine() + .AppendLine("You can reproduce this failure with the following Recheck Seed:") + .AppendIndentedLine(indent, $"\"%s{serialized}\"") |> ignore + | None -> () - // Finally render exceptions - if not (List.isEmpty exceptions) then - appendLinef sb "" - appendLinef sb "Actual error:" - Seq.iter (appendLine sb) exceptions + // Evaluate journal entries and group consecutively by type + let journalLines = Journal.eval failure.Journal + + // Classify each journal line and group consecutive entries of the same type + let groups = + journalLines + |> Seq.map classifyJournalLine + |> groupConsecutiveBy groupKey + |> List.map (fun (_, groupList) -> mergeGroups groupList) + + // Render each group in order + groups |> List.iter (fun group -> + match group with + | ParametersGroup parameters -> renderParameters sb parameters + | GeneratedGroup values -> renderGenerated sb values + | CounterexamplesGroup messages -> renderCounterexamples sb messages + | TextsGroup messages -> renderTexts sb messages + | CancellationsGroup messages -> renderCancellations sb messages + | ExceptionsGroup exceptions -> renderExceptions sb exceptions) - sb.ToString().Trim() // Exclude extra newline. + sb.ToString() let render (report : Report) : string = match report.Status with diff --git a/src/Hedgehog/ValueFormatting.fs b/src/Hedgehog/ValueFormatting.fs new file mode 100644 index 00000000..ff5ad90e --- /dev/null +++ b/src/Hedgehog/ValueFormatting.fs @@ -0,0 +1,25 @@ +namespace Hedgehog.FSharp + +/// Utilities for formatting values in test output +[] +module internal ValueFormatting = + + /// Formats a value for display in test output. + /// Converts ResizeArray to list for better readability. + let printValue (value: obj) : string = + let prepareForPrinting (value: obj) : obj = + #if FABLE_COMPILER + value + #else + if value = null then + value + else + let t = value.GetType() + let t = System.Reflection.IntrospectionExtensions.GetTypeInfo(t) + let isList = t.IsGenericType && t.GetGenericTypeDefinition() = typedefof> + if isList + then value :?> System.Collections.IEnumerable |> Seq.cast |> List.ofSeq :> obj + else value + #endif + + value |> prepareForPrinting |> sprintf "%A" diff --git a/tests/Hedgehog.Autogen.Tests/GenTests.fs b/tests/Hedgehog.Autogen.Tests/GenTests.fs index d00a3795..c46210f0 100644 --- a/tests/Hedgehog.Autogen.Tests/GenTests.fs +++ b/tests/Hedgehog.Autogen.Tests/GenTests.fs @@ -499,7 +499,7 @@ module ShrinkTests = test <@ not (value.String.Contains('b')) @> } let rendered = render property - test <@ rendered.Contains "{ String = \"b\"\n Int = 0 }" @> + test <@ rendered.Contains $"{{ String = \"b\"{Environment.NewLine} Int = 0 }}" @> type MyCliMutable() = @@ -612,7 +612,7 @@ module ShrinkTests = } let rendered = render property test <@ rendered.Contains "[[1; 0" || - rendered.Contains "[[1]\n [0]" || + rendered.Contains $"[[1]{Environment.NewLine} [0]" || rendered.Contains "[[1]]"@> [] diff --git a/tests/Hedgehog.Tests/GenTests.fs b/tests/Hedgehog.Tests/GenTests.fs index 9da816cd..ed623f38 100644 --- a/tests/Hedgehog.Tests/GenTests.fs +++ b/tests/Hedgehog.Tests/GenTests.fs @@ -121,7 +121,7 @@ let genTests = testList "Gen tests" [ actual =! expected testCase "dateTime shrinks to correct mid-value" <| fun _ -> - let actual = + let generatedValues = property { let! actual = (Range.constantFrom @@ -131,12 +131,12 @@ let genTests = testList "Gen tests" [ |> Gen.dateTime actual =! DateTime.Now } - |> Property.report - |> Report.render - |> (fun x -> x.Split ([|Environment.NewLine|], StringSplitOptions.None)) - |> Array.item 1 - |> DateTime.Parse + |> expectFailureWithGeneratedValues + if List.isEmpty generatedValues then + failwith "Should have generated values in journal" + + let actual = generatedValues.[0] :?> DateTime actual =! DateTime (2000, 1, 1) fableIgnore "int64 can create exponentially bounded integer" <| fun _ -> diff --git a/tests/Hedgehog.Tests/PropertyBindTests.fs b/tests/Hedgehog.Tests/PropertyBindTests.fs index 4e289463..c63bc9b3 100644 --- a/tests/Hedgehog.Tests/PropertyBindTests.fs +++ b/tests/Hedgehog.Tests/PropertyBindTests.fs @@ -82,12 +82,16 @@ let propertyBindTests = testList "Property.bind semantics" [ match report.Status with | Failed failure -> // After shrinking completes, finalX and finalY contain the minimal counterexample - let journalEntries = failure.Journal |> Journal.eval |> List.ofSeq - let counterexample = journalEntries |> String.concat "\n" + let journalLines = failure.Journal |> Journal.eval |> List.ofSeq + + // Verify we have the expected journal structure + let counterexamples = + journalLines + |> List.choose (function Counterexample msg -> Some msg | _ -> None) // The shrunk counterexample should have y=5 (minimal failing value) // and x should be shrunk towards 1 (the origin of the range) - Expect.equal finalY 5 $"y should shrink to minimal failing value of 5. Counterexample:\n{counterexample}" + Expect.equal finalY 5 $"y should shrink to minimal failing value of 5. Journal: {counterexamples}" | _ -> failwith "Expected failure" fableIgnoreAsync "async bind preserves shrinking - same as sync test but with async" <| async { diff --git a/tests/Hedgehog.Tests/PropertyTests.fs b/tests/Hedgehog.Tests/PropertyTests.fs index 55e7140b..421240c9 100644 --- a/tests/Hedgehog.Tests/PropertyTests.fs +++ b/tests/Hedgehog.Tests/PropertyTests.fs @@ -148,37 +148,33 @@ let propertyTests = testList "Property tests" [ testCase "BindReturn adds value to Journal" <| fun () -> - let actual = + let generatedValues = property { let! b = Gen.bool return Expect.isTrue b } - |> Property.report - |> Report.render - |> (fun x -> x.Split ([|Environment.NewLine|], StringSplitOptions.None)) - |> Array.item 1 - actual =! "false" + |> expectFailureWithGeneratedValues + + if List.isEmpty generatedValues then + failwith "Should have generated values in journal" + + Expect.equal (List.head generatedValues) false "Should have generated 'false'" testCase "and! syntax is applicative" <| fun () -> // Based on https://well-typed.com/blog/2019/05/integrated-shrinking/#:~:text=For%20example%2C%20consider%20the%20property%20that - let actual = + let generatedValues = property { let! x = Range.constant 0 1_000_000_000 |> Gen.int32 and! y = Range.constant 0 1_000_000_000 |> Gen.int32 return x <= y |> Expect.isTrue } - |> Property.report - |> Report.render - |> (fun x -> x.Split ([|Environment.NewLine|], StringSplitOptions.None)) - |> Array.item 1 - - let actual = - // normalize printing of a pair between .NET and Fable/JS - actual.Replace("(", "") - .Replace(" ", "") - .Replace(")", "") - - actual =! "1,0" + |> expectFailureWithGeneratedValues + + if List.length generatedValues <> 1 then + failwithf "Should have 1 generated value (tuple) in journal, but got %d" (List.length generatedValues) + + let (x, y) = generatedValues.[0] :?> (int * int) + Expect.equal (x, y) (1, 0) "Should have shrunk to (1, 0)" ] diff --git a/tests/Hedgehog.Tests/TestDsl.fs b/tests/Hedgehog.Tests/TestDsl.fs index c21953f8..338c662a 100644 --- a/tests/Hedgehog.Tests/TestDsl.fs +++ b/tests/Hedgehog.Tests/TestDsl.fs @@ -1,5 +1,8 @@ module internal Hedgehog.Tests.TestDsl +open Hedgehog +open Hedgehog.FSharp + #if FABLE_COMPILER open Fable.Mocha @@ -42,6 +45,21 @@ let fableIgnoreAsync (label : string) (test : Async) : TestCase = let inline (=!) (actual : 'a) (expected : 'a) : unit = Expect.equal actual expected "Should be equal" +/// Runs a property, expects it to fail, and returns the journal for inspection +let expectFailure (prop : Property) : Journal = + let report = Property.report prop + match report.Status with + | Failed failure -> failure.Journal + | OK -> failwith "Expected property to fail but it passed" + | GaveUp -> failwith "Expected property to fail but it gave up" + +/// Expects the property to fail and returns the generated values from the journal +let expectFailureWithGeneratedValues (prop: Property) : obj list = + let journal = expectFailure prop + Journal.eval journal + |> Seq.choose (function GeneratedValue v -> Some v | _ -> None) + |> List.ofSeq + [] module Expect = let isTrue value = diff --git a/tests/Hedgehog.Xunit.Tests.CSharp/Async.cs b/tests/Hedgehog.Xunit.Tests.CSharp/Async.cs index f0822216..40b18574 100644 --- a/tests/Hedgehog.Xunit.Tests.CSharp/Async.cs +++ b/tests/Hedgehog.Xunit.Tests.CSharp/Async.cs @@ -1,4 +1,8 @@ -namespace Hedgehog.Xunit.Tests.CSharp; +using AwesomeAssertions; +using Hedgehog.Linq; +using Range = Hedgehog.Linq.Range; + +namespace Hedgehog.Xunit.Tests.CSharp; public class Async { @@ -33,6 +37,7 @@ public async Task Async_property_with_custom_value_should_run(string return result; } + [Property] public async ValueTask Async_property_returning_ValueTask_with_custom_type(string s) { diff --git a/tests/Hedgehog.Xunit.Tests.FSharp/PropertyTests.fs b/tests/Hedgehog.Xunit.Tests.FSharp/PropertyTests.fs index baf0f663..e4aca7d9 100644 --- a/tests/Hedgehog.Xunit.Tests.FSharp/PropertyTests.fs +++ b/tests/Hedgehog.Xunit.Tests.FSharp/PropertyTests.fs @@ -36,12 +36,18 @@ module ``Property module tests`` = type private Marker = class end let getMethod = typeof.DeclaringType.GetMethod - let assertShrunk methodName expected = + let assertShrunk methodName (expectedParams: (string * obj) list) = let report = PropertyTest.runReport methodName typeof.DeclaringType null match report.Status with | Status.Failed r -> - let rep = r.Journal |> Journal.eval - Assert.Equal(expected, rep |> Seq.head) + let actualParams = + r.Journal + |> Journal.eval + |> Seq.choose (function + | TestParameter (name, value) -> Some (name, value) + | _ -> None) + |> Seq.toList + Assert.Equal<(string * obj) list>(expectedParams, actualParams) | _ -> failwith "impossible" [] @@ -49,7 +55,7 @@ module ``Property module tests`` = [] let ``fails for false`` () = - assertShrunk (nameof ``fails for false, skipped``) "value = 0" + assertShrunk (nameof ``fails for false, skipped``) [("value", box 0)] [] let ``Result with Error shrinks, skipped`` (i: int) = @@ -59,7 +65,7 @@ module ``Property module tests`` = Ok () [] let ``Result with Error shrinks`` () = - assertShrunk (nameof ``Result with Error shrinks, skipped``) "i = 11" + assertShrunk (nameof ``Result with Error shrinks, skipped``) [("i", box 11)] [] let ``Result with Error reports exception with Error value, skipped`` (i: int) = @@ -72,7 +78,13 @@ module ``Property module tests`` = let report = PropertyTest.runReport (nameof ``Result with Error reports exception with Error value, skipped``) typeof.DeclaringType null match report.Status with | Status.Failed r -> - let errorMessage = r.Journal |> Journal.eval |> Seq.skip 1 |> Seq.exactlyOne + let errorMessage = + r.Journal + |> Journal.eval + |> Seq.choose (function + | JournalLine.Exception exn -> Some (exn.ToString()) + | _ -> None) + |> Seq.exactlyOne Assert.Contains($"System.Exception: Result is in the Error case with the following value:{Environment.NewLine}\"Too many digits!\"", errorMessage) | _ -> failwith "impossible" @@ -85,7 +97,7 @@ module ``Property module tests`` = if i >= 50 then failwith "Some error." [] let ``Can shrink an int`` () = - assertShrunk (nameof ``Can shrink an int, skipped``) "i = 50" + assertShrunk (nameof ``Can shrink an int, skipped``) [("i", box 50)] [] let ``Can generate two ints`` (i1: int, i2: int) = @@ -97,7 +109,7 @@ module ``Property module tests`` = i2 >= 20 then failwith "Some error." [] let ``Can shrink both ints`` () = - assertShrunk (nameof ``Can shrink both ints, skipped``) $"i1 = 10{Environment.NewLine}i2 = 20" + assertShrunk (nameof ``Can shrink both ints, skipped``) [("i1", box 10); ("i2", box 20)] [] let ``Can generate an int and string`` (i: int, s: string) = @@ -108,7 +120,7 @@ module ``Property module tests`` = if i >= 2 && s.Contains "b" then failwith "Some error." [] let ``Can shrink an int and string`` () = - assertShrunk (nameof ``Can shrink an int and string, skipped``) $"i = 2{Environment.NewLine}s = \"b\"" + assertShrunk (nameof ``Can shrink an int and string, skipped``) [("i", box 2); ("s", box "b")] [, 1)>] let ``runs with 13 once`` () = () @@ -344,12 +356,19 @@ module ``Asynchronous tests`` = type private Marker = class end let getMethod = typeof.DeclaringType.GetMethod - let assertShrunk methodName expected = + let assertShrunk methodName (expectedParams: (string * obj) list) = let report = PropertyTest.runReport methodName typeof.DeclaringType null printfn "DEBUG: Report status = %A" report.Status match report.Status with | Status.Failed r -> - Assert.Equal(expected, r.Journal |> Journal.eval |> Seq.head) + let actualParams = + r.Journal + |> Journal.eval + |> Seq.choose (function + | TestParameter (name, value) -> Some (name, value) + | _ -> None) + |> Seq.toList + Assert.Equal<(string * obj) list>(expectedParams, actualParams) | _ -> failwithf "impossible - status was: %A" report.Status open System.Threading.Tasks @@ -359,33 +378,33 @@ module ``Asynchronous tests`` = [] let ``Returning Task with exception fails, skipped`` (i: int) : Task = if i > 10 then - Exception() |> Task.FromException + raise <| System.Exception() else FooAsync() [] let ``Returning Task with exception fails`` () = - assertShrunk (nameof ``Returning Task with exception fails, skipped``) "i = 11" + assertShrunk (nameof ``Returning Task with exception fails, skipped``) [("i", box 11)] [] let ``TaskBuilder (returning Task) with exception shrinks, skipped`` (i: int) : Task = task { do! FooAsync() if i > 10 then - raise <| Exception() + raise <| System.Exception() } [] let ``TaskBuilder (returning Task) with exception shrinks`` () = - assertShrunk (nameof ``TaskBuilder (returning Task) with exception shrinks, skipped``) "i = 11" + assertShrunk (nameof ``TaskBuilder (returning Task) with exception shrinks, skipped``) [("i", box 11)] [] let ``Async with exception shrinks, skipped`` (i: int) = async { do! Async.Sleep 2 if i > 10 then - raise <| Exception() + raise <| System.Exception() } [] let ``Async with exception shrinks`` () = - assertShrunk (nameof ``Async with exception shrinks, skipped``) "i = 11" + assertShrunk (nameof ``Async with exception shrinks, skipped``) [("i", box 11)] [] let ``AsyncResult with Error shrinks, skipped`` (i: int) = @@ -398,7 +417,7 @@ module ``Asynchronous tests`` = } [] let ``AsyncResult with Error shrinks`` () = - assertShrunk (nameof ``AsyncResult with Error shrinks, skipped``) "i = 11" + assertShrunk (nameof ``AsyncResult with Error shrinks, skipped``) [("i", box 11)] [] let ``TaskResult with Error shrinks, skipped`` (i: int) = @@ -411,7 +430,7 @@ module ``Asynchronous tests`` = } [] let ``TaskResult with Error shrinks`` () = - assertShrunk (nameof ``TaskResult with Error shrinks, skipped``) "i = 11" + assertShrunk (nameof ``TaskResult with Error shrinks, skipped``) [("i", box 11)] [] let ``Non-unit TaskResult with Error shrinks, skipped`` (i: int) = @@ -424,7 +443,7 @@ module ``Asynchronous tests`` = } [] let ``Non-unit TaskResult with Error shrinks`` () = - assertShrunk (nameof ``Non-unit TaskResult with Error shrinks, skipped``) "i = 11" + assertShrunk (nameof ``Non-unit TaskResult with Error shrinks, skipped``) [("i", box 11)] module ``IDisposable test module`` = let mutable runs = 0 @@ -439,7 +458,7 @@ module ``IDisposable test module`` = [] let ``IDisposable arg get disposed even if exception thrown, skipped`` (_: DisposableImplementation) (i: int) = runs <- runs + 1 - if i > 10 then raise <| Exception() + if i > 10 then raise <| System.Exception() [] let ``IDisposable arg get disposed even if exception thrown`` () = let report = PropertyTest.runReport (nameof ``IDisposable arg get disposed even if exception thrown, skipped``) typeof.DeclaringType null @@ -683,8 +702,10 @@ module ``tryRaise tests`` = let actual = Assert.Throws(fun () -> ReportFormatter.tryRaise report) let expectedMessage = """*** Failed! Falsifiable (after 1 test):""" Assert.Contains(expectedMessage, actual.Message) - let expectedMessage = """Recheck seed: "0_""" + let expectedMessage = """You can reproduce this failure with the following Recheck Seed:""" Assert.Contains(expectedMessage, actual.Message) + let expectedSeed = """"0_""" + Assert.Contains(expectedSeed, actual.Message) module ``returning a property runs it`` =