diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 17b2b7478e7..697630ffde7 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -32,15 +32,33 @@ extra-source-files: -- Generated with 'misc/gen-extra-source-files.sh' -- Do NOT edit this section manually; instead, run the script. -- BEGIN gen-extra-source-files + tests/ParserTests/errors/common1.cabal + tests/ParserTests/errors/common1.errors + tests/ParserTests/errors/common2.cabal + tests/ParserTests/errors/common2.errors + tests/ParserTests/errors/common3.cabal + tests/ParserTests/errors/common3.errors tests/ParserTests/regressions/Octree-0.5.cabal + tests/ParserTests/regressions/Octree-0.5.format + tests/ParserTests/regressions/common.cabal + tests/ParserTests/regressions/common.format + tests/ParserTests/regressions/common2.cabal + tests/ParserTests/regressions/common2.format tests/ParserTests/regressions/elif.cabal + tests/ParserTests/regressions/elif.format tests/ParserTests/regressions/elif2.cabal + tests/ParserTests/regressions/elif2.format tests/ParserTests/regressions/encoding-0.8.cabal + tests/ParserTests/regressions/encoding-0.8.format tests/ParserTests/regressions/generics-sop.cabal + tests/ParserTests/regressions/generics-sop.format tests/ParserTests/regressions/haddock-api-2.18.1-check.cabal tests/ParserTests/regressions/issue-774.cabal + tests/ParserTests/regressions/issue-774.format tests/ParserTests/regressions/nothing-unicode.cabal + tests/ParserTests/regressions/nothing-unicode.format tests/ParserTests/regressions/shake.cabal + tests/ParserTests/regressions/shake.format tests/ParserTests/warnings/bom.cabal tests/ParserTests/warnings/bool.cabal tests/ParserTests/warnings/deprecatedfield.cabal diff --git a/Cabal/Distribution/PackageDescription/FieldGrammar.hs b/Cabal/Distribution/PackageDescription/FieldGrammar.hs index 578883824f7..ef969965532 100644 --- a/Cabal/Distribution/PackageDescription/FieldGrammar.hs +++ b/Cabal/Distribution/PackageDescription/FieldGrammar.hs @@ -175,6 +175,9 @@ data TestSuiteStanza = TestSuiteStanza , _testStanzaBuildInfo :: BuildInfo } +instance L.HasBuildInfo TestSuiteStanza where + buildInfo = testStanzaBuildInfo + testStanzaTestType :: Lens' TestSuiteStanza (Maybe TestType) testStanzaTestType f s = fmap (\x -> s { _testStanzaTestType = x }) (f (_testStanzaTestType s)) {-# INLINE testStanzaTestType #-} @@ -274,6 +277,9 @@ data BenchmarkStanza = BenchmarkStanza , _benchmarkStanzaBuildInfo :: BuildInfo } +instance L.HasBuildInfo BenchmarkStanza where + buildInfo = benchmarkStanzaBuildInfo + benchmarkStanzaBenchmarkType :: Lens' BenchmarkStanza (Maybe BenchmarkType) benchmarkStanzaBenchmarkType f s = fmap (\x -> s { _benchmarkStanzaBenchmarkType = x }) (f (_benchmarkStanzaBenchmarkType s)) {-# INLINE benchmarkStanzaBenchmarkType #-} diff --git a/Cabal/Distribution/PackageDescription/Parsec.hs b/Cabal/Distribution/PackageDescription/Parsec.hs index 53166f7179f..57d632aa39f 100644 --- a/Cabal/Distribution/PackageDescription/Parsec.hs +++ b/Cabal/Distribution/PackageDescription/Parsec.hs @@ -42,7 +42,7 @@ import Distribution.FieldGrammar import Distribution.PackageDescription import Distribution.PackageDescription.FieldGrammar import Distribution.PackageDescription.Quirks (patchQuirks) -import Distribution.Parsec.Class (parsec) +import Distribution.Parsec.Class (parsecCommaList, parsec, parsecToken) import Distribution.Parsec.Common import Distribution.Parsec.ConfVar (parseConditionConfVar) import Distribution.Parsec.Field (FieldName, getName) @@ -52,6 +52,7 @@ import Distribution.Parsec.ParseResult import Distribution.Simple.Utils (die', fromUTF8BS, warn) import Distribution.Text (display) import Distribution.Types.CondTree +import Distribution.Types.Dependency (Dependency) import Distribution.Types.ForeignLib import Distribution.Types.UnqualComponentName (UnqualComponentName, mkUnqualComponentName) @@ -62,6 +63,7 @@ import Distribution.Version import System.Directory (doesFileExist) import Distribution.Compat.Lens +import qualified Distribution.Types.BuildInfo.Lens as L import qualified Distribution.Types.GenericPackageDescription.Lens as L import qualified Distribution.Types.PackageDescription.Lens as L @@ -124,7 +126,21 @@ fieldlinesToBS :: [FieldLine ann] -> BS.ByteString fieldlinesToBS = BS.intercalate "\n" . map (\(FieldLine _ bs) -> bs) -- Monad in which sections are parsed -type SectionParser = StateT GenericPackageDescription ParseResult +type SectionParser = StateT SectionS ParseResult + +-- | State of section parser +data SectionS = SectionS + { _stateGpd :: !GenericPackageDescription + , _stateCommonStanzas :: !(Map String CondTreeBuildInfo) + } + +stateGpd :: Lens' SectionS GenericPackageDescription +stateGpd f (SectionS gpd cs) = (\x -> SectionS x cs) <$> f gpd +{-# INLINE stateGpd #-} + +stateCommonStanzas :: Lens' SectionS (Map String CondTreeBuildInfo) +stateCommonStanzas f (SectionS gpd cs) = SectionS gpd <$> f cs +{-# INLINE stateCommonStanzas #-} -- Note [Accumulating parser] -- @@ -147,9 +163,10 @@ parseGenericPackageDescription' lexWarnings fs = do -- Sections let gpd = emptyGpd & L.packageDescription .~ pd - -- elif conditional is accepted if spec version is >= 2.1 - let hasElif = if specVersion pd >= mkVersion [2,1] then HasElif else NoElif - execStateT (goSections hasElif sectionFields) gpd + -- parse sections + view stateGpd <$> execStateT + (goSections (specVersion pd) sectionFields) + (SectionS gpd Map.empty) where emptyGpd :: GenericPackageDescription emptyGpd = GenericPackageDescription emptyPackageDescription [] Nothing [] [] [] [] [] @@ -180,9 +197,14 @@ parseGenericPackageDescription' lexWarnings fs = do maybeWarnCabalVersion _ _ = return () -- Sections -goSections :: HasElif -> [Field Position] -> SectionParser () -goSections hasElif = traverse_ process +goSections :: Version -> [Field Position] -> SectionParser () +goSections sv = traverse_ process where + hasElif = if sv >= mkVersion [2,1] then HasElif else NoElif + + -- Common stanzas are avaiable since cabal-version: 2.1 + hasCommonStanzas = sv >= mkVersion [2,1] + process (Field (Name pos name) _) = lift $ parseWarning pos PWTTrailingFields $ "Ignoring trailing fields after sections: " ++ show name @@ -193,55 +215,75 @@ goSections hasElif = traverse_ process parseSection :: Name Position -> [SectionArg Position] -> [Field Position] -> SectionParser () parseSection (Name pos name) args fields + | not hasCommonStanzas, name == "common" = lift $ do + parseWarning pos PWTUnknownSection $ "Ignoring section: common. You should set cabal-version: 2.2 or larger to use common stanzas." + + | name == "common" = do + commonStanzas <- use stateCommonStanzas + name' <- lift $ parseCommonName pos args + biTree <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas buildInfoFieldGrammar commonStanzas fields + + case Map.lookup name' commonStanzas of + Nothing -> stateCommonStanzas .= Map.insert name' biTree commonStanzas + Just _ -> lift $ parseFailure pos $ + "Duplicate common stanza: " ++ name' + | name == "library" && null args = do - lib <- lift $ parseCondTree hasElif (libraryFieldGrammar Nothing) (targetBuildDepends . libBuildInfo) fields + commonStanzas <- use stateCommonStanzas + lib <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas (libraryFieldGrammar Nothing) commonStanzas fields -- TODO: check that library is defined once - L.condLibrary ?= lib + stateGpd . L.condLibrary ?= lib -- Sublibraries + -- TODO: check cabal-version | name == "library" = do - -- TODO: check cabal-version + commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - lib <- lift $ parseCondTree hasElif (libraryFieldGrammar $ Just name') (targetBuildDepends . libBuildInfo) fields + lib <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas (libraryFieldGrammar $ Just name') commonStanzas fields -- TODO check duplicate name here? - L.condSubLibraries %= snoc (name', lib) + stateGpd . L.condSubLibraries %= snoc (name', lib) + -- TODO: check cabal-version | name == "foreign-library" = do + commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - flib <- lift $ parseCondTree hasElif (foreignLibFieldGrammar name') (targetBuildDepends . foreignLibBuildInfo) fields + flib <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas (foreignLibFieldGrammar name') commonStanzas fields -- TODO check duplicate name here? - L.condForeignLibs %= snoc (name', flib) + stateGpd . L.condForeignLibs %= snoc (name', flib) | name == "executable" = do + commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - exe <- lift $ parseCondTree hasElif (executableFieldGrammar name') (targetBuildDepends . buildInfo) fields + exe <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas (executableFieldGrammar name') commonStanzas fields -- TODO check duplicate name here? - L.condExecutables %= snoc (name', exe) + stateGpd . L.condExecutables %= snoc (name', exe) | name == "test-suite" = do + commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - testStanza <- lift $ parseCondTree hasElif testSuiteFieldGrammar (targetBuildDepends . _testStanzaBuildInfo) fields + testStanza <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas testSuiteFieldGrammar commonStanzas fields testSuite <- lift $ traverse (validateTestSuite pos) testStanza -- TODO check duplicate name here? - L.condTestSuites %= snoc (name', testSuite) + stateGpd . L.condTestSuites %= snoc (name', testSuite) | name == "benchmark" = do + commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - benchStanza <- lift $ parseCondTree hasElif benchmarkFieldGrammar (targetBuildDepends . _benchmarkStanzaBuildInfo) fields + benchStanza <- lift $ parseCondTreeWithCommonStanzas hasElif hasCommonStanzas benchmarkFieldGrammar commonStanzas fields bench <- lift $ traverse (validateBenchmark pos) benchStanza -- TODO check duplicate name here? - L.condBenchmarks %= snoc (name', bench) + stateGpd . L.condBenchmarks %= snoc (name', bench) | name == "flag" = do name' <- parseName pos args name'' <- lift $ runFieldParser' pos parsec name' `recoverWith` mkFlagName "" flag <- lift $ parseFields fields (flagFieldGrammar name'') -- Check default flag - L.genPackageFlags %= snoc flag + stateGpd . L.genPackageFlags %= snoc flag | name == "custom-setup" && null args = do sbi <- lift $ parseFields fields (setupBInfoFieldGrammar False) - L.packageDescription . L.setupBuildInfo ?= sbi + stateGpd . L.packageDescription . L.setupBuildInfo ?= sbi | name == "source-repository" = do kind <- lift $ case args of @@ -255,12 +297,13 @@ goSections hasElif = traverse_ process pure RepoHead sr <- lift $ parseFields fields (sourceRepoFieldGrammar kind) - L.packageDescription . L.sourceRepos %= snoc sr + stateGpd . L.packageDescription . L.sourceRepos %= snoc sr | otherwise = lift $ parseWarning pos PWTUnknownSection $ "Ignoring section: " ++ show name parseName :: Position -> [SectionArg Position] -> SectionParser String +-- TODO: use strict parser parseName pos args = case args of [SecArgName _pos secName] -> pure $ fromUTF8BS secName @@ -274,6 +317,20 @@ parseName pos args = case args of lift $ parseFailure pos $ "Invalid name " ++ show args pure "" +parseCommonName :: Position -> [SectionArg Position] -> ParseResult String +parseCommonName pos args = case args of + [SecArgName _pos secName] -> + pure $ fromUTF8BS secName + [SecArgStr _pos secName] -> + pure $ fromUTF8BS secName + [] -> do + parseFailure pos $ "name required" + pure "" + _ -> do + -- TODO: pretty print args + parseFailure pos $ "Invalid name " ++ show args + pure "" + parseUnqualComponentName :: Position -> [SectionArg Position] -> SectionParser UnqualComponentName parseUnqualComponentName pos args = mkUnqualComponentName <$> parseName pos args @@ -291,7 +348,6 @@ warnInvalidSubsection :: Section Position -> ParseResult () warnInvalidSubsection (MkSection (Name pos name) _ _) = void (parseFailure pos $ "invalid subsection " ++ show name) - data HasElif = HasElif | NoElif deriving (Eq, Show) @@ -333,6 +389,8 @@ parseCondTree hasElif grammar cond = go sections' <- parseIfs sections return (Just elseFields, sections') + + parseElseIfs (MkSection (Name _ name) test fields : sections) | hasElif == HasElif, name == "elif" = do -- TODO: check cabal-version test' <- parseConditionConfVar test @@ -342,6 +400,10 @@ parseCondTree hasElif grammar cond = go a <- parseFieldGrammar mempty grammar return (Just $ CondNode a (cond a) [CondBranch test' fields' elseFields], sections') + parseElseIfs (MkSection (Name pos name) _ _ : sections) | name == "elif" = do + parseWarning pos PWTInvalidSubsection $ "invalid subsection \"elif\". You should set cabal-version: 2.2 or larger to use elif-conditionals." + (,) Nothing <$> parseIfs sections + parseElseIfs sections = (,) Nothing <$> parseIfs sections {- Note [Accumulating parser] @@ -366,6 +428,111 @@ When/if we re-implement the parser to support formatting preservging roundtrip with new AST, this all need to be rewritten. -} +------------------------------------------------------------------------------- +-- Common stanzas +------------------------------------------------------------------------------- + +-- $commonStanzas +-- +-- [Note: Common stanzas] +-- +-- In Cabal 2.2 we support simple common stanzas: +-- +-- * Commons stanzas define 'BuildInfo' +-- +-- * import "fields" can only occur at top of other stanzas (think: imports) +-- +-- In particular __there aren't__ +-- +-- * implicit stanzas +-- +-- * More specific common stanzas (executable, test-suite). +-- +-- +-- The approach uses the fact that 'BuildInfo' is a 'Monoid': +-- +-- @ +-- mergeCommonStanza' :: HasBuildInfo comp => BuildInfo -> comp -> comp +-- mergeCommonStanza' bi = over L.BuildInfo (bi <>) +-- @ +-- +-- Real 'mergeCommonStanza' is more complicated as we have to deal with +-- conditional trees. +-- +-- The approach is simple, and have good properties: +-- +-- * Common stanzas are parsed exactly once, even if not-used. Thus we report errors in them. +-- +type CondTreeBuildInfo = CondTree ConfVar [Dependency] BuildInfo + +-- | Create @a@ from 'BuildInfo'. +-- +-- Law: @view buildInfo . fromBuildInfo = id@ +class L.HasBuildInfo a => FromBuildInfo a where + fromBuildInfo :: BuildInfo -> a + +instance FromBuildInfo BuildInfo where fromBuildInfo = id +instance FromBuildInfo Library where fromBuildInfo bi = set L.buildInfo bi emptyLibrary +instance FromBuildInfo ForeignLib where fromBuildInfo bi = set L.buildInfo bi emptyForeignLib +instance FromBuildInfo Executable where fromBuildInfo bi = set L.buildInfo bi emptyExecutable + +instance FromBuildInfo TestSuiteStanza where + fromBuildInfo = TestSuiteStanza Nothing Nothing Nothing + +instance FromBuildInfo BenchmarkStanza where + fromBuildInfo = BenchmarkStanza Nothing Nothing Nothing + +parseCondTreeWithCommonStanzas + :: forall a. FromBuildInfo a + => HasElif -- ^ accept @elif@ + -> Bool -- ^ accept @import@ + -> ParsecFieldGrammar' a -- ^ grammar + -> Map String CondTreeBuildInfo -- ^ common stanzas + -> [Field Position] + -> ParseResult (CondTree ConfVar [Dependency] a) +parseCondTreeWithCommonStanzas hasElif hasCommonStanzas grammar commonStanzas = goImports [] + where + -- parse leading imports + -- not supported: + goImports acc (Field (Name pos name) _ : fields) | name == "import", not hasCommonStanzas = do + parseWarning pos PWTUnknownField "Unknown field: import. You should set cabal-version: 2.2 or larger to use common stanzas" + goImports acc fields + -- supported: + goImports acc (Field (Name pos name) fls : fields) | name == "import" = do + names <- runFieldParser pos (parsecCommaList parsecToken) fls + names' <- for names $ \commonName -> + case Map.lookup commonName commonStanzas of + Nothing -> do + parseFailure pos $ "Undefined common stanza imported: " ++ commonName + pure Nothing + Just commonTree -> + pure (Just commonTree) + + goImports (acc ++ catMaybes names') fields + + -- Go to parsing condTree after first non-import 'Field'. + goImports acc fields = go acc fields + + -- parse actual CondTree + go :: [CondTreeBuildInfo] -> [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a) + go bis fields = do + x <- parseCondTree hasElif grammar (view L.targetBuildDepends) fields + pure $ foldr mergeCommonStanza x bis + +mergeCommonStanza + :: forall a. FromBuildInfo a + => CondTree ConfVar [Dependency] BuildInfo + -> CondTree ConfVar [Dependency] a + -> CondTree ConfVar [Dependency] a +mergeCommonStanza (CondNode bi _ bis) (CondNode x _ cs) = + CondNode x' (x' ^. L.targetBuildDepends) cs' + where + -- new value is old value with buildInfo field _prepended_. + x' = x & L.buildInfo %~ (bi <>) + + -- tree components are appended together. + cs' = map (fmap fromBuildInfo) bis ++ cs + ------------------------------------------------------------------------------- -- Old syntax ------------------------------------------------------------------------------- diff --git a/Cabal/Distribution/Parsec/Newtypes.hs b/Cabal/Distribution/Parsec/Newtypes.hs index 3716afd005f..b7277795dc9 100644 --- a/Cabal/Distribution/Parsec/Newtypes.hs +++ b/Cabal/Distribution/Parsec/Newtypes.hs @@ -63,8 +63,9 @@ data P sep = P class Sep sep where prettySep :: P sep -> [Doc] -> Doc parseSep - :: P sep -> P.Stream s Identity Char - => P.Parsec s [PWarning] a + :: P.Stream s Identity Char + => P sep + -> P.Parsec s [PWarning] a -> P.Parsec s [PWarning] [a] instance Sep CommaVCat where diff --git a/Cabal/changelog b/Cabal/changelog index 08a9993aa1b..e89b625a6d4 100644 --- a/Cabal/changelog +++ b/Cabal/changelog @@ -29,6 +29,7 @@ * Support for building with Win32 version 2.6 (#4835). * Compilation with section splitting is now supported via the '--enable-split-sections' flag (#4819) + * Support for common stanzas (#4751) * TODO 2.0.1.1 Mikhail Glushenkov December 2017 diff --git a/Cabal/doc/developing-packages.rst b/Cabal/doc/developing-packages.rst index 32a99d33cf6..83828436a9f 100644 --- a/Cabal/doc/developing-packages.rst +++ b/Cabal/doc/developing-packages.rst @@ -1251,7 +1251,7 @@ Executables ^^^^^^^^^^^ .. pkg-section:: executable name - :synopsis: Exectuable build info section. + :synopsis: Executable build info section. Executable sections (if present) describe executable programs contained in the package and must have an argument after the section label, which @@ -2520,6 +2520,45 @@ and outside then they are combined using the following rules. else Main-is: Main.hs +Common stanzas +^^^^^^^^^^^^^^ + +.. pkg-section:: common name + :synopsis: Common build info section + +Starting with Cabal-2.2 it's possible to use common build info stanzas. + +:: + + common deps + build-depends: base ^>= 4.11 + ghc-options: -Wall + + common test-deps + build-depends: tasty + + library + import: deps + exposed-modules: Foo + + test-suite tests + import: deps, test-deps + type: exitcode-stdio-1.0 + main-is: Tests.hs + build-depends: foo + +- You can use `build information`_ fields in common stanzas. + +- Common stanzas must be defined before use. + +- Common stanzas can import other common stanzas. + +- You can import multiple stanzas at once. Stanza names must be separated by commas. + +.. Note:: + + The name `import` was chosen, because there is ``includes`` field. + Source Repositories ^^^^^^^^^^^^^^^^^^^ diff --git a/Cabal/tests/ParserTests.hs b/Cabal/tests/ParserTests.hs index 68ea95fad51..732b3569a97 100644 --- a/Cabal/tests/ParserTests.hs +++ b/Cabal/tests/ParserTests.hs @@ -27,8 +27,9 @@ import qualified Distribution.Types.PackageDescription.Lens as L tests :: TestTree tests = testGroup "parsec tests" - [ warningTests - , regressionTests + [ regressionTests + , warningTests + , errorTests ] ------------------------------------------------------------------------------- @@ -69,6 +70,33 @@ warningTest wt fp = testCase (show wt) $ do [] -> assertFailure "got no warnings" _ -> assertFailure $ "got multiple warnings: " ++ show warns +------------------------------------------------------------------------------- +-- Errors +------------------------------------------------------------------------------- + +errorTests :: TestTree +errorTests = testGroup "errors" + [ errorTest "common1.cabal" + , errorTest "common2.cabal" + , errorTest "common3.cabal" + ] + +errorTest :: FilePath -> TestTree +errorTest fp = cabalGoldenTest "errors" correct $ do + contents <- BS.readFile input + let res = parseGenericPackageDescription contents + let (_, errs, x) = runParseResult res + + return $ toUTF8BS $ case x of + Just gpd | null errs -> + "UNXPECTED SUCCESS\n" ++ + showGenericPackageDescription gpd + _ -> + unlines $ map show errs + where + input = "tests" "ParserTests" "errors" fp + correct = replaceExtension input "errors" + ------------------------------------------------------------------------------- -- Regressions ------------------------------------------------------------------------------- @@ -83,6 +111,8 @@ regressionTests = testGroup "regressions" , regressionTest "elif.cabal" , regressionTest "elif2.cabal" , regressionTest "shake.cabal" + , regressionTest "common.cabal" + , regressionTest "common2.cabal" ] regressionTest :: FilePath -> TestTree @@ -95,11 +125,12 @@ formatGoldenTest :: FilePath -> TestTree formatGoldenTest fp = cabalGoldenTest "format" correct $ do contents <- BS.readFile input let res = parseGenericPackageDescription contents - let (_, errs, x) = runParseResult res + let (warns, errs, x) = runParseResult res return $ toUTF8BS $ case x of Just gpd | null errs -> - showGenericPackageDescription gpd + unlines (map show warns) + ++ showGenericPackageDescription gpd _ -> unlines $ "ERROR" : map show errs where diff --git a/Cabal/tests/ParserTests/errors/common1.cabal b/Cabal/tests/ParserTests/errors/common1.cabal new file mode 100644 index 00000000000..1af7db136b4 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/common1.cabal @@ -0,0 +1,29 @@ +name: common +version: 0 +synopsis: Common-stanza demo demo +build-type: Simple +cabal-version: >=2.1 + +source-repository head + Type: git + Location: https://github.com/hvr/-.git + +common windows + if os(windows) + build-depends: Win32 + +-- Non-existing common stanza +common deps + import: windo + build-depends: + base >=4.10 && <4.11, + containers + +library + import: deps + + default-language: Haskell2010 + exposed-modules: ElseIf + + build-depends: + ghc-prim diff --git a/Cabal/tests/ParserTests/errors/common1.errors b/Cabal/tests/ParserTests/errors/common1.errors new file mode 100644 index 00000000000..32f4f871222 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/common1.errors @@ -0,0 +1 @@ +PError (Position 17 3) "Undefined common stanza imported: windo" diff --git a/Cabal/tests/ParserTests/errors/common2.cabal b/Cabal/tests/ParserTests/errors/common2.cabal new file mode 100644 index 00000000000..537687534b1 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/common2.cabal @@ -0,0 +1,29 @@ +name: common +version: 0 +synopsis: Common-stanza demo demo +build-type: Simple +cabal-version: >=2.1 + +source-repository head + Type: git + Location: https://github.com/hvr/-.git + +-- Used before use +common deps + import: windows + build-depends: + base >=4.10 && <4.11, + containers + +common windows + if os(windows) + build-depends: Win32 + +library + import: deps + + default-language: Haskell2010 + exposed-modules: ElseIf + + build-depends: + ghc-prim diff --git a/Cabal/tests/ParserTests/errors/common2.errors b/Cabal/tests/ParserTests/errors/common2.errors new file mode 100644 index 00000000000..37af94f85fd --- /dev/null +++ b/Cabal/tests/ParserTests/errors/common2.errors @@ -0,0 +1 @@ +PError (Position 13 3) "Undefined common stanza imported: windows" diff --git a/Cabal/tests/ParserTests/errors/common3.cabal b/Cabal/tests/ParserTests/errors/common3.cabal new file mode 100644 index 00000000000..15cca82e6ca --- /dev/null +++ b/Cabal/tests/ParserTests/errors/common3.cabal @@ -0,0 +1,31 @@ +name: common +version: 0 +synopsis: Common-stanza demo demo +build-type: Simple +cabal-version: >=2.1 + +source-repository head + Type: git + Location: https://github.com/hvr/-.git + +common windows + if os(windows) + build-depends: Win32 + +common deps + import: windows + build-depends: + base >=4.10 && <4.11, + containers + +-- Duplicate +common deps + +library + import: deps + + default-language: Haskell2010 + exposed-modules: ElseIf + + build-depends: + ghc-prim diff --git a/Cabal/tests/ParserTests/errors/common3.errors b/Cabal/tests/ParserTests/errors/common3.errors new file mode 100644 index 00000000000..13f7e7757d7 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/common3.errors @@ -0,0 +1 @@ +PError (Position 22 1) "Duplicate common stanza: deps" diff --git a/Cabal/tests/ParserTests/regressions/Octree-0.5.format b/Cabal/tests/ParserTests/regressions/Octree-0.5.format index 61d1ccedee0..94422084391 100644 --- a/Cabal/tests/ParserTests/regressions/Octree-0.5.format +++ b/Cabal/tests/ParserTests/regressions/Octree-0.5.format @@ -1,3 +1,6 @@ +PWarning PWTLexNBSP (Position 43 3) "Non-breaking space found" +PWarning PWTLexNBSP (Position 41 3) "Non-breaking space found" +PWarning PWTLexNBSP (Position 39 3) "Non-breaking space found" name: Octree version: 0.5 license: BSD3 diff --git a/Cabal/tests/ParserTests/regressions/common.cabal b/Cabal/tests/ParserTests/regressions/common.cabal new file mode 100644 index 00000000000..2ccdebd001a --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/common.cabal @@ -0,0 +1,32 @@ +name: common +version: 0 +synopsis: Common-stanza demo demo +build-type: Simple +cabal-version: >=1.10 + +source-repository head + Type: git + Location: https://github.com/hvr/-.git + +common deps + build-depends: + base >=4.10 && <4.11, + containers + +library + import: deps + + default-language: Haskell2010 + exposed-modules: ElseIf + + build-depends: + ghc-prim + +test-suite tests + import: deps + + type: exitcode-stdio-1.0 + main-is: Tests.hs + + build-depends: + HUnit diff --git a/Cabal/tests/ParserTests/regressions/common.format b/Cabal/tests/ParserTests/regressions/common.format new file mode 100644 index 00000000000..8192f931f08 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/common.format @@ -0,0 +1,25 @@ +PWarning PWTUnknownField (Position 26 3) "Unknown field: import. You should set cabal-version: 2.2 or larger to use common stanzas" +PWarning PWTUnknownField (Position 17 3) "Unknown field: import. You should set cabal-version: 2.2 or larger to use common stanzas" +PWarning PWTUnknownSection (Position 11 1) "Ignoring section: common. You should set cabal-version: 2.2 or larger to use common stanzas." +name: common +version: 0 +synopsis: Common-stanza demo demo +cabal-version: >=1.10 +build-type: Simple + +source-repository head + type: git + location: https://github.com/hvr/-.git + +library + exposed-modules: + ElseIf + default-language: Haskell2010 + build-depends: + ghc-prim -any + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Tests.hs + build-depends: + HUnit -any \ No newline at end of file diff --git a/Cabal/tests/ParserTests/regressions/common2.cabal b/Cabal/tests/ParserTests/regressions/common2.cabal new file mode 100644 index 00000000000..3b3ed32fe19 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/common2.cabal @@ -0,0 +1,37 @@ +name: common +version: 0 +synopsis: Common-stanza demo demo +build-type: Simple +cabal-version: >=2.1 + +source-repository head + Type: git + Location: https://github.com/hvr/-.git + +common win-dows + if os(windows) + build-depends: Win32 + +common deps + import: win-dows + build-depends: + base >=4.10 && <4.11, + containers + +library + import: deps + + default-language: Haskell2010 + exposed-modules: ElseIf + + build-depends: + ghc-prim + +test-suite tests + import: deps, win-dows + + type: exitcode-stdio-1.0 + main-is: Tests.hs + + build-depends: + HUnit diff --git a/Cabal/tests/ParserTests/regressions/common2.format b/Cabal/tests/ParserTests/regressions/common2.format new file mode 100644 index 00000000000..dde33df890c --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/common2.format @@ -0,0 +1,38 @@ +name: common +version: 0 +synopsis: Common-stanza demo demo +cabal-version: >=2.1 +build-type: Simple + +source-repository head + type: git + location: https://github.com/hvr/-.git + +library + exposed-modules: + ElseIf + default-language: Haskell2010 + build-depends: + base >=4.10 && <4.11, + containers -any, + ghc-prim -any + + if os(windows) + build-depends: + Win32 -any + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Tests.hs + build-depends: + base >=4.10 && <4.11, + containers -any, + HUnit -any + + if os(windows) + build-depends: + Win32 -any + + if os(windows) + build-depends: + Win32 -any \ No newline at end of file diff --git a/Cabal/tests/ParserTests/regressions/elif.format b/Cabal/tests/ParserTests/regressions/elif.format index 9f53ec5634c..aa350e305c5 100644 --- a/Cabal/tests/ParserTests/regressions/elif.format +++ b/Cabal/tests/ParserTests/regressions/elif.format @@ -1,3 +1,5 @@ +PWarning PWTInvalidSubsection (Position 19 3) "invalid subsection \"else\"" +PWarning PWTInvalidSubsection (Position 17 3) "invalid subsection \"elif\". You should set cabal-version: 2.2 or larger to use elif-conditionals." name: elif version: 0 synopsis: The elif demo diff --git a/Cabal/tests/ParserTests/regressions/encoding-0.8.cabal b/Cabal/tests/ParserTests/regressions/encoding-0.8.cabal index 1f2b5370c91..c4032ad3152 100644 --- a/Cabal/tests/ParserTests/regressions/encoding-0.8.cabal +++ b/Cabal/tests/ParserTests/regressions/encoding-0.8.cabal @@ -1,10 +1,11 @@ Name: encoding Version: 0.8 +cabal-version: >=1.12 custom-setup -  setup-depends: + setup-depends: base < 5, -    ghc-prim + ghc-prim Library -- version range round trip is better diff --git a/Cabal/tests/ParserTests/regressions/encoding-0.8.format b/Cabal/tests/ParserTests/regressions/encoding-0.8.format index 1c1fce660c1..bb2a6b09256 100644 --- a/Cabal/tests/ParserTests/regressions/encoding-0.8.format +++ b/Cabal/tests/ParserTests/regressions/encoding-0.8.format @@ -1,5 +1,6 @@ name: encoding version: 0.8 +cabal-version: >=1.12 custom-setup setup-depends: base <5, diff --git a/cabal-dev-scripts/src/GenExtraSourceFiles.hs b/cabal-dev-scripts/src/GenExtraSourceFiles.hs index f47bd67d972..895e9b30888 100644 --- a/cabal-dev-scripts/src/GenExtraSourceFiles.hs +++ b/cabal-dev-scripts/src/GenExtraSourceFiles.hs @@ -64,7 +64,7 @@ whitelistedFiles = [ "ghc", "ghc-pkg", "ghc-7.10", "ghc-pkg-7.10", "ghc-pkg-ghc- whitelistedExtensionss :: [String] whitelistedExtensionss = map ('.' : ) - [ "hs", "lhs", "c", "h", "sh", "cabal", "hsc", "err", "out", "in", "project" ] + [ "hs", "lhs", "c", "h", "sh", "cabal", "hsc", "err", "out", "in", "project", "format", "errors" ] getOtherModulesFiles :: GenericPackageDescription -> [FilePath] getOtherModulesFiles gpd = mainModules ++ map fromModuleName otherModules'