From d2c6a430255e201ebee2461ab9ad932be8f60a91 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 18 Dec 2024 12:25:38 -0500 Subject: [PATCH] Add NeedleHaystack - Add expectNeedleInHaystack field to NeedleHaystack - Remove 3 assert*Contains functions - Add TxContains record - Apply the txBwd transformations before display - Add displayHaystack field - Switch to using as the marker - Sort language pragmas - Use ++ rather than cons with reversals - Rerun ParseErrorProvenance test - Add doctests for single line strings - Read exected multiline string from file - Use lineBreaksToSpaces - Add module Test.Cabal.NeedleHaystack - Redo ConditionalAndImport with multiline expectations - Add test of string expectation start and end marking - Rename encodeLf and decodeLfMarkLines - Rename original concatOutput to lineBreaksToSpaces - Add assertOutputContainsWrapped - Use multiline and wrapped assertions - Satisfy fix-whitespace - DedupUsingConfigFromComplex multiline assertion - Remove redundant tests that fail on Windows - Use normalizeWindowsOutput in ConditionalAndImport - Forward conversion applied twice by mistake - Easier diff when assertOn follows assertOutputContains --- .../BuildDeps/InternalLibrary2/setup.test.hs | 2 +- .../BuildDeps/InternalLibrary3/setup.test.hs | 2 +- .../PackageTests/CheckSetup/setup.test.hs | 8 +- .../ConditionalAndImport/cabal.test.hs | 192 ++++++++---------- .../PackageTests/NewBuild/T4288/cabal.test.hs | 10 +- .../DedupUsingConfigFromComplex/cabal.test.hs | 15 +- .../ParseErrorProvenance/cabal.out | 8 + .../ParseErrorProvenance/cabal.test.hs | 27 ++- .../ParseErrorProvenance/msg.txt | 5 + ...endency-for-library-and-build-tool.test.hs | 18 +- cabal-testsuite/cabal-testsuite.cabal | 1 + .../src/Test/Cabal/NeedleHaystack.hs | 101 +++++++++ cabal-testsuite/src/Test/Cabal/Prelude.hs | 78 +++---- 13 files changed, 280 insertions(+), 187 deletions(-) create mode 100644 cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/msg.txt create mode 100644 cabal-testsuite/src/Test/Cabal/NeedleHaystack.hs diff --git a/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary2/setup.test.hs b/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary2/setup.test.hs index e36e33823d2..6b6da17f116 100644 --- a/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary2/setup.test.hs +++ b/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary2/setup.test.hs @@ -6,4 +6,4 @@ main = setupAndCabalTest . withPackageDb $ do assertEqual ("executable should have linked with the internal library") ("foo foo myLibFunc internal") - (concatOutput (resultOutput r)) + (lineBreaksToSpaces $ resultOutput r) diff --git a/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary3/setup.test.hs b/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary3/setup.test.hs index 549e8bf8bb4..ac05c394383 100644 --- a/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary3/setup.test.hs +++ b/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary3/setup.test.hs @@ -8,4 +8,4 @@ main = setupAndCabalTest . withPackageDb $ do assertEqual ("executable should have linked with the internal library") ("foo foo myLibFunc internal") - (concatOutput (resultOutput r)) + (lineBreaksToSpaces $ resultOutput r) diff --git a/cabal-testsuite/PackageTests/CheckSetup/setup.test.hs b/cabal-testsuite/PackageTests/CheckSetup/setup.test.hs index 96ed4395785..67997e7e21b 100644 --- a/cabal-testsuite/PackageTests/CheckSetup/setup.test.hs +++ b/cabal-testsuite/PackageTests/CheckSetup/setup.test.hs @@ -13,8 +13,12 @@ main = cabalTest $ do "The dependency 'setup-depends: 'base' does not specify " ++ "an upper bound on the version number" + -- 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}} + -- Asserts for the desired check messages after configure. - assertOutputContains libError1 checkResult - assertOutputContains libError2 checkResult + assertOn lineBreakBlind libError1 checkResult + assertOn lineBreakBlind libError2 checkResult return () diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs index 704ea45c877..d0abb33de2d 100644 --- a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs @@ -1,4 +1,6 @@ import Test.Cabal.Prelude +import Test.Cabal.OutputNormalizer +import Data.Function ((&)) main = cabalTest . withRepo "repo" . recordMode RecordMarked $ do let log = recordHeader . pure @@ -108,89 +110,65 @@ main = cabalTest . withRepo "repo" . recordMode RecordMarked $ do -- +-- hops/hops-9.config (no further imports so not cyclical) log "checking that imports work skipping into a subfolder and then back out again and again" hopping <- cabal' "v2-build" [ "--project-file=hops-0.project" ] - assertOutputContains "Configuration is affected by the following files" hopping - assertOutputContains "- hops-0.project" hopping - assertOutputContains - (normalizeWindowsOutput "- hops-2.config \ - \ imported by: hops/hops-1.config \ - \ imported by: hops-0.project") - hopping - - assertOutputContains - (normalizeWindowsOutput "- hops-4.config \ - \ imported by: hops/hops-3.config \ - \ imported by: hops-2.config \ - \ imported by: hops/hops-1.config \ - \ imported by: hops-0.project") - hopping - - assertOutputContains - (normalizeWindowsOutput "- hops-6.config \ - \ imported by: hops/hops-5.config \ - \ imported by: hops-4.config \ - \ imported by: hops/hops-3.config \ - \ imported by: hops-2.config \ - \ imported by: hops/hops-1.config \ - \ imported by: hops-0.project") - hopping - - assertOutputContains - (normalizeWindowsOutput "- hops-8.config \ - \ imported by: hops/hops-7.config \ - \ imported by: hops-6.config \ - \ imported by: hops/hops-5.config \ - \ imported by: hops-4.config \ - \ imported by: hops/hops-3.config \ - \ imported by: hops-2.config \ - \ imported by: hops/hops-1.config \ - \ imported by: hops-0.project") - hopping - - assertOutputContains - (normalizeWindowsOutput "- hops/hops-1.config \ - \ imported by: hops-0.project") - hopping - - assertOutputContains - (normalizeWindowsOutput "- hops/hops-3.config \ - \ imported by: hops-2.config \ - \ imported by: hops/hops-1.config \ - \ imported by: hops-0.project") - hopping - - assertOutputContains - (normalizeWindowsOutput "- hops/hops-5.config \ - \ imported by: hops-4.config \ - \ imported by: hops/hops-3.config \ - \ imported by: hops-2.config \ - \ imported by: hops/hops-1.config \ - \ imported by: hops-0.project") - hopping - - assertOutputContains - (normalizeWindowsOutput "- hops/hops-7.config \ - \ imported by: hops-6.config \ - \ imported by: hops/hops-5.config \ - \ imported by: hops-4.config \ - \ imported by: hops/hops-3.config \ - \ imported by: hops-2.config \ - \ imported by: hops/hops-1.config \ - \ imported by: hops-0.project") - hopping - - assertOutputContains - (normalizeWindowsOutput "- hops/hops-9.config \ - \ imported by: hops-8.config \ - \ imported by: hops/hops-7.config \ - \ imported by: hops-6.config \ - \ imported by: hops/hops-5.config \ - \ imported by: hops-4.config \ - \ imported by: hops/hops-3.config \ - \ imported by: hops-2.config \ - \ imported by: hops/hops-1.config \ - \ imported by: hops-0.project") - hopping + "Configuration is affected by the following files:\n\ + \- hops-0.project\n\ + \- hops-2.config\n\ + \ imported by: hops/hops-1.config\n\ + \ imported by: hops-0.project\n\ + \- hops-4.config\n\ + \ imported by: hops/hops-3.config\n\ + \ imported by: hops-2.config\n\ + \ imported by: hops/hops-1.config\n\ + \ imported by: hops-0.project\n\ + \- hops-6.config\n\ + \ imported by: hops/hops-5.config\n\ + \ imported by: hops-4.config\n\ + \ imported by: hops/hops-3.config\n\ + \ imported by: hops-2.config\n\ + \ imported by: hops/hops-1.config\n\ + \ imported by: hops-0.project\n\ + \- hops-8.config\n\ + \ imported by: hops/hops-7.config\n\ + \ imported by: hops-6.config\n\ + \ imported by: hops/hops-5.config\n\ + \ imported by: hops-4.config\n\ + \ imported by: hops/hops-3.config\n\ + \ imported by: hops-2.config\n\ + \ imported by: hops/hops-1.config\n\ + \ imported by: hops-0.project\n\ + \- hops/hops-1.config\n\ + \ imported by: hops-0.project\n\ + \- hops/hops-3.config\n\ + \ imported by: hops-2.config\n\ + \ imported by: hops/hops-1.config\n\ + \ imported by: hops-0.project\n\ + \- hops/hops-5.config\n\ + \ imported by: hops-4.config\n\ + \ imported by: hops/hops-3.config\n\ + \ imported by: hops-2.config\n\ + \ imported by: hops/hops-1.config\n\ + \ imported by: hops-0.project\n\ + \- hops/hops-7.config\n\ + \ imported by: hops-6.config\n\ + \ imported by: hops/hops-5.config\n\ + \ imported by: hops-4.config\n\ + \ imported by: hops/hops-3.config\n\ + \ imported by: hops-2.config\n\ + \ imported by: hops/hops-1.config\n\ + \ imported by: hops-0.project\n\ + \- hops/hops-9.config\n\ + \ imported by: hops-8.config\n\ + \ imported by: hops/hops-7.config\n\ + \ imported by: hops-6.config\n\ + \ imported by: hops/hops-5.config\n\ + \ imported by: hops-4.config\n\ + \ imported by: hops/hops-3.config\n\ + \ imported by: hops-2.config\n\ + \ imported by: hops/hops-1.config\n\ + \ imported by: hops-0.project" + & normalizeWindowsOutput + & flip (assertOn multilineNeedleHaystack) hopping -- The project is named oops as it is like hops but has conflicting constraints. -- +-- oops-0.project @@ -205,22 +183,25 @@ main = cabalTest . withRepo "repo" . recordMode RecordMarked $ do -- +-- oops/oops-9.config (has conflicting constraints) log "checking conflicting constraints skipping into a subfolder and then back out again and again" oopsing <- fails $ cabal' "v2-build" [ "all", "--project-file=oops-0.project" ] - assertOutputContains "rejecting: hashable-1.4.2.0" oopsing - assertOutputContains "rejecting: hashable-1.4.3.0" oopsing - assertOutputContains "(constraint from oops-0.project requires ==1.4.3.0)" oopsing - assertOutputContains - (normalizeWindowsOutput " (constraint from oops/oops-9.config requires ==1.4.2.0) \ - \ imported by: oops-8.config \ - \ imported by: oops/oops-7.config \ - \ imported by: oops-6.config \ - \ imported by: oops/oops-5.config \ - \ imported by: oops-4.config \ - \ imported by: oops/oops-3.config \ - \ imported by: oops-2.config \ - \ imported by: oops/oops-1.config \ - \ imported by: oops-0.project") - oopsing + "Could not resolve dependencies:\n\ + \[__0] trying: oops-0.1 (user goal)\n\ + \[__1] next goal: hashable (dependency of oops)\n\ + \[__1] rejecting: hashable-1.4.3.0\n\ + \ (constraint from oops/oops-9.config requires ==1.4.2.0)\n\ + \ imported by: oops-8.config\n\ + \ imported by: oops/oops-7.config\n\ + \ imported by: oops-6.config\n\ + \ imported by: oops/oops-5.config\n\ + \ imported by: oops-4.config\n\ + \ imported by: oops/oops-3.config\n\ + \ imported by: oops-2.config\n\ + \ imported by: oops/oops-1.config\n\ + \ imported by: oops-0.project\n\ + \[__1] rejecting: hashable-1.4.2.0\n\ + \ (constraint from oops-0.project requires ==1.4.3.0)" + & normalizeWindowsOutput + & flip (assertOn multilineNeedleHaystack) oopsing -- The project is named yops as it is like hops but with y's for forks. -- +-- yops-0.project @@ -261,13 +242,14 @@ main = cabalTest . withRepo "repo" . recordMode RecordMarked $ do log "checking that missing package message lists configuration provenance" missing <- fails $ cabal' "v2-build" [ "--project-file=cabal-missing-package.project" ] - assertOutputContains - (normalizeWindowsOutput "When using configuration from: \ - \ - cabal-missing-package.project \ - \ - missing/pkgs.config \ - \ - missing/pkgs/default.config \ - \The following errors occurred: \ - \ - The package location 'pkg-doesnt-exist' does not exist.") - missing + + "When using configuration from:\n\ + \ - cabal-missing-package.project\n\ + \ - missing/pkgs.config\n\ + \ - missing/pkgs/default.config\n\ + \The following errors occurred:\n\ + \ - The package location 'pkg-doesnt-exist' does not exist." + & normalizeWindowsOutput + & flip (assertOn multilineNeedleHaystack) missing return () diff --git a/cabal-testsuite/PackageTests/NewBuild/T4288/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/T4288/cabal.test.hs index 3e3b8de853e..3313f596546 100644 --- a/cabal-testsuite/PackageTests/NewBuild/T4288/cabal.test.hs +++ b/cabal-testsuite/PackageTests/NewBuild/T4288/cabal.test.hs @@ -1,4 +1,5 @@ import Test.Cabal.Prelude +import Data.Function ((&)) -- 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 @@ -10,8 +11,7 @@ main = cabalTest $ do skipUnless "no v2-build compatible boot-Cabal" =<< hasNewBuildCompatBootCabal r <- recordMode DoNotRecord $ cabal' "v2-build" ["T4288"] assertOutputContains "This is setup-helper-1.0." r - assertOutputContains - ("In order, the following will be built: " - ++ " - setup-helper-1.0 (lib:setup-helper) (first run) " - ++ " - T4288-1.0 (lib:T4288) (first run)") - r + "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 diff --git a/cabal-testsuite/PackageTests/ProjectImport/DedupUsingConfigFromComplex/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectImport/DedupUsingConfigFromComplex/cabal.test.hs index e354b356d7f..0c65ff68c60 100644 --- a/cabal-testsuite/PackageTests/ProjectImport/DedupUsingConfigFromComplex/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ProjectImport/DedupUsingConfigFromComplex/cabal.test.hs @@ -1,4 +1,5 @@ import Test.Cabal.Prelude +import Data.Function ((&)) main = cabalTest . recordMode RecordMarked $ do let log = recordHeader . pure @@ -31,12 +32,12 @@ main = cabalTest . recordMode RecordMarked $ do out log "checking that package directories and locations are reported in order" - assertOutputContains - "The following errors occurred: \ - \ - The package directory 'no-pkg-1' does not contain any .cabal file. \ - \ - The package location 'no-pkg-2-dir' does not exist. \ - \ - The package directory 'no-pkg-3' does not contain any .cabal file. \ - \ - The package location 'no-pkg-4-dir' does not exist." - out + + "The following errors occurred:\n\ + \ - The package directory 'no-pkg-1' does not contain any .cabal file.\n\ + \ - The package location 'no-pkg-2-dir' does not exist.\n\ + \ - The package directory 'no-pkg-3' does not contain any .cabal file.\n\ + \ - The package location 'no-pkg-4-dir' does not exist." + & flip (assertOn multilineNeedleHaystack) out return () diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out index 77a1861fe42..a3143ff9ffd 100644 --- a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out @@ -1,2 +1,10 @@ # cabal v2-build Warning: /else.project, else.project: 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.$ diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.test.hs index dbeb8f082d8..4d5d4c2811f 100644 --- a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.test.hs @@ -1,15 +1,28 @@ import Test.Cabal.Prelude +import System.Directory main = cabalTest . recordMode RecordMarked $ do let log = recordHeader . pure + cwd <- liftIO getCurrentDirectory + env <- getTestEnv + let testDir = testCurrentDir env + liftIO . putStrLn $ "Current working directory: " ++ cwd + msg <- liftIO . readFile $ testDir "msg.txt" outElse <- fails $ cabal' "v2-build" [ "all", "--dry-run", "--project-file=else.project" ] - assertOutputContainsOn unConcatOutput unConcatOutput concatOutput - (concatOutput "When using configuration from:\n\ - \ - else.project\n\ - \ - dir-else/else.config\n\ - \The following errors occurred:\n\ - \ - The package location 'no-pkg-here' does not exist.") - outElse + + let msgSingle = lineBreaksToSpaces msg + + log "Multiline string marking:" + mapM_ log (lines . decodeLfMarkLines $ encodeLf msg) + + log "Pseudo multiline string marking:" + mapM_ log (lines . decodeLfMarkLines $ encodeLf msgSingle) + + assertOn multilineNeedleHaystack msg outElse + assertOn multilineNeedleHaystack{expectNeedleInHaystack = False} msgSingle outElse + + assertOutputDoesNotContain msg outElse + assertOutputDoesNotContain msgSingle outElse return () diff --git a/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/msg.txt b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/msg.txt new file mode 100644 index 00000000000..e5291b3adcd --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/msg.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/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 index 2a3eb3c093c..4bbb8b91a9b 100644 --- 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,4 +1,5 @@ import Test.Cabal.Prelude +import Data.Function ((&)) -- 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 @@ -16,16 +17,13 @@ main = cabalTest $ withShorterPathForNewBuildStore $ do r1 <- recordMode DoNotRecord $ cabal' "v2-build" ["pkg:my-exe"] - let msg = concat - [ "In order, the following will be built:" - , " - build-tool-pkg-1 (lib) (requires build)" - , " - build-tool-pkg-2 (lib) (requires build)" - , " - build-tool-pkg-2 (exe:build-tool-exe) (requires build)" - , " - pkg-1.0 (exe:my-exe) (first run)" - ] + "In order, the following will be built:\n\ + \ - build-tool-pkg-1 (lib) (requires build)\n\ + \ - 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 - assertOutputContains msg r1 withPlan $ do r2 <- runPlanExe' "pkg" "my-exe" [] - assertOutputContains - "build-tool library version: 1, build-tool exe version: 2" r2 + assertOn multilineNeedleHaystack "build-tool library version: 1,\nbuild-tool exe version: 2" r2 diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index 0f3383af38a..2dd8090252e 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -45,6 +45,7 @@ library Test.Cabal.CheckArMetadata Test.Cabal.DecodeShowBuildInfo Test.Cabal.Monad + Test.Cabal.NeedleHaystack Test.Cabal.OutputNormalizer Test.Cabal.Plan Test.Cabal.Prelude diff --git a/cabal-testsuite/src/Test/Cabal/NeedleHaystack.hs b/cabal-testsuite/src/Test/Cabal/NeedleHaystack.hs new file mode 100644 index 00000000000..7b2b1fd76fa --- /dev/null +++ b/cabal-testsuite/src/Test/Cabal/NeedleHaystack.hs @@ -0,0 +1,101 @@ +module Test.Cabal.NeedleHaystack where + +import Data.List (isPrefixOf) + +-- | Transformations for the search strings and the text to search in. +data TxContains = + TxContains + { + -- | Reverse conversion for display, applied to the forward converted value. + txBwd :: (String -> String), + -- | Forward conversion for comparison. + txFwd :: (String -> String) + } + +txContainsId :: TxContains +txContainsId = TxContains id id + +-- | Conversions of the needle and haystack strings, the seach string and the +-- text to search in. +data NeedleHaystack = + NeedleHaystack + { + expectNeedleInHaystack :: Bool, + displayHaystack :: Bool, + txNeedle :: TxContains, + txHaystack :: TxContains + } + +-- | 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 + +multilineNeedleHaystack :: NeedleHaystack +multilineNeedleHaystack = symNeedleHaystack decodeLfMarkLines encodeLf + +-- | Needle and haystack functions that do not change the strings. Set up for +-- finding the needle in the haystack and not displaying the line-delimited +-- haystack. +needleHaystack :: NeedleHaystack +needleHaystack = NeedleHaystack True False txContainsId txContainsId + +-- | Replace line breaks with spaces, correctly handling "\r\n". +-- +-- >>> lineBreaksToSpaces "foo\nbar\r\nbaz" +-- "foo bar baz" +-- +-- >>> lineBreaksToSpaces "foo\nbar\r\nbaz\n" +-- "foo bar baz" +-- +-- >>> lineBreaksToSpaces "\nfoo\nbar\r\nbaz\n" +-- " foo bar baz" +lineBreaksToSpaces :: String -> String +lineBreaksToSpaces = unwords . lines . filter ((/=) '\r') + +-- | Replace line breaks with , correctly handling "\r\n". +-- +-- >>> encodeLf "foo\nbar\r\nbaz" +-- "foobarbaz" +-- +-- >>> encodeLf "foo\nbar\r\nbaz\n" +-- "foobarbaz" +-- +-- >>> encodeLf "\nfoo\nbar\r\nbaz\n" +-- "foobarbaz" +encodeLf :: String -> String +encodeLf = + (\s -> if "" `isPrefixOf` s then drop 5 s else s) + . concat + . (fmap ("" ++)) + . lines + . filter ((/=) '\r') + +-- | Replace markers with line breaks and wrap lines with ^ and $ markers +-- for the start and end. +-- +-- >>> decodeLfMarkLines "foobarbaz" +-- "^foo$\n^bar$\n^baz$\n" +-- +-- >>> decodeLfMarkLines "foobarbaz" +-- "^foo$\n^bar$\n^baz$\n" +decodeLfMarkLines:: String -> String +decodeLfMarkLines output = + (\xs -> case reverse $ lines xs of + [] -> xs + [line0] -> line0 ++ "$" + lineN : ys -> + let lineN' = lineN ++ "$" + in unlines $ reverse (lineN' : ys)) + . unlines + . (fmap ('^' :)) + . lines + . (\s -> if "" `isPrefixOf` s then drop 5 s else s) + $ foldr + (\c acc -> c : + if ("" `isPrefixOf` acc) + then "$\n" ++ drop 5 acc + else acc + ) + "" + output diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 4f1f8c16d58..1bbdebbec25 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -1,8 +1,9 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NondecreasingIndentation #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} -- | Generally useful definitions that we expect most test scripts @@ -10,6 +11,7 @@ module Test.Cabal.Prelude ( module Test.Cabal.Prelude, module Test.Cabal.Monad, + module Test.Cabal.NeedleHaystack, module Test.Cabal.Run, module System.FilePath, module Distribution.Utils.Path, @@ -19,6 +21,7 @@ module Test.Cabal.Prelude ( module Distribution.Simple.Program, ) where +import Test.Cabal.NeedleHaystack import Test.Cabal.Script import Test.Cabal.Run import Test.Cabal.Monad @@ -796,31 +799,32 @@ recordMode mode = withReaderT (\env -> env { testRecordUserMode = Just mode }) -assertOutputContainsOn :: MonadIO m => WithCallStack ((String -> String) -> (String -> String) -> (String -> String) -> (String -> String) -> String -> Result -> m ()) -assertOutputContainsOn unN n unO o (n -> needle) (o . resultOutput -> output) = - withFrozenCallStack $ - unless (n needle `isInfixOf` output) $ - assertFailure $ "expected:\n" ++ unN needle ++ - "\nin output:\n" ++ unO output - -assertOutputDoesNotContainOn :: MonadIO m => WithCallStack ((String -> String) -> (String -> String) -> (String -> String) -> (String -> String) -> String -> Result -> m ()) -assertOutputDoesNotContainOn unN n unO o (n -> needle) (o . resultOutput -> output) = - withFrozenCallStack $ - when (needle `isInfixOf` output) $ - assertFailure $ "unexpected:\n" ++ unN needle ++ - "\nin output:\n" ++ unO output - assertOutputContains :: MonadIO m => WithCallStack (String -> Result -> m ()) -assertOutputContains = assertOutputContainsOn id id unConcatOutput concatOutput +assertOutputContains = assertOn + needleHaystack + {txHaystack = TxContains{txBwd = decodeLfMarkLines, txFwd = encodeLf}} assertOutputDoesNotContain :: MonadIO m => WithCallStack (String -> Result -> m ()) -assertOutputDoesNotContain = assertOutputDoesNotContainOn id id unConcatOutput concatOutput - -assertOutputContainsMultiline :: MonadIO m => WithCallStack (String -> Result -> m ()) -assertOutputContainsMultiline = assertOutputContainsOn unConcatOutput concatOutput unConcatOutput concatOutput - -assertOutputDoesNotContainMultiline :: MonadIO m => WithCallStack (String -> Result -> m ()) -assertOutputDoesNotContainMultiline = assertOutputDoesNotContainOn unConcatOutput concatOutput unConcatOutput concatOutput +assertOutputDoesNotContain = assertOn + needleHaystack + { expectNeedleInHaystack = False + , txHaystack = TxContains{txBwd = decodeLfMarkLines, txFwd = encodeLf} + } + +assertOn :: MonadIO m => WithCallStack (NeedleHaystack -> String -> Result -> m ()) +assertOn NeedleHaystack{..} (txFwd txNeedle -> needle) (txFwd txHaystack. resultOutput -> output) = + withFrozenCallStack $ + if expectNeedleInHaystack + then unless (needle `isInfixOf` output) + $ assertFailure $ "expected:\n" ++ (txBwd txNeedle needle) ++ + if displayHaystack + then "\nin output:\n" ++ (txBwd txHaystack output) + else "" + else when (needle `isInfixOf` output) + $ assertFailure $ "unexpected:\n" ++ (txBwd txNeedle needle) ++ + if displayHaystack + then "\nin output:\n" ++ (txBwd txHaystack output) + else "" assertFindInFile :: MonadIO m => WithCallStack (String -> FilePath -> m ()) assertFindInFile needle path = @@ -874,30 +878,6 @@ assertNoFileContains paths needle = \path -> assertFileDoesNotContain path needle --- | Replace line breaks with , correctly handling "\r\n". -concatOutput :: String -> String -concatOutput = - (\s -> if "" `isPrefixOf` s then drop 4 s else s) . - concat . (fmap ("" ++)) . lines . filter ((/=) '\r') - --- | Replace markers with line breaks and wrap lines with ^ and $ markers --- for the start and end. -unConcatOutput :: String -> String -unConcatOutput output = - (\xs -> case lines xs of [line0] -> line0 ++ "$"; _ -> xs) - . unlines - . (fmap ('^' :)) - . lines - . (\s -> if "" `isPrefixOf` s then drop 4 s else s) - $ foldr - (\c acc -> c : - if ("" `isPrefixOf` acc) - then "$\n" ++ drop 4 acc - else acc - ) - "" - output - -- | The directory where script build artifacts are expected to be cached getScriptCacheDirectory :: FilePath -> TestM FilePath getScriptCacheDirectory script = do