Implement assertOutputMatches with assertOn

philderbeast · philderbeast · commit b2d1fcc3cf26 · 2025-04-25T06:35:50.000-04:00
- Add NeedleHaystackCompare
- Add tests of assertions
- Quote regex pattern
- Add regex tests
- Add assertOutputMatches tests
- Add tests using POSIX character classes
- Rename to TxFwdBwd
- Add isInfixOf predicate to assertOn calls
diff --git a/cabal-testsuite/AssertTests/cabal.out b/cabal-testsuite/AssertTests/cabal.out
@@ -0,0 +1,8 @@
+# Multiline string marking:
+# ^When using configuration from:$
+# ^  - else.project$
+# ^  - dir-else/else.config$
+# ^The following errors occurred:$
+# ^  - The package location 'no-pkg-here' does not exist.$
+# Pseudo multiline string marking:
+# ^When using configuration from:   - else.project   - dir-else/else.config The following errors occurred:   - The package location 'no-pkg-here' does not exist.$
diff --git a/cabal-testsuite/AssertTests/cabal.test.hs b/cabal-testsuite/AssertTests/cabal.test.hs
@@ -0,0 +1,40 @@
+import Test.Cabal.Prelude
+import Data.List (isInfixOf)
+import System.Directory
+import System.Exit
+
+mkResult :: String -> Result
+mkResult = Result ExitSuccess "run"
+
+main = cabalTest . recordMode RecordMarked $ do
+  let log = recordHeader . pure
+
+  msg <- readFileVerbatim "msg.expect.txt"
+  let out = mkResult msg
+  let msgSingle = lineBreaksToSpaces msg
+
+  log "Multiline string marking:"
+  mapM_ log (lines . delimitLines $ encodeLf msg)
+  assertOn isInfixOf multilineNeedleHaystack msg out
+  assertOutputContains msg out
+
+  assertOutputMatches "^When.*from:$" out
+  assertOutputMatches "no[-]{1,1}pkg-here" out
+
+  assertOutputMatches "else\\.project" out
+  assertOutputMatches "else\\/else" out
+
+  assertOutputMatches "^The f[lo]{4,}wing[[:space:]]errors[ ]{1,1}occurred[:]*$" out
+
+  assertOutputMatches " errors " out
+  assertOutputDoesNotMatch " error " out
+
+  assertOutputMatches "[[:space:]]+errors[[:space:]]+" out
+  assertOutputDoesNotMatch "[[:space:]]+error[[:space:]]+" out
+
+  log "Pseudo multiline string marking:"
+  mapM_ log (lines . delimitLines $ encodeLf msgSingle)
+  assertOn isInfixOf multilineNeedleHaystack{expectNeedleInHaystack = False} msgSingle out
+  assertOutputDoesNotContain msgSingle out
+
+  return ()
diff --git a/cabal-testsuite/AssertTests/msg.expect.txt b/cabal-testsuite/AssertTests/msg.expect.txt
@@ -0,0 +1,5 @@
+When using configuration from:
+  - else.project
+  - dir-else/else.config
+The following errors occurred:
+  - The package location 'no-pkg-here' does not exist.
diff --git a/cabal-testsuite/PackageTests/CheckSetup/setup.test.hs b/cabal-testsuite/PackageTests/CheckSetup/setup.test.hs
@@ -1,4 +1,5 @@
 import Test.Cabal.Prelude
+import Data.List (isInfixOf)
 
 -- Test that setup shows all the 'autogen-modules' warnings.
 main = cabalTest $ do
@@ -15,10 +16,10 @@ main = cabalTest $ do
 
         -- Replace line breaks with spaces in the haystack so that we can search
         -- for a string that wraps lines.
-        let lineBreakBlind = needleHaystack{txHaystack = txContainsId{txFwd = lineBreaksToSpaces}}
+        let lineBreakBlind = needleHaystack{txHaystack = txFwdBwdId{txFwd = lineBreaksToSpaces}}
 
         -- Asserts for the desired check messages after configure.
-        assertOn lineBreakBlind libError1 checkResult
-        assertOn lineBreakBlind libError2 checkResult
+        assertOn isInfixOf lineBreakBlind libError1 checkResult
+        assertOn isInfixOf lineBreakBlind libError2 checkResult
 
         return ()
diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs
@@ -2,6 +2,7 @@ import Test.Cabal.Prelude
 import Test.Cabal.OutputNormalizer
 import Data.Function ((&))
 import Data.Functor ((<&>))
+import Data.List (isInfixOf)
 
 main = cabalTest . withRepo "repo" . recordMode RecordMarked $ do
   let log = recordHeader . pure
@@ -113,7 +114,7 @@ main = cabalTest . withRepo "repo" . recordMode RecordMarked $ do
   hopping <- cabal' "v2-build" [ "--project-file=hops-0.project" ]
 
   readFileVerbatim "hops.expect.txt" >>=
-    flip (assertOn multilineNeedleHaystack) hopping .  normalizePathSeparators
+    flip (assertOn isInfixOf multilineNeedleHaystack) hopping .  normalizePathSeparators
 
   -- The project is named oops as it is like hops but has conflicting constraints.
   -- +-- oops-0.project
@@ -130,7 +131,7 @@ main = cabalTest . withRepo "repo" . recordMode RecordMarked $ do
   oopsing <- fails $ cabal' "v2-build" [ "all", "--project-file=oops-0.project" ]
 
   readFileVerbatim "oops.expect.txt"
-    >>= flip (assertOn multilineNeedleHaystack) oopsing . normalizePathSeparators
+    >>= flip (assertOn isInfixOf multilineNeedleHaystack) oopsing . normalizePathSeparators
 
   -- The project is named yops as it is like hops but with y's for forks.
   -- +-- yops-0.project
@@ -173,6 +174,6 @@ main = cabalTest . withRepo "repo" . recordMode RecordMarked $ do
   missing <- fails $ cabal' "v2-build" [ "--project-file=cabal-missing-package.project" ]
 
   readFileVerbatim "cabal-missing-package.expect.txt"
-    >>= flip (assertOn multilineNeedleHaystack) missing . normalizePathSeparators
+    >>= flip (assertOn isInfixOf multilineNeedleHaystack) missing . normalizePathSeparators
 
   return ()
diff --git a/cabal-testsuite/PackageTests/NewBuild/T4288/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/T4288/cabal.test.hs
@@ -1,5 +1,6 @@
 import Test.Cabal.Prelude
 import Data.Function ((&))
+import Data.List (isInfixOf)
 
 -- This test is similar to the simplified example in issue #4288. The package's
 -- setup script only depends on base and setup-helper. setup-helper exposes a
@@ -14,4 +15,4 @@ main = cabalTest $ do
   "In order, the following will be built:\n\
   \ - setup-helper-1.0 (lib:setup-helper) (first run)\n\
   \ - T4288-1.0 (lib:T4288) (first run)"
-    & flip (assertOn multilineNeedleHaystack) r
+    & flip (assertOn isInfixOf multilineNeedleHaystack) r
diff --git a/cabal-testsuite/PackageTests/ProjectImport/DedupUsingConfigFromComplex/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectImport/DedupUsingConfigFromComplex/cabal.test.hs
@@ -1,5 +1,6 @@
 import Test.Cabal.Prelude
 import Data.Function ((&))
+import Data.List (isInfixOf)
 
 main = cabalTest . flakyIfCI 10927. recordMode RecordMarked $ do
   let log = recordHeader . pure
@@ -11,6 +12,6 @@ main = cabalTest . flakyIfCI 10927. recordMode RecordMarked $ do
   log "check package directories and locations are reported in order"
 
   readFileVerbatim "errors.expect.txt"
-    >>= flip (assertOn multilineNeedleHaystack) out . normalizePathSeparators
+    >>= flip (assertOn isInfixOf multilineNeedleHaystack) out . normalizePathSeparators
 
   return ()
diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out
@@ -1,14 +1,6 @@
 # cabal v2-build
 Warnings found while parsing the project file, else.project:
  - dir-else/else.config: Unrecognized section '_' on line 3
-# Multiline string marking:
-# ^When using configuration from:$
-# ^  - else.project$
-# ^  - dir-else/else.config$
-# ^The following errors occurred:$
-# ^  - The package location 'no-pkg-here' does not exist.$
-# Pseudo multiline string marking:
-# ^When using configuration from:   - else.project   - dir-else/else.config The following errors occurred:   - The package location 'no-pkg-here' does not exist.$
 # cabal v2-build
 Error: [Cabal-7090]
 Error parsing project file cabal.project:3:
diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.test.hs
@@ -1,25 +1,11 @@
 import Test.Cabal.Prelude
-import System.Directory
 
 main = cabalTest . recordMode RecordMarked $ do
   let log = recordHeader . pure
 
   outElse <- fails $ cabal' "v2-build" [ "all", "--dry-run", "--project-file=else.project" ]
-
   msg <- readFileVerbatim "msg.expect.txt"
-  let msgSingle = lineBreaksToSpaces msg
-
-  log "Multiline string marking:"
-  mapM_ log (lines . delimitLines $ encodeLf msg)
-
-  log "Pseudo multiline string marking:"
-  mapM_ log (lines . delimitLines $ encodeLf msgSingle)
-
-  assertOn multilineNeedleHaystack msg outElse
-  assertOn multilineNeedleHaystack{expectNeedleInHaystack = False} msgSingle outElse
-
   assertOutputContains msg outElse
-  assertOutputDoesNotContain msgSingle outElse
 
 
   outDefault <- fails $ cabal' "v2-build" [ "all", "--dry-run", "--project-file=cabal.project" ]
diff --git a/cabal-testsuite/PackageTests/Regression/T5409/use-different-versions-of-dependency-for-library-and-build-tool.test.hs b/cabal-testsuite/PackageTests/Regression/T5409/use-different-versions-of-dependency-for-library-and-build-tool.test.hs
@@ -1,5 +1,6 @@
 import Test.Cabal.Prelude
 import Data.Function ((&))
+import Data.List (isInfixOf)
 
 -- The local package, pkg-1.0, depends on build-tool-pkg-1 as a library and
 -- build-tool-pkg-2 as a build-tool.  This test checks that cabal uses the
@@ -22,8 +23,8 @@ main = cabalTest $ withShorterPathForNewBuildStore $ do
       \ - build-tool-pkg-2 (lib) (requires build)\n\
       \ - build-tool-pkg-2 (exe:build-tool-exe) (requires build)\n\
       \ - pkg-1.0 (exe:my-exe) (first run)"
-        & flip (assertOn multilineNeedleHaystack) r1
+        & flip (assertOn isInfixOf multilineNeedleHaystack) r1
 
       withPlan $ do
         r2 <- runPlanExe' "pkg" "my-exe" []
-        assertOn multilineNeedleHaystack "build-tool library version: 1,\nbuild-tool exe version: 2" r2
+        assertOn isInfixOf multilineNeedleHaystack "build-tool library version: 1,\nbuild-tool exe version: 2" r2
diff --git a/cabal-testsuite/src/Test/Cabal/NeedleHaystack.hs b/cabal-testsuite/src/Test/Cabal/NeedleHaystack.hs
@@ -6,9 +6,10 @@
 -- for the strings to search in and the search strings such as re-encoding line
 -- breaks or delimiting lines. Both LF and CRLF line breaks are recognized.
 module Test.Cabal.NeedleHaystack
-    ( TxContains(..)
-    , txContainsId
+    ( TxFwdBwd(..)
+    , txFwdBwdId
     , NeedleHaystack(..)
+    , NeedleHaystackCompare
     , symNeedleHaystack
     , multilineNeedleHaystack
     , needleHaystack
@@ -127,9 +128,11 @@ before comparison and before display can help find out why an expected value is
 or isn't found in the test output.
 -}
 
+type NeedleHaystackCompare = String -> String -> Bool
+
 -- | Transformations for the search strings and the text to search in.
-data TxContains =
-    TxContains
+data TxFwdBwd =
+    TxFwdBwd
         {
             -- | Reverse conversion for display, applied to the forward converted value.
             txBwd :: (String -> String),
@@ -139,8 +142,8 @@ data TxContains =
 
 -- | Identity transformation for the search strings and the text to search in,
 -- leaves them unchanged.
-txContainsId :: TxContains
-txContainsId = TxContains id id
+txFwdBwdId :: TxFwdBwd
+txFwdBwdId = TxFwdBwd id id
 
 -- | Conversions of the needle and haystack strings, the seach string and the
 -- text to search in.
@@ -149,14 +152,14 @@ data NeedleHaystack =
         {
             expectNeedleInHaystack :: Bool,
             displayHaystack :: Bool,
-            txNeedle :: TxContains,
-            txHaystack :: TxContains
+            txNeedle :: TxFwdBwd,
+            txHaystack :: TxFwdBwd
         }
 
 -- | Symmetric needle and haystack functions, the same conversion for each going
 -- forward and the same coversion for each going backward.
 symNeedleHaystack :: (String -> String) -> (String -> String) -> NeedleHaystack
-symNeedleHaystack bwd fwd = let tx = TxContains bwd fwd in NeedleHaystack True False tx tx
+symNeedleHaystack bwd fwd = let tx = TxFwdBwd bwd fwd in NeedleHaystack True False tx tx
 
 -- | Multiline needle and haystack functions with symmetric conversions. Going
 -- forward converts line breaks to @"\\n"@.  Going backward adds visible
@@ -167,7 +170,7 @@ multilineNeedleHaystack = symNeedleHaystack delimitLines encodeLf
 -- | Minimal set up for finding the needle in the haystack. Doesn't change the
 -- strings and doesn't display the haystack in any assertion failure message.
 needleHaystack :: NeedleHaystack
-needleHaystack = NeedleHaystack True False txContainsId txContainsId
+needleHaystack = NeedleHaystack True False txFwdBwdId txFwdBwdId
 
 -- | Replace line breaks with spaces, correctly handling @"\\r\\n"@.
 --
diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs
@@ -809,23 +809,21 @@ recordMode mode = withReaderT (\env -> env {
 
 -- See Note [Multiline Needles]
 assertOutputContains :: MonadIO m => WithCallStack (String -> Result -> m ())
-assertOutputContains = assertOn
-    needleHaystack
-        {txHaystack = TxContains{txBwd = delimitLines, txFwd = encodeLf}}
+assertOutputContains = assertOn isInfixOf needleHaystack
+    {txHaystack = TxFwdBwd{txBwd = delimitLines, txFwd = encodeLf}}
 
 assertOutputDoesNotContain :: MonadIO m => WithCallStack (String -> Result -> m ())
-assertOutputDoesNotContain = assertOn
-    needleHaystack
-        { expectNeedleInHaystack = False
-        , txHaystack = TxContains{txBwd = delimitLines, txFwd = encodeLf}
-        }
+assertOutputDoesNotContain = assertOn isInfixOf needleHaystack
+    { expectNeedleInHaystack = False
+    , txHaystack = TxFwdBwd{txBwd = delimitLines, txFwd = encodeLf}
+    }
 
 -- See Note [Multiline Needles]
-assertOn :: MonadIO m => WithCallStack (NeedleHaystack -> String -> Result -> m ())
-assertOn NeedleHaystack{..} (txFwd txNeedle -> needle) (txFwd txHaystack. resultOutput -> output) =
+assertOn :: MonadIO m => WithCallStack (NeedleHaystackCompare -> NeedleHaystack -> String -> Result -> m ())
+assertOn isIn NeedleHaystack{..} (txFwd txNeedle -> needle) (txFwd txHaystack. resultOutput -> output) =
     withFrozenCallStack $
     if expectNeedleInHaystack
-        then unless (needle `isInfixOf` output)
+        then unless (needle `isIn` output)
             $ assertFailure $ "expected:\n" ++ (txBwd txNeedle needle) ++
             if displayHaystack
                 then "\nin output:\n" ++ (txBwd txHaystack output)
@@ -837,18 +835,17 @@ assertOn NeedleHaystack{..} (txFwd txNeedle -> needle) (txFwd txHaystack. result
                 else ""
 
 assertOutputMatches :: MonadIO m => WithCallStack (String -> Result -> m ())
-assertOutputMatches regex result =
-    withFrozenCallStack $
-    unless (encodeLf output =~ regex) $
-    assertFailure $ "expected regex match: " ++ regex
-  where output = resultOutput result
+assertOutputMatches = assertOn (flip (=~)) needleHaystack
+    { txNeedle = TxFwdBwd{txBwd = ("regex match with '" ++) . (++ "'"), txFwd = id}
+    , txHaystack = TxFwdBwd{txBwd = delimitLines, txFwd = encodeLf}
+    }
 
 assertOutputDoesNotMatch :: MonadIO m => WithCallStack (String -> Result -> m ())
-assertOutputDoesNotMatch regex result =
-    withFrozenCallStack $
-    when (encodeLf output =~ regex) $
-    assertFailure $ "unexpected regex match: " ++ regex
-  where output = resultOutput result
+assertOutputDoesNotMatch = assertOn (flip (=~)) needleHaystack
+    { expectNeedleInHaystack = False
+    , txNeedle = TxFwdBwd{txBwd = ("regex match with '" ++) . (++ "'"), txFwd = id}
+    , txHaystack = TxFwdBwd{txBwd = delimitLines, txFwd = encodeLf}
+    }
 
 assertFindInFile :: MonadIO m => WithCallStack (String -> FilePath -> m ())
 assertFindInFile needle path =
