Skip to content
Snippets Groups Projects
Unverified Commit f085beb1 authored by fendor's avatar fendor Committed by GitHub
Browse files

Merge pull request #7440 from fendor/fix/warn-missing-freeze-file

Print error message if no freeze file can be found
parents 5371dd90 5cde5b99
No related branches found
No related tags found
No related merge requests found
......@@ -89,7 +89,7 @@ import Distribution.ReadE
import qualified Data.Set as S
import System.Directory
( getCurrentDirectory )
( getCurrentDirectory, doesFileExist )
-------------------------------------------------------------------------------
-- Command
......@@ -304,8 +304,18 @@ depsFromNewFreezeFile verbosity mprojectFile = do
let ucnstrs = map fst . projectConfigConstraints . projectConfigShared
$ projectConfig
deps = userConstraintsToDependencies ucnstrs
freezeFile = distProjectFile distDirLayout "freeze"
freezeFileExists <- doesFileExist freezeFile
unless freezeFileExists $
die' verbosity $
"Couldn't find a freeze file expected at: " ++ freezeFile ++ "\n\n"
++ "We are looking for this file because you supplied '--project-file' or '--v2-freeze-file'. "
++ "When one of these flags is given, we try to read the dependencies from a freeze file. "
++ "If it is undesired behaviour, you should not use these flags, otherwise please generate "
++ "a freeze file via 'cabal freeze'."
debug verbosity $
"Reading the list of dependencies from the new-style freeze file " ++ distProjectFile distDirLayout "freeze"
"Reading the list of dependencies from the new-style freeze file " ++ freezeFile
return deps
-- | Read the list of dependencies from the package description.
......
packages: ./
......@@ -22,3 +22,7 @@ All dependencies are up to date.
Outdated dependencies:
template-haskell ==2.3.0.0 (latest: 2.3.0.1)
binary ==0.8.5.0 (latest: 0.8.6.0)
# cabal outdated
cabal: Couldn't find a freeze file expected at: <ROOT>/cabal.project.missing.freeze.freeze
We are looking for this file because you supplied '--project-file' or '--v2-freeze-file'. When one of these flags is given, we try to read the dependencies from a freeze file. If it is undesired behaviour, you should not use these flags, otherwise please generate a freeze file via 'cabal freeze'.
import Test.Cabal.Prelude
main = cabalTest $ withRepo "repo"
$ forM_ ["--v2-freeze-file", "--freeze-file"] $ \arg -> do
main = cabalTest $ withRepo "repo" $ do
forM_ ["--v2-freeze-file", "--freeze-file"] $ \arg -> do
cabal' "outdated" [arg] >>=
(\out -> do
assertOutputContains "base" out
assertOutputContains "template-haskell" out
assertOutputContains "binary" out)
cabal' "outdated" [arg] >>=
(\out -> do
assertOutputContains "base" out
assertOutputContains "template-haskell" out
assertOutputContains "binary" out)
cabal' "outdated" [arg, "--ignore=base,template-haskell,binary"] >>=
(\out -> do
assertOutputDoesNotContain "base" out
assertOutputDoesNotContain "template-haskell" out
assertOutputDoesNotContain "binary" out)
cabal' "outdated" [arg, "--ignore=base,template-haskell,binary"] >>=
(\out -> do
assertOutputDoesNotContain "base" out
assertOutputDoesNotContain "template-haskell" out
assertOutputDoesNotContain "binary" out)
cabal' "outdated" [arg, "--minor=base,template-haskell,binary"] >>=
(\out -> do
assertOutputDoesNotContain "base" out
assertOutputContains "template-haskell" out
assertOutputContains "binary" out)
cabal' "outdated" [arg, "--minor=base,template-haskell,binary"] >>=
(\out -> do
assertOutputDoesNotContain "base" out
assertOutputContains "template-haskell" out
assertOutputContains "binary" out)
fails $ cabal' "outdated" ["--project-file=cabal.project.missing.freeze", "--v2-freeze-file"]
return ()
synopsis: Print error message if not freeze file can be found
packages: cabal-install
prs: #7440
issues: #7406
description: {
Instead of ignoring a missing .freeze file, abort execution and print an error message.
}
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment