Merge pull request #5076 from phadej/issue-5055

Make Cabal-2.2 behave like Cabal-2.0 related to #5055

Author: 23Skidoo

Cabal/Cabal.cabal

@@ -44,6 +44,10 @@ extra-source-files:
   tests/ParserTests/errors/forward-compat2.errors
   tests/ParserTests/errors/forward-compat3.cabal
   tests/ParserTests/errors/forward-compat3.errors
+  tests/ParserTests/errors/issue-5055-2.cabal
+  tests/ParserTests/errors/issue-5055-2.errors
+  tests/ParserTests/errors/issue-5055.cabal
+  tests/ParserTests/errors/issue-5055.errors
   tests/ParserTests/errors/leading-comma.cabal
   tests/ParserTests/errors/leading-comma.errors
   tests/ParserTests/errors/range-ge-wild.cabal
@@ -82,6 +86,9 @@ extra-source-files:
   tests/ParserTests/regressions/generics-sop.expr
   tests/ParserTests/regressions/generics-sop.format
   tests/ParserTests/regressions/haddock-api-2.18.1-check.cabal
+  tests/ParserTests/regressions/issue-5055.cabal
+  tests/ParserTests/regressions/issue-5055.expr
+  tests/ParserTests/regressions/issue-5055.format
   tests/ParserTests/regressions/issue-774.cabal
   tests/ParserTests/regressions/issue-774.expr
   tests/ParserTests/regressions/issue-774.format

Cabal/Distribution/PackageDescription/Parsec.hs

@@ -61,6 +61,7 @@ import Distribution.Text                            (display)
 import Distribution.Types.CondTree
 import Distribution.Types.Dependency                (Dependency)
 import Distribution.Types.ForeignLib
+import Distribution.Types.ForeignLibType            (knownForeignLibTypes)
 import Distribution.Types.GenericPackageDescription (emptyGenericPackageDescription)
 import Distribution.Types.PackageDescription        (specVersion')
 import Distribution.Types.UnqualComponentName       (UnqualComponentName, mkUnqualComponentName)
@@ -306,6 +307,16 @@ goSections specVer = traverse_ process
             commonStanzas <- use stateCommonStanzas
             name' <- parseUnqualComponentName pos args
             flib  <- lift $ parseCondTree' (foreignLibFieldGrammar name')  commonStanzas fields
+
+            let hasType ts = foreignLibType ts /= foreignLibType mempty
+            unless (onAllBranches hasType flib) $ lift $ parseFailure pos $ concat
+                [ "Foreign library " ++ show (display name')
+                , " is missing required field \"type\" or the field "
+                , "is not present in all conditional branches. The "
+                , "available test types are: "
+                , intercalate ", " (map display knownForeignLibTypes)
+                ]
+
             -- TODO check duplicate name here?
             stateGpd . L.condForeignLibs %= snoc (name', flib)
 
@@ -321,6 +332,16 @@ goSections specVer = traverse_ process
             name'      <- parseUnqualComponentName pos args
             testStanza <- lift $ parseCondTree' testSuiteFieldGrammar commonStanzas fields
             testSuite  <- lift $ traverse (validateTestSuite pos) testStanza
+
+            let hasType ts = testInterface ts /= testInterface mempty
+            unless (onAllBranches hasType testSuite) $ lift $ parseFailure pos $ concat
+                [ "Test suite " ++ show (display name')
+                , " is missing required field \"type\" or the field "
+                , "is not present in all conditional branches. The "
+                , "available test types are: "
+                , intercalate ", " (map display knownTestTypes)
+                ]
+
             -- TODO check duplicate name here?
             stateGpd . L.condTestSuites %= snoc (name', testSuite)
 
@@ -329,6 +350,16 @@ goSections specVer = traverse_ process
             name'       <- parseUnqualComponentName pos args
             benchStanza <- lift $ parseCondTree' benchmarkFieldGrammar commonStanzas fields
             bench       <- lift $ traverse (validateBenchmark pos) benchStanza
+
+            let hasType ts = benchmarkInterface ts /= benchmarkInterface mempty
+            unless (onAllBranches hasType bench) $ lift $ parseFailure pos $ concat
+                [ "Benchmark " ++ show (display name')
+                , " is missing required field \"type\" or the field "
+                , "is not present in all conditional branches. The "
+                , "available benchmark types are: "
+                , intercalate ", " (map display knownBenchmarkTypes)
+                ]
+
             -- TODO check duplicate name here?
             stateGpd . L.condBenchmarks %= snoc (name', bench)
 
@@ -599,6 +630,28 @@ mergeCommonStanza (CondNode bi _ bis) (CondNode x _ cs) =
     -- tree components are appended together.
     cs' = map (fmap fromBuildInfo) bis ++ cs
 
+-------------------------------------------------------------------------------
+-- Branches
+-------------------------------------------------------------------------------
+
+-- Check that a property holds on all branches of a condition tree
+onAllBranches :: forall v c a. Monoid a => (a -> Bool) -> CondTree v c a -> Bool
+onAllBranches p = go mempty
+  where
+    -- If the current level of the tree satisfies the property, then we are
+    -- done. If not, then one of the conditional branches below the current node
+    -- must satisfy it. Each node may have multiple immediate children; we only
+    -- one need one to satisfy the property because the configure step uses
+    -- 'mappend' to join together the results of flag resolution.
+    go :: a -> CondTree v c a -> Bool
+    go acc ct = let acc' = acc `mappend` condTreeData ct
+                in p acc' || any (goBranch acc') (condTreeComponents ct)
+
+    -- Both the 'true' and the 'false' block must satisfy the property.
+    goBranch :: a -> CondBranch v c a -> Bool
+    goBranch _   (CondBranch _ _ Nothing) = False
+    goBranch acc (CondBranch _ t (Just e))  = go acc t && go acc e
+
 -------------------------------------------------------------------------------
 -- Old syntax
 -------------------------------------------------------------------------------

Cabal/tests/ParserTests.hs

@@ -99,6 +99,8 @@ errorTests = testGroup "errors"
     , errorTest "forward-compat.cabal"
     , errorTest "forward-compat2.cabal"
     , errorTest "forward-compat3.cabal"
+    , errorTest "issue-5055.cabal"
+    , errorTest "issue-5055-2.cabal"
     ]
 
 errorTest :: FilePath -> TestTree
@@ -136,6 +138,7 @@ regressionTests = testGroup "regressions"
     , regressionTest "leading-comma.cabal"
     , regressionTest "wl-pprint-indef.cabal"
     , regressionTest "th-lift-instances.cabal"
+    , regressionTest "issue-5055.cabal"
     ]
 
 regressionTest :: FilePath -> TestTree

Cabal/tests/ParserTests/errors/issue-5055-2.cabal

@@ -0,0 +1,25 @@
+name:                issue
+version:             5055
+synopsis:            no type in all branches
+description:         no type in all branches.
+license:             BSD3
+category:            Test
+build-type:          Simple
+cabal-version:       >=2.0
+
+executable flag-test-exe
+  main-is: FirstMain.hs
+  build-depends: base >= 4.8 && < 5
+  default-language: Haskell2010
+
+test-suite flag-cabal-test
+  -- TODO: fix so `type` can be on the top level
+  build-depends:       base >= 4.8 && < 5
+  default-language:    Haskell2010
+
+  if os(windows)
+    main-is:             FirstMain.hs
+    type:                exitcode-stdio-1.0
+  else:
+    main-is:             SecondMain.hs
+    type:                exitcode-stdio-1.0

Cabal/tests/ParserTests/errors/issue-5055-2.errors

@@ -0,0 +1,2 @@
+VERSION: Just (mkVersion [2,0])
+issue-5055-2.cabal:15:1: Test suite "flag-cabal-test" is missing required field "type" or the field is not present in all conditional branches. The available test types are: exitcode-stdio-1.0, detailed-0.9

Cabal/tests/ParserTests/errors/issue-5055.cabal

@@ -0,0 +1,21 @@
+name:                issue
+version:             5055
+synopsis:            no type in all branches
+description:         no type in all branches.
+license:             BSD3
+category:            Test
+build-type:          Simple
+cabal-version:       >=2.0
+
+executable flag-test-exe
+  main-is: FirstMain.hs
+  build-depends: base >= 4.8 && < 5
+  default-language: Haskell2010
+
+test-suite flag-cabal-test
+  build-depends:       base >= 4.8 && < 5
+  default-language:    Haskell2010
+
+  if os(windows)
+    main-is:             FirstMain.hs
+    type:                exitcode-stdio-1.0

Cabal/tests/ParserTests/errors/issue-5055.errors

@@ -0,0 +1,2 @@
+VERSION: Just (mkVersion [2,0])
+issue-5055.cabal:15:1: Test suite "flag-cabal-test" is missing required field "type" or the field is not present in all conditional branches. The available test types are: exitcode-stdio-1.0, detailed-0.9

Cabal/tests/ParserTests/regressions/issue-5055.cabal

@@ -0,0 +1,25 @@
+name:                issue
+version:             5055
+synopsis:            no type in all branches
+description:         no type in all branches.
+license:             BSD3
+category:            Test
+build-type:          Simple
+cabal-version:       >=2.0
+
+executable flag-test-exe
+  main-is: FirstMain.hs
+  build-depends: base >= 4.8 && < 5
+  default-language: Haskell2010
+
+test-suite flag-cabal-test
+  -- TODO: fix so `type` can be on the top level
+  build-depends:       base >= 4.8 && < 5
+  default-language:    Haskell2010
+
+  main-is:             SecondMain.hs
+  type:                exitcode-stdio-1.0
+
+  if os(windows)
+    main-is:             FirstMain.hs
+    -- type:                exitcode-stdio-1.0