Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
15 changes: 0 additions & 15 deletions src/Distribution/Server/Util/CabalRevisions.hs
Original file line number Diff line number Diff line change
Expand Up @@ -250,21 +250,6 @@ checkFlag flagOld flagNew = do
checkSame "Cannot change ordering of flags"
(flagName flagOld) (flagName flagNew)

-- Automatic flags' defaults may be changed as they don't make new
-- configurations reachable by the solver that weren't before
--
-- Moreover, automatic flags may be converted into manual flags
-- but not the other way round.
--
-- NB: We always allow to change the flag description as it has
-- purely informational value
when (flagManual flagOld) $ do
checkSame "Cannot change the default of a manual flag"
(flagDefault flagOld) (flagDefault flagNew)

checkSame "Cannot change a manual flag into an automatic flag"
(flagManual flagOld) (flagManual flagNew)

let fname = unFlagName (flagName flagOld)

changesOk ("type of flag '" ++ fname ++ "'")
Expand Down
59 changes: 57 additions & 2 deletions tests/HighLevelTest.hs
Original file line number Diff line number Diff line change
Expand Up @@ -218,7 +218,7 @@ runPackageUploadTests = do
(testpackageTarFilename, testpackageTarFileContent, _, _, _, _) =
testpackage
(testpackageTarFilenameVariant, testpackageTarFileContentVariant, _, _, _, _) =
mkPackage "testPackage"
mkPackage "testPackage" Nothing
uploadTime = "Tue Oct 18 20:54:28 UTC 2010"
uploadTimeISO = "2010-10-18T20:54:28Z"
uploadTimeISO2 = "2020-10-18T20:54:28Z"
Expand All @@ -234,11 +234,66 @@ runRevisionTests = do
xs <- getUrl NoAuth "/package/testpackage-1.0.0.0/revision/1.cabal"
unless (xs == revisedCabalFileContent) $
die "Bad revised cabal file content"
do info "Uploading testpackage with flags"
postFile isOk
(Auth "HackageTestUser1" "testpass1")
"/packages/" "package"
(testpackageFlagsTarFilename, testpackageFlagsTarFileContent)
do info "Revising default for automatic flag"
post (Auth "HackageTestUser1" "testpass1") "/package/testpackageFlags-1.0.0.0/testpackageFlags.cabal/edit"
[ ("cabalfile", revisedCabalFileContentDefaultAutomaticFlag)
, ("publish", "Publish new revision")
]
do info "Checking automatic default flag revision exists"
xs <- getUrl NoAuth "/package/testpackageFlags-1.0.0.0/revision/1.cabal"
unless (xs == revisedCabalFileContentDefaultAutomaticFlag) $
die "Bad revised cabal file content"
do info "Revising flag to manual"
post (Auth "HackageTestUser1" "testpass1") "/package/testpackageFlags-1.0.0.0/testpackageFlags.cabal/edit"
[ ("cabalfile", revisedCabalFileContentToManualFlag)
, ("publish", "Publish new revision")
]
do info "Checking automatic -> manual flag revision exists"
xs <- getUrl NoAuth "/package/testpackageFlags-1.0.0.0/revision/2.cabal"
unless (xs == revisedCabalFileContentToManualFlag) $
die "Bad revised cabal file content"
do info "Revising default for manual flag"
post (Auth "HackageTestUser1" "testpass1") "/package/testpackageFlags-1.0.0.0/testpackageFlags.cabal/edit"
[ ("cabalfile", revisedCabalFileContentDefaultManualFlag)
, ("publish", "Publish new revision")
]
do info "Checking manual default flag revision exists"
xs <- getUrl NoAuth "/package/testpackageFlags-1.0.0.0/revision/3.cabal"
unless (xs == revisedCabalFileContentDefaultManualFlag) $
die "Bad revised cabal file content"
do info "Revising flag to automatic"
post (Auth "HackageTestUser1" "testpass1") "/package/testpackageFlags-1.0.0.0/testpackageFlags.cabal/edit"
[ ("cabalfile", revisedCabalFileContentToAutomaticFlag)
, ("publish", "Publish new revision")
]
do info "Checking manual -> automatic flag revision exists"
xs <- getUrl NoAuth "/package/testpackageFlags-1.0.0.0/revision/4.cabal"
unless (xs == revisedCabalFileContentToAutomaticFlag) $
die "Bad revised cabal file content"
where
(_, _, _, testpackageCabalFileContent, _, _) = testpackage
revisedCabalFileContent =
"x-revision: 1\ndescription: a description added by revision\n"
++ testpackageCabalFileContent
(testpackageFlagsTarFilename, testpackageFlagsTarFileContent, _, _, _, _) = mkPackage "testpackageFlags" $ Just $ flagDefaultManual False False
revisedCabalFileContentDefaultAutomaticFlag = mkTestPackageRevisionFlagDefaultManual True False 1
revisedCabalFileContentToManualFlag = mkTestPackageRevisionFlagDefaultManual True True 2
revisedCabalFileContentDefaultManualFlag = mkTestPackageRevisionFlagDefaultManual False True 3
revisedCabalFileContentToAutomaticFlag = mkTestPackageRevisionFlagDefaultManual False False 4
flagDefaultManual flagDefault manual = unlines [
"flag isTest",
" default: " ++ show flagDefault,
" manual: " ++ show manual]

mkTestPackageRevisionFlagDefaultManual :: Bool -> Bool -> Int -> String
mkTestPackageRevisionFlagDefaultManual flagDefault manual revision =
let (_, _, _, testpackageCabalFlagsFileContent, _, _) = mkPackage "testpackageFlags" $ Just $ flagDefaultManual flagDefault manual
in "x-revision: " ++ show revision ++ "\n" ++ testpackageCabalFlagsFileContent

runPackageTests :: IO ()
runPackageTests = do
Expand Down Expand Up @@ -308,4 +363,4 @@ runPackageTests = do
= testpackage

testpackage :: (FilePath, String, FilePath, String, FilePath, String)
testpackage = mkPackage "testpackage"
testpackage = mkPackage "testpackage" Nothing
19 changes: 11 additions & 8 deletions tests/Package.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,13 +8,16 @@ import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Char
import System.FilePath

mkPackage :: String -> (FilePath, -- Tar filename
String, -- Tar file content
FilePath, -- Cabal filename in index
String, -- Cabal file content
FilePath, -- Haskell filename in source tree
String) -- Haskell file content
mkPackage name = (name ++ "-1.0.0.0.tar.gz", BS.unpack targz,
mkPackage :: String -> -- Package name
Maybe String -> -- Optional additional Cabal file contents
(FilePath, -- Tar filename
String, -- Tar file content
FilePath, -- Cabal filename in index
String, -- Cabal file content
FilePath, -- Haskell filename in source tree
String) -- Haskell file content
mkPackage name additionalCabalFileContents =
(name ++ "-1.0.0.0.tar.gz", BS.unpack targz,
name ++ "/1.0.0.0/" ++ name ++ ".cabal", cabalFile,
modName <.> "hs", modFile)
where targz = compress tar
Expand All @@ -39,7 +42,7 @@ mkPackage name = (name ++ "-1.0.0.0.tar.gz", BS.unpack targz,
"",
"Library {",
" exposed-modules: " ++ modName,
"}"]
"}"] ++ maybe "" ("\n" ++) additionalCabalFileContents
modFile = unlines [
"module " ++ modName ++ " where",
"f" ++ name ++ " :: () -> ()",
Expand Down
Loading