Commit 8ed42ceb authored by barmston's avatar barmston
Browse files

Self-constraint not included in frozen constraints

parent bd5f7c26
...@@ -65,12 +65,6 @@ import Distribution.Version ...@@ -65,12 +65,6 @@ import Distribution.Version
-- * The freeze command -- * The freeze command
-- ------------------------------------------------------------ -- ------------------------------------------------------------
--TODO:
-- * Don't overwrite all of `cabal.config`, just the constraints section.
-- * Should the package represented by `UserTargetLocalDir "."` be
-- constrained too? What about `base`?
-- | Freeze all of the dependencies by writing a constraints section -- | Freeze all of the dependencies by writing a constraints section
-- constraining each dependency to an exact version. -- constraining each dependency to an exact version.
-- --
...@@ -113,10 +107,13 @@ freeze verbosity packageDBs repos comp platform conf mSandboxPkgInfo ...@@ -113,10 +107,13 @@ freeze verbosity packageDBs repos comp platform conf mSandboxPkgInfo
where where
dryRun = fromFlag (freezeDryRun freezeFlags) dryRun = fromFlag (freezeDryRun freezeFlags)
sanityCheck pkgSpecifiers = sanityCheck pkgSpecifiers = do
when (not . null $ [n | n@(NamedPackage _ _) <- pkgSpecifiers]) $ when (not . null $ [n | n@(NamedPackage _ _) <- pkgSpecifiers]) $
die $ "internal error: 'resolveUserTargets' returned " die $ "internal error: 'resolveUserTargets' returned "
++ "unexpected named package specifiers!" ++ "unexpected named package specifiers!"
when (length pkgSpecifiers /= 1) $
die $ "internal error: 'resolveUserTargets' returned "
++ "unexpected source package specifiers!"
planPackages :: Verbosity planPackages :: Verbosity
-> Compiler -> Compiler
...@@ -184,21 +181,28 @@ planPackages verbosity comp platform mSandboxPkgInfo freezeFlags ...@@ -184,21 +181,28 @@ planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
-- | Remove all unneeded packages from an install plan. -- | Remove all unneeded packages from an install plan.
-- --
-- A package is unneeded if it is not a dependency (directly or -- A package is unneeded if it is either
-- transitively) of any of the 'PackageSpecifier SourcePackage's. This is --
-- useful for removing previously installed packages which are no longer -- 1) the package that we are freezing, or
-- required from the install plan. --
-- 2) not a dependency (directly or transitively) of the package we are
-- freezing. This is useful for removing previously installed packages
-- which are no longer required from the install plan.
pruneInstallPlan :: InstallPlan.InstallPlan pruneInstallPlan :: InstallPlan.InstallPlan
-> [PackageSpecifier SourcePackage] -> [PackageSpecifier SourcePackage]
-> Either [PlanPackage] [(PlanPackage, [PackageIdentifier])] -> Either [PlanPackage] [(PlanPackage, [PackageIdentifier])]
pruneInstallPlan installPlan pkgSpecifiers = pruneInstallPlan installPlan pkgSpecifiers =
mapLeft PackageIndex.allPackages $ mapLeft (removeSelf pkgIds . PackageIndex.allPackages) $
PackageIndex.dependencyClosure pkgIdx pkgIds PackageIndex.dependencyClosure pkgIdx pkgIds
where where
pkgIdx = PackageIndex.fromList $ InstallPlan.toList installPlan pkgIdx = PackageIndex.fromList $ InstallPlan.toList installPlan
pkgIds = [ packageId pkg | SpecificSourcePackage pkg <- pkgSpecifiers ] pkgIds = [ packageId pkg | SpecificSourcePackage pkg <- pkgSpecifiers ]
mapLeft f (Left v) = Left $ f v mapLeft f (Left v) = Left $ f v
mapLeft _ (Right v) = Right v mapLeft _ (Right v) = Right v
removeSelf [thisPkg] = filter (\pp -> packageId pp /= thisPkg)
removeSelf _ =
error $ "internal error: 'pruneInstallPlan' given "
++ "unexpected package specifiers!"
freezePackages :: Package pkg => Verbosity -> [pkg] -> IO () freezePackages :: Package pkg => Verbosity -> [pkg] -> IO ()
......
...@@ -52,6 +52,14 @@ tests cabalPath = ...@@ -52,6 +52,14 @@ tests cabalPath =
assertBool ("should not have frozen exceptions\n" ++ c) $ not $ assertBool ("should not have frozen exceptions\n" ++ c) $ not $
" exceptions ==" `isInfixOf` (intercalate " " $ lines $ c) " exceptions ==" `isInfixOf` (intercalate " " $ lines $ c)
, testCase "does not include a constraint for the package being frozen" $ do
removeCabalConfig
result <- cabal_freeze dir [] cabalPath
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should not have frozen self\n" ++ c) $ not $
" my ==" `isInfixOf` (intercalate " " $ lines $ c)
, testCase "--dry-run does not modify the cabal.config file" $ do , testCase "--dry-run does not modify the cabal.config file" $ do
removeCabalConfig removeCabalConfig
result <- cabal_freeze dir ["--dry-run"] cabalPath result <- cabal_freeze dir ["--dry-run"] cabalPath
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment