diff --git a/Cabal-tests/tests/UnitTests/Distribution/Simple/Compiler.hs b/Cabal-tests/tests/UnitTests/Distribution/Simple/Compiler.hs index 35834d0a940..c0c73e2a6cc 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Simple/Compiler.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Simple/Compiler.hs @@ -2,10 +2,12 @@ module UnitTests.Distribution.Simple.Compiler ( tests ) where +import Control.Exception qualified as C import Data.List (isInfixOf) import Data.Map (fromList) import Distribution.Compiler import Distribution.Package +import Distribution.Parsec (eitherParsec) import Distribution.Simple.Compiler import Distribution.Version import Language.Haskell.Extension @@ -13,6 +15,91 @@ import Test.Tasty import Test.Tasty.HUnit import Text.Read (readMaybe) +tests :: [TestTree] +tests = + [ testGroup "flagToDebugInfoLevel" flagToDebugInfoLevelTests + , testGroup "flagToOptimisationLevel" flagToOptimisationLevelTests + , testGroup "DebugInfoLevel Parsec" debugInfoLevelParsecTests + , testGroup "OptimisationLevel Parsec" optimisationLevelParsecTests + , testGroup "Show/Read instance" showReadTests + ] + +flagToDebugInfoLevelTests :: [TestTree] +flagToDebugInfoLevelTests = + [ testCase "defaults to NormalDebugInfo" $ + flagToDebugInfoLevel Nothing @?= NormalDebugInfo + , testCase "--enable-debug-info=True" $ + flagToDebugInfoLevel (Just "True") @?= NormalDebugInfo + , testCase "--enable-debug-info=False" $ + flagToDebugInfoLevel (Just "False") @?= NoDebugInfo + , testCase "--enable-debug-info=0" $ + flagToDebugInfoLevel (Just "0") @?= NoDebugInfo + , testCase "--enable-debug-info=1" $ + flagToDebugInfoLevel (Just "1") @?= MinimalDebugInfo + , testCase "--enable-debug-info=2" $ + flagToDebugInfoLevel (Just "2") @?= NormalDebugInfo + , testCase "--enable-debug-info=3" $ + flagToDebugInfoLevel (Just "3") @?= MaximalDebugInfo + , testCase "--enable-debug-info=4 is out of range" $ + assertError "expected an error for out-of-range debug info level" $ + flagToDebugInfoLevel (Just "4") + , testCase "--enable-debug-info=foo is unparsable" $ + assertError "expected an error for unparsable debug info level" $ + flagToDebugInfoLevel (Just "foo") + ] + +flagToOptimisationLevelTests :: [TestTree] +flagToOptimisationLevelTests = + [ testCase "defaults to NormalOptimisation" $ + flagToOptimisationLevel Nothing @?= NormalOptimisation + , testCase "--enable-optimization=True" $ + flagToOptimisationLevel (Just "True") @?= NormalOptimisation + , testCase "--enable-optimization=False" $ + flagToOptimisationLevel (Just "False") @?= NoOptimisation + , testCase "--enable-optimization=0" $ + flagToOptimisationLevel (Just "0") @?= NoOptimisation + , testCase "--enable-optimization=1" $ + flagToOptimisationLevel (Just "1") @?= NormalOptimisation + , testCase "--enable-optimization=2" $ + flagToOptimisationLevel (Just "2") @?= MaximumOptimisation + , testCase "--enable-optimization=3 is out of range" $ + assertError "expected an error for out-of-range optimisation level" $ + flagToOptimisationLevel (Just "3") + , testCase "--enable-optimization=foo is unparsable" $ + assertError "expected an error for unparsable optimisation level" $ + flagToOptimisationLevel (Just "foo") + ] + +debugInfoLevelParsecTests :: [TestTree] +debugInfoLevelParsecTests = + [ testCase "parses True" $ + eitherParsec "True" @?= (Right NormalDebugInfo :: Either String DebugInfoLevel) + , testCase "parses False" $ + eitherParsec "False" @?= (Right NoDebugInfo :: Either String DebugInfoLevel) + , testCase "parses 0" $ + eitherParsec "0" @?= (Right NoDebugInfo :: Either String DebugInfoLevel) + , testCase "parses 1" $ + eitherParsec "1" @?= (Right MinimalDebugInfo :: Either String DebugInfoLevel) + , testCase "parses 2" $ + eitherParsec "2" @?= (Right NormalDebugInfo :: Either String DebugInfoLevel) + , testCase "parses 3" $ + eitherParsec "3" @?= (Right MaximalDebugInfo :: Either String DebugInfoLevel) + ] + +optimisationLevelParsecTests :: [TestTree] +optimisationLevelParsecTests = + [ testCase "parses True" $ + eitherParsec "True" @?= (Right NormalOptimisation :: Either String OptimisationLevel) + , testCase "parses False" $ + eitherParsec "False" @?= (Right NoOptimisation :: Either String OptimisationLevel) + , testCase "parses 0" $ + eitherParsec "0" @?= (Right NoOptimisation :: Either String OptimisationLevel) + , testCase "parses 1" $ + eitherParsec "1" @?= (Right NormalOptimisation :: Either String OptimisationLevel) + , testCase "parses 2" $ + eitherParsec "2" @?= (Right MaximumOptimisation :: Either String OptimisationLevel) + ] + -- | A 'Compiler' as configured for a recent GHC, with 'compilerWiredInUnitIds' -- populated (GHC >= 9.14) or not (older compilers). testCompiler :: Maybe [(PackageName, UnitId)] -> Compiler @@ -36,8 +123,8 @@ wiredInUnitIds = , (mkPackageName "ghc-internal", mkUnitId "ghc-internal-9.14.1") ] -tests :: [TestTree] -tests = +showReadTests :: [TestTree] +showReadTests = [ testCase "show renders valid Haskell source" $ do let shown = show (testCompiler (Just wiredInUnitIds)) assertBool ("uses mkPackageName: " ++ shown) $ @@ -65,3 +152,9 @@ tests = ([] :: [(Compiler, String)]) (readsPrec 11 (show (testCompiler (Just wiredInUnitIds)))) ] + +assertError :: String -> a -> Assertion +assertError msg x = + C.catch + (C.evaluate x >> assertFailure msg) + (\(C.ErrorCall _) -> return ()) diff --git a/Cabal/src/Distribution/Simple/Compiler.hs b/Cabal/src/Distribution/Simple/Compiler.hs index 40e7a36da76..91e65cfa561 100644 --- a/Cabal/src/Distribution/Simple/Compiler.hs +++ b/Cabal/src/Distribution/Simple/Compiler.hs @@ -416,28 +416,14 @@ parsecOptimisationLevel :: CabalParsing m => m OptimisationLevel parsecOptimisationLevel = boolParser <|> intParser where boolParser = bool NoOptimisation NormalOptimisation <$> parsec - intParser = intToOptimisationLevel <$> integral + intParser = intToEnum "optimisation level" <$> integral flagToOptimisationLevel :: Maybe String -> OptimisationLevel flagToOptimisationLevel Nothing = NormalOptimisation -flagToOptimisationLevel (Just s) = case reads s of - [(i, "")] -> intToOptimisationLevel i - _ -> error $ "Can't parse optimisation level " ++ s - -intToOptimisationLevel :: Int -> OptimisationLevel -intToOptimisationLevel i - | i >= minLevel && i <= maxLevel = toEnum i - | otherwise = - error $ - "Bad optimisation level: " - ++ show i - ++ ". Valid values are " - ++ show minLevel - ++ ".." - ++ show maxLevel - where - minLevel = fromEnum (minBound :: OptimisationLevel) - maxLevel = fromEnum (maxBound :: OptimisationLevel) +flagToOptimisationLevel (Just s) + | Just i <- readMaybe s = intToEnum "optimisation level" i + | Just b <- readMaybe s = if b then NormalOptimisation else NoOptimisation + | otherwise = error $ "Can't parse optimisation level: " ++ s -- ------------------------------------------------------------ @@ -463,21 +449,17 @@ instance Parsec DebugInfoLevel where parsec = parsecDebugInfoLevel parsecDebugInfoLevel :: CabalParsing m => m DebugInfoLevel -parsecDebugInfoLevel = flagToDebugInfoLevel . pure <$> parsecToken +parsecDebugInfoLevel = boolParser <|> intParser + where + boolParser = bool NoDebugInfo NormalDebugInfo <$> parsec + intParser = intToEnum "debug info level" <$> integral flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel flagToDebugInfoLevel Nothing = NormalDebugInfo -flagToDebugInfoLevel (Just s) = case reads s of - [(i, "")] - | i >= fromEnum (minBound :: DebugInfoLevel) - && i <= fromEnum (maxBound :: DebugInfoLevel) -> - toEnum i - | otherwise -> - error $ - "Bad debug info level: " - ++ show i - ++ ". Valid values are 0..3" - _ -> error $ "Can't parse debug info level " ++ s +flagToDebugInfoLevel (Just s) + | Just i <- readMaybe s = intToEnum "debug info level" i + | Just b <- readMaybe s = if b then NormalDebugInfo else NoDebugInfo + | otherwise = error $ "Can't parse debug info level " ++ s -- ------------------------------------------------------------ diff --git a/Cabal/src/Distribution/Simple/Utils.hs b/Cabal/src/Distribution/Simple/Utils.hs index 3186e2950f1..2b67dfa2888 100644 --- a/Cabal/src/Distribution/Simple/Utils.hs +++ b/Cabal/src/Distribution/Simple/Utils.hs @@ -201,6 +201,7 @@ module Distribution.Simple.Utils , wrapText , wrapLine , stripCommonPrefix + , intToEnum -- * FilePath stuff , isAbsoluteOnAnyPlatform @@ -2194,3 +2195,21 @@ stripCommonPrefix (x : xs) (y : ys) | x == y = stripCommonPrefix xs ys | otherwise = y : ys stripCommonPrefix _ ys = ys + +intToEnum :: (Show a, Enum a, Bounded a) => String -> Int -> a +intToEnum str i = + let res = toEnum i + maxLevel = maxBound `asTypeOf` res + minLevel = minBound `asTypeOf` res + in if i >= fromEnum minLevel && i <= fromEnum maxLevel + then res + else + error $ + "Bad " + ++ str + ++ ": " + ++ show i + ++ ". Valid values are " + ++ show minLevel + ++ ".." + ++ show maxLevel diff --git a/cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.out b/cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.out index 19b2a69fa0a..733b6d5a815 100644 --- a/cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.out +++ b/cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.out @@ -8,3 +8,6 @@ In order, the following would be built: # cabal build Warnings found while parsing the project file, cabal.boolean.project: - cabal.boolean.project:2:1: The field "debug-info" is specified more than once at positions 2:1, 3:1 +Build profile: -w ghc- -O1 +In order, the following would be built: + - debug-info-0 (lib) (first run) diff --git a/cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.test.hs index 66fb7f795f0..c0a56a3580b 100644 --- a/cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ProjectConfig/DebugInfo/cabal.test.hs @@ -6,7 +6,5 @@ main = cabalTest . recordMode RecordMarked $ do numeric <- cabal' "build" ["--project-file=cabal.numeric.project", "--dry-run"] assertOutputDoesNotContain errMsg numeric - boolean <- fails $ cabal' "build" ["--project-file=cabal.boolean.project", "--dry-run"] - -- TODO: When fixed, change this to assertOutputDoesNotContain. - assertOutputContains errMsg boolean - pure () + boolean <- cabal' "build" ["--project-file=cabal.boolean.project", "--dry-run"] + assertOutputDoesNotContain errMsg boolean diff --git a/changelog.d/12202.md b/changelog.d/12202.md new file mode 100644 index 00000000000..6e4d083b0d9 --- /dev/null +++ b/changelog.d/12202.md @@ -0,0 +1,48 @@ +--- +synopsis: Accept boolean values for `debug-info` and `optimization` levels +packages: [Cabal] +prs: 12202 +issues: 12140 +--- + +The `debug-info` and `optimization`/`optimisation` options now accept boolean +values in addition to numeric levels, both in project files +(`debug-info: True`) and on the command line (`--enable-debug-info=True`, +`--enable-optimization=True`). + +`True` is parsed as the normal level and `False` as the disabled level. +Previously the parsec project-file parser rejected `debug-info: True` with +"Can't parse debug info level True" (the legacy parser already accepted it), +and the corresponding command-line options only accepted numeric arguments. + +In a project file: + +```diff +- debug-info: True +- # Can't parse debug info level True ++ debug-info: True ++ # OK, treated as NormalDebugInfo +``` + +On the command line: + +```diff +- $ cabal build all --dry-run --enable-debug-info=True +- Can't parse debug info level True ++ $ cabal build all --dry-run --enable-debug-info=True ++ Resolving dependencies... ++ Build profile: -w ghc- -O1 ++ In order, the following would be built: ++ - debug-info-0 (lib) (first run) +``` + +```diff +- $ cabal build all --dry-run --enable-optimization=True +- Can't parse optimisation level True ++ $ cabal build all --dry-run --enable-optimization=True ++ Build profile: -w ghc- -O1 +- $ cabal build all --dry-run --enable-optimization=False +- Can't parse optimisation level False ++ $ cabal build all --dry-run --enable-optimization=False ++ Build profile: -w ghc- -O0 +```