diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 00000000..4e3965cd --- /dev/null +++ b/.travis.yml @@ -0,0 +1,35 @@ +language: c +dist: trusty +# This doesn't actually help because we always push a single +# commit to the branch in question +#git: +# # https://github.com/travis-ci/travis-ci/issues/4575 +# depth: 1 +sudo: required +before_install: + - export PATH=/opt/ghc/$GHCVER/bin:$PATH + - export PATH=$HOME/.ghc-install/$GHCVER/bin:$PATH + - export PATH=$HOME/bin:$PATH + - export PATH=$HOME/.cabal/bin:$PATH + - export PATH=$HOME/.local/bin:$PATH + - export PATH=/opt/cabal/2.0/bin:$PATH + - export PATH=/opt/happy/1.19.5/bin:$PATH + - export PATH=/opt/alex/3.1.7/bin:$PATH + - ./travis-install.sh +script: + - ./travis-test.sh +after_success: + - ./travis-cleanup.sh +notifications: + webhooks: + urls: https://sake-bot.herokuapp.com/ + on_start: always + irc: + channels: + - "chat.freenode.net##haskell-cabal" + slack: haskell-cabal:sCq6GLfy9N8MJrInosg871n4 +# To append on: +# env: GHCVER=7.6.3 UPSTREAM_BUILD_DIR=/home/travis/user/repo +# os: linux +env: GHCVER=7.6.3 UPSTREAM_BUILD_DIR=/home/travis/build/haskell/cabal CABAL_LIB_ONLY=YES TEST_OTHER_VERSIONS=YES +os: linux diff --git a/Cabal/tests/CheckTests.hs b/Cabal/tests/CheckTests.hs new file mode 100644 index 00000000..ab21b101 --- /dev/null +++ b/Cabal/tests/CheckTests.hs @@ -0,0 +1,79 @@ +module Main + ( main + ) where + +import Test.Tasty +import Test.Tasty.Golden.Advanced (goldenTest) + +import Data.Algorithm.Diff (Diff (..), getGroupedDiff) +import Distribution.PackageDescription.Check (checkPackage) +import Distribution.PackageDescription.Parsec (parseGenericPackageDescription) +import Distribution.Parsec.Common (showPError, showPWarning) +import Distribution.Parsec.ParseResult (runParseResult) +import Distribution.Utils.Generic (fromUTF8BS, toUTF8BS) +import System.FilePath (replaceExtension, ()) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 + +tests :: TestTree +tests = checkTests + +------------------------------------------------------------------------------- +-- Regressions +------------------------------------------------------------------------------- + +checkTests :: TestTree +checkTests = testGroup "regressions" + [ checkTest "nothing-unicode.cabal" + , checkTest "haddock-api-2.18.1-check.cabal" + , checkTest "issue-774.cabal" + , checkTest "MiniAgda.cabal" + , checkTest "extensions-paths-5054.cabal" + , checkTest "pre-1.6-glob.cabal" + , checkTest "pre-2.4-globstar.cabal" + , checkTest "bad-glob-syntax.cabal" + , checkTest "cc-options-with-optimization.cabal" + , checkTest "cxx-options-with-optimization.cabal" + , checkTest "ghc-option-j.cabal" + ] + +checkTest :: FilePath -> TestTree +checkTest fp = cabalGoldenTest fp correct $ do + contents <- BS.readFile input + let res = parseGenericPackageDescription contents + let (ws, x) = runParseResult res + + return $ toUTF8BS $ case x of + Right gpd -> + -- Note: parser warnings are reported by `cabal check`, but not by + -- D.PD.Check functionality. + unlines (map (showPWarning fp) ws) ++ + unlines (map show (checkPackage gpd Nothing)) + Left (_, errs) -> unlines $ map (("ERROR: " ++) . showPError fp) errs + where + input = "tests" "ParserTests" "regressions" fp + correct = replaceExtension input "check" + +------------------------------------------------------------------------------- +-- Main +------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain tests + +cabalGoldenTest :: TestName -> FilePath -> IO BS.ByteString -> TestTree +cabalGoldenTest name ref act = goldenTest name (BS.readFile ref) act cmp upd + where + upd = BS.writeFile ref + cmp x y | x == y = return Nothing + cmp x y = return $ Just $ unlines $ + concatMap f (getGroupedDiff (BS8.lines x) (BS8.lines y)) + where + f (First xs) = map (cons3 '-' . fromUTF8BS) xs + f (Second ys) = map (cons3 '+' . fromUTF8BS) ys + -- we print unchanged lines too. It shouldn't be a problem while we have + -- reasonably small examples + f (Both xs _) = map (cons3 ' ' . fromUTF8BS) xs + -- we add three characters, so the changed lines are easier to spot + cons3 c cs = c : c : c : ' ' : cs diff --git a/Cabal/tests/HackageTests.hs b/Cabal/tests/HackageTests.hs new file mode 100644 index 00000000..97a5bf71 --- /dev/null +++ b/Cabal/tests/HackageTests.hs @@ -0,0 +1,301 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ScopedTypeVariables #-} +#if !MIN_VERSION_deepseq(1,4,0) +{-# OPTIONS_GHC -fno-warn-orphans #-} +#endif +module Main where + +import Distribution.Compat.Semigroup +import Prelude () +import Prelude.Compat + +import Control.Applicative (many, (<**>), (<|>)) +import Control.DeepSeq (NFData (..), force) +import Control.Exception (evaluate) +import Control.Monad (join, unless) +import Data.Foldable (traverse_) +import Data.List (isPrefixOf, isSuffixOf) +import Data.Maybe (mapMaybe) +import Data.Monoid (Sum (..)) +import Distribution.PackageDescription.Check (PackageCheck (..) + ,checkPackage) +import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) +import Distribution.Simple.Utils (toUTF8BS) +import System.Directory (getAppUserDataDirectory) +import System.Exit (exitFailure) +import System.FilePath (()) + +import Data.Orphans () + +import qualified Codec.Archive.Tar as Tar +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Lazy as BSL +import qualified Data.Map as Map +import qualified Distribution.PackageDescription.Parsec as Parsec +import qualified Distribution.Parsec.Common as Parsec +import qualified Distribution.Parsec.Parser as Parsec + +import Distribution.Compat.Lens +import qualified Distribution.Types.GenericPackageDescription.Lens as L +import qualified Distribution.Types.PackageDescription.Lens as L +import qualified Options.Applicative as O + +#ifdef MIN_VERSION_tree_diff +import Data.TreeDiff (ansiWlEditExpr, ediff) +import Instances.TreeDiff () +#endif + +parseIndex :: (Monoid a, NFData a) => (FilePath -> Bool) + -> (FilePath -> BSL.ByteString -> IO a) -> IO a +parseIndex predicate action = do + cabalDir <- getAppUserDataDirectory "cabal" + cfg <- B.readFile (cabalDir "config") + cfgFields <- either (fail . show) pure $ Parsec.readFields cfg + let repos = reposFromConfig cfgFields + repoCache = case lookupInConfig "remote-repo-cache" cfgFields of + [] -> cabalDir "packages" -- Default + (rrc : _) -> rrc -- User-specified + tarName repo = repoCache repo "01-index.tar" + mconcat <$> traverse (parseIndex' predicate action . tarName) repos + +parseIndex' :: (Monoid a, NFData a) => (FilePath -> Bool) + -> (FilePath -> BSL.ByteString -> IO a) -> FilePath -> IO a +parseIndex' predicate action path = do + putStrLn $ "Reading index from: " ++ path + contents <- BSL.readFile path + let entries = Tar.read contents + entries' = Tar.foldEntries cons [] (error . show) entries + foldIO f entries' + + where + cons entry entries + | predicate (Tar.entryPath entry) = entry : entries + | otherwise = entries + + f entry = case Tar.entryContent entry of + Tar.NormalFile contents _ + | ".cabal" `isSuffixOf` fpath -> + action fpath contents >>= evaluate . force + | otherwise -> + return mempty + Tar.Directory -> return mempty + _ -> putStrLn ("Unknown content in " ++ fpath) + >> return mempty + where + fpath = Tar.entryPath entry + +readFieldTest :: FilePath -> BSL.ByteString -> IO () +readFieldTest fpath bsl = case Parsec.readFields $ BSL.toStrict bsl of + Right _ -> return () + Left err -> putStrLn $ fpath ++ "\n" ++ show err + +-- | Map with unionWith monoid +newtype M k v = M (Map.Map k v) + deriving (Show) +instance (Ord k, Monoid v) => Semigroup (M k v) where + M a <> M b = M (Map.unionWith mappend a b) +instance (Ord k, Monoid v) => Monoid (M k v) where + mempty = M Map.empty + mappend = (<>) +instance (NFData k, NFData v) => NFData (M k v) where + rnf (M m) = rnf m + +parseParsecTest :: FilePath -> BSL.ByteString -> IO (Sum Int) +parseParsecTest fpath bsl = do + let bs = BSL.toStrict bsl + let (_warnings, parsec) = Parsec.runParseResult $ + Parsec.parseGenericPackageDescription bs + case parsec of + Right _ -> return (Sum 1) + Left (_, errors) -> do + traverse_ (putStrLn . Parsec.showPError fpath) errors + exitFailure + +parseCheckTest :: FilePath -> BSL.ByteString -> IO CheckResult +parseCheckTest fpath bsl = do + let bs = BSL.toStrict bsl + let (_warnings, parsec) = Parsec.runParseResult $ + Parsec.parseGenericPackageDescription bs + case parsec of + Right gpd -> do + let checks = checkPackage gpd Nothing + -- one for file, many checks + return (CheckResult 1 0 0 0 0 0 <> foldMap toCheckResult checks) + Left (_, errors) -> do + traverse_ (putStrLn . Parsec.showPError fpath) errors + exitFailure + +data CheckResult = CheckResult !Int !Int !Int !Int !Int !Int + +instance NFData CheckResult where + rnf !_ = () + +instance Semigroup CheckResult where + CheckResult n a b c d e <> CheckResult n' a' b' c' d' e' = + CheckResult (n + n') (a + a') (b + b') (c + c') (d + d') (e + e') + +instance Monoid CheckResult where + mempty = CheckResult 0 0 0 0 0 0 + mappend = (<>) + +toCheckResult :: PackageCheck -> CheckResult +toCheckResult PackageBuildImpossible {} = CheckResult 0 1 0 0 0 0 +toCheckResult PackageBuildWarning {} = CheckResult 0 0 1 0 0 0 +toCheckResult PackageDistSuspicious {} = CheckResult 0 0 0 1 0 0 +toCheckResult PackageDistSuspiciousWarn {} = CheckResult 0 0 0 0 1 0 +toCheckResult PackageDistInexcusable {} = CheckResult 0 0 0 0 0 1 + +roundtripTest :: FilePath -> BSL.ByteString -> IO (Sum Int) +roundtripTest fpath bsl = do + let bs = BSL.toStrict bsl + x0 <- parse "1st" bs + let bs' = showGenericPackageDescription x0 + y0 <- parse "2nd" (toUTF8BS bs') + + -- we mungled license here + let y1 = y0 + + -- license-files: "" + let stripEmpty = filter (/="") + let x1 = x0 & L.packageDescription . L.licenseFiles %~ stripEmpty + let y2 = y1 & L.packageDescription . L.licenseFiles %~ stripEmpty + + let y = y2 & L.packageDescription . L.description .~ "" + let x = x1 & L.packageDescription . L.description .~ "" + + unless (x == y || fpath == "ixset/1.0.4/ixset.cabal") $ do + putStrLn fpath +#ifdef MIN_VERSION_tree_diff + print $ ansiWlEditExpr $ ediff x y +#else + putStrLn "<<<<<<" + print x + putStrLn "======" + print y + putStrLn ">>>>>>" +#endif + putStrLn bs' + exitFailure + + return (Sum 1) + where + parse phase c = do + let (_, x') = Parsec.runParseResult $ + Parsec.parseGenericPackageDescription c + case x' of + Right gpd -> pure gpd + Left (_, errs) -> do + putStrLn $ fpath ++ " " ++ phase + traverse_ print errs + B.putStr c + fail "parse error" + +main :: IO () +main = join (O.execParser opts) + where + opts = O.info (optsP <**> O.helper) $ mconcat + [ O.fullDesc + , O.progDesc "tests using Hackage's index" + ] + + optsP = subparser + [ command "read-fields" readFieldsP + "Parse outer format (to '[Field]', TODO: apply Quirks)" + , command "parsec" parsecP "Parse GPD with parsec" + , command "roundtrip" roundtripP "parse . pretty . parse = parse" + , command "check" checkP "Check GPD" + ] <|> pure defaultA + + defaultA = do + putStrLn "Default action: parsec k" + parsecA (mkPredicate ["k"]) + + readFieldsP = readFieldsA <$> prefixP + readFieldsA pfx = parseIndex pfx readFieldTest + + parsecP = parsecA <$> prefixP + parsecA pfx = do + Sum n <- parseIndex pfx parseParsecTest + putStrLn $ show n ++ " files processed" + + roundtripP = roundtripA <$> prefixP + roundtripA pfx = do + Sum n <- parseIndex pfx roundtripTest + putStrLn $ show n ++ " files processed" + + checkP = checkA <$> prefixP + checkA pfx = do + CheckResult n a b c d e <- parseIndex pfx parseCheckTest + putStrLn $ show n ++ " files processed" + putStrLn $ show a ++ " build impossible" + putStrLn $ show b ++ " build warning" + putStrLn $ show c ++ " build dist suspicious" + putStrLn $ show d ++ " build dist suspicious warning" + putStrLn $ show e ++ " build dist inexcusable" + + prefixP = fmap mkPredicate $ many $ O.strArgument $ mconcat + [ O.metavar "PREFIX" + , O.help "Check only files starting with a prefix" + ] + + mkPredicate [] = const True + mkPredicate pfxs = \n -> any (`isPrefixOf` n) pfxs + + command name p desc = O.command name + (O.info (p <**> O.helper) (O.progDesc desc)) + subparser = O.subparser . mconcat + +------------------------------------------------------------------------------- +-- Index shuffling +------------------------------------------------------------------------------- + +-- TODO: Use 'Cabal' for this? +reposFromConfig :: [Parsec.Field ann] -> [String] +reposFromConfig fields = takeWhile (/= ':') <$> mapMaybe f fields + where + f (Parsec.Field (Parsec.Name _ name) fieldLines) + | B8.unpack name == "remote-repo" = + Just $ fieldLinesToString fieldLines + f (Parsec.Section (Parsec.Name _ name) + [Parsec.SecArgName _ secName] _fieldLines) + | B8.unpack name == "repository" = + Just $ B8.unpack secName + f _ = Nothing + +-- | Looks up the given key in the cabal configuration file +lookupInConfig :: String -> [Parsec.Field ann] -> [String] +lookupInConfig key = mapMaybe f + where + f (Parsec.Field (Parsec.Name _ name) fieldLines) + | B8.unpack name == key = + Just $ fieldLinesToString fieldLines + f _ = Nothing + +fieldLinesToString :: [Parsec.FieldLine ann] -> String +fieldLinesToString fieldLines = + B8.unpack $ B.concat $ bsFromFieldLine <$> fieldLines + where + bsFromFieldLine (Parsec.FieldLine _ bs) = bs + +------------------------------------------------------------------------------- +-- Utilities +------------------------------------------------------------------------------- + +foldIO :: (Monoid m, NFData m) => (a -> IO m) -> [a] -> IO m +foldIO f = go mempty where + go !acc [] = return acc + go !acc (x : xs) = do + y <- f x + go (mappend acc y) xs + +------------------------------------------------------------------------------- +-- Orphans +------------------------------------------------------------------------------- + +#if !MIN_VERSION_deepseq(1,4,0) +instance NFData a => NFData (Sum a) where + rnf (Sum a) = rnf a +#endif diff --git a/Cabal/tests/Instances/TreeDiff.hs b/Cabal/tests/Instances/TreeDiff.hs new file mode 100644 index 00000000..6d386ca2 --- /dev/null +++ b/Cabal/tests/Instances/TreeDiff.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -freduction-depth=0 #-} +#else +{-# OPTIONS_GHC -fcontext-stack=151 #-} +#endif +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Instances.TreeDiff where + +import Data.TreeDiff + +import Instances.TreeDiff.Language () +import Instances.TreeDiff.SPDX () +import Instances.TreeDiff.Version () + +------------------------------------------------------------------------------- + +import Distribution.Backpack (OpenModule, OpenUnitId) +import Distribution.Compiler (CompilerFlavor) +import Distribution.InstalledPackageInfo (AbiDependency, ExposedModule, InstalledPackageInfo) +import Distribution.ModuleName (ModuleName) +import Distribution.Package (Dependency, PackageIdentifier, PackageName) +import Distribution.PackageDescription +import Distribution.Types.AbiHash (AbiHash) +import Distribution.Types.ComponentId (ComponentId) +import Distribution.Types.CondTree +import Distribution.Types.ExecutableScope +import Distribution.Types.ExeDependency +import Distribution.Types.ForeignLib +import Distribution.Types.ForeignLibOption +import Distribution.Types.ForeignLibType +import Distribution.Types.IncludeRenaming (IncludeRenaming) +import Distribution.Types.LegacyExeDependency +import Distribution.Types.Mixin +import Distribution.Types.PkgconfigDependency +import Distribution.Types.UnitId (DefUnitId, UnitId) +import Distribution.Types.UnqualComponentName + +------------------------------------------------------------------------------- +-- instances +------------------------------------------------------------------------------- + +instance (Eq a, Show a) => ToExpr (Condition a) where toExpr = defaultExprViaShow +instance (Show a, ToExpr b, ToExpr c, Show b, Show c, Eq a, Eq c, Eq b) => ToExpr (CondTree a b c) +instance (Show a, ToExpr b, ToExpr c, Show b, Show c, Eq a, Eq c, Eq b) => ToExpr (CondBranch a b c) + +instance ToExpr AbiDependency where toExpr = defaultExprViaShow +instance ToExpr AbiHash where toExpr = defaultExprViaShow +instance ToExpr Benchmark +instance ToExpr BenchmarkInterface +instance ToExpr BenchmarkType +instance ToExpr BuildInfo +instance ToExpr BuildType +instance ToExpr CompilerFlavor +instance ToExpr ComponentId where toExpr = defaultExprViaShow +instance ToExpr DefUnitId +instance ToExpr Dependency +instance ToExpr ExeDependency where toExpr = defaultExprViaShow +instance ToExpr Executable +instance ToExpr ExecutableScope where toExpr = defaultExprViaShow +instance ToExpr ExposedModule where toExpr = defaultExprViaShow +instance ToExpr Flag +instance ToExpr FlagName where toExpr = defaultExprViaShow +instance ToExpr ForeignLib +instance ToExpr ForeignLibOption +instance ToExpr ForeignLibType +instance ToExpr GenericPackageDescription +instance ToExpr IncludeRenaming +instance ToExpr InstalledPackageInfo +instance ToExpr LegacyExeDependency where toExpr = defaultExprViaShow +instance ToExpr LibVersionInfo where toExpr = defaultExprViaShow +instance ToExpr Library +instance ToExpr LibraryName +instance ToExpr Mixin where toExpr = defaultExprViaShow +instance ToExpr ModuleName where toExpr = defaultExprViaShow +instance ToExpr ModuleReexport +instance ToExpr ModuleRenaming +instance ToExpr OpenModule +instance ToExpr OpenUnitId +instance ToExpr PackageDescription +instance ToExpr PackageIdentifier +instance ToExpr PackageName where toExpr = defaultExprViaShow +instance ToExpr PkgconfigDependency where toExpr = defaultExprViaShow +instance ToExpr RepoKind +instance ToExpr RepoType +instance ToExpr SetupBuildInfo +instance ToExpr SourceRepo +instance ToExpr TestSuite +instance ToExpr TestSuiteInterface +instance ToExpr TestType +instance ToExpr UnitId where toExpr = defaultExprViaShow +instance ToExpr UnqualComponentName where toExpr = defaultExprViaShow diff --git a/Cabal/tests/Instances/TreeDiff/Language.hs b/Cabal/tests/Instances/TreeDiff/Language.hs new file mode 100644 index 00000000..6e1fac32 --- /dev/null +++ b/Cabal/tests/Instances/TreeDiff/Language.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -freduction-depth=0 #-} +#else +{-# OPTIONS_GHC -fcontext-stack=151 #-} +#endif +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Instances.TreeDiff.Language where + +import Data.TreeDiff +import Language.Haskell.Extension (Extension, KnownExtension, Language) + +-- This are big enums, so they are in separate file. +-- +instance ToExpr Extension +instance ToExpr KnownExtension +instance ToExpr Language diff --git a/Cabal/tests/Instances/TreeDiff/SPDX.hs b/Cabal/tests/Instances/TreeDiff/SPDX.hs new file mode 100644 index 00000000..e5d3d980 --- /dev/null +++ b/Cabal/tests/Instances/TreeDiff/SPDX.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -freduction-depth=0 #-} +#else +{-# OPTIONS_GHC -fcontext-stack=151 #-} +#endif +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Instances.TreeDiff.SPDX where + +import Data.TreeDiff +import Distribution.License (License) + +import Instances.TreeDiff.Version () + +import qualified Distribution.SPDX as SPDX + +-- 'License' almost belongs here. + +instance ToExpr License + +-- Generics instance is too heavy +instance ToExpr SPDX.LicenseId where toExpr = defaultExprViaShow +instance ToExpr SPDX.LicenseExceptionId where toExpr = defaultExprViaShow + +instance ToExpr SPDX.License +instance ToExpr SPDX.LicenseExpression +instance ToExpr SPDX.LicenseRef +instance ToExpr SPDX.SimpleLicenseExpression diff --git a/Cabal/tests/Instances/TreeDiff/Version.hs b/Cabal/tests/Instances/TreeDiff/Version.hs new file mode 100644 index 00000000..ddd2ee71 --- /dev/null +++ b/Cabal/tests/Instances/TreeDiff/Version.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -freduction-depth=0 #-} +#else +{-# OPTIONS_GHC -fcontext-stack=151 #-} +#endif +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Instances.TreeDiff.Version where + +import Data.TreeDiff +import Distribution.Version (Version, VersionRange) + +instance ToExpr Version where toExpr = defaultExprViaShow +instance ToExpr VersionRange diff --git a/Cabal/tests/ParserTests.hs b/Cabal/tests/ParserTests.hs new file mode 100644 index 00000000..1f46d122 --- /dev/null +++ b/Cabal/tests/ParserTests.hs @@ -0,0 +1,308 @@ +{-# LANGUAGE CPP #-} +module Main + ( main + ) where + +import Prelude () +import Prelude.Compat + +import Test.Tasty +import Test.Tasty.Golden.Advanced (goldenTest) +import Test.Tasty.HUnit + +import Control.Monad (void) +import Data.Algorithm.Diff (Diff (..), getGroupedDiff) +import Data.Maybe (isNothing) +import Distribution.PackageDescription (GenericPackageDescription) +import Distribution.PackageDescription.Parsec (parseGenericPackageDescription) +import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) +import Distribution.Parsec.Common + (PWarnType (..), PWarning (..), showPError, showPWarning) +import Distribution.Parsec.ParseResult (runParseResult) +import Distribution.Utils.Generic (fromUTF8BS, toUTF8BS) +import System.FilePath (replaceExtension, ()) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 + +import qualified Distribution.InstalledPackageInfo as IPI +import qualified Distribution.ParseUtils as ReadP + +#ifdef MIN_VERSION_tree_diff +import Data.TreeDiff (toExpr) +import Data.TreeDiff.Golden (ediffGolden) +import Instances.TreeDiff () +#endif + +tests :: TestTree +tests = testGroup "parsec tests" + [ regressionTests + , warningTests + , errorTests + , ipiTests + ] + +------------------------------------------------------------------------------- +-- Warnings +------------------------------------------------------------------------------- + +-- Verify that we trigger warnings +warningTests :: TestTree +warningTests = testGroup "warnings triggered" + [ warningTest PWTLexBOM "bom.cabal" + , warningTest PWTLexNBSP "nbsp.cabal" + , warningTest PWTLexTab "tab.cabal" + , warningTest PWTUTF "utf8.cabal" + , warningTest PWTBoolCase "bool.cabal" + , warningTest PWTVersionTag "versiontag.cabal" + , warningTest PWTNewSyntax "newsyntax.cabal" + , warningTest PWTOldSyntax "oldsyntax.cabal" + , warningTest PWTDeprecatedField "deprecatedfield.cabal" + , warningTest PWTInvalidSubsection "subsection.cabal" + , warningTest PWTUnknownField "unknownfield.cabal" + , warningTest PWTUnknownSection "unknownsection.cabal" + , warningTest PWTTrailingFields "trailingfield.cabal" + , warningTest PWTDoubleDash "doubledash.cabal" + , warningTest PWTMultipleSingularField "multiplesingular.cabal" + -- TODO: not implemented yet + -- , warningTest PWTExtraTestModule "extratestmodule.cabal" + ] + +warningTest :: PWarnType -> FilePath -> TestTree +warningTest wt fp = testCase (show wt) $ do + contents <- BS.readFile $ "tests" "ParserTests" "warnings" fp + + let res = parseGenericPackageDescription contents + let (warns, x) = runParseResult res + + assertBool ("should parse successfully: " ++ show x) $ isRight x + + case warns of + [PWarning wt' _ _] -> assertEqual "warning type" wt wt' + [] -> assertFailure "got no warnings" + _ -> assertFailure $ "got multiple warnings: " ++ show warns + where + isRight (Right _) = True + isRight _ = False + +------------------------------------------------------------------------------- +-- Errors +------------------------------------------------------------------------------- + +errorTests :: TestTree +errorTests = testGroup "errors" + [ errorTest "common1.cabal" + , errorTest "common2.cabal" + , errorTest "common3.cabal" + , errorTest "leading-comma.cabal" + , errorTest "range-ge-wild.cabal" + , errorTest "forward-compat.cabal" + , errorTest "forward-compat2.cabal" + , errorTest "forward-compat3.cabal" + , errorTest "issue-5055.cabal" + , errorTest "issue-5055-2.cabal" + , errorTest "noVersion.cabal" + , errorTest "noVersion2.cabal" + , errorTest "spdx-1.cabal" + , errorTest "spdx-2.cabal" + , errorTest "spdx-3.cabal" + ] + +errorTest :: FilePath -> TestTree +errorTest fp = cabalGoldenTest fp correct $ do + contents <- BS.readFile input + let res = parseGenericPackageDescription contents + let (_, x) = runParseResult res + + return $ toUTF8BS $ case x of + Right gpd -> + "UNXPECTED SUCCESS\n" ++ + showGenericPackageDescription gpd + Left (v, errs) -> + unlines $ ("VERSION: " ++ show v) : map (showPError fp) errs + where + input = "tests" "ParserTests" "errors" fp + correct = replaceExtension input "errors" + +------------------------------------------------------------------------------- +-- Regressions +------------------------------------------------------------------------------- + +regressionTests :: TestTree +regressionTests = testGroup "regressions" + [ regressionTest "encoding-0.8.cabal" + , regressionTest "Octree-0.5.cabal" + , regressionTest "nothing-unicode.cabal" + , regressionTest "issue-774.cabal" + , regressionTest "generics-sop.cabal" + , regressionTest "elif.cabal" + , regressionTest "elif2.cabal" + , regressionTest "shake.cabal" + , regressionTest "common.cabal" + , regressionTest "common2.cabal" + , regressionTest "leading-comma.cabal" + , regressionTest "wl-pprint-indef.cabal" + , regressionTest "th-lift-instances.cabal" + , regressionTest "issue-5055.cabal" + , regressionTest "noVersion.cabal" + , regressionTest "spdx-1.cabal" + , regressionTest "spdx-2.cabal" + , regressionTest "spdx-3.cabal" + ] + +regressionTest :: FilePath -> TestTree +regressionTest fp = testGroup fp + [ formatGoldenTest fp + , formatRoundTripTest fp +#ifdef MIN_VERSION_tree_diff + , treeDiffGoldenTest fp +#endif + ] + +formatGoldenTest :: FilePath -> TestTree +formatGoldenTest fp = cabalGoldenTest "format" correct $ do + contents <- BS.readFile input + let res = parseGenericPackageDescription contents + let (warns, x) = runParseResult res + + return $ toUTF8BS $ case x of + Right gpd -> + unlines (map (showPWarning fp) warns) + ++ showGenericPackageDescription gpd + Left (_, errs) -> + unlines $ "ERROR" : map (showPError fp) errs + where + input = "tests" "ParserTests" "regressions" fp + correct = replaceExtension input "format" + +#ifdef MIN_VERSION_tree_diff +treeDiffGoldenTest :: FilePath -> TestTree +treeDiffGoldenTest fp = ediffGolden goldenTest "expr" exprFile $ do + contents <- BS.readFile input + let res = parseGenericPackageDescription contents + let (_, x) = runParseResult res + case x of + Right gpd -> pure (toExpr gpd) + Left (_, errs) -> fail $ unlines $ "ERROR" : map (showPError fp) errs + where + input = "tests" "ParserTests" "regressions" fp + exprFile = replaceExtension input "expr" +#endif + +formatRoundTripTest :: FilePath -> TestTree +formatRoundTripTest fp = testCase "roundtrip" $ do + contents <- BS.readFile input + x <- parse contents + let contents' = showGenericPackageDescription x + y <- parse (toUTF8BS contents') + -- previously we mangled licenses a bit + let y' = y + assertEqual "re-parsed doesn't match" x y' + where + parse :: BS.ByteString -> IO GenericPackageDescription + parse c = do + let (_, x') = runParseResult $ parseGenericPackageDescription c + case x' of + Right gpd -> pure gpd + Left (_, errs) -> do + void $ assertFailure $ unlines (map (showPError fp) errs) + fail "failure" + input = "tests" "ParserTests" "regressions" fp + +------------------------------------------------------------------------------- +-- InstalledPackageInfo regressions +------------------------------------------------------------------------------- + +ipiTests :: TestTree +ipiTests = testGroup "ipis" + [ ipiTest "transformers.cabal" + , ipiTest "Includes2.cabal" + , ipiTest "issue-2276-ghc-9885.cabal" + , ipiTest "internal-preprocessor-test.cabal" + ] + +ipiTest :: FilePath -> TestTree +ipiTest fp = testGroup fp $ +#ifdef MIN_VERSION_tree_diff + [ ipiTreeDiffGoldenTest fp ] ++ +#endif + [ ipiFormatGoldenTest fp + , ipiFormatRoundTripTest fp + ] + +ipiFormatGoldenTest :: FilePath -> TestTree +ipiFormatGoldenTest fp = cabalGoldenTest "format" correct $ do + contents <- readFile input + let res = IPI.parseInstalledPackageInfo contents + return $ toUTF8BS $ case res of + ReadP.ParseFailed err -> "ERROR " ++ show err + ReadP.ParseOk ws ipi -> + unlines (map (ReadP.showPWarning fp) ws) + ++ IPI.showInstalledPackageInfo ipi + where + input = "tests" "ParserTests" "ipi" fp + correct = replaceExtension input "format" + +#ifdef MIN_VERSION_tree_diff +ipiTreeDiffGoldenTest :: FilePath -> TestTree +ipiTreeDiffGoldenTest fp = ediffGolden goldenTest "expr" exprFile $ do + contents <- readFile input + let res = IPI.parseInstalledPackageInfo contents + case res of + ReadP.ParseFailed err -> fail $ "ERROR " ++ show err + ReadP.ParseOk _ws ipi -> pure (toExpr ipi) + where + input = "tests" "ParserTests" "ipi" fp + exprFile = replaceExtension input "expr" +#endif + +ipiFormatRoundTripTest :: FilePath -> TestTree +ipiFormatRoundTripTest fp = testCase "roundtrip" $ do + contents <- readFile input + x <- parse contents + let contents' = IPI.showInstalledPackageInfo x + y <- parse contents' + + -- ghc-pkg prints pkgroot itself, based on cli arguments! + let x' = x { IPI.pkgRoot = Nothing } + let y' = y + assertBool "pkgRoot isn't shown" (isNothing (IPI.pkgRoot y)) + assertEqual "re-parsed doesn't match" x' y' + + -- Complete round-trip + let contents2 = IPI.showFullInstalledPackageInfo x + z <- parse contents2 + assertEqual "re-parsed doesn't match" x z + + where + parse :: String -> IO IPI.InstalledPackageInfo + parse c = do + case IPI.parseInstalledPackageInfo c of + ReadP.ParseOk _ ipi -> return ipi + ReadP.ParseFailed err -> do + void $ assertFailure $ show err + fail "failure" + input = "tests" "ParserTests" "ipi" fp + +------------------------------------------------------------------------------- +-- Main +------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain tests + +cabalGoldenTest :: TestName -> FilePath -> IO BS.ByteString -> TestTree +cabalGoldenTest name ref act = goldenTest name (BS.readFile ref) act cmp upd + where + upd = BS.writeFile ref + cmp x y | x == y = return Nothing + cmp x y = return $ Just $ unlines $ + concatMap f (getGroupedDiff (BS8.lines x) (BS8.lines y)) + where + f (First xs) = map (cons3 '-' . fromUTF8BS) xs + f (Second ys) = map (cons3 '+' . fromUTF8BS) ys + -- we print unchanged lines too. It shouldn't be a problem while we have + -- reasonably small examples + f (Both xs _) = map (cons3 ' ' . fromUTF8BS) xs + -- we add three characters, so the changed lines are easier to spot + cons3 c cs = c : c : c : ' ' : cs diff --git a/Cabal/tests/ParserTests/errors/common1.cabal b/Cabal/tests/ParserTests/errors/common1.cabal new file mode 100644 index 00000000..7a3c3def --- /dev/null +++ b/Cabal/tests/ParserTests/errors/common1.cabal @@ -0,0 +1,29 @@ +cabal-version: 2.1 +name: common +version: 0 +synopsis: Common-stanza demo demo +build-type: Simple + +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 00000000..2e257e0c --- /dev/null +++ b/Cabal/tests/ParserTests/errors/common1.errors @@ -0,0 +1,2 @@ +VERSION: Just (mkVersion [2,1]) +common1.cabal: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 00000000..fff797c2 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/common2.cabal @@ -0,0 +1,29 @@ +cabal-version: 2.1 +name: common +version: 0 +synopsis: Common-stanza demo demo +build-type: Simple + +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 00000000..17b7d72d --- /dev/null +++ b/Cabal/tests/ParserTests/errors/common2.errors @@ -0,0 +1,2 @@ +VERSION: Just (mkVersion [2,1]) +common2.cabal: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 00000000..3dedb63a --- /dev/null +++ b/Cabal/tests/ParserTests/errors/common3.cabal @@ -0,0 +1,31 @@ +cabal-version: 2.1 +name: common +version: 0 +synopsis: Common-stanza demo demo +build-type: Simple + +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 00000000..db3cb5ee --- /dev/null +++ b/Cabal/tests/ParserTests/errors/common3.errors @@ -0,0 +1,2 @@ +VERSION: Just (mkVersion [2,1]) +common3.cabal:22:1: Duplicate common stanza: deps diff --git a/Cabal/tests/ParserTests/errors/forward-compat.cabal b/Cabal/tests/ParserTests/errors/forward-compat.cabal new file mode 100644 index 00000000..23bd72f9 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/forward-compat.cabal @@ -0,0 +1,4 @@ +cabal-version: 99999.9 +name: future +============ +Lexically completely changed future diff --git a/Cabal/tests/ParserTests/errors/forward-compat.errors b/Cabal/tests/ParserTests/errors/forward-compat.errors new file mode 100644 index 00000000..39044934 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/forward-compat.errors @@ -0,0 +1,5 @@ +VERSION: Just (mkVersion [99999,9]) +forward-compat.cabal:3:1: "the input" (line 3, column 1): +unexpected operator "============" +expecting field or section name +forward-compat.cabal:0:0: Unsupported cabal-version. See https://github.com/haskell/cabal/issues/4899. diff --git a/Cabal/tests/ParserTests/errors/forward-compat2.cabal b/Cabal/tests/ParserTests/errors/forward-compat2.cabal new file mode 100644 index 00000000..67840482 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/forward-compat2.cabal @@ -0,0 +1,16 @@ +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 + +library + default-language: Haskell2010 + exposed-modules: ElseIf + + build-depends: + ghc-prim diff --git a/Cabal/tests/ParserTests/errors/forward-compat2.errors b/Cabal/tests/ParserTests/errors/forward-compat2.errors new file mode 100644 index 00000000..2cf00650 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/forward-compat2.errors @@ -0,0 +1,2 @@ +VERSION: Just (mkVersion [2,1]) +forward-compat2.cabal:5:1: cabal-version should be at the beginning of the file starting with spec version 2.2. See https://github.com/haskell/cabal/issues/4899 diff --git a/Cabal/tests/ParserTests/errors/forward-compat3.cabal b/Cabal/tests/ParserTests/errors/forward-compat3.cabal new file mode 100644 index 00000000..44cddd10 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/forward-compat3.cabal @@ -0,0 +1,16 @@ +cabal-version: 99999.99 +name: forward-compat +version: 0 +synopsis: Forward compat, too new cabal-version: we fail. +build-type: Simple + +source-repository head + Type: git + Location: https://github.com/hvr/-.git + +library + default-language: Haskell2010 + exposed-modules: ElseIf + + build-depends: + ghc-prim diff --git a/Cabal/tests/ParserTests/errors/forward-compat3.errors b/Cabal/tests/ParserTests/errors/forward-compat3.errors new file mode 100644 index 00000000..a7d3174a --- /dev/null +++ b/Cabal/tests/ParserTests/errors/forward-compat3.errors @@ -0,0 +1,2 @@ +VERSION: Just (mkVersion [99999,99]) +forward-compat3.cabal:0:0: Unsupported cabal-version. See https://github.com/haskell/cabal/issues/4899. diff --git a/Cabal/tests/ParserTests/errors/issue-5055-2.cabal b/Cabal/tests/ParserTests/errors/issue-5055-2.cabal new file mode 100644 index 00000000..c8cce2e1 --- /dev/null +++ b/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 diff --git a/Cabal/tests/ParserTests/errors/issue-5055-2.errors b/Cabal/tests/ParserTests/errors/issue-5055-2.errors new file mode 100644 index 00000000..fa30b4ad --- /dev/null +++ b/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 diff --git a/Cabal/tests/ParserTests/errors/issue-5055.cabal b/Cabal/tests/ParserTests/errors/issue-5055.cabal new file mode 100644 index 00000000..bc3cf65e --- /dev/null +++ b/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 diff --git a/Cabal/tests/ParserTests/errors/issue-5055.errors b/Cabal/tests/ParserTests/errors/issue-5055.errors new file mode 100644 index 00000000..650ac0d8 --- /dev/null +++ b/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 diff --git a/Cabal/tests/ParserTests/errors/leading-comma.cabal b/Cabal/tests/ParserTests/errors/leading-comma.cabal new file mode 100644 index 00000000..2332a115 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/leading-comma.cabal @@ -0,0 +1,20 @@ +name: leading-comma +version: 0 +synopsis: leading comma, trailing comma, or ordinary +build-type: Simple +-- too small cabal-version +cabal-version: 2.0 + +library + default-language: Haskell2010 + exposed-modules: LeadingComma + + build-depends: base, containers + + build-depends: + deepseq, + transformers, + + build-depends: + , filepath + , directory diff --git a/Cabal/tests/ParserTests/errors/leading-comma.errors b/Cabal/tests/ParserTests/errors/leading-comma.errors new file mode 100644 index 00000000..6df6f3e8 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/leading-comma.errors @@ -0,0 +1,8 @@ +VERSION: Just (mkVersion [2,0]) +leading-comma.cabal:16:18: +unexpected end of input +expecting white space + +deepseq, +transformers, + diff --git a/Cabal/tests/ParserTests/errors/noVersion.cabal b/Cabal/tests/ParserTests/errors/noVersion.cabal new file mode 100644 index 00000000..f6e1311b --- /dev/null +++ b/Cabal/tests/ParserTests/errors/noVersion.cabal @@ -0,0 +1,10 @@ +name: noVersion +version: 0 +synopsis: -none in build-depends +build-type: Simple +cabal-version: 1.20 + +library + default-language: Haskell2010 + exposed-modules: ElseIf + build-depends: bad-package -none diff --git a/Cabal/tests/ParserTests/errors/noVersion.errors b/Cabal/tests/ParserTests/errors/noVersion.errors new file mode 100644 index 00000000..ac3f225a --- /dev/null +++ b/Cabal/tests/ParserTests/errors/noVersion.errors @@ -0,0 +1,6 @@ +VERSION: Just (mkVersion [1,20]) +noVersion.cabal:10:38: +unexpected -none version range used. To use this syntax the package needs to specify at least 'cabal-version: 1.22'. Alternatively, if broader compatibility is important then use <0 or other empty range. + +bad-package -none + diff --git a/Cabal/tests/ParserTests/errors/noVersion2.cabal b/Cabal/tests/ParserTests/errors/noVersion2.cabal new file mode 100644 index 00000000..d31c5dd4 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/noVersion2.cabal @@ -0,0 +1,10 @@ +name: noVersion +version: 0 +synopsis: ^>= in build-depends +build-type: Simple +cabal-version: 1.20 + +library + default-language: Haskell2010 + exposed-modules: ElseIf + build-depends: bad-package ^>= 2.0 diff --git a/Cabal/tests/ParserTests/errors/noVersion2.errors b/Cabal/tests/ParserTests/errors/noVersion2.errors new file mode 100644 index 00000000..26415c85 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/noVersion2.errors @@ -0,0 +1,7 @@ +VERSION: Just (mkVersion [1,20]) +noVersion2.cabal:10:40: +unexpected major bounded version syntax (caret, ^>=) used. To use this syntax the package need to specify at least 'cabal-version: 2.0'. Alternatively, if broader compatibility is important then use: >=2.0 && <2.1 +expecting "." or "-" + +bad-package ^>= 2.0 + diff --git a/Cabal/tests/ParserTests/errors/range-ge-wild.cabal b/Cabal/tests/ParserTests/errors/range-ge-wild.cabal new file mode 100644 index 00000000..3de53701 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/range-ge-wild.cabal @@ -0,0 +1,10 @@ +name: range-ge-wild +version: 0 +synopsis: Wild range after non-== op +build-type: Simple +cabal-version: >=1.10 + +library + build-depends: + -- comment, to check that position is right + base >= 4.* diff --git a/Cabal/tests/ParserTests/errors/range-ge-wild.errors b/Cabal/tests/ParserTests/errors/range-ge-wild.errors new file mode 100644 index 00000000..92b82656 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/range-ge-wild.errors @@ -0,0 +1,6 @@ +VERSION: Just (mkVersion [1,10]) +range-ge-wild.cabal:10:16: +unexpected wild-card version after non-== operator: ">=" + +base >= 4.* + diff --git a/Cabal/tests/ParserTests/errors/spdx-1.cabal b/Cabal/tests/ParserTests/errors/spdx-1.cabal new file mode 100644 index 00000000..40da8b83 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/spdx-1.cabal @@ -0,0 +1,9 @@ +cabal-version: 2.2 +name: spdx +version: 0 +synopsis: testing positive parsing of spdx identifiers +build-type: Simple +license: BSD3 + +library + default-language: Haskell2010 diff --git a/Cabal/tests/ParserTests/errors/spdx-1.errors b/Cabal/tests/ParserTests/errors/spdx-1.errors new file mode 100644 index 00000000..a9314115 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/spdx-1.errors @@ -0,0 +1,6 @@ +VERSION: Just (mkVersion [2,2]) +spdx-1.cabal:6:26: +unexpected Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause? + +BSD3 + diff --git a/Cabal/tests/ParserTests/errors/spdx-2.cabal b/Cabal/tests/ParserTests/errors/spdx-2.cabal new file mode 100644 index 00000000..72c7f686 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/spdx-2.cabal @@ -0,0 +1,9 @@ +cabal-version: 2.4 +name: spdx +version: 0 +synopsis: testing positive parsing of spdx identifiers +build-type: Simple +license: AGPL-1.0 + +library + default-language: Haskell2010 diff --git a/Cabal/tests/ParserTests/errors/spdx-2.errors b/Cabal/tests/ParserTests/errors/spdx-2.errors new file mode 100644 index 00000000..9b81d3b6 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/spdx-2.errors @@ -0,0 +1,6 @@ +VERSION: Just (mkVersion [2,4]) +spdx-2.cabal:6:30: +unexpected Unknown SPDX license identifier: 'AGPL-1.0' + +AGPL-1.0 + diff --git a/Cabal/tests/ParserTests/errors/spdx-3.cabal b/Cabal/tests/ParserTests/errors/spdx-3.cabal new file mode 100644 index 00000000..de5e5d28 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/spdx-3.cabal @@ -0,0 +1,9 @@ +cabal-version: 2.2 +name: spdx +version: 0 +synopsis: testing positive parsing of spdx identifiers +build-type: Simple +license: AGPL-1.0-only + +library + default-language: Haskell2010 diff --git a/Cabal/tests/ParserTests/errors/spdx-3.errors b/Cabal/tests/ParserTests/errors/spdx-3.errors new file mode 100644 index 00000000..561af592 --- /dev/null +++ b/Cabal/tests/ParserTests/errors/spdx-3.errors @@ -0,0 +1,6 @@ +VERSION: Just (mkVersion [2,2]) +spdx-3.cabal:6:35: +unexpected Unknown SPDX license identifier: 'AGPL-1.0-only' + +AGPL-1.0-only + diff --git a/Cabal/tests/ParserTests/ipi/Includes2.cabal b/Cabal/tests/ParserTests/ipi/Includes2.cabal new file mode 100644 index 00000000..efaad1e6 --- /dev/null +++ b/Cabal/tests/ParserTests/ipi/Includes2.cabal @@ -0,0 +1,27 @@ +name: z-Includes2-z-mylib +version: 0.1.0.0 +id: Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n +instantiated-with: Database=Includes2-0.1.0.0-inplace-mysql:Database.MySQL +package-name: Includes2 +lib-name: mylib +key: Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n +license: BSD3 +maintainer: ezyang@cs.stanford.edu +author: Edward Z. Yang +exposed: False +indefinite: False +exposed-modules: + Mine +abi: inplace +trusted: False +import-dirs: /home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/build/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n +library-dirs: /home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/build/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n +dynamic-library-dirs: /home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/build/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n +data-dir: /home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2 +hs-libraries: HSIncludes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n +depends: + base-4.10.1.0 Includes2-0.1.0.0-inplace-mysql +abi-depends: base-4.10.1.0=35a7f6be752ee4f7385cb5bf28677879 + Includes2-0.1.0.0-inplace-mysql=inplace +haddock-interfaces: /home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/doc/html/Includes2/Includes2.haddock +haddock-html: /home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/doc/html/Includes2 diff --git a/Cabal/tests/ParserTests/ipi/Includes2.expr b/Cabal/tests/ParserTests/ipi/Includes2.expr new file mode 100644 index 00000000..0d3a02d8 --- /dev/null +++ b/Cabal/tests/ParserTests/ipi/Includes2.expr @@ -0,0 +1,51 @@ +InstalledPackageInfo + {abiDepends = [`AbiDependency {depUnitId = UnitId "base-4.10.1.0", depAbiHash = AbiHash "35a7f6be752ee4f7385cb5bf28677879"}`, + `AbiDependency {depUnitId = UnitId "Includes2-0.1.0.0-inplace-mysql", depAbiHash = AbiHash "inplace"}`], + abiHash = `AbiHash "inplace"`, + author = "Edward Z. Yang", + category = "", + ccOptions = [], + compatPackageKey = "Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n", + copyright = "", + cxxOptions = [], + dataDir = "/home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2", + depends = [`UnitId "base-4.10.1.0"`, + `UnitId "Includes2-0.1.0.0-inplace-mysql"`], + description = "", + exposed = False, + exposedModules = [`ExposedModule {exposedName = ModuleName ["Mine"], exposedReexport = Nothing}`], + extraGHCiLibraries = [], + extraLibraries = [], + frameworkDirs = [], + frameworks = [], + haddockHTMLs = ["/home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/doc/html/Includes2"], + haddockInterfaces = ["/home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/doc/html/Includes2/Includes2.haddock"], + hiddenModules = [], + homepage = "", + hsLibraries = ["HSIncludes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n"], + importDirs = ["/home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/build/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n"], + includeDirs = [], + includes = [], + indefinite = False, + installedComponentId_ = `ComponentId ""`, + installedUnitId = `UnitId "Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n"`, + instantiatedWith = [_×_ + `ModuleName ["Database"]` + (OpenModule + (DefiniteUnitId + (DefUnitId `UnitId "Includes2-0.1.0.0-inplace-mysql"`)) + `ModuleName ["Database","MySQL"]`)], + ldOptions = [], + libraryDirs = ["/home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/build/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n"], + libraryDynDirs = ["/home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/build/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n"], + license = Right BSD3, + maintainer = "ezyang@cs.stanford.edu", + pkgRoot = Nothing, + pkgUrl = "", + sourceLibName = Just `UnqualComponentName "mylib"`, + sourcePackageId = PackageIdentifier + {pkgName = `PackageName "Includes2"`, + pkgVersion = `mkVersion [0,1,0,0]`}, + stability = "", + synopsis = "", + trusted = False} diff --git a/Cabal/tests/ParserTests/ipi/Includes2.format b/Cabal/tests/ParserTests/ipi/Includes2.format new file mode 100644 index 00000000..10ff7895 --- /dev/null +++ b/Cabal/tests/ParserTests/ipi/Includes2.format @@ -0,0 +1,24 @@ +name: z-Includes2-z-mylib +version: 0.1.0.0 +package-name: Includes2 +lib-name: mylib +id: Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n +instantiated-with: Database=Includes2-0.1.0.0-inplace-mysql:Database.MySQL +key: Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n +license: BSD3 +maintainer: ezyang@cs.stanford.edu +author: Edward Z. Yang +abi: inplace +exposed-modules: + Mine +import-dirs: /home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/build/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n +library-dirs: /home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/build/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n +dynamic-library-dirs: /home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/build/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n +data-dir: /home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2 +hs-libraries: HSIncludes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n +depends: + base-4.10.1.0 Includes2-0.1.0.0-inplace-mysql +abi-depends: base-4.10.1.0=35a7f6be752ee4f7385cb5bf28677879 + Includes2-0.1.0.0-inplace-mysql=inplace +haddock-interfaces: /home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/doc/html/Includes2/Includes2.haddock +haddock-html: /home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/doc/html/Includes2 diff --git a/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.cabal b/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.cabal new file mode 100644 index 00000000..084aa135 --- /dev/null +++ b/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.cabal @@ -0,0 +1,26 @@ +name: internal-preprocessor-test +version: 0.1.0.0 +id: internal-preprocessor-test-0.1.0.0 +key: internal-preprocessor-test-0.1.0.0 +license: GPL-3 +maintainer: mikhail.glushenkov@gmail.com +synopsis: Internal custom preprocessor example. +description: + See https://github.com/haskell/cabal/issues/1541#issuecomment-30155513 +category: Testing +author: Mikhail Glushenkov +exposed: True +exposed-modules: + A +trusted: False +import-dirs: /home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/build +library-dirs: /home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/build + /home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/build +data-dir: /home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess +hs-libraries: HSinternal-preprocessor-test-0.1.0.0 +depends: + base-4.8.2.0-0d6d1084fbc041e1cded9228e80e264d +haddock-interfaces: /home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/doc/html/internal-preprocessor-test/internal-preprocessor-test.haddock +haddock-html: /home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/doc/html/internal-preprocessor-test +pkgroot: "/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist" + diff --git a/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr b/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr new file mode 100644 index 00000000..bc5ae425 --- /dev/null +++ b/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr @@ -0,0 +1,46 @@ +InstalledPackageInfo + {abiDepends = [], + abiHash = `AbiHash ""`, + author = "Mikhail Glushenkov", + category = "Testing", + ccOptions = [], + compatPackageKey = "internal-preprocessor-test-0.1.0.0", + copyright = "", + cxxOptions = [], + dataDir = "/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess", + depends = [`UnitId "base-4.8.2.0-0d6d1084fbc041e1cded9228e80e264d"`], + description = "See https://github.com/haskell/cabal/issues/1541#issuecomment-30155513", + exposed = True, + exposedModules = [`ExposedModule {exposedName = ModuleName ["A"], exposedReexport = Nothing}`], + extraGHCiLibraries = [], + extraLibraries = [], + frameworkDirs = [], + frameworks = [], + haddockHTMLs = ["/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/doc/html/internal-preprocessor-test"], + haddockInterfaces = ["/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/doc/html/internal-preprocessor-test/internal-preprocessor-test.haddock"], + hiddenModules = [], + homepage = "", + hsLibraries = ["HSinternal-preprocessor-test-0.1.0.0"], + importDirs = ["/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/build"], + includeDirs = [], + includes = [], + indefinite = False, + installedComponentId_ = `ComponentId ""`, + installedUnitId = `UnitId "internal-preprocessor-test-0.1.0.0"`, + instantiatedWith = [], + ldOptions = [], + libraryDirs = ["/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/build", + "/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/build"], + libraryDynDirs = [], + license = Right (GPL (Just `mkVersion [3]`)), + maintainer = "mikhail.glushenkov@gmail.com", + pkgRoot = Just + "/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist", + pkgUrl = "", + sourceLibName = Nothing, + sourcePackageId = PackageIdentifier + {pkgName = `PackageName "internal-preprocessor-test"`, + pkgVersion = `mkVersion [0,1,0,0]`}, + stability = "", + synopsis = "Internal custom preprocessor example.", + trusted = False} diff --git a/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.format b/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.format new file mode 100644 index 00000000..74b21a09 --- /dev/null +++ b/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.format @@ -0,0 +1,23 @@ +name: internal-preprocessor-test +version: 0.1.0.0 +id: internal-preprocessor-test-0.1.0.0 +key: internal-preprocessor-test-0.1.0.0 +license: GPL-3 +maintainer: mikhail.glushenkov@gmail.com +author: Mikhail Glushenkov +synopsis: Internal custom preprocessor example. +description: + See https://github.com/haskell/cabal/issues/1541#issuecomment-30155513 +category: Testing +exposed: True +exposed-modules: + A +import-dirs: /home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/build +library-dirs: /home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/build + /home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/build +data-dir: /home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess +hs-libraries: HSinternal-preprocessor-test-0.1.0.0 +depends: + base-4.8.2.0-0d6d1084fbc041e1cded9228e80e264d +haddock-interfaces: /home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/doc/html/internal-preprocessor-test/internal-preprocessor-test.haddock +haddock-html: /home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/doc/html/internal-preprocessor-test diff --git a/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.cabal b/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.cabal new file mode 100644 index 00000000..c7319e41 --- /dev/null +++ b/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.cabal @@ -0,0 +1,175 @@ +name: transformers +version: 0.5.2.0 +id: transformers-0.5.2.0 +key: transformers-0.5.2.0 +license: BSD3 +maintainer: Ross Paterson +synopsis: Concrete functor and monad transformers +description: + A portable library of functor and monad transformers, inspired by + the paper \"Functional Programming with Overloading and Higher-Order + Polymorphism\", by Mark P Jones, + in /Advanced School of Functional Programming/, 1995 + (). + . + This package contains: + . + * the monad transformer class (in "Control.Monad.Trans.Class") + and IO monad class (in "Control.Monad.IO.Class") + . + * concrete functor and monad transformers, each with associated + operations and functions to lift operations associated with other + transformers. + . + The package can be used on its own in portable Haskell code, in + which case operations need to be manually lifted through transformer + stacks (see "Control.Monad.Trans.Class" for some examples). + Alternatively, it can be used with the non-portable monad classes in + the @mtl@ or @monads-tf@ packages, which automatically lift operations + introduced by monad transformers through other transformers. +category: Control +author: Andy Gill, Ross Paterson +exposed: True +indefinite: False +exposed-modules: + Control.Applicative.Backwards Control.Applicative.Lift + Control.Monad.Signatures Control.Monad.Trans.Class + Control.Monad.Trans.Cont Control.Monad.Trans.Error + Control.Monad.Trans.Except Control.Monad.Trans.Identity + Control.Monad.Trans.List Control.Monad.Trans.Maybe + Control.Monad.Trans.RWS Control.Monad.Trans.RWS.Lazy + Control.Monad.Trans.RWS.Strict Control.Monad.Trans.Reader + Control.Monad.Trans.State Control.Monad.Trans.State.Lazy + Control.Monad.Trans.State.Strict Control.Monad.Trans.Writer + Control.Monad.Trans.Writer.Lazy Control.Monad.Trans.Writer.Strict + Data.Functor.Constant Data.Functor.Reverse +abi: e04579c0363c9229351d1a0b394bf2d5 +trusted: False +import-dirs: /opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0 +library-dirs: /opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0 +dynamic-library-dirs: /opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0 +data-dir: /opt/ghc/8.2.2/share/x86_64-linux-ghc-8.2.2/transformers-0.5.2.0 +hs-libraries: HStransformers-0.5.2.0 +depends: + base-4.10.1.0 +abi-depends: base-4.10.1.0=35a7f6be752ee4f7385cb5bf28677879 +haddock-interfaces: /opt/ghc/8.2.2/share/doc/ghc-8.2.2/html/libraries/transformers-0.5.2.0/transformers.haddock +haddock-html: /opt/ghc/8.2.2/share/doc/ghc-8.2.2/html/libraries/transformers-0.5.2.0 +ld-options: -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm diff --git a/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr b/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr new file mode 100644 index 00000000..f39d1e71 --- /dev/null +++ b/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr @@ -0,0 +1,2086 @@ +InstalledPackageInfo + {abiDepends = [`AbiDependency {depUnitId = UnitId "base-4.10.1.0", depAbiHash = AbiHash "35a7f6be752ee4f7385cb5bf28677879"}`], + abiHash = `AbiHash "e04579c0363c9229351d1a0b394bf2d5"`, + author = "Andy Gill, Ross Paterson", + category = "Control", + ccOptions = [], + compatPackageKey = "transformers-0.5.2.0", + copyright = "", + cxxOptions = [], + dataDir = "/opt/ghc/8.2.2/share/x86_64-linux-ghc-8.2.2/transformers-0.5.2.0", + depends = [`UnitId "base-4.10.1.0"`], + description = concat + ["A portable library of functor and monad transformers, inspired by\n", + "the paper \\\"Functional Programming with Overloading and Higher-Order\n", + "Polymorphism\\\", by Mark P Jones,\n", + "in /Advanced School of Functional Programming/, 1995\n", + "().\n", + "\n", + "This package contains:\n", + "\n", + "* the monad transformer class (in \"Control.Monad.Trans.Class\")\n", + "and IO monad class (in \"Control.Monad.IO.Class\")\n", + "\n", + "* concrete functor and monad transformers, each with associated\n", + "operations and functions to lift operations associated with other\n", + "transformers.\n", + "\n", + "The package can be used on its own in portable Haskell code, in\n", + "which case operations need to be manually lifted through transformer\n", + "stacks (see \"Control.Monad.Trans.Class\" for some examples).\n", + "Alternatively, it can be used with the non-portable monad classes in\n", + "the @mtl@ or @monads-tf@ packages, which automatically lift operations\n", + "introduced by monad transformers through other transformers."], + exposed = True, + exposedModules = [`ExposedModule {exposedName = ModuleName ["Control","Applicative","Backwards"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Applicative","Lift"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Signatures"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Class"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Cont"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Error"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Except"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Identity"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","List"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Maybe"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","RWS"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","RWS","Lazy"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","RWS","Strict"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Reader"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","State"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","State","Lazy"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","State","Strict"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Writer"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Writer","Lazy"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Writer","Strict"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Data","Functor","Constant"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Data","Functor","Reverse"], exposedReexport = Nothing}`], + extraGHCiLibraries = [], + extraLibraries = [], + frameworkDirs = [], + frameworks = [], + haddockHTMLs = ["/opt/ghc/8.2.2/share/doc/ghc-8.2.2/html/libraries/transformers-0.5.2.0"], + haddockInterfaces = ["/opt/ghc/8.2.2/share/doc/ghc-8.2.2/html/libraries/transformers-0.5.2.0/transformers.haddock"], + hiddenModules = [], + homepage = "", + hsLibraries = ["HStransformers-0.5.2.0"], + importDirs = ["/opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0"], + includeDirs = [], + includes = [], + indefinite = False, + installedComponentId_ = `ComponentId ""`, + installedUnitId = `UnitId "transformers-0.5.2.0"`, + instantiatedWith = [], + ldOptions = ["-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm", + "-lm"], + libraryDirs = ["/opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0"], + libraryDynDirs = ["/opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0"], + license = Right BSD3, + maintainer = "Ross Paterson ", + pkgRoot = Nothing, + pkgUrl = "", + sourceLibName = Nothing, + sourcePackageId = PackageIdentifier + {pkgName = `PackageName "transformers"`, + pkgVersion = `mkVersion [0,5,2,0]`}, + stability = "", + synopsis = "Concrete functor and monad transformers", + trusted = False} diff --git a/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.format b/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.format new file mode 100644 index 00000000..7575d823 --- /dev/null +++ b/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.format @@ -0,0 +1,173 @@ +name: transformers +version: 0.5.2.0 +id: transformers-0.5.2.0 +key: transformers-0.5.2.0 +license: BSD3 +maintainer: Ross Paterson +author: Andy Gill, Ross Paterson +synopsis: Concrete functor and monad transformers +description: + A portable library of functor and monad transformers, inspired by + the paper \"Functional Programming with Overloading and Higher-Order + Polymorphism\", by Mark P Jones, + in /Advanced School of Functional Programming/, 1995 + (). + . + This package contains: + . + * the monad transformer class (in "Control.Monad.Trans.Class") + and IO monad class (in "Control.Monad.IO.Class") + . + * concrete functor and monad transformers, each with associated + operations and functions to lift operations associated with other + transformers. + . + The package can be used on its own in portable Haskell code, in + which case operations need to be manually lifted through transformer + stacks (see "Control.Monad.Trans.Class" for some examples). + Alternatively, it can be used with the non-portable monad classes in + the @mtl@ or @monads-tf@ packages, which automatically lift operations + introduced by monad transformers through other transformers. +category: Control +abi: e04579c0363c9229351d1a0b394bf2d5 +exposed: True +exposed-modules: + Control.Applicative.Backwards Control.Applicative.Lift + Control.Monad.Signatures Control.Monad.Trans.Class + Control.Monad.Trans.Cont Control.Monad.Trans.Error + Control.Monad.Trans.Except Control.Monad.Trans.Identity + Control.Monad.Trans.List Control.Monad.Trans.Maybe + Control.Monad.Trans.RWS Control.Monad.Trans.RWS.Lazy + Control.Monad.Trans.RWS.Strict Control.Monad.Trans.Reader + Control.Monad.Trans.State Control.Monad.Trans.State.Lazy + Control.Monad.Trans.State.Strict Control.Monad.Trans.Writer + Control.Monad.Trans.Writer.Lazy Control.Monad.Trans.Writer.Strict + Data.Functor.Constant Data.Functor.Reverse +import-dirs: /opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0 +library-dirs: /opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0 +dynamic-library-dirs: /opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0 +data-dir: /opt/ghc/8.2.2/share/x86_64-linux-ghc-8.2.2/transformers-0.5.2.0 +hs-libraries: HStransformers-0.5.2.0 +depends: + base-4.10.1.0 +abi-depends: base-4.10.1.0=35a7f6be752ee4f7385cb5bf28677879 +ld-options: -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm + -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm -lm +haddock-interfaces: /opt/ghc/8.2.2/share/doc/ghc-8.2.2/html/libraries/transformers-0.5.2.0/transformers.haddock +haddock-html: /opt/ghc/8.2.2/share/doc/ghc-8.2.2/html/libraries/transformers-0.5.2.0 diff --git a/Cabal/tests/ParserTests/ipi/transformers.cabal b/Cabal/tests/ParserTests/ipi/transformers.cabal new file mode 100644 index 00000000..2c6387c2 --- /dev/null +++ b/Cabal/tests/ParserTests/ipi/transformers.cabal @@ -0,0 +1,59 @@ +name: transformers +version: 0.5.2.0 +id: transformers-0.5.2.0 +key: transformers-0.5.2.0 +license: BSD3 +maintainer: Ross Paterson +synopsis: Concrete functor and monad transformers +description: + A portable library of functor and monad transformers, inspired by + the paper \"Functional Programming with Overloading and Higher-Order + Polymorphism\", by Mark P Jones, + in /Advanced School of Functional Programming/, 1995 + (). + . + This package contains: + . + * the monad transformer class (in "Control.Monad.Trans.Class") + and IO monad class (in "Control.Monad.IO.Class") + . + * concrete functor and monad transformers, each with associated + operations and functions to lift operations associated with other + transformers. + . + The package can be used on its own in portable Haskell code, in + which case operations need to be manually lifted through transformer + stacks (see "Control.Monad.Trans.Class" for some examples). + Alternatively, it can be used with the non-portable monad classes in + the @mtl@ or @monads-tf@ packages, which automatically lift operations + introduced by monad transformers through other transformers. +category: Control +author: Andy Gill, Ross Paterson +exposed: True +indefinite: False +exposed-modules: + Control.Applicative.Backwards Control.Applicative.Lift + Control.Monad.Signatures Control.Monad.Trans.Class + Control.Monad.Trans.Cont Control.Monad.Trans.Error + Control.Monad.Trans.Except Control.Monad.Trans.Identity + Control.Monad.Trans.List Control.Monad.Trans.Maybe + Control.Monad.Trans.RWS Control.Monad.Trans.RWS.Lazy + Control.Monad.Trans.RWS.Strict Control.Monad.Trans.Reader + Control.Monad.Trans.State Control.Monad.Trans.State.Lazy + Control.Monad.Trans.State.Strict Control.Monad.Trans.Writer + Control.Monad.Trans.Writer.Lazy Control.Monad.Trans.Writer.Strict + Data.Functor.Constant Data.Functor.Reverse +abi: e04579c0363c9229351d1a0b394bf2d5 +trusted: False +import-dirs: /opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0 +library-dirs: /opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0 +dynamic-library-dirs: /opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0 +data-dir: /opt/ghc/8.2.2/share/x86_64-linux-ghc-8.2.2/transformers-0.5.2.0 +hs-libraries: HStransformers-0.5.2.0 +depends: + base-4.10.1.0 +abi-depends: base-4.10.1.0=35a7f6be752ee4f7385cb5bf28677879 +haddock-interfaces: /opt/ghc/8.2.2/share/doc/ghc-8.2.2/html/libraries/transformers-0.5.2.0/transformers.haddock +haddock-html: /opt/ghc/8.2.2/share/doc/ghc-8.2.2/html/libraries/transformers-0.5.2.0 +pkgroot: "/opt/ghc/8.2.2/lib/ghc-8.2.2" + diff --git a/Cabal/tests/ParserTests/ipi/transformers.expr b/Cabal/tests/ParserTests/ipi/transformers.expr new file mode 100644 index 00000000..429883f3 --- /dev/null +++ b/Cabal/tests/ParserTests/ipi/transformers.expr @@ -0,0 +1,86 @@ +InstalledPackageInfo + {abiDepends = [`AbiDependency {depUnitId = UnitId "base-4.10.1.0", depAbiHash = AbiHash "35a7f6be752ee4f7385cb5bf28677879"}`], + abiHash = `AbiHash "e04579c0363c9229351d1a0b394bf2d5"`, + author = "Andy Gill, Ross Paterson", + category = "Control", + ccOptions = [], + cxxOptions = [], + compatPackageKey = "transformers-0.5.2.0", + copyright = "", + dataDir = "/opt/ghc/8.2.2/share/x86_64-linux-ghc-8.2.2/transformers-0.5.2.0", + depends = [`UnitId "base-4.10.1.0"`], + description = concat + ["A portable library of functor and monad transformers, inspired by\n", + "the paper \\\"Functional Programming with Overloading and Higher-Order\n", + "Polymorphism\\\", by Mark P Jones,\n", + "in /Advanced School of Functional Programming/, 1995\n", + "().\n", + "\n", + "This package contains:\n", + "\n", + "* the monad transformer class (in \"Control.Monad.Trans.Class\")\n", + "and IO monad class (in \"Control.Monad.IO.Class\")\n", + "\n", + "* concrete functor and monad transformers, each with associated\n", + "operations and functions to lift operations associated with other\n", + "transformers.\n", + "\n", + "The package can be used on its own in portable Haskell code, in\n", + "which case operations need to be manually lifted through transformer\n", + "stacks (see \"Control.Monad.Trans.Class\" for some examples).\n", + "Alternatively, it can be used with the non-portable monad classes in\n", + "the @mtl@ or @monads-tf@ packages, which automatically lift operations\n", + "introduced by monad transformers through other transformers."], + exposed = True, + exposedModules = [`ExposedModule {exposedName = ModuleName ["Control","Applicative","Backwards"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Applicative","Lift"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Signatures"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Class"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Cont"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Error"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Except"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Identity"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","List"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Maybe"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","RWS"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","RWS","Lazy"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","RWS","Strict"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Reader"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","State"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","State","Lazy"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","State","Strict"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Writer"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Writer","Lazy"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Control","Monad","Trans","Writer","Strict"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Data","Functor","Constant"], exposedReexport = Nothing}`, + `ExposedModule {exposedName = ModuleName ["Data","Functor","Reverse"], exposedReexport = Nothing}`], + extraGHCiLibraries = [], + extraLibraries = [], + frameworkDirs = [], + frameworks = [], + haddockHTMLs = ["/opt/ghc/8.2.2/share/doc/ghc-8.2.2/html/libraries/transformers-0.5.2.0"], + haddockInterfaces = ["/opt/ghc/8.2.2/share/doc/ghc-8.2.2/html/libraries/transformers-0.5.2.0/transformers.haddock"], + hiddenModules = [], + homepage = "", + hsLibraries = ["HStransformers-0.5.2.0"], + importDirs = ["/opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0"], + includeDirs = [], + includes = [], + indefinite = False, + installedComponentId_ = `ComponentId ""`, + installedUnitId = `UnitId "transformers-0.5.2.0"`, + instantiatedWith = [], + ldOptions = [], + libraryDirs = ["/opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0"], + libraryDynDirs = ["/opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0"], + license = Right BSD3, + maintainer = "Ross Paterson ", + pkgRoot = Just "/opt/ghc/8.2.2/lib/ghc-8.2.2", + pkgUrl = "", + sourceLibName = Nothing, + sourcePackageId = PackageIdentifier + {pkgName = `PackageName "transformers"`, + pkgVersion = `mkVersion [0,5,2,0]`}, + stability = "", + synopsis = "Concrete functor and monad transformers", + trusted = False} diff --git a/Cabal/tests/ParserTests/ipi/transformers.format b/Cabal/tests/ParserTests/ipi/transformers.format new file mode 100644 index 00000000..31c301a7 --- /dev/null +++ b/Cabal/tests/ParserTests/ipi/transformers.format @@ -0,0 +1,55 @@ +name: transformers +version: 0.5.2.0 +id: transformers-0.5.2.0 +key: transformers-0.5.2.0 +license: BSD3 +maintainer: Ross Paterson +author: Andy Gill, Ross Paterson +synopsis: Concrete functor and monad transformers +description: + A portable library of functor and monad transformers, inspired by + the paper \"Functional Programming with Overloading and Higher-Order + Polymorphism\", by Mark P Jones, + in /Advanced School of Functional Programming/, 1995 + (). + . + This package contains: + . + * the monad transformer class (in "Control.Monad.Trans.Class") + and IO monad class (in "Control.Monad.IO.Class") + . + * concrete functor and monad transformers, each with associated + operations and functions to lift operations associated with other + transformers. + . + The package can be used on its own in portable Haskell code, in + which case operations need to be manually lifted through transformer + stacks (see "Control.Monad.Trans.Class" for some examples). + Alternatively, it can be used with the non-portable monad classes in + the @mtl@ or @monads-tf@ packages, which automatically lift operations + introduced by monad transformers through other transformers. +category: Control +abi: e04579c0363c9229351d1a0b394bf2d5 +exposed: True +exposed-modules: + Control.Applicative.Backwards Control.Applicative.Lift + Control.Monad.Signatures Control.Monad.Trans.Class + Control.Monad.Trans.Cont Control.Monad.Trans.Error + Control.Monad.Trans.Except Control.Monad.Trans.Identity + Control.Monad.Trans.List Control.Monad.Trans.Maybe + Control.Monad.Trans.RWS Control.Monad.Trans.RWS.Lazy + Control.Monad.Trans.RWS.Strict Control.Monad.Trans.Reader + Control.Monad.Trans.State Control.Monad.Trans.State.Lazy + Control.Monad.Trans.State.Strict Control.Monad.Trans.Writer + Control.Monad.Trans.Writer.Lazy Control.Monad.Trans.Writer.Strict + Data.Functor.Constant Data.Functor.Reverse +import-dirs: /opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0 +library-dirs: /opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0 +dynamic-library-dirs: /opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0 +data-dir: /opt/ghc/8.2.2/share/x86_64-linux-ghc-8.2.2/transformers-0.5.2.0 +hs-libraries: HStransformers-0.5.2.0 +depends: + base-4.10.1.0 +abi-depends: base-4.10.1.0=35a7f6be752ee4f7385cb5bf28677879 +haddock-interfaces: /opt/ghc/8.2.2/share/doc/ghc-8.2.2/html/libraries/transformers-0.5.2.0/transformers.haddock +haddock-html: /opt/ghc/8.2.2/share/doc/ghc-8.2.2/html/libraries/transformers-0.5.2.0 diff --git a/Cabal/tests/ParserTests/regressions/MiniAgda.cabal b/Cabal/tests/ParserTests/regressions/MiniAgda.cabal new file mode 100644 index 00000000..072d19cc --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/MiniAgda.cabal @@ -0,0 +1,89 @@ +name: MiniAgda +version: 0.2017.02.18 +build-type: Simple +cabal-version: 1.22 +license: OtherLicense +license-file: LICENSE +author: Andreas Abel and Karl Mehltretter +maintainer: Andreas Abel +homepage: http://www.tcs.ifi.lmu.de/~abel/miniagda/ +bug-reports: https://github.com/andreasabel/miniagda/issues +category: Dependent types +synopsis: A toy dependently typed programming language with type-based termination. +description: + MiniAgda is a tiny dependently-typed programming language in the style + of Agda. It serves as a laboratory to test potential additions to the + language and type system of Agda. MiniAgda's termination checker is a + fusion of sized types and size-change termination and supports + coinduction. Equality incorporates eta-expansion at record and + singleton types. Function arguments can be declared as static; such + arguments are discarded during equality checking and compilation. + + Recent features include bounded size quantification and destructor + patterns for a more general handling of coinduction. + +tested-with: GHC == 7.6.3 + GHC == 7.8.4 + GHC == 7.10.3 + GHC == 8.0.1 + +extra-source-files: Makefile + +data-files: test/succeed/Makefile + test/succeed/*.ma + test/fail/Makefile + test/fail/*.ma + test/fail/*.err + test/fail/adm/*.ma + test/fail/adm/*.err + lib/*.ma +source-repository head + type: git + location: https://github.com/andreasabel/miniagda + +executable miniagda + hs-source-dirs: src + build-depends: array >= 0.3 && < 0.6, + base >= 4.6 && < 4.11, + containers >= 0.3 && < 0.6, + haskell-src-exts >= 1.17 && < 1.18, + mtl >= 2.2.0.1 && < 2.3, + pretty >= 1.0 && < 1.2 + build-tools: happy >= 1.15 && < 2, + alex >= 3.0 && < 4 + default-language: Haskell98 + default-extensions: CPP + MultiParamTypeClasses + TypeSynonymInstances + FlexibleInstances + FlexibleContexts + GeneralizedNewtypeDeriving + NoMonomorphismRestriction + PatternGuards + TupleSections + NamedFieldPuns + main-is: Main.hs + other-modules: Abstract + Collection + Concrete + Eval + Extract + HsSyntax + Lexer + Main + Parser + Polarity + PrettyTCM + ScopeChecker + Semiring + SparseMatrix + TCM + Termination + ToHaskell + Tokens + TraceError + TreeShapedOrder + TypeChecker + Util + Value + Warshall diff --git a/Cabal/tests/ParserTests/regressions/MiniAgda.check b/Cabal/tests/ParserTests/regressions/MiniAgda.check new file mode 100644 index 00000000..b482da32 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/MiniAgda.check @@ -0,0 +1 @@ +MiniAgda.cabal:0:0: Version digit with leading zero. Use cabal-version: 2.0 or later to write such versions. For more information see https://github.com/haskell/cabal/issues/5092 diff --git a/Cabal/tests/ParserTests/regressions/Octree-0.5.cabal b/Cabal/tests/ParserTests/regressions/Octree-0.5.cabal new file mode 100644 index 00000000..454a6906 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/Octree-0.5.cabal @@ -0,0 +1,44 @@ +name: Octree +version: 0.5 +stability: beta +homepage: https://github.com/mgajda/octree +package-url: http://hackage.haskell.org/package/octree +synopsis: Simple unbalanced Octree for storing data about 3D points +description: Octree data structure is relatively shallow data structure for space partitioning. +category: Data +license: BSD3 +license-file: LICENSE + +author: Michal J. Gajda +copyright: Copyright by Michal J. Gajda '2012 +maintainer: mjgajda@googlemail.com +bug-reports: mailto:mjgajda@googlemail.com + + +build-type: Simple +cabal-version: >=1.8 +tested-with: GHC==7.0.4,GHC==7.4.1,GHC==7.4.2,GHC==7.6.0 + +source-repository head + type: git + location: git@github.com:mgajda/octree.git + +Library + build-depends: base>=4.0 && < 4.7, AC-Vector >= 2.3.0, QuickCheck >= 2.4.0 + exposed-modules: Data.Octree + other-modules: Data.Octree.Internal + exposed: True + extensions: ScopedTypeVariables + +Test-suite test_Octree + Type: exitcode-stdio-1.0 + Build-depends: base>=4.0 && < 4.7, AC-Vector >= 2.3.0, QuickCheck >= 2.4.0 + Main-is: tests/test_Octree.hs + +Test-suite readme +  type: exitcode-stdio-1.0 + -- We have a symlink: README.lhs -> README.md +  main-is: README.lhs + Build-depends: base>=4.0 && < 4.7, AC-Vector >= 2.3.0, QuickCheck >= 2.4.0, markdown-unlit +  ghc-options: -pgmL markdown-unlit + diff --git a/Cabal/tests/ParserTests/regressions/Octree-0.5.expr b/Cabal/tests/ParserTests/regressions/Octree-0.5.expr new file mode 100644 index 00000000..f3df7cb0 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/Octree-0.5.expr @@ -0,0 +1,316 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [4,0]`) + (EarlierVersion `mkVersion [4,7]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "AC-Vector"` + (OrLaterVersion `mkVersion [2,3,0]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "QuickCheck"` + (OrLaterVersion `mkVersion [2,4,0]`) + (Set.fromList [LMainLibName])], + condTreeData = Library + {exposedModules = [`ModuleName ["Data","Octree"]`], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [EnableExtension + ScopedTypeVariables], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [`ModuleName ["Data","Octree","Internal"]`], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [4,0]`) + (EarlierVersion + `mkVersion [4,7]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "AC-Vector"` + (OrLaterVersion + `mkVersion [2,3,0]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "QuickCheck"` + (OrLaterVersion + `mkVersion [2,4,0]`) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [_×_ + `UnqualComponentName "test_Octree"` + CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [4,0]`) + (EarlierVersion `mkVersion [4,7]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "AC-Vector"` + (OrLaterVersion `mkVersion [2,3,0]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "QuickCheck"` + (OrLaterVersion `mkVersion [2,4,0]`) + (Set.fromList [LMainLibName])], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [4,0]`) + (EarlierVersion + `mkVersion [4,7]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "AC-Vector"` + (OrLaterVersion + `mkVersion [2,3,0]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "QuickCheck"` + (OrLaterVersion + `mkVersion [2,4,0]`) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + testInterface = TestSuiteExeV10 + `mkVersion [1,0]` + "tests/test_Octree.hs", + testName = `UnqualComponentName ""`}}, + _×_ + `UnqualComponentName "readme"` + CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [4,0]`) + (EarlierVersion `mkVersion [4,7]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "AC-Vector"` + (OrLaterVersion `mkVersion [2,3,0]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "QuickCheck"` + (OrLaterVersion `mkVersion [2,4,0]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "markdown-unlit"` + AnyVersion + (Set.fromList [LMainLibName])], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [_×_ + GHC + ["-pgmL", + "markdown-unlit"]], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [4,0]`) + (EarlierVersion + `mkVersion [4,7]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "AC-Vector"` + (OrLaterVersion + `mkVersion [2,3,0]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "QuickCheck"` + (OrLaterVersion + `mkVersion [2,4,0]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "markdown-unlit"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + testInterface = TestSuiteExeV10 + `mkVersion [1,0]` "README.lhs", + testName = `UnqualComponentName ""`}}], + genPackageFlags = [], + packageDescription = PackageDescription + {author = "Michal J. Gajda", + benchmarks = [], + bugReports = "mailto:mjgajda@googlemail.com", + buildTypeRaw = Just Simple, + category = "Data", + copyright = "Copyright by Michal J. Gajda '2012", + customFieldsPD = [], + dataDir = "", + dataFiles = [], + description = "Octree data structure is relatively shallow data structure for space partitioning.", + executables = [], + extraDocFiles = [], + extraSrcFiles = [], + extraTmpFiles = [], + foreignLibs = [], + homepage = "https://github.com/mgajda/octree", + library = Nothing, + licenseFiles = ["LICENSE"], + licenseRaw = Right BSD3, + maintainer = "mjgajda@googlemail.com", + package = PackageIdentifier + {pkgName = `PackageName "Octree"`, + pkgVersion = `mkVersion [0,5]`}, + pkgUrl = "http://hackage.haskell.org/package/octree", + setupBuildInfo = Nothing, + sourceRepos = [SourceRepo + {repoBranch = Nothing, + repoKind = RepoHead, + repoLocation = Just "git@github.com:mgajda/octree.git", + repoModule = Nothing, + repoSubdir = Nothing, + repoTag = Nothing, + repoType = Just Git}], + specVersionRaw = Right (OrLaterVersion `mkVersion [1,8]`), + stability = "beta", + subLibraries = [], + synopsis = "Simple unbalanced Octree for storing data about 3D points", + testSuites = [], + testedWith = [_×_ GHC (ThisVersion `mkVersion [7,0,4]`), + _×_ GHC (ThisVersion `mkVersion [7,4,1]`), + _×_ GHC (ThisVersion `mkVersion [7,4,2]`), + _×_ GHC (ThisVersion `mkVersion [7,6,0]`)]}} diff --git a/Cabal/tests/ParserTests/regressions/Octree-0.5.format b/Cabal/tests/ParserTests/regressions/Octree-0.5.format new file mode 100644 index 00000000..b27a21c5 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/Octree-0.5.format @@ -0,0 +1,52 @@ +Octree-0.5.cabal:39:3: Non breaking spaces at 39:3, 41:3, 43:3 +cabal-version: >=1.8 +name: Octree +version: 0.5 +license: BSD3 +license-file: LICENSE +copyright: Copyright by Michal J. Gajda '2012 +maintainer: mjgajda@googlemail.com +author: Michal J. Gajda +stability: beta +tested-with: ghc ==7.0.4 ghc ==7.4.1 ghc ==7.4.2 ghc ==7.6.0 +homepage: https://github.com/mgajda/octree +package-url: http://hackage.haskell.org/package/octree +bug-reports: mailto:mjgajda@googlemail.com +synopsis: Simple unbalanced Octree for storing data about 3D points +description: + Octree data structure is relatively shallow data structure for space partitioning. +category: Data +build-type: Simple + +source-repository head + type: git + location: git@github.com:mgajda/octree.git + +library + exposed-modules: + Data.Octree + other-modules: + Data.Octree.Internal + extensions: ScopedTypeVariables + build-depends: + base >=4.0 && <4.7, + AC-Vector >=2.3.0, + QuickCheck >=2.4.0 + +test-suite test_Octree + type: exitcode-stdio-1.0 + main-is: tests/test_Octree.hs + build-depends: + base >=4.0 && <4.7, + AC-Vector >=2.3.0, + QuickCheck >=2.4.0 + +test-suite readme + type: exitcode-stdio-1.0 + main-is: README.lhs + ghc-options: -pgmL markdown-unlit + build-depends: + base >=4.0 && <4.7, + AC-Vector >=2.3.0, + QuickCheck >=2.4.0, + markdown-unlit -any diff --git a/Cabal/tests/ParserTests/regressions/bad-glob-syntax.cabal b/Cabal/tests/ParserTests/regressions/bad-glob-syntax.cabal new file mode 100644 index 00000000..df9d7756 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/bad-glob-syntax.cabal @@ -0,0 +1,16 @@ +cabal-version: 2.2 +name: bad-glob-syntax +version: 0 +extra-source-files: + foo/blah-*.hs + foo/*/bar +license: BSD-3-Clause +synopsis: no +description: none +category: Test +maintainer: none + +library + default-language: Haskell2010 + exposed-modules: + Foo diff --git a/Cabal/tests/ParserTests/regressions/bad-glob-syntax.check b/Cabal/tests/ParserTests/regressions/bad-glob-syntax.check new file mode 100644 index 00000000..5b7a0a12 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/bad-glob-syntax.check @@ -0,0 +1,2 @@ +In the 'extra-source-files' field: invalid file glob 'foo/blah-*.hs'. Wildcards '*' may only totally replace the file's base name, not only parts of it. +In the 'extra-source-files' field: invalid file glob 'foo/*/bar'. A wildcard '**' is only allowed as the final parent directory. Stars must not otherwise appear in the parent directories. diff --git a/Cabal/tests/ParserTests/regressions/cc-options-with-optimization.cabal b/Cabal/tests/ParserTests/regressions/cc-options-with-optimization.cabal new file mode 100644 index 00000000..6eb8cec6 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/cc-options-with-optimization.cabal @@ -0,0 +1,15 @@ +cabal-version: 2.2 +category: test +description: test a build check involving C++-options field +license: BSD-3-Clause +maintainer: me@example.com +name: cxx-options-with-optimization +synopsis: test a build check +version: 1 + +library + build-depends: base >= 4.9 && <4.10 + cc-options: -O2 + default-language: Haskell2010 + exposed-modules: Prelude + hs-source-dirs: . diff --git a/Cabal/tests/ParserTests/regressions/cc-options-with-optimization.check b/Cabal/tests/ParserTests/regressions/cc-options-with-optimization.check new file mode 100644 index 00000000..16cfdb25 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/cc-options-with-optimization.check @@ -0,0 +1 @@ +'cc-options: -O[n]' is generally not needed. When building with optimisations Cabal automatically adds '-O2' for C code. Setting it yourself interferes with the --disable-optimization flag. diff --git a/Cabal/tests/ParserTests/regressions/common.cabal b/Cabal/tests/ParserTests/regressions/common.cabal new file mode 100644 index 00000000..62c8ad91 --- /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.expr b/Cabal/tests/ParserTests/regressions/common.expr new file mode 100644 index 00000000..c8eaf7f8 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/common.expr @@ -0,0 +1,163 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "ghc-prim"` + AnyVersion + (Set.fromList [LMainLibName])], + condTreeData = Library + {exposedModules = [`ModuleName ["ElseIf"]`], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "ghc-prim"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [_×_ + `UnqualComponentName "tests"` + CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "HUnit"` + AnyVersion + (Set.fromList [LMainLibName])], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "HUnit"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + testInterface = TestSuiteExeV10 + `mkVersion [1,0]` "Tests.hs", + testName = `UnqualComponentName ""`}}], + genPackageFlags = [], + packageDescription = PackageDescription + {author = "", + benchmarks = [], + bugReports = "", + buildTypeRaw = Just Simple, + category = "", + copyright = "", + customFieldsPD = [], + dataDir = "", + dataFiles = [], + description = "", + executables = [], + extraDocFiles = [], + extraSrcFiles = [], + extraTmpFiles = [], + foreignLibs = [], + homepage = "", + library = Nothing, + licenseFiles = [], + licenseRaw = Left NONE, + maintainer = "", + package = PackageIdentifier + {pkgName = `PackageName "common"`, + pkgVersion = `mkVersion [0]`}, + pkgUrl = "", + setupBuildInfo = Nothing, + sourceRepos = [SourceRepo + {repoBranch = Nothing, + repoKind = RepoHead, + repoLocation = Just "https://github.com/hvr/-.git", + repoModule = Nothing, + repoSubdir = Nothing, + repoTag = Nothing, + repoType = Just Git}], + specVersionRaw = Right (OrLaterVersion `mkVersion [1,10]`), + stability = "", + subLibraries = [], + synopsis = "Common-stanza demo demo", + testSuites = [], + testedWith = []}} diff --git a/Cabal/tests/ParserTests/regressions/common.format b/Cabal/tests/ParserTests/regressions/common.format new file mode 100644 index 00000000..22870d7c --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/common.format @@ -0,0 +1,25 @@ +common.cabal:26:3: Unknown field: import. You should set cabal-version: 2.2 or larger to use common stanzas +common.cabal:17:3: Unknown field: import. You should set cabal-version: 2.2 or larger to use common stanzas +common.cabal:11:1: Ignoring section: common. You should set cabal-version: 2.2 or larger to use common stanzas. +cabal-version: >=1.10 +name: common +version: 0 +synopsis: Common-stanza demo demo +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 diff --git a/Cabal/tests/ParserTests/regressions/common2.cabal b/Cabal/tests/ParserTests/regressions/common2.cabal new file mode 100644 index 00000000..c84479b8 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/common2.cabal @@ -0,0 +1,43 @@ +cabal-version: 2.1 +name: common +version: 0 +synopsis: Common-stanza demo demo +build-type: Simple + +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 + buildable: True + 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 + + -- buildable fields verify that we don't have duplicate field warnings + buildable: True + if os(windows) + buildable: False + + type: exitcode-stdio-1.0 + main-is: Tests.hs + + build-depends: + HUnit diff --git a/Cabal/tests/ParserTests/regressions/common2.expr b/Cabal/tests/ParserTests/regressions/common2.expr new file mode 100644 index 00000000..96f39001 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/common2.expr @@ -0,0 +1,449 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `Var (OS Windows)`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "Win32"` + AnyVersion + (Set.fromList + [LMainLibName])], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "Win32"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}}], + condTreeConstraints = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [4,10]`) + (EarlierVersion `mkVersion [4,11]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "containers"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "ghc-prim"` + AnyVersion + (Set.fromList [LMainLibName])], + condTreeData = Library + {exposedModules = [`ModuleName ["ElseIf"]`], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [4,10]`) + (EarlierVersion + `mkVersion [4,11]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "containers"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "ghc-prim"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [_×_ + `UnqualComponentName "tests"` + CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `Var (OS Windows)`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "Win32"` + AnyVersion + (Set.fromList + [LMainLibName])], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "Win32"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + testInterface = TestSuiteUnsupported + (TestTypeUnknown + "" + `mkVersion []`), + testName = `UnqualComponentName ""`}}}, + CondBranch + {condBranchCondition = `Var (OS Windows)`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "Win32"` + AnyVersion + (Set.fromList + [LMainLibName])], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "Win32"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + testInterface = TestSuiteUnsupported + (TestTypeUnknown + "" + `mkVersion []`), + testName = `UnqualComponentName ""`}}}, + CondBranch + {condBranchCondition = `Var (OS Windows)`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = False, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + testInterface = TestSuiteUnsupported + (TestTypeUnknown + "" + `mkVersion []`), + testName = `UnqualComponentName ""`}}}], + condTreeConstraints = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [4,10]`) + (EarlierVersion `mkVersion [4,11]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "containers"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "HUnit"` + AnyVersion + (Set.fromList [LMainLibName])], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [4,10]`) + (EarlierVersion + `mkVersion [4,11]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "containers"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "HUnit"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + testInterface = TestSuiteExeV10 + `mkVersion [1,0]` "Tests.hs", + testName = `UnqualComponentName ""`}}], + genPackageFlags = [], + packageDescription = PackageDescription + {author = "", + benchmarks = [], + bugReports = "", + buildTypeRaw = Just Simple, + category = "", + copyright = "", + customFieldsPD = [], + dataDir = "", + dataFiles = [], + description = "", + executables = [], + extraDocFiles = [], + extraSrcFiles = [], + extraTmpFiles = [], + foreignLibs = [], + homepage = "", + library = Nothing, + licenseFiles = [], + licenseRaw = Left NONE, + maintainer = "", + package = PackageIdentifier + {pkgName = `PackageName "common"`, + pkgVersion = `mkVersion [0]`}, + pkgUrl = "", + setupBuildInfo = Nothing, + sourceRepos = [SourceRepo + {repoBranch = Nothing, + repoKind = RepoHead, + repoLocation = Just "https://github.com/hvr/-.git", + repoModule = Nothing, + repoSubdir = Nothing, + repoTag = Nothing, + repoType = Just Git}], + specVersionRaw = Left `mkVersion [2,1]`, + stability = "", + subLibraries = [], + synopsis = "Common-stanza demo demo", + testSuites = [], + testedWith = []}} diff --git a/Cabal/tests/ParserTests/regressions/common2.format b/Cabal/tests/ParserTests/regressions/common2.format new file mode 100644 index 00000000..616d7ac3 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/common2.format @@ -0,0 +1,41 @@ +cabal-version: 2.1 +name: common +version: 0 +synopsis: Common-stanza demo demo +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 + + if os(windows) + buildable: False diff --git a/Cabal/tests/ParserTests/regressions/cxx-options-with-optimization.cabal b/Cabal/tests/ParserTests/regressions/cxx-options-with-optimization.cabal new file mode 100644 index 00000000..d081a5dd --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/cxx-options-with-optimization.cabal @@ -0,0 +1,15 @@ +cabal-version: 2.2 +category: test +description: test a build check involving C++-options field +license: BSD-3-Clause +maintainer: me@example.com +name: cxx-options-with-optimization +synopsis: test a build check +version: 1 + +library + build-depends: base >= 4.9 && <4.10 + cxx-options: -O2 + default-language: Haskell2010 + exposed-modules: Prelude + hs-source-dirs: . diff --git a/Cabal/tests/ParserTests/regressions/cxx-options-with-optimization.check b/Cabal/tests/ParserTests/regressions/cxx-options-with-optimization.check new file mode 100644 index 00000000..822bea38 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/cxx-options-with-optimization.check @@ -0,0 +1 @@ +'cxx-options: -O[n]' is generally not needed. When building with optimisations Cabal automatically adds '-O2' for C++ code. Setting it yourself interferes with the --disable-optimization flag. diff --git a/Cabal/tests/ParserTests/regressions/elif.cabal b/Cabal/tests/ParserTests/regressions/elif.cabal new file mode 100644 index 00000000..2d760681 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/elif.cabal @@ -0,0 +1,20 @@ +name: elif +version: 0 +synopsis: The elif demo +build-type: Simple +cabal-version: >=1.10 + +source-repository head + Type: git + Location: https://github.com/hvr/-.git + +library + default-language: Haskell2010 + exposed-modules: ElseIf + + if os(linux) + build-depends: unix + elif os(windows) + build-depends: Win32 + else + buildable: False diff --git a/Cabal/tests/ParserTests/regressions/elif.expr b/Cabal/tests/ParserTests/regressions/elif.expr new file mode 100644 index 00000000..bdcc6ea4 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/elif.expr @@ -0,0 +1,160 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `Var (OS Linux)`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "unix"` + AnyVersion + (Set.fromList + [LMainLibName])], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "unix"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}}], + condTreeConstraints = [], + condTreeData = Library + {exposedModules = [`ModuleName ["ElseIf"]`], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [], + genPackageFlags = [], + packageDescription = PackageDescription + {author = "", + benchmarks = [], + bugReports = "", + buildTypeRaw = Just Simple, + category = "", + copyright = "", + customFieldsPD = [], + dataDir = "", + dataFiles = [], + description = "", + executables = [], + extraDocFiles = [], + extraSrcFiles = [], + extraTmpFiles = [], + foreignLibs = [], + homepage = "", + library = Nothing, + licenseFiles = [], + licenseRaw = Left NONE, + maintainer = "", + package = PackageIdentifier + {pkgName = `PackageName "elif"`, + pkgVersion = `mkVersion [0]`}, + pkgUrl = "", + setupBuildInfo = Nothing, + sourceRepos = [SourceRepo + {repoBranch = Nothing, + repoKind = RepoHead, + repoLocation = Just "https://github.com/hvr/-.git", + repoModule = Nothing, + repoSubdir = Nothing, + repoTag = Nothing, + repoType = Just Git}], + specVersionRaw = Right (OrLaterVersion `mkVersion [1,10]`), + stability = "", + subLibraries = [], + synopsis = "The elif demo", + testSuites = [], + testedWith = []}} diff --git a/Cabal/tests/ParserTests/regressions/elif.format b/Cabal/tests/ParserTests/regressions/elif.format new file mode 100644 index 00000000..6f7fa624 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/elif.format @@ -0,0 +1,20 @@ +elif.cabal:19:3: invalid subsection "else" +elif.cabal:17:3: invalid subsection "elif". You should set cabal-version: 2.2 or larger to use elif-conditionals. +cabal-version: >=1.10 +name: elif +version: 0 +synopsis: The elif demo +build-type: Simple + +source-repository head + type: git + location: https://github.com/hvr/-.git + +library + exposed-modules: + ElseIf + default-language: Haskell2010 + + if os(linux) + build-depends: + unix -any diff --git a/Cabal/tests/ParserTests/regressions/elif2.cabal b/Cabal/tests/ParserTests/regressions/elif2.cabal new file mode 100644 index 00000000..46185b0a --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/elif2.cabal @@ -0,0 +1,20 @@ +cabal-version: 2.1 +name: elif +version: 0 +synopsis: The elif demo +build-type: Simple + +source-repository head + Type: git + Location: https://github.com/hvr/-.git + +library + default-language: Haskell2010 + exposed-modules: ElseIf + + if os(linux) + build-depends: unix + elif os(windows) + build-depends: Win32 + else + buildable: False diff --git a/Cabal/tests/ParserTests/regressions/elif2.expr b/Cabal/tests/ParserTests/regressions/elif2.expr new file mode 100644 index 00000000..214e6695 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/elif2.expr @@ -0,0 +1,323 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `Var (OS Linux)`, + condBranchIfFalse = Just + CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `Var (OS Windows)`, + condBranchIfFalse = Just + CondNode + {condTreeComponents = [], + condTreeConstraints = [], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = False, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "Win32"` + AnyVersion + (Set.fromList + [LMainLibName])], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "Win32"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}}], + condTreeConstraints = [], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "unix"` + AnyVersion + (Set.fromList + [LMainLibName])], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "unix"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}}], + condTreeConstraints = [], + condTreeData = Library + {exposedModules = [`ModuleName ["ElseIf"]`], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [], + genPackageFlags = [], + packageDescription = PackageDescription + {author = "", + benchmarks = [], + bugReports = "", + buildTypeRaw = Just Simple, + category = "", + copyright = "", + customFieldsPD = [], + dataDir = "", + dataFiles = [], + description = "", + executables = [], + extraDocFiles = [], + extraSrcFiles = [], + extraTmpFiles = [], + foreignLibs = [], + homepage = "", + library = Nothing, + licenseFiles = [], + licenseRaw = Left NONE, + maintainer = "", + package = PackageIdentifier + {pkgName = `PackageName "elif"`, + pkgVersion = `mkVersion [0]`}, + pkgUrl = "", + setupBuildInfo = Nothing, + sourceRepos = [SourceRepo + {repoBranch = Nothing, + repoKind = RepoHead, + repoLocation = Just "https://github.com/hvr/-.git", + repoModule = Nothing, + repoSubdir = Nothing, + repoTag = Nothing, + repoType = Just Git}], + specVersionRaw = Left `mkVersion [2,1]`, + stability = "", + subLibraries = [], + synopsis = "The elif demo", + testSuites = [], + testedWith = []}} diff --git a/Cabal/tests/ParserTests/regressions/elif2.format b/Cabal/tests/ParserTests/regressions/elif2.format new file mode 100644 index 00000000..b8309471 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/elif2.format @@ -0,0 +1,25 @@ +cabal-version: 2.1 +name: elif +version: 0 +synopsis: The elif demo +build-type: Simple + +source-repository head + type: git + location: https://github.com/hvr/-.git + +library + exposed-modules: + ElseIf + default-language: Haskell2010 + + if os(linux) + build-depends: + unix -any + else + + if os(windows) + build-depends: + Win32 -any + else + buildable: False diff --git a/Cabal/tests/ParserTests/regressions/encoding-0.8.cabal b/Cabal/tests/ParserTests/regressions/encoding-0.8.cabal new file mode 100644 index 00000000..2113714b --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/encoding-0.8.cabal @@ -0,0 +1,24 @@ +Name: encoding-wrong +Name: encoding +Version: 0.8 +cabal-version: >=1.12 +-- double-dash files +extra-source-files: + -- this is comment + README.md "--" + "--" + +custom-setup + setup-depends: + base < 5, + ghc-prim + +Library + -- version range round trip is better + build-depends: base (> 4.4 || == 4.4) + + Exposed-Modules: + Data.Encoding + + -- options with spaces + GHC-Options: -Wall -O2 -threaded -rtsopts "-with-rtsopts=-N1 -A64m" diff --git a/Cabal/tests/ParserTests/regressions/encoding-0.8.expr b/Cabal/tests/ParserTests/regressions/encoding-0.8.expr new file mode 100644 index 00000000..ef36d7b1 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/encoding-0.8.expr @@ -0,0 +1,123 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "base"` + (VersionRangeParens + (UnionVersionRanges + (LaterVersion `mkVersion [4,4]`) + (ThisVersion `mkVersion [4,4]`))) + (Set.fromList [LMainLibName])], + condTreeData = Library + {exposedModules = [`ModuleName ["Data","Encoding"]`], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [_×_ + GHC + ["-Wall", + "-O2", + "-threaded", + "-rtsopts", + "-with-rtsopts=-N1 -A64m"]], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + (VersionRangeParens + (UnionVersionRanges + (LaterVersion + `mkVersion [4,4]`) + (ThisVersion + `mkVersion [4,4]`))) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [], + genPackageFlags = [], + packageDescription = PackageDescription + {author = "", + benchmarks = [], + bugReports = "", + buildTypeRaw = Nothing, + category = "", + copyright = "", + customFieldsPD = [], + dataDir = "", + dataFiles = [], + description = "", + executables = [], + extraDocFiles = [], + extraSrcFiles = ["README.md", "--", "--"], + extraTmpFiles = [], + foreignLibs = [], + homepage = "", + library = Nothing, + licenseFiles = [], + licenseRaw = Left NONE, + maintainer = "", + package = PackageIdentifier + {pkgName = `PackageName "encoding"`, + pkgVersion = `mkVersion [0,8]`}, + pkgUrl = "", + setupBuildInfo = Just + SetupBuildInfo + {defaultSetupDepends = False, + setupDepends = [Dependency + `PackageName "base"` + (EarlierVersion `mkVersion [5]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "ghc-prim"` + AnyVersion + (Set.fromList [LMainLibName])]}, + sourceRepos = [], + specVersionRaw = Right (OrLaterVersion `mkVersion [1,12]`), + stability = "", + subLibraries = [], + synopsis = "", + testSuites = [], + testedWith = []}} diff --git a/Cabal/tests/ParserTests/regressions/encoding-0.8.format b/Cabal/tests/ParserTests/regressions/encoding-0.8.format new file mode 100644 index 00000000..3fe5dbcb --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/encoding-0.8.format @@ -0,0 +1,19 @@ +encoding-0.8.cabal:1:1: The field "name" is specified more than once at positions 1:1, 2:1 +cabal-version: >=1.12 +name: encoding +version: 0.8 +extra-source-files: + README.md + "--" + "--" + +custom-setup + setup-depends: base <5, + ghc-prim -any + +library + exposed-modules: + Data.Encoding + ghc-options: -Wall -O2 -threaded -rtsopts "-with-rtsopts=-N1 -A64m" + build-depends: + base (>4.4 || ==4.4) diff --git a/Cabal/tests/ParserTests/regressions/extensions-paths-5054.cabal b/Cabal/tests/ParserTests/regressions/extensions-paths-5054.cabal new file mode 100644 index 00000000..d6cc4fea --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/extensions-paths-5054.cabal @@ -0,0 +1,39 @@ +name: extensions-paths +version: 5054 +category: Test +maintainer: Oleg Grenrus +license: BSD3 +license-file: LICENSe +synopsis: Paths_pkg module + "bad" extensions + old cabal +description: + Only cabal-version: 2.2 or later will build Paths_pkg ok with + + * RebindableSyntax and + + * OverloadedLists or OverloadedStrings + + `fromList` or `fromString` will be out-of-scope when compiling Paths_ module. + + Other extensions (like NoImplicitPrelude) were handled before +build-type: Simple +cabal-version: 1.12 + +library + default-language: Haskell2010 + exposed-modules: Issue Paths_extensions_paths + default-extensions: + RebindableSyntax + OverloadedStrings + +test-suite tests + default-language: Haskell2010 + main-is: Test.hs + type: exitcode-stdio-1.0 + if os(linux) + other-modules: Paths_extensions_paths + else + buildable: False + + default-extensions: + OverloadedLists + RebindableSyntax diff --git a/Cabal/tests/ParserTests/regressions/extensions-paths-5054.check b/Cabal/tests/ParserTests/regressions/extensions-paths-5054.check new file mode 100644 index 00000000..6268308c --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/extensions-paths-5054.check @@ -0,0 +1 @@ +The package uses RebindableSyntax with OverloadedStrings or OverloadedLists in default-extensions, and also Paths_ autogen module. That configuration is known to cause compile failures with Cabal < 2.2. To use these default-extensions with Paths_ autogen module specify at least 'cabal-version: 2.2'. diff --git a/Cabal/tests/ParserTests/regressions/generics-sop.cabal b/Cabal/tests/ParserTests/regressions/generics-sop.cabal new file mode 100644 index 00000000..e8932980 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/generics-sop.cabal @@ -0,0 +1,128 @@ +name: generics-sop +version: 0.3.1.0 +synopsis: Generic Programming using True Sums of Products +description: + A library to support the definition of generic functions. + Datatypes are viewed in a uniform, structured way: + the choice between constructors is represented using an n-ary + sum, and the arguments of each constructor are represented using + an n-ary product. + . + The module "Generics.SOP" is the main module of this library and contains + more detailed documentation. + . + Examples of using this library are provided by the following + packages: + . + * @@ basic examples, + . + * @@ generic pretty printing, + . + * @@ generically computed lenses, + . + * @@ generic JSON conversions. + . + A detailed description of the ideas behind this library is provided by + the paper: + . + * Edsko de Vries and Andres Löh. + . + Workshop on Generic Programming (WGP) 2014. + . +license: BSD3 +license-file: LICENSE +author: Edsko de Vries , Andres Löh +maintainer: andres@well-typed.com +category: Generics +build-type: Custom +cabal-version: >=1.10 +extra-source-files: CHANGELOG.md +tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1, GHC == 8.0.2, GHC == 8.2.1, GHC == 8.3.* + +custom-setup + setup-depends: + base, + Cabal, + cabal-doctest >= 1.0.2 && <1.1 + +source-repository head + type: git + location: https://github.com/well-typed/generics-sop + +library + exposed-modules: Generics.SOP + Generics.SOP.GGP + Generics.SOP.TH + Generics.SOP.Dict + Generics.SOP.Type.Metadata + -- exposed via Generics.SOP: + Generics.SOP.BasicFunctors + Generics.SOP.Classes + Generics.SOP.Constraint + Generics.SOP.Instances + Generics.SOP.Metadata + Generics.SOP.NP + Generics.SOP.NS + Generics.SOP.Universe + Generics.SOP.Sing + build-depends: base >= 4.7 && < 5, + template-haskell >= 2.8 && < 2.13, + ghc-prim >= 0.3 && < 0.6, + deepseq >= 1.3 && < 1.5 + if !impl (ghc >= 7.8) + build-depends: tagged >= 0.7 && < 0.9 + if !impl (ghc >= 8.0) + build-depends: transformers-compat >= 0.3 && < 0.6, + transformers >= 0.3 && < 0.6 + + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall + default-extensions: CPP + ScopedTypeVariables + TypeFamilies + RankNTypes + TypeOperators + GADTs + ConstraintKinds + MultiParamTypeClasses + TypeSynonymInstances + FlexibleInstances + FlexibleContexts + DeriveFunctor + DeriveFoldable + DeriveTraversable + DefaultSignatures + KindSignatures + DataKinds + FunctionalDependencies + if impl (ghc >= 7.8) + default-extensions: AutoDeriveTypeable + other-extensions: OverloadedStrings + PolyKinds + UndecidableInstances + TemplateHaskell + DeriveGeneric + StandaloneDeriving + if impl (ghc < 7.10) + other-extensions: OverlappingInstances + +test-suite doctests + type: exitcode-stdio-1.0 + main-is: doctests.hs + x-doctest-options: --preserve-it + hs-source-dirs: test + default-language: Haskell2010 + build-depends: base, + doctest >= 0.13 && <0.14 + ghc-options: -Wall -threaded + +test-suite generics-sop-examples + type: exitcode-stdio-1.0 + main-is: Example.hs + other-modules: HTransExample + hs-source-dirs: test + default-language: Haskell2010 + ghc-options: -Wall + build-depends: base >= 4.6 && < 5, + generics-sop diff --git a/Cabal/tests/ParserTests/regressions/generics-sop.expr b/Cabal/tests/ParserTests/regressions/generics-sop.expr new file mode 100644 index 00000000..bb43a40f --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/generics-sop.expr @@ -0,0 +1,681 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `CNot (Var (Impl GHC (OrLaterVersion (mkVersion [7,8]))))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "tagged"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [0,7]`) + (EarlierVersion + `mkVersion [0,9]`)) + (Set.fromList + [LMainLibName])], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "tagged"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [0,7]`) + (EarlierVersion + `mkVersion [0,9]`)) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}}, + CondBranch + {condBranchCondition = `CNot (Var (Impl GHC (OrLaterVersion (mkVersion [8,0]))))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "transformers-compat"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [0,3]`) + (EarlierVersion + `mkVersion [0,6]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "transformers"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [0,3]`) + (EarlierVersion + `mkVersion [0,6]`)) + (Set.fromList + [LMainLibName])], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "transformers-compat"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [0,3]`) + (EarlierVersion + `mkVersion [0,6]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "transformers"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [0,3]`) + (EarlierVersion + `mkVersion [0,6]`)) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}}, + CondBranch + {condBranchCondition = `Var (Impl GHC (OrLaterVersion (mkVersion [7,8])))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [EnableExtension + AutoDeriveTypeable], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}}, + CondBranch + {condBranchCondition = `Var (Impl GHC (EarlierVersion (mkVersion [7,10])))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [EnableExtension + OverlappingInstances], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}}], + condTreeConstraints = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [4,7]`) + (EarlierVersion `mkVersion [5]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "template-haskell"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [2,8]`) + (EarlierVersion `mkVersion [2,13]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "ghc-prim"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [0,3]`) + (EarlierVersion `mkVersion [0,6]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "deepseq"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [1,3]`) + (EarlierVersion `mkVersion [1,5]`)) + (Set.fromList [LMainLibName])], + condTreeData = Library + {exposedModules = [`ModuleName ["Generics","SOP"]`, + `ModuleName ["Generics","SOP","GGP"]`, + `ModuleName ["Generics","SOP","TH"]`, + `ModuleName ["Generics","SOP","Dict"]`, + `ModuleName ["Generics","SOP","Type","Metadata"]`, + `ModuleName ["Generics","SOP","BasicFunctors"]`, + `ModuleName ["Generics","SOP","Classes"]`, + `ModuleName ["Generics","SOP","Constraint"]`, + `ModuleName ["Generics","SOP","Instances"]`, + `ModuleName ["Generics","SOP","Metadata"]`, + `ModuleName ["Generics","SOP","NP"]`, + `ModuleName ["Generics","SOP","NS"]`, + `ModuleName ["Generics","SOP","Universe"]`, + `ModuleName ["Generics","SOP","Sing"]`], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [EnableExtension CPP, + EnableExtension + ScopedTypeVariables, + EnableExtension + TypeFamilies, + EnableExtension + RankNTypes, + EnableExtension + TypeOperators, + EnableExtension + GADTs, + EnableExtension + ConstraintKinds, + EnableExtension + MultiParamTypeClasses, + EnableExtension + TypeSynonymInstances, + EnableExtension + FlexibleInstances, + EnableExtension + FlexibleContexts, + EnableExtension + DeriveFunctor, + EnableExtension + DeriveFoldable, + EnableExtension + DeriveTraversable, + EnableExtension + DefaultSignatures, + EnableExtension + KindSignatures, + EnableExtension + DataKinds, + EnableExtension + FunctionalDependencies], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = ["src"], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [_×_ GHC ["-Wall"]], + otherExtensions = [EnableExtension + OverloadedStrings, + EnableExtension + PolyKinds, + EnableExtension + UndecidableInstances, + EnableExtension + TemplateHaskell, + EnableExtension + DeriveGeneric, + EnableExtension + StandaloneDeriving], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [4,7]`) + (EarlierVersion + `mkVersion [5]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "template-haskell"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [2,8]`) + (EarlierVersion + `mkVersion [2,13]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "ghc-prim"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [0,3]`) + (EarlierVersion + `mkVersion [0,6]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "deepseq"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [1,3]`) + (EarlierVersion + `mkVersion [1,5]`)) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [_×_ + `UnqualComponentName "doctests"` + CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "base"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "doctest"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [0,13]`) + (EarlierVersion `mkVersion [0,14]`)) + (Set.fromList [LMainLibName])], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [_×_ + "x-doctest-options" + "--preserve-it"], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = ["test"], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [_×_ + GHC + ["-Wall", "-threaded"]], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "doctest"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [0,13]`) + (EarlierVersion + `mkVersion [0,14]`)) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + testInterface = TestSuiteExeV10 + `mkVersion [1,0]` "doctests.hs", + testName = `UnqualComponentName ""`}}, + _×_ + `UnqualComponentName "generics-sop-examples"` + CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [4,6]`) + (EarlierVersion `mkVersion [5]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "generics-sop"` + AnyVersion + (Set.fromList [LMainLibName])], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = ["test"], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [_×_ GHC ["-Wall"]], + otherExtensions = [], + otherLanguages = [], + otherModules = [`ModuleName ["HTransExample"]`], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [4,6]`) + (EarlierVersion + `mkVersion [5]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "generics-sop"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + testInterface = TestSuiteExeV10 + `mkVersion [1,0]` "Example.hs", + testName = `UnqualComponentName ""`}}], + genPackageFlags = [], + packageDescription = PackageDescription + {author = "Edsko de Vries , Andres L\246h ", + benchmarks = [], + bugReports = "", + buildTypeRaw = Just Custom, + category = "Generics", + copyright = "", + customFieldsPD = [], + dataDir = "", + dataFiles = [], + description = concat + ["A library to support the definition of generic functions.\n", + "Datatypes are viewed in a uniform, structured way:\n", + "the choice between constructors is represented using an n-ary\n", + "sum, and the arguments of each constructor are represented using\n", + "an n-ary product.\n", + "\n", + "The module \"Generics.SOP\" is the main module of this library and contains\n", + "more detailed documentation.\n", + "\n", + "Examples of using this library are provided by the following\n", + "packages:\n", + "\n", + "* @@ basic examples,\n", + "\n", + "* @@ generic pretty printing,\n", + "\n", + "* @@ generically computed lenses,\n", + "\n", + "* @@ generic JSON conversions.\n", + "\n", + "A detailed description of the ideas behind this library is provided by\n", + "the paper:\n", + "\n", + "* Edsko de Vries and Andres L\246h.\n", + ".\n", + "Workshop on Generic Programming (WGP) 2014.\n"], + executables = [], + extraDocFiles = [], + extraSrcFiles = ["CHANGELOG.md"], + extraTmpFiles = [], + foreignLibs = [], + homepage = "", + library = Nothing, + licenseFiles = ["LICENSE"], + licenseRaw = Right BSD3, + maintainer = "andres@well-typed.com", + package = PackageIdentifier + {pkgName = `PackageName "generics-sop"`, + pkgVersion = `mkVersion [0,3,1,0]`}, + pkgUrl = "", + setupBuildInfo = Just + SetupBuildInfo + {defaultSetupDepends = False, + setupDepends = [Dependency + `PackageName "base"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "Cabal"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "cabal-doctest"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [1,0,2]`) + (EarlierVersion + `mkVersion [1,1]`)) + (Set.fromList [LMainLibName])]}, + sourceRepos = [SourceRepo + {repoBranch = Nothing, + repoKind = RepoHead, + repoLocation = Just + "https://github.com/well-typed/generics-sop", + repoModule = Nothing, + repoSubdir = Nothing, + repoTag = Nothing, + repoType = Just Git}], + specVersionRaw = Right (OrLaterVersion `mkVersion [1,10]`), + stability = "", + subLibraries = [], + synopsis = "Generic Programming using True Sums of Products", + testSuites = [], + testedWith = [_×_ GHC (ThisVersion `mkVersion [7,8,4]`), + _×_ GHC (ThisVersion `mkVersion [7,10,3]`), + _×_ GHC (ThisVersion `mkVersion [8,0,1]`), + _×_ GHC (ThisVersion `mkVersion [8,0,2]`), + _×_ GHC (ThisVersion `mkVersion [8,2,1]`), + _×_ GHC (WildcardVersion `mkVersion [8,3]`)]}} diff --git a/Cabal/tests/ParserTests/regressions/generics-sop.format b/Cabal/tests/ParserTests/regressions/generics-sop.format new file mode 100644 index 00000000..e388c375 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/generics-sop.format @@ -0,0 +1,121 @@ +cabal-version: >=1.10 +name: generics-sop +version: 0.3.1.0 +license: BSD3 +license-file: LICENSE +maintainer: andres@well-typed.com +author: Edsko de Vries , Andres Löh +tested-with: ghc ==7.8.4 ghc ==7.10.3 ghc ==8.0.1 ghc ==8.0.2 + ghc ==8.2.1 ghc ==8.3.* +synopsis: Generic Programming using True Sums of Products +description: + A library to support the definition of generic functions. + Datatypes are viewed in a uniform, structured way: + the choice between constructors is represented using an n-ary + sum, and the arguments of each constructor are represented using + an n-ary product. + . + The module "Generics.SOP" is the main module of this library and contains + more detailed documentation. + . + Examples of using this library are provided by the following + packages: + . + * @@ basic examples, + . + * @@ generic pretty printing, + . + * @@ generically computed lenses, + . + * @@ generic JSON conversions. + . + A detailed description of the ideas behind this library is provided by + the paper: + . + * Edsko de Vries and Andres Löh. + . + Workshop on Generic Programming (WGP) 2014. + . +category: Generics +build-type: Custom +extra-source-files: + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/well-typed/generics-sop + +custom-setup + setup-depends: base -any, + Cabal -any, + cabal-doctest >=1.0.2 && <1.1 + +library + exposed-modules: + Generics.SOP + Generics.SOP.GGP + Generics.SOP.TH + Generics.SOP.Dict + Generics.SOP.Type.Metadata + Generics.SOP.BasicFunctors + Generics.SOP.Classes + Generics.SOP.Constraint + Generics.SOP.Instances + Generics.SOP.Metadata + Generics.SOP.NP + Generics.SOP.NS + Generics.SOP.Universe + Generics.SOP.Sing + hs-source-dirs: src + default-language: Haskell2010 + default-extensions: CPP ScopedTypeVariables TypeFamilies RankNTypes + TypeOperators GADTs ConstraintKinds MultiParamTypeClasses + TypeSynonymInstances FlexibleInstances FlexibleContexts + DeriveFunctor DeriveFoldable DeriveTraversable DefaultSignatures + KindSignatures DataKinds FunctionalDependencies + other-extensions: OverloadedStrings PolyKinds UndecidableInstances + TemplateHaskell DeriveGeneric StandaloneDeriving + ghc-options: -Wall + build-depends: + base >=4.7 && <5, + template-haskell >=2.8 && <2.13, + ghc-prim >=0.3 && <0.6, + deepseq >=1.3 && <1.5 + + if !impl(ghc >=7.8) + build-depends: + tagged >=0.7 && <0.9 + + if !impl(ghc >=8.0) + build-depends: + transformers-compat >=0.3 && <0.6, + transformers >=0.3 && <0.6 + + if impl(ghc >=7.8) + default-extensions: AutoDeriveTypeable + + if impl(ghc <7.10) + other-extensions: OverlappingInstances + +test-suite doctests + type: exitcode-stdio-1.0 + main-is: doctests.hs + hs-source-dirs: test + default-language: Haskell2010 + ghc-options: -Wall -threaded + x-doctest-options: --preserve-it + build-depends: + base -any, + doctest >=0.13 && <0.14 + +test-suite generics-sop-examples + type: exitcode-stdio-1.0 + main-is: Example.hs + hs-source-dirs: test + other-modules: + HTransExample + default-language: Haskell2010 + ghc-options: -Wall + build-depends: + base >=4.6 && <5, + generics-sop -any diff --git a/Cabal/tests/ParserTests/regressions/ghc-option-j.cabal b/Cabal/tests/ParserTests/regressions/ghc-option-j.cabal new file mode 100644 index 00000000..fc46239f --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/ghc-option-j.cabal @@ -0,0 +1,18 @@ +cabal-version: 2.2 +name: ghc-option-j +version: 0 +license: BSD-2-Clause +synopsis: Test +description: Testy test. +maintainer: none +category: none + +library + exposed-modules: Foo + ghc-options: -Wall -j -Wno-all + default-language: Haskell2010 + +executable foo + main-is: Main.hs + ghc-shared-options: -Wall -j2 -Wno-all + default-language: Haskell2010 diff --git a/Cabal/tests/ParserTests/regressions/ghc-option-j.check b/Cabal/tests/ParserTests/regressions/ghc-option-j.check new file mode 100644 index 00000000..3643c13a --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/ghc-option-j.check @@ -0,0 +1,2 @@ +'ghc-options: -j[N]' can make sense for specific user's setup, but it is not appropriate for a distributed package. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. +'ghc-shared-options: -j[N]' can make sense for specific user's setup, but it is not appropriate for a distributed package. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. diff --git a/Cabal/tests/ParserTests/regressions/haddock-api-2.18.1-check.cabal b/Cabal/tests/ParserTests/regressions/haddock-api-2.18.1-check.cabal new file mode 100644 index 00000000..5ecfcd13 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/haddock-api-2.18.1-check.cabal @@ -0,0 +1,147 @@ +name: haddock-api +version: 2.18.1 +synopsis: A documentation-generation tool for Haskell libraries +description: Haddock is a documentation-generation tool for Haskell + libraries +license: BSD3 +license-file: LICENSE +author: Simon Marlow, David Waern +maintainer: Alex Biehl , Simon Hengel , Mateusz Kowalczyk +homepage: http://www.haskell.org/haddock/ +bug-reports: https://github.com/haskell/haddock/issues +copyright: (c) Simon Marlow, David Waern +category: Documentation +build-type: Simple +cabal-version: >= 1.10 + +extra-source-files: + CHANGES.md + +data-dir: + resources +data-files: + html/solarized.css + html/haddock-util.js + html/highlight.js + html/Classic.theme/haskell_icon.gif + html/Classic.theme/minus.gif + html/Classic.theme/plus.gif + html/Classic.theme/xhaddock.css + html/Ocean.std-theme/hslogo-16.png + html/Ocean.std-theme/minus.gif + html/Ocean.std-theme/ocean.css + html/Ocean.std-theme/plus.gif + html/Ocean.std-theme/synopsis.png + latex/haddock.sty + +library + default-language: Haskell2010 + + -- this package typically supports only single major versions + build-depends: base ^>= 4.10.0 + , Cabal ^>= 2.0.0 + , ghc ^>= 8.2 + , ghc-paths ^>= 0.1.0.9 + , haddock-library == 1.4.4.* + , xhtml ^>= 3000.2.2 + + -- Versions for the dependencies below are transitively pinned by + -- the non-reinstallable `ghc` package and hence need no version + -- bounds + build-depends: array + , bytestring + , containers + , deepseq + , directory + , filepath + , ghc-boot + , transformers + + hs-source-dirs: src + + ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 + ghc-options: -Wall + if impl(ghc >= 8.0) + ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances + + exposed-modules: + Documentation.Haddock + + other-modules: + Haddock + Haddock.Interface + Haddock.Interface.Rename + Haddock.Interface.Create + Haddock.Interface.AttachInstances + Haddock.Interface.LexParseRn + Haddock.Interface.ParseModuleHeader + Haddock.Interface.Specialize + Haddock.Parser + Haddock.Utils + Haddock.Backends.Xhtml + Haddock.Backends.Xhtml.Decl + Haddock.Backends.Xhtml.DocMarkup + Haddock.Backends.Xhtml.Layout + Haddock.Backends.Xhtml.Names + Haddock.Backends.Xhtml.Themes + Haddock.Backends.Xhtml.Types + Haddock.Backends.Xhtml.Utils + Haddock.Backends.LaTeX + Haddock.Backends.HaddockDB + Haddock.Backends.Hoogle + Haddock.Backends.Hyperlinker + Haddock.Backends.Hyperlinker.Ast + Haddock.Backends.Hyperlinker.Parser + Haddock.Backends.Hyperlinker.Renderer + Haddock.Backends.Hyperlinker.Types + Haddock.Backends.Hyperlinker.Utils + Haddock.ModuleTree + Haddock.Types + Haddock.Doc + Haddock.Version + Haddock.InterfaceFile + Haddock.Options + Haddock.GhcUtils + Haddock.Syb + Haddock.Convert + Paths_haddock_api + + autogen-modules: + Paths_haddock_api + +test-suite spec + type: exitcode-stdio-1.0 + default-language: Haskell2010 + main-is: Spec.hs + ghc-options: -Wall + + hs-source-dirs: + test + , src + + -- NB: We only use a small subset of lib:haddock-api here, which + -- explains why this component has a smaller build-depends set + other-modules: + Haddock.Backends.Hyperlinker.ParserSpec + Haddock.Backends.Hyperlinker.Parser + Haddock.Backends.Hyperlinker.Types + + build-depends: + ghc ^>= 8.2 + , hspec ^>= 2.4.4 + , QuickCheck ^>= 2.10 + + -- Versions for the dependencies below are transitively pinned by + -- the non-reinstallable `ghc` package and hence need no version + -- bounds + build-depends: + base + , containers + + build-tool-depends: + hspec-discover:hspec-discover ^>= 2.4.4 + +source-repository head + type: git + subdir: haddock-api + location: https://github.com/haskell/haddock.git diff --git a/Cabal/tests/ParserTests/regressions/haddock-api-2.18.1-check.check b/Cabal/tests/ParserTests/regressions/haddock-api-2.18.1-check.check new file mode 100644 index 00000000..4d328b12 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/haddock-api-2.18.1-check.check @@ -0,0 +1,11 @@ +ERROR: haddock-api-2.18.1-check.cabal:41:44: +unexpected major bounded version syntax (caret, ^>=) used. To use this syntax the package need to specify at least 'cabal-version: 2.0'. Alternatively, if broader compatibility is important then use: >=4.10.0 && <4.11 +expecting "." or "-" + +base ^>= 4.10.0 +, Cabal ^>= 2.0.0 +, ghc ^>= 8.2 +, ghc-paths ^>= 0.1.0.9 +, haddock-library == 1.4.4.* +, xhtml ^>= 3000.2.2 + diff --git a/Cabal/tests/ParserTests/regressions/issue-5055.cabal b/Cabal/tests/ParserTests/regressions/issue-5055.cabal new file mode 100644 index 00000000..e1a35ea1 --- /dev/null +++ b/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 diff --git a/Cabal/tests/ParserTests/regressions/issue-5055.expr b/Cabal/tests/ParserTests/regressions/issue-5055.expr new file mode 100644 index 00000000..20cba5ad --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/issue-5055.expr @@ -0,0 +1,220 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [_×_ + `UnqualComponentName "flag-test-exe"` + CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [4,8]`) + (EarlierVersion `mkVersion [5]`)) + (Set.fromList [LMainLibName])], + condTreeData = Executable + {buildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [4,8]`) + (EarlierVersion + `mkVersion [5]`)) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + exeName = `UnqualComponentName "flag-test-exe"`, + exeScope = ExecutablePublic, + modulePath = "FirstMain.hs"}}], + condForeignLibs = [], + condLibrary = Nothing, + condSubLibraries = [], + condTestSuites = [_×_ + `UnqualComponentName "flag-cabal-test"` + CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `Var (OS Windows)`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + testInterface = TestSuiteUnsupported + (TestTypeUnknown + "" + `mkVersion []`), + testName = `UnqualComponentName ""`}}}], + condTreeConstraints = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [4,8]`) + (EarlierVersion `mkVersion [5]`)) + (Set.fromList [LMainLibName])], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [4,8]`) + (EarlierVersion + `mkVersion [5]`)) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + testInterface = TestSuiteExeV10 + `mkVersion [1,0]` "SecondMain.hs", + testName = `UnqualComponentName ""`}}], + genPackageFlags = [], + packageDescription = PackageDescription + {author = "", + benchmarks = [], + bugReports = "", + buildTypeRaw = Just Simple, + category = "Test", + copyright = "", + customFieldsPD = [], + dataDir = "", + dataFiles = [], + description = "no type in all branches.", + executables = [], + extraDocFiles = [], + extraSrcFiles = [], + extraTmpFiles = [], + foreignLibs = [], + homepage = "", + library = Nothing, + licenseFiles = [], + licenseRaw = Right BSD3, + maintainer = "", + package = PackageIdentifier + {pkgName = `PackageName "issue"`, + pkgVersion = `mkVersion [5055]`}, + pkgUrl = "", + setupBuildInfo = Nothing, + sourceRepos = [], + specVersionRaw = Right (OrLaterVersion `mkVersion [2,0]`), + stability = "", + subLibraries = [], + synopsis = "no type in all branches", + testSuites = [], + testedWith = []}} diff --git a/Cabal/tests/ParserTests/regressions/issue-5055.format b/Cabal/tests/ParserTests/regressions/issue-5055.format new file mode 100644 index 00000000..558c0c37 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/issue-5055.format @@ -0,0 +1,24 @@ +cabal-version: >=2.0 +name: issue +version: 5055 +license: BSD3 +synopsis: no type in all branches +description: + no type in all branches. +category: Test +build-type: Simple + +executable flag-test-exe + main-is: FirstMain.hs + default-language: Haskell2010 + build-depends: + base >=4.8 && <5 + +test-suite flag-cabal-test + type: exitcode-stdio-1.0 + main-is: SecondMain.hs + default-language: Haskell2010 + build-depends: + base >=4.8 && <5 + + if os(windows) diff --git a/Cabal/tests/ParserTests/regressions/issue-774.cabal b/Cabal/tests/ParserTests/regressions/issue-774.cabal new file mode 100644 index 00000000..b6d05a16 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/issue-774.cabal @@ -0,0 +1,21 @@ +name: issue +version: 744 +synopsis: Package description parser interprets curly braces in the description field +description: Here is some C code: + . + > for(i = 0; i < 100; i++) { + > printf("%d\n",i); + > } + . + What does it look like? +build-type: Simple +-- we test that check warns about this +cabal-version: >=1.12 + +library + default-language: Haskell2010 + exposed-modules: Issue + + -- Test for round-trip of ghc-options here too + -- See https://github.com/haskell/cabal/issues/2661 + ghc-options: -Wall -threaded "-with-rtsopts=-N -s -M1G -c" -rtsopts diff --git a/Cabal/tests/ParserTests/regressions/issue-774.check b/Cabal/tests/ParserTests/regressions/issue-774.check new file mode 100644 index 00000000..e2606052 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/issue-774.check @@ -0,0 +1,7 @@ +No 'category' field. +No 'maintainer' field. +The 'license' field is missing or is NONE. +'ghc-options: -threaded' has no effect for libraries. It should only be used for executables. +'ghc-options: -rtsopts' has no effect for libraries. It should only be used for executables. +'ghc-options: -with-rtsopts' has no effect for libraries. It should only be used for executables. +Packages relying on Cabal 1.12 or later should specify a specific version of the Cabal spec of the form 'cabal-version: x.y'. Use 'cabal-version: 1.12'. diff --git a/Cabal/tests/ParserTests/regressions/issue-774.expr b/Cabal/tests/ParserTests/regressions/issue-774.expr new file mode 100644 index 00000000..5cda458c --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/issue-774.expr @@ -0,0 +1,104 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [], + condTreeConstraints = [], + condTreeData = Library + {exposedModules = [`ModuleName ["Issue"]`], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [_×_ + GHC + ["-Wall", + "-threaded", + "-with-rtsopts=-N -s -M1G -c", + "-rtsopts"]], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [], + genPackageFlags = [], + packageDescription = PackageDescription + {author = "", + benchmarks = [], + bugReports = "", + buildTypeRaw = Just Simple, + category = "", + copyright = "", + customFieldsPD = [], + dataDir = "", + dataFiles = [], + description = concat + ["Here is some C code:\n", + "\n", + "> for(i = 0; i < 100; i++) {\n", + "> printf(\"%d\\n\",i);\n", + "> }\n", + "\n", + "What does it look like?"], + executables = [], + extraDocFiles = [], + extraSrcFiles = [], + extraTmpFiles = [], + foreignLibs = [], + homepage = "", + library = Nothing, + licenseFiles = [], + licenseRaw = Left NONE, + maintainer = "", + package = PackageIdentifier + {pkgName = `PackageName "issue"`, + pkgVersion = `mkVersion [744]`}, + pkgUrl = "", + setupBuildInfo = Nothing, + sourceRepos = [], + specVersionRaw = Right (OrLaterVersion `mkVersion [1,12]`), + stability = "", + subLibraries = [], + synopsis = "Package description parser interprets curly braces in the description field", + testSuites = [], + testedWith = []}} diff --git a/Cabal/tests/ParserTests/regressions/issue-774.format b/Cabal/tests/ParserTests/regressions/issue-774.format new file mode 100644 index 00000000..af2641d7 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/issue-774.format @@ -0,0 +1,19 @@ +cabal-version: >=1.12 +name: issue +version: 744 +synopsis: Package description parser interprets curly braces in the description field +description: + Here is some C code: + . + > for(i = 0; i < 100; i++) { + > printf("%d\n",i); + > } + . + What does it look like? +build-type: Simple + +library + exposed-modules: + Issue + default-language: Haskell2010 + ghc-options: -Wall -threaded "-with-rtsopts=-N -s -M1G -c" -rtsopts diff --git a/Cabal/tests/ParserTests/regressions/leading-comma.cabal b/Cabal/tests/ParserTests/regressions/leading-comma.cabal new file mode 100644 index 00000000..0c407a79 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/leading-comma.cabal @@ -0,0 +1,19 @@ +cabal-version: 2.1 +name: leading-comma +version: 0 +synopsis: leading comma, trailing comma, or ordinary +build-type: Simple + +library + default-language: Haskell2010 + exposed-modules: LeadingComma + + build-depends: base, containers + + build-depends: + deepseq, + transformers, + + build-depends: + , filepath + , directory diff --git a/Cabal/tests/ParserTests/regressions/leading-comma.expr b/Cabal/tests/ParserTests/regressions/leading-comma.expr new file mode 100644 index 00000000..e696392f --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/leading-comma.expr @@ -0,0 +1,144 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "base"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "containers"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "deepseq"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "transformers"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "filepath"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "directory"` + AnyVersion + (Set.fromList [LMainLibName])], + condTreeData = Library + {exposedModules = [`ModuleName ["LeadingComma"]`], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "containers"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "deepseq"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "transformers"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "filepath"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "directory"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [], + genPackageFlags = [], + packageDescription = PackageDescription + {author = "", + benchmarks = [], + bugReports = "", + buildTypeRaw = Just Simple, + category = "", + copyright = "", + customFieldsPD = [], + dataDir = "", + dataFiles = [], + description = "", + executables = [], + extraDocFiles = [], + extraSrcFiles = [], + extraTmpFiles = [], + foreignLibs = [], + homepage = "", + library = Nothing, + licenseFiles = [], + licenseRaw = Left NONE, + maintainer = "", + package = PackageIdentifier + {pkgName = `PackageName "leading-comma"`, + pkgVersion = `mkVersion [0]`}, + pkgUrl = "", + setupBuildInfo = Nothing, + sourceRepos = [], + specVersionRaw = Left `mkVersion [2,1]`, + stability = "", + subLibraries = [], + synopsis = "leading comma, trailing comma, or ordinary", + testSuites = [], + testedWith = []}} diff --git a/Cabal/tests/ParserTests/regressions/leading-comma.format b/Cabal/tests/ParserTests/regressions/leading-comma.format new file mode 100644 index 00000000..50801764 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/leading-comma.format @@ -0,0 +1,17 @@ +cabal-version: 2.1 +name: leading-comma +version: 0 +synopsis: leading comma, trailing comma, or ordinary +build-type: Simple + +library + exposed-modules: + LeadingComma + default-language: Haskell2010 + build-depends: + base -any, + containers -any, + deepseq -any, + transformers -any, + filepath -any, + directory -any diff --git a/Cabal/tests/ParserTests/regressions/noVersion.cabal b/Cabal/tests/ParserTests/regressions/noVersion.cabal new file mode 100644 index 00000000..d643c06b --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/noVersion.cabal @@ -0,0 +1,11 @@ +name: noVersion +version: 0 +synopsis: -none in build-depends +build-type: Simple +cabal-version: 1.22 + +library + default-language: Haskell2010 + exposed-modules: ElseIf + + build-depends: bad-package -none diff --git a/Cabal/tests/ParserTests/regressions/noVersion.expr b/Cabal/tests/ParserTests/regressions/noVersion.expr new file mode 100644 index 00000000..88dd88d8 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/noVersion.expr @@ -0,0 +1,105 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "bad-package"` + (IntersectVersionRanges + (LaterVersion `mkVersion [1]`) + (EarlierVersion `mkVersion [1]`)) + (Set.fromList [LMainLibName])], + condTreeData = Library + {exposedModules = [`ModuleName ["ElseIf"]`], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "bad-package"` + (IntersectVersionRanges + (LaterVersion + `mkVersion [1]`) + (EarlierVersion + `mkVersion [1]`)) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [], + genPackageFlags = [], + packageDescription = PackageDescription + {author = "", + benchmarks = [], + bugReports = "", + buildTypeRaw = Just Simple, + category = "", + copyright = "", + customFieldsPD = [], + dataDir = "", + dataFiles = [], + description = "", + executables = [], + extraDocFiles = [], + extraSrcFiles = [], + extraTmpFiles = [], + foreignLibs = [], + homepage = "", + library = Nothing, + licenseFiles = [], + licenseRaw = Left NONE, + maintainer = "", + package = PackageIdentifier + {pkgName = `PackageName "noVersion"`, + pkgVersion = `mkVersion [0]`}, + pkgUrl = "", + setupBuildInfo = Nothing, + sourceRepos = [], + specVersionRaw = Left `mkVersion [1,22]`, + stability = "", + subLibraries = [], + synopsis = "-none in build-depends", + testSuites = [], + testedWith = []}} diff --git a/Cabal/tests/ParserTests/regressions/noVersion.format b/Cabal/tests/ParserTests/regressions/noVersion.format new file mode 100644 index 00000000..3aacd6b5 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/noVersion.format @@ -0,0 +1,12 @@ +cabal-version: 1.22 +name: noVersion +version: 0 +synopsis: -none in build-depends +build-type: Simple + +library + exposed-modules: + ElseIf + default-language: Haskell2010 + build-depends: + bad-package >1 && <1 diff --git a/Cabal/tests/ParserTests/regressions/nothing-unicode.cabal b/Cabal/tests/ParserTests/regressions/nothing-unicode.cabal new file mode 100644 index 00000000..382ea77b --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/nothing-unicode.cabal @@ -0,0 +1,21 @@ +name: ç„¡ +version: 0 +synopsis: The canonical non-package ç„¡ +build-type: Simple +cabal-version: >=1.10 +x-ç„¡: ç„¡ + +source-repository head + Type: git + Location: https://github.com/hvr/-.git + +flag ç„¡ + description: ç„¡ + +library + default-language: Haskell2010 + + exposed-modules: Ω + + if !flag(ç„¡) + buildable:False diff --git a/Cabal/tests/ParserTests/regressions/nothing-unicode.check b/Cabal/tests/ParserTests/regressions/nothing-unicode.check new file mode 100644 index 00000000..aa57fe96 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/nothing-unicode.check @@ -0,0 +1,6 @@ +No 'category' field. +No 'maintainer' field. +No 'description' field. +The 'license' field is missing or is NONE. +Suspicious flag names: ç„¡. To avoid ambiguity in command line interfaces, flag shouldn't start with a dash. Also for better compatibility, flag names shouldn't contain non-ascii characters. +Non ascii custom fields: x-ç„¡. For better compatibility, custom field names shouldn't contain non-ascii characters. diff --git a/Cabal/tests/ParserTests/regressions/nothing-unicode.expr b/Cabal/tests/ParserTests/regressions/nothing-unicode.expr new file mode 100644 index 00000000..3fd9b482 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/nothing-unicode.expr @@ -0,0 +1,156 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `CNot (Var (Flag (FlagName "\\28961")))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = False, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}}], + condTreeConstraints = [], + condTreeData = Library + {exposedModules = [`ModuleName ["\\937"]`], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [], + genPackageFlags = [MkFlag + {flagDefault = True, + flagDescription = "\28961", + flagManual = False, + flagName = `FlagName "\\28961"`}], + packageDescription = PackageDescription + {author = "", + benchmarks = [], + bugReports = "", + buildTypeRaw = Just Simple, + category = "", + copyright = "", + customFieldsPD = [_×_ "x-\28961" "\28961"], + dataDir = "", + dataFiles = [], + description = "", + executables = [], + extraDocFiles = [], + extraSrcFiles = [], + extraTmpFiles = [], + foreignLibs = [], + homepage = "", + library = Nothing, + licenseFiles = [], + licenseRaw = Left NONE, + maintainer = "", + package = PackageIdentifier + {pkgName = `PackageName "\\28961"`, + pkgVersion = `mkVersion [0]`}, + pkgUrl = "", + setupBuildInfo = Nothing, + sourceRepos = [SourceRepo + {repoBranch = Nothing, + repoKind = RepoHead, + repoLocation = Just "https://github.com/hvr/-.git", + repoModule = Nothing, + repoSubdir = Nothing, + repoTag = Nothing, + repoType = Just Git}], + specVersionRaw = Right (OrLaterVersion `mkVersion [1,10]`), + stability = "", + subLibraries = [], + synopsis = "The canonical non-package \28961", + testSuites = [], + testedWith = []}} diff --git a/Cabal/tests/ParserTests/regressions/nothing-unicode.format b/Cabal/tests/ParserTests/regressions/nothing-unicode.format new file mode 100644 index 00000000..f314547b --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/nothing-unicode.format @@ -0,0 +1,22 @@ +cabal-version: >=1.10 +name: ç„¡ +version: 0 +synopsis: The canonical non-package ç„¡ +x-ç„¡: ç„¡ +build-type: Simple + +source-repository head + type: git + location: https://github.com/hvr/-.git + +flag ç„¡ + description: + ç„¡ + +library + exposed-modules: + Ω + default-language: Haskell2010 + + if !flag(ç„¡) + buildable: False diff --git a/Cabal/tests/ParserTests/regressions/pre-1.6-glob.cabal b/Cabal/tests/ParserTests/regressions/pre-1.6-glob.cabal new file mode 100644 index 00000000..2760f48f --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/pre-1.6-glob.cabal @@ -0,0 +1,17 @@ +cabal-version: >= 1.4 +name: pre-1dot6-glob +version: 0 +license: BSD3 +license-file: pre-1.6-glob.cabal +synopsis: no +description: none +build-type: Simple +category: Test +maintainer: none + +extra-source-files: + foo/*.hs + +library + exposed-modules: + Foo diff --git a/Cabal/tests/ParserTests/regressions/pre-1.6-glob.check b/Cabal/tests/ParserTests/regressions/pre-1.6-glob.check new file mode 100644 index 00000000..3c69e99a --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/pre-1.6-glob.check @@ -0,0 +1 @@ +In the 'extra-source-files' field: invalid file glob 'foo/*.hs'. Using star wildcards requires 'cabal-version: >= 1.6'. Alternatively if you require compatibility with earlier Cabal versions then list all the files explicitly. diff --git a/Cabal/tests/ParserTests/regressions/pre-2.4-globstar.cabal b/Cabal/tests/ParserTests/regressions/pre-2.4-globstar.cabal new file mode 100644 index 00000000..0481abb1 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/pre-2.4-globstar.cabal @@ -0,0 +1,19 @@ +cabal-version: 2.2 +name: pre-3dot0-globstar +version: 0 +extra-source-files: + foo/**/*.hs +extra-doc-files: + foo/**/*.html +data-files: + foo/**/*.dat +license: BSD-3-Clause +synopsis: no +description: none +category: Test +maintainer: none + +library + default-language: Haskell2010 + exposed-modules: + Foo diff --git a/Cabal/tests/ParserTests/regressions/pre-2.4-globstar.check b/Cabal/tests/ParserTests/regressions/pre-2.4-globstar.check new file mode 100644 index 00000000..331d5a0a --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/pre-2.4-globstar.check @@ -0,0 +1,3 @@ +In the 'data-files' field: invalid file glob 'foo/**/*.dat'. Using the double-star syntax requires 'cabal-version: 2.4' or greater. Alternatively, for compatibility with earlier Cabal versions, list the included directories explicitly. +In the 'extra-source-files' field: invalid file glob 'foo/**/*.hs'. Using the double-star syntax requires 'cabal-version: 2.4' or greater. Alternatively, for compatibility with earlier Cabal versions, list the included directories explicitly. +In the 'extra-doc-files' field: invalid file glob 'foo/**/*.html'. Using the double-star syntax requires 'cabal-version: 2.4' or greater. Alternatively, for compatibility with earlier Cabal versions, list the included directories explicitly. diff --git a/Cabal/tests/ParserTests/regressions/shake.cabal b/Cabal/tests/ParserTests/regressions/shake.cabal new file mode 100644 index 00000000..6bffd2c4 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/shake.cabal @@ -0,0 +1,402 @@ +cabal-version: >= 1.18 +build-type: Simple +name: shake +version: 0.15.11 +license: BSD3 +license-file: LICENSE +category: Development, Shake +author: Neil Mitchell +maintainer: Neil Mitchell +copyright: Neil Mitchell 2011-2017 +synopsis: Build system library, like Make, but more accurate dependencies. +description: + Shake is a Haskell library for writing build systems - designed as a + replacement for @make@. See "Development.Shake" for an introduction, + including an example. Further examples are included in the Cabal tarball, + under the @Examples@ directory. The homepage contains links to a user + manual, an academic paper and further information: + + . + To use Shake the user writes a Haskell program + that imports "Development.Shake", defines some build rules, and calls + the 'Development.Shake.shakeArgs' function. Thanks to do notation and infix + operators, a simple Shake build system + is not too dissimilar from a simple Makefile. However, as build systems + get more complex, Shake is able to take advantage of the excellent + abstraction facilities offered by Haskell and easily support much larger + projects. The Shake library provides all the standard features available in other + build systems, including automatic parallelism and minimal rebuilds. + Shake also provides more accurate dependency tracking, including seamless + support for generated files, and dependencies on system information + (e.g. compiler version). +homepage: http://shakebuild.com +bug-reports: https://github.com/ndmitchell/shake/issues +tested-with: GHC==8.0.1, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 +extra-doc-files: + CHANGES.txt + README.md +extra-source-files: + src/Test/C/constants.c + src/Test/C/constants.h + src/Test/C/main.c + src/Test/MakeTutor/Makefile + src/Test/MakeTutor/hellofunc.c + src/Test/MakeTutor/hellomake.c + src/Test/MakeTutor/hellomake.h + src/Test/Tar/list.txt + src/Test/Ninja/*.ninja + src/Test/Ninja/subdir/*.ninja + src/Test/Ninja/*.output + src/Test/Progress/*.prog + src/Test/Tup/hello.c + src/Test/Tup/root.cfg + src/Test/Tup/newmath/root.cfg + src/Test/Tup/newmath/square.c + src/Test/Tup/newmath/square.h + src/Paths.hs + docs/Manual.md + docs/shake-progress.png + +data-files: + html/viz.js + html/profile.html + html/progress.html + html/shake.js + docs/manual/build.bat + docs/manual/Build.hs + docs/manual/build.sh + docs/manual/constants.c + docs/manual/constants.h + docs/manual/main.c + +source-repository head + type: git + location: https://github.com/ndmitchell/shake.git + +flag portable + default: False + manual: True + description: Obtain FileTime using portable functions + +library + default-language: Haskell2010 + hs-source-dirs: src + build-depends: + base >= 4.5, + directory, + hashable >= 1.1.2.3, + binary, + filepath, + process >= 1.1, + unordered-containers >= 0.2.1, + bytestring, + utf8-string >= 0.3, + time, + random, + js-jquery, + js-flot, + transformers >= 0.2, + extra >= 1.4.8, + deepseq >= 1.1 + + if flag(portable) + cpp-options: -DPORTABLE + if impl(ghc < 7.6) + build-depends: old-time + else + if !os(windows) + build-depends: unix >= 2.5.1 + if !os(windows) + build-depends: unix + + exposed-modules: + Development.Shake + Development.Shake.Classes + Development.Shake.Command + Development.Shake.Config + Development.Shake.FilePath + Development.Shake.Forward + Development.Shake.Rule + Development.Shake.Util + + other-modules: + Development.Ninja.Env + Development.Ninja.Lexer + Development.Ninja.Parse + Development.Ninja.Type + Development.Shake.Args + Development.Shake.ByteString + Development.Shake.Core + Development.Shake.CmdOption + Development.Shake.Database + Development.Shake.Demo + Development.Shake.Derived + Development.Shake.Errors + Development.Shake.FileInfo + Development.Shake.FilePattern + Development.Shake.Monad + Development.Shake.Pool + Development.Shake.Profile + Development.Shake.Progress + Development.Shake.Resource + Development.Shake.Rules.Directory + Development.Shake.Rules.File + Development.Shake.Rules.Files + Development.Shake.Rules.Oracle + Development.Shake.Rules.OrderOnly + Development.Shake.Rules.Rerun + Development.Shake.Shake + Development.Shake.Special + Development.Shake.Storage + Development.Shake.Types + Development.Shake.Value + General.Bilist + General.Binary + General.Cleanup + General.Concurrent + General.Extra + General.FileLock + General.Intern + General.Process + General.String + General.Template + General.Timing + Paths_shake + + +executable shake + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -main-is Run.main + main-is: Run.hs + ghc-options: -rtsopts + -- GHC bug 7646 means -threaded causes errors + if impl(ghc >= 7.8) + ghc-options: -threaded "-with-rtsopts=-I0 -qg -qb" + build-depends: + base == 4.*, + directory, + hashable >= 1.1.2.3, + binary, + filepath, + process >= 1.1, + unordered-containers >= 0.2.1, + bytestring, + utf8-string >= 0.3, + time, + random, + js-jquery, + js-flot, + transformers >= 0.2, + extra >= 1.4.8, + deepseq >= 1.1, + primitive + + if flag(portable) + cpp-options: -DPORTABLE + if impl(ghc < 7.6) + build-depends: old-time + else + if !os(windows) + build-depends: unix >= 2.5.1 + if !os(windows) + build-depends: unix + + other-modules: + Development.Make.All + Development.Make.Env + Development.Make.Parse + Development.Make.Rules + Development.Make.Type + Development.Ninja.All + Development.Ninja.Env + Development.Ninja.Lexer + Development.Ninja.Parse + Development.Ninja.Type + Development.Shake + Development.Shake.Args + Development.Shake.ByteString + Development.Shake.Classes + Development.Shake.CmdOption + Development.Shake.Command + Development.Shake.Core + Development.Shake.Database + Development.Shake.Demo + Development.Shake.Derived + Development.Shake.Errors + Development.Shake.FileInfo + Development.Shake.FilePath + Development.Shake.FilePattern + Development.Shake.Forward + Development.Shake.Monad + Development.Shake.Pool + Development.Shake.Profile + Development.Shake.Progress + Development.Shake.Resource + Development.Shake.Rule + Development.Shake.Rules.Directory + Development.Shake.Rules.File + Development.Shake.Rules.Files + Development.Shake.Rules.Oracle + Development.Shake.Rules.OrderOnly + Development.Shake.Rules.Rerun + Development.Shake.Shake + Development.Shake.Special + Development.Shake.Storage + Development.Shake.Types + Development.Shake.Value + General.Bilist + General.Binary + General.Cleanup + General.Concurrent + General.Extra + General.FileLock + General.Intern + General.Process + General.String + General.Template + General.Timing + Paths_shake + Run + + +test-suite shake-test + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: Test.hs + hs-source-dirs: src + + ghc-options: -main-is Test.main -rtsopts + if impl(ghc >= 7.6) + -- space leak introduced by -O1 in 7.4, see #445 + ghc-options: -with-rtsopts=-K1K + if impl(ghc >= 7.8) + -- GHC bug 7646 (fixed in 7.8) means -threaded causes errors + ghc-options: -threaded + + build-depends: + base == 4.*, + directory, + hashable >= 1.1.2.3, + binary, + filepath, + process >= 1.1, + unordered-containers >= 0.2.1, + bytestring, + utf8-string >= 0.3, + time, + random, + js-jquery, + js-flot, + transformers >= 0.2, + deepseq >= 1.1, + extra >= 1.4.8, + QuickCheck >= 2.0 + + if flag(portable) + cpp-options: -DPORTABLE + if impl(ghc < 7.6) + build-depends: old-time + else + if !os(windows) + build-depends: unix >= 2.5.1 + if !os(windows) + build-depends: unix + + other-modules: + Development.Make.All + Development.Make.Env + Development.Make.Parse + Development.Make.Rules + Development.Make.Type + Development.Ninja.All + Development.Ninja.Env + Development.Ninja.Lexer + Development.Ninja.Parse + Development.Ninja.Type + Development.Shake + Development.Shake.Args + Development.Shake.ByteString + Development.Shake.Classes + Development.Shake.CmdOption + Development.Shake.Command + Development.Shake.Config + Development.Shake.Core + Development.Shake.Database + Development.Shake.Demo + Development.Shake.Derived + Development.Shake.Errors + Development.Shake.FileInfo + Development.Shake.FilePath + Development.Shake.FilePattern + Development.Shake.Forward + Development.Shake.Monad + Development.Shake.Pool + Development.Shake.Profile + Development.Shake.Progress + Development.Shake.Resource + Development.Shake.Rule + Development.Shake.Rules.Directory + Development.Shake.Rules.File + Development.Shake.Rules.Files + Development.Shake.Rules.Oracle + Development.Shake.Rules.OrderOnly + Development.Shake.Rules.Rerun + Development.Shake.Shake + Development.Shake.Special + Development.Shake.Storage + Development.Shake.Types + Development.Shake.Util + Development.Shake.Value + General.Bilist + General.Binary + General.Cleanup + General.Concurrent + General.Extra + General.FileLock + General.Intern + General.Process + General.String + General.Template + General.Timing + Paths_shake + Run + Test.Assume + Test.Basic + Test.Benchmark + Test.C + Test.Cache + Test.Command + Test.Config + Test.Digest + Test.Directory + Test.Docs + Test.Errors + Test.FileLock + Test.FilePath + Test.FilePattern + Test.Files + Test.Forward + Test.Journal + Test.Lint + Test.Live + Test.Makefile + Test.Manual + Test.Match + Test.Monad + Test.Ninja + Test.Oracle + Test.OrderOnly + Test.Parallel + Test.Pool + Test.Progress + Test.Random + Test.Resources + Test.Self + Test.Tar + Test.Tup + Test.Type + Test.Unicode + Test.Util + Test.Verbosity + Test.Version diff --git a/Cabal/tests/ParserTests/regressions/shake.expr b/Cabal/tests/ParserTests/regressions/shake.expr new file mode 100644 index 00000000..4f289b65 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/shake.expr @@ -0,0 +1,1956 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [_×_ + `UnqualComponentName "shake"` + CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `Var (Impl GHC (OrLaterVersion (mkVersion [7,8])))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [], + condTreeData = Executable + {buildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [_×_ + GHC + ["-threaded", + "-with-rtsopts=-I0 -qg -qb"]], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + exeName = `UnqualComponentName "shake"`, + exeScope = ExecutablePublic, + modulePath = ""}}}, + CondBranch + {condBranchCondition = `Var (Flag (FlagName "portable"))`, + condBranchIfFalse = Just + CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `CNot (Var (OS Windows))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "unix"` + (OrLaterVersion + `mkVersion [2,5,1]`) + (Set.fromList + [LMainLibName])], + condTreeData = Executable + {buildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "unix"` + (OrLaterVersion + `mkVersion [2,5,1]`) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + exeName = `UnqualComponentName "shake"`, + exeScope = ExecutablePublic, + modulePath = ""}}}], + condTreeConstraints = [], + condTreeData = Executable + {buildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + exeName = `UnqualComponentName "shake"`, + exeScope = ExecutablePublic, + modulePath = ""}}, + condBranchIfTrue = CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `Var (Impl GHC (EarlierVersion (mkVersion [7,6])))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "old-time"` + AnyVersion + (Set.fromList + [LMainLibName])], + condTreeData = Executable + {buildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "old-time"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + exeName = `UnqualComponentName "shake"`, + exeScope = ExecutablePublic, + modulePath = ""}}}], + condTreeConstraints = [], + condTreeData = Executable + {buildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = ["-DPORTABLE"], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + exeName = `UnqualComponentName "shake"`, + exeScope = ExecutablePublic, + modulePath = ""}}}, + CondBranch + {condBranchCondition = `CNot (Var (OS Windows))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "unix"` + AnyVersion + (Set.fromList + [LMainLibName])], + condTreeData = Executable + {buildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "unix"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + exeName = `UnqualComponentName "shake"`, + exeScope = ExecutablePublic, + modulePath = ""}}}], + condTreeConstraints = [Dependency + `PackageName "base"` + (WildcardVersion `mkVersion [4]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "directory"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "hashable"` + (OrLaterVersion `mkVersion [1,1,2,3]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "binary"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "filepath"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "process"` + (OrLaterVersion `mkVersion [1,1]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "unordered-containers"` + (OrLaterVersion `mkVersion [0,2,1]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "bytestring"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "utf8-string"` + (OrLaterVersion `mkVersion [0,3]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "time"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "random"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "js-jquery"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "js-flot"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "transformers"` + (OrLaterVersion `mkVersion [0,2]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "extra"` + (OrLaterVersion `mkVersion [1,4,8]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "deepseq"` + (OrLaterVersion `mkVersion [1,1]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "primitive"` + AnyVersion + (Set.fromList [LMainLibName])], + condTreeData = Executable + {buildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = ["src"], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [_×_ + GHC + ["-main-is", + "Run.main", + "-rtsopts"]], + otherExtensions = [], + otherLanguages = [], + otherModules = [`ModuleName ["Development","Make","All"]`, + `ModuleName ["Development","Make","Env"]`, + `ModuleName ["Development","Make","Parse"]`, + `ModuleName ["Development","Make","Rules"]`, + `ModuleName ["Development","Make","Type"]`, + `ModuleName ["Development","Ninja","All"]`, + `ModuleName ["Development","Ninja","Env"]`, + `ModuleName ["Development","Ninja","Lexer"]`, + `ModuleName ["Development","Ninja","Parse"]`, + `ModuleName ["Development","Ninja","Type"]`, + `ModuleName ["Development","Shake"]`, + `ModuleName ["Development","Shake","Args"]`, + `ModuleName ["Development","Shake","ByteString"]`, + `ModuleName ["Development","Shake","Classes"]`, + `ModuleName ["Development","Shake","CmdOption"]`, + `ModuleName ["Development","Shake","Command"]`, + `ModuleName ["Development","Shake","Core"]`, + `ModuleName ["Development","Shake","Database"]`, + `ModuleName ["Development","Shake","Demo"]`, + `ModuleName ["Development","Shake","Derived"]`, + `ModuleName ["Development","Shake","Errors"]`, + `ModuleName ["Development","Shake","FileInfo"]`, + `ModuleName ["Development","Shake","FilePath"]`, + `ModuleName ["Development","Shake","FilePattern"]`, + `ModuleName ["Development","Shake","Forward"]`, + `ModuleName ["Development","Shake","Monad"]`, + `ModuleName ["Development","Shake","Pool"]`, + `ModuleName ["Development","Shake","Profile"]`, + `ModuleName ["Development","Shake","Progress"]`, + `ModuleName ["Development","Shake","Resource"]`, + `ModuleName ["Development","Shake","Rule"]`, + `ModuleName ["Development","Shake","Rules","Directory"]`, + `ModuleName ["Development","Shake","Rules","File"]`, + `ModuleName ["Development","Shake","Rules","Files"]`, + `ModuleName ["Development","Shake","Rules","Oracle"]`, + `ModuleName ["Development","Shake","Rules","OrderOnly"]`, + `ModuleName ["Development","Shake","Rules","Rerun"]`, + `ModuleName ["Development","Shake","Shake"]`, + `ModuleName ["Development","Shake","Special"]`, + `ModuleName ["Development","Shake","Storage"]`, + `ModuleName ["Development","Shake","Types"]`, + `ModuleName ["Development","Shake","Value"]`, + `ModuleName ["General","Bilist"]`, + `ModuleName ["General","Binary"]`, + `ModuleName ["General","Cleanup"]`, + `ModuleName ["General","Concurrent"]`, + `ModuleName ["General","Extra"]`, + `ModuleName ["General","FileLock"]`, + `ModuleName ["General","Intern"]`, + `ModuleName ["General","Process"]`, + `ModuleName ["General","String"]`, + `ModuleName ["General","Template"]`, + `ModuleName ["General","Timing"]`, + `ModuleName ["Paths_shake"]`, + `ModuleName ["Run"]`], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + (WildcardVersion + `mkVersion [4]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "directory"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "hashable"` + (OrLaterVersion + `mkVersion [1,1,2,3]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "binary"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "filepath"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "process"` + (OrLaterVersion + `mkVersion [1,1]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "unordered-containers"` + (OrLaterVersion + `mkVersion [0,2,1]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "bytestring"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "utf8-string"` + (OrLaterVersion + `mkVersion [0,3]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "time"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "random"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "js-jquery"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "js-flot"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "transformers"` + (OrLaterVersion + `mkVersion [0,2]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "extra"` + (OrLaterVersion + `mkVersion [1,4,8]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "deepseq"` + (OrLaterVersion + `mkVersion [1,1]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "primitive"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + exeName = `UnqualComponentName "shake"`, + exeScope = ExecutablePublic, + modulePath = "Run.hs"}}], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `Var (Flag (FlagName "portable"))`, + condBranchIfFalse = Just + CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `CNot (Var (OS Windows))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "unix"` + (OrLaterVersion + `mkVersion [2,5,1]`) + (Set.fromList + [LMainLibName])], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "unix"` + (OrLaterVersion + `mkVersion [2,5,1]`) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}}], + condTreeConstraints = [], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condBranchIfTrue = CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `Var (Impl GHC (EarlierVersion (mkVersion [7,6])))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "old-time"` + AnyVersion + (Set.fromList + [LMainLibName])], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "old-time"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}}], + condTreeConstraints = [], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = ["-DPORTABLE"], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}}, + CondBranch + {condBranchCondition = `CNot (Var (OS Windows))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "unix"` + AnyVersion + (Set.fromList + [LMainLibName])], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "unix"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}}], + condTreeConstraints = [Dependency + `PackageName "base"` + (OrLaterVersion `mkVersion [4,5]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "directory"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "hashable"` + (OrLaterVersion `mkVersion [1,1,2,3]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "binary"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "filepath"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "process"` + (OrLaterVersion `mkVersion [1,1]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "unordered-containers"` + (OrLaterVersion `mkVersion [0,2,1]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "bytestring"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "utf8-string"` + (OrLaterVersion `mkVersion [0,3]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "time"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "random"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "js-jquery"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "js-flot"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "transformers"` + (OrLaterVersion `mkVersion [0,2]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "extra"` + (OrLaterVersion `mkVersion [1,4,8]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "deepseq"` + (OrLaterVersion `mkVersion [1,1]`) + (Set.fromList [LMainLibName])], + condTreeData = Library + {exposedModules = [`ModuleName ["Development","Shake"]`, + `ModuleName ["Development","Shake","Classes"]`, + `ModuleName ["Development","Shake","Command"]`, + `ModuleName ["Development","Shake","Config"]`, + `ModuleName ["Development","Shake","FilePath"]`, + `ModuleName ["Development","Shake","Forward"]`, + `ModuleName ["Development","Shake","Rule"]`, + `ModuleName ["Development","Shake","Util"]`], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = ["src"], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [`ModuleName ["Development","Ninja","Env"]`, + `ModuleName ["Development","Ninja","Lexer"]`, + `ModuleName ["Development","Ninja","Parse"]`, + `ModuleName ["Development","Ninja","Type"]`, + `ModuleName ["Development","Shake","Args"]`, + `ModuleName ["Development","Shake","ByteString"]`, + `ModuleName ["Development","Shake","Core"]`, + `ModuleName ["Development","Shake","CmdOption"]`, + `ModuleName ["Development","Shake","Database"]`, + `ModuleName ["Development","Shake","Demo"]`, + `ModuleName ["Development","Shake","Derived"]`, + `ModuleName ["Development","Shake","Errors"]`, + `ModuleName ["Development","Shake","FileInfo"]`, + `ModuleName ["Development","Shake","FilePattern"]`, + `ModuleName ["Development","Shake","Monad"]`, + `ModuleName ["Development","Shake","Pool"]`, + `ModuleName ["Development","Shake","Profile"]`, + `ModuleName ["Development","Shake","Progress"]`, + `ModuleName ["Development","Shake","Resource"]`, + `ModuleName ["Development","Shake","Rules","Directory"]`, + `ModuleName ["Development","Shake","Rules","File"]`, + `ModuleName ["Development","Shake","Rules","Files"]`, + `ModuleName ["Development","Shake","Rules","Oracle"]`, + `ModuleName ["Development","Shake","Rules","OrderOnly"]`, + `ModuleName ["Development","Shake","Rules","Rerun"]`, + `ModuleName ["Development","Shake","Shake"]`, + `ModuleName ["Development","Shake","Special"]`, + `ModuleName ["Development","Shake","Storage"]`, + `ModuleName ["Development","Shake","Types"]`, + `ModuleName ["Development","Shake","Value"]`, + `ModuleName ["General","Bilist"]`, + `ModuleName ["General","Binary"]`, + `ModuleName ["General","Cleanup"]`, + `ModuleName ["General","Concurrent"]`, + `ModuleName ["General","Extra"]`, + `ModuleName ["General","FileLock"]`, + `ModuleName ["General","Intern"]`, + `ModuleName ["General","Process"]`, + `ModuleName ["General","String"]`, + `ModuleName ["General","Template"]`, + `ModuleName ["General","Timing"]`, + `ModuleName ["Paths_shake"]`], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + (OrLaterVersion + `mkVersion [4,5]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "directory"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "hashable"` + (OrLaterVersion + `mkVersion [1,1,2,3]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "binary"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "filepath"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "process"` + (OrLaterVersion + `mkVersion [1,1]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "unordered-containers"` + (OrLaterVersion + `mkVersion [0,2,1]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "bytestring"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "utf8-string"` + (OrLaterVersion + `mkVersion [0,3]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "time"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "random"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "js-jquery"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "js-flot"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "transformers"` + (OrLaterVersion + `mkVersion [0,2]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "extra"` + (OrLaterVersion + `mkVersion [1,4,8]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "deepseq"` + (OrLaterVersion + `mkVersion [1,1]`) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [_×_ + `UnqualComponentName "shake-test"` + CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `Var (Impl GHC (OrLaterVersion (mkVersion [7,6])))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [_×_ + GHC + ["-with-rtsopts=-K1K"]], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + testInterface = TestSuiteUnsupported + (TestTypeUnknown + "" + `mkVersion []`), + testName = `UnqualComponentName ""`}}}, + CondBranch + {condBranchCondition = `Var (Impl GHC (OrLaterVersion (mkVersion [7,8])))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [_×_ + GHC + ["-threaded"]], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + testInterface = TestSuiteUnsupported + (TestTypeUnknown + "" + `mkVersion []`), + testName = `UnqualComponentName ""`}}}, + CondBranch + {condBranchCondition = `Var (Flag (FlagName "portable"))`, + condBranchIfFalse = Just + CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `CNot (Var (OS Windows))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "unix"` + (OrLaterVersion + `mkVersion [2,5,1]`) + (Set.fromList + [LMainLibName])], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "unix"` + (OrLaterVersion + `mkVersion [2,5,1]`) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + testInterface = TestSuiteUnsupported + (TestTypeUnknown + "" + `mkVersion []`), + testName = `UnqualComponentName ""`}}}], + condTreeConstraints = [], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + testInterface = TestSuiteUnsupported + (TestTypeUnknown + "" + `mkVersion []`), + testName = `UnqualComponentName ""`}}, + condBranchIfTrue = CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `Var (Impl GHC (EarlierVersion (mkVersion [7,6])))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "old-time"` + AnyVersion + (Set.fromList + [LMainLibName])], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "old-time"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + testInterface = TestSuiteUnsupported + (TestTypeUnknown + "" + `mkVersion []`), + testName = `UnqualComponentName ""`}}}], + condTreeConstraints = [], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = ["-DPORTABLE"], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + testInterface = TestSuiteUnsupported + (TestTypeUnknown + "" + `mkVersion []`), + testName = `UnqualComponentName ""`}}}, + CondBranch + {condBranchCondition = `CNot (Var (OS Windows))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "unix"` + AnyVersion + (Set.fromList + [LMainLibName])], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "unix"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + testInterface = TestSuiteUnsupported + (TestTypeUnknown + "" + `mkVersion []`), + testName = `UnqualComponentName ""`}}}], + condTreeConstraints = [Dependency + `PackageName "base"` + (WildcardVersion `mkVersion [4]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "directory"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "hashable"` + (OrLaterVersion `mkVersion [1,1,2,3]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "binary"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "filepath"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "process"` + (OrLaterVersion `mkVersion [1,1]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "unordered-containers"` + (OrLaterVersion `mkVersion [0,2,1]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "bytestring"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "utf8-string"` + (OrLaterVersion `mkVersion [0,3]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "time"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "random"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "js-jquery"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "js-flot"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "transformers"` + (OrLaterVersion `mkVersion [0,2]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "deepseq"` + (OrLaterVersion `mkVersion [1,1]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "extra"` + (OrLaterVersion `mkVersion [1,4,8]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "QuickCheck"` + (OrLaterVersion `mkVersion [2,0]`) + (Set.fromList [LMainLibName])], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = ["src"], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [_×_ + GHC + ["-main-is", + "Test.main", + "-rtsopts"]], + otherExtensions = [], + otherLanguages = [], + otherModules = [`ModuleName ["Development","Make","All"]`, + `ModuleName ["Development","Make","Env"]`, + `ModuleName ["Development","Make","Parse"]`, + `ModuleName ["Development","Make","Rules"]`, + `ModuleName ["Development","Make","Type"]`, + `ModuleName ["Development","Ninja","All"]`, + `ModuleName ["Development","Ninja","Env"]`, + `ModuleName ["Development","Ninja","Lexer"]`, + `ModuleName ["Development","Ninja","Parse"]`, + `ModuleName ["Development","Ninja","Type"]`, + `ModuleName ["Development","Shake"]`, + `ModuleName ["Development","Shake","Args"]`, + `ModuleName ["Development","Shake","ByteString"]`, + `ModuleName ["Development","Shake","Classes"]`, + `ModuleName ["Development","Shake","CmdOption"]`, + `ModuleName ["Development","Shake","Command"]`, + `ModuleName ["Development","Shake","Config"]`, + `ModuleName ["Development","Shake","Core"]`, + `ModuleName ["Development","Shake","Database"]`, + `ModuleName ["Development","Shake","Demo"]`, + `ModuleName ["Development","Shake","Derived"]`, + `ModuleName ["Development","Shake","Errors"]`, + `ModuleName ["Development","Shake","FileInfo"]`, + `ModuleName ["Development","Shake","FilePath"]`, + `ModuleName ["Development","Shake","FilePattern"]`, + `ModuleName ["Development","Shake","Forward"]`, + `ModuleName ["Development","Shake","Monad"]`, + `ModuleName ["Development","Shake","Pool"]`, + `ModuleName ["Development","Shake","Profile"]`, + `ModuleName ["Development","Shake","Progress"]`, + `ModuleName ["Development","Shake","Resource"]`, + `ModuleName ["Development","Shake","Rule"]`, + `ModuleName ["Development","Shake","Rules","Directory"]`, + `ModuleName ["Development","Shake","Rules","File"]`, + `ModuleName ["Development","Shake","Rules","Files"]`, + `ModuleName ["Development","Shake","Rules","Oracle"]`, + `ModuleName ["Development","Shake","Rules","OrderOnly"]`, + `ModuleName ["Development","Shake","Rules","Rerun"]`, + `ModuleName ["Development","Shake","Shake"]`, + `ModuleName ["Development","Shake","Special"]`, + `ModuleName ["Development","Shake","Storage"]`, + `ModuleName ["Development","Shake","Types"]`, + `ModuleName ["Development","Shake","Util"]`, + `ModuleName ["Development","Shake","Value"]`, + `ModuleName ["General","Bilist"]`, + `ModuleName ["General","Binary"]`, + `ModuleName ["General","Cleanup"]`, + `ModuleName ["General","Concurrent"]`, + `ModuleName ["General","Extra"]`, + `ModuleName ["General","FileLock"]`, + `ModuleName ["General","Intern"]`, + `ModuleName ["General","Process"]`, + `ModuleName ["General","String"]`, + `ModuleName ["General","Template"]`, + `ModuleName ["General","Timing"]`, + `ModuleName ["Paths_shake"]`, + `ModuleName ["Run"]`, + `ModuleName ["Test","Assume"]`, + `ModuleName ["Test","Basic"]`, + `ModuleName ["Test","Benchmark"]`, + `ModuleName ["Test","C"]`, + `ModuleName ["Test","Cache"]`, + `ModuleName ["Test","Command"]`, + `ModuleName ["Test","Config"]`, + `ModuleName ["Test","Digest"]`, + `ModuleName ["Test","Directory"]`, + `ModuleName ["Test","Docs"]`, + `ModuleName ["Test","Errors"]`, + `ModuleName ["Test","FileLock"]`, + `ModuleName ["Test","FilePath"]`, + `ModuleName ["Test","FilePattern"]`, + `ModuleName ["Test","Files"]`, + `ModuleName ["Test","Forward"]`, + `ModuleName ["Test","Journal"]`, + `ModuleName ["Test","Lint"]`, + `ModuleName ["Test","Live"]`, + `ModuleName ["Test","Makefile"]`, + `ModuleName ["Test","Manual"]`, + `ModuleName ["Test","Match"]`, + `ModuleName ["Test","Monad"]`, + `ModuleName ["Test","Ninja"]`, + `ModuleName ["Test","Oracle"]`, + `ModuleName ["Test","OrderOnly"]`, + `ModuleName ["Test","Parallel"]`, + `ModuleName ["Test","Pool"]`, + `ModuleName ["Test","Progress"]`, + `ModuleName ["Test","Random"]`, + `ModuleName ["Test","Resources"]`, + `ModuleName ["Test","Self"]`, + `ModuleName ["Test","Tar"]`, + `ModuleName ["Test","Tup"]`, + `ModuleName ["Test","Type"]`, + `ModuleName ["Test","Unicode"]`, + `ModuleName ["Test","Util"]`, + `ModuleName ["Test","Verbosity"]`, + `ModuleName ["Test","Version"]`], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + (WildcardVersion + `mkVersion [4]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "directory"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "hashable"` + (OrLaterVersion + `mkVersion [1,1,2,3]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "binary"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "filepath"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "process"` + (OrLaterVersion + `mkVersion [1,1]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "unordered-containers"` + (OrLaterVersion + `mkVersion [0,2,1]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "bytestring"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "utf8-string"` + (OrLaterVersion + `mkVersion [0,3]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "time"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "random"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "js-jquery"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "js-flot"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "transformers"` + (OrLaterVersion + `mkVersion [0,2]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "deepseq"` + (OrLaterVersion + `mkVersion [1,1]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "extra"` + (OrLaterVersion + `mkVersion [1,4,8]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "QuickCheck"` + (OrLaterVersion + `mkVersion [2,0]`) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + testInterface = TestSuiteExeV10 + `mkVersion [1,0]` "Test.hs", + testName = `UnqualComponentName ""`}}], + genPackageFlags = [MkFlag + {flagDefault = False, + flagDescription = "Obtain FileTime using portable functions", + flagManual = True, + flagName = `FlagName "portable"`}], + packageDescription = PackageDescription + {author = "Neil Mitchell ", + benchmarks = [], + bugReports = "https://github.com/ndmitchell/shake/issues", + buildTypeRaw = Just Simple, + category = "Development, Shake", + copyright = "Neil Mitchell 2011-2017", + customFieldsPD = [], + dataDir = "", + dataFiles = ["html/viz.js", + "html/profile.html", + "html/progress.html", + "html/shake.js", + "docs/manual/build.bat", + "docs/manual/Build.hs", + "docs/manual/build.sh", + "docs/manual/constants.c", + "docs/manual/constants.h", + "docs/manual/main.c"], + description = concat + ["Shake is a Haskell library for writing build systems - designed as a\n", + "replacement for @make@. See \"Development.Shake\" for an introduction,\n", + "including an example. Further examples are included in the Cabal tarball,\n", + "under the @Examples@ directory. The homepage contains links to a user\n", + "manual, an academic paper and further information:\n", + "\n", + "\n", + "To use Shake the user writes a Haskell program\n", + "that imports \"Development.Shake\", defines some build rules, and calls\n", + "the 'Development.Shake.shakeArgs' function. Thanks to do notation and infix\n", + "operators, a simple Shake build system\n", + "is not too dissimilar from a simple Makefile. However, as build systems\n", + "get more complex, Shake is able to take advantage of the excellent\n", + "abstraction facilities offered by Haskell and easily support much larger\n", + "projects. The Shake library provides all the standard features available in other\n", + "build systems, including automatic parallelism and minimal rebuilds.\n", + "Shake also provides more accurate dependency tracking, including seamless\n", + "support for generated files, and dependencies on system information\n", + "(e.g. compiler version)."], + executables = [], + extraDocFiles = ["CHANGES.txt", "README.md"], + extraSrcFiles = ["src/Test/C/constants.c", + "src/Test/C/constants.h", + "src/Test/C/main.c", + "src/Test/MakeTutor/Makefile", + "src/Test/MakeTutor/hellofunc.c", + "src/Test/MakeTutor/hellomake.c", + "src/Test/MakeTutor/hellomake.h", + "src/Test/Tar/list.txt", + "src/Test/Ninja/*.ninja", + "src/Test/Ninja/subdir/*.ninja", + "src/Test/Ninja/*.output", + "src/Test/Progress/*.prog", + "src/Test/Tup/hello.c", + "src/Test/Tup/root.cfg", + "src/Test/Tup/newmath/root.cfg", + "src/Test/Tup/newmath/square.c", + "src/Test/Tup/newmath/square.h", + "src/Paths.hs", + "docs/Manual.md", + "docs/shake-progress.png"], + extraTmpFiles = [], + foreignLibs = [], + homepage = "http://shakebuild.com", + library = Nothing, + licenseFiles = ["LICENSE"], + licenseRaw = Right BSD3, + maintainer = "Neil Mitchell ", + package = PackageIdentifier + {pkgName = `PackageName "shake"`, + pkgVersion = `mkVersion [0,15,11]`}, + pkgUrl = "", + setupBuildInfo = Nothing, + sourceRepos = [SourceRepo + {repoBranch = Nothing, + repoKind = RepoHead, + repoLocation = Just + "https://github.com/ndmitchell/shake.git", + repoModule = Nothing, + repoSubdir = Nothing, + repoTag = Nothing, + repoType = Just Git}], + specVersionRaw = Right (OrLaterVersion `mkVersion [1,18]`), + stability = "", + subLibraries = [], + synopsis = "Build system library, like Make, but more accurate dependencies.", + testSuites = [], + testedWith = [_×_ GHC (ThisVersion `mkVersion [8,0,1]`), + _×_ GHC (ThisVersion `mkVersion [7,10,3]`), + _×_ GHC (ThisVersion `mkVersion [7,8,4]`), + _×_ GHC (ThisVersion `mkVersion [7,6,3]`), + _×_ GHC (ThisVersion `mkVersion [7,4,2]`)]}} diff --git a/Cabal/tests/ParserTests/regressions/shake.format b/Cabal/tests/ParserTests/regressions/shake.format new file mode 100644 index 00000000..c6461434 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/shake.format @@ -0,0 +1,411 @@ +cabal-version: >=1.18 +name: shake +version: 0.15.11 +license: BSD3 +license-file: LICENSE +copyright: Neil Mitchell 2011-2017 +maintainer: Neil Mitchell +author: Neil Mitchell +tested-with: ghc ==8.0.1 ghc ==7.10.3 ghc ==7.8.4 ghc ==7.6.3 + ghc ==7.4.2 +homepage: http://shakebuild.com +bug-reports: https://github.com/ndmitchell/shake/issues +synopsis: Build system library, like Make, but more accurate dependencies. +description: + Shake is a Haskell library for writing build systems - designed as a + replacement for @make@. See "Development.Shake" for an introduction, + including an example. Further examples are included in the Cabal tarball, + under the @Examples@ directory. The homepage contains links to a user + manual, an academic paper and further information: + + . + To use Shake the user writes a Haskell program + that imports "Development.Shake", defines some build rules, and calls + the 'Development.Shake.shakeArgs' function. Thanks to do notation and infix + operators, a simple Shake build system + is not too dissimilar from a simple Makefile. However, as build systems + get more complex, Shake is able to take advantage of the excellent + abstraction facilities offered by Haskell and easily support much larger + projects. The Shake library provides all the standard features available in other + build systems, including automatic parallelism and minimal rebuilds. + Shake also provides more accurate dependency tracking, including seamless + support for generated files, and dependencies on system information + (e.g. compiler version). +category: Development, Shake +build-type: Simple +data-files: + html/viz.js + html/profile.html + html/progress.html + html/shake.js + docs/manual/build.bat + docs/manual/Build.hs + docs/manual/build.sh + docs/manual/constants.c + docs/manual/constants.h + docs/manual/main.c +extra-source-files: + src/Test/C/constants.c + src/Test/C/constants.h + src/Test/C/main.c + src/Test/MakeTutor/Makefile + src/Test/MakeTutor/hellofunc.c + src/Test/MakeTutor/hellomake.c + src/Test/MakeTutor/hellomake.h + src/Test/Tar/list.txt + src/Test/Ninja/*.ninja + src/Test/Ninja/subdir/*.ninja + src/Test/Ninja/*.output + src/Test/Progress/*.prog + src/Test/Tup/hello.c + src/Test/Tup/root.cfg + src/Test/Tup/newmath/root.cfg + src/Test/Tup/newmath/square.c + src/Test/Tup/newmath/square.h + src/Paths.hs + docs/Manual.md + docs/shake-progress.png +extra-doc-files: CHANGES.txt + README.md + +source-repository head + type: git + location: https://github.com/ndmitchell/shake.git + +flag portable + description: + Obtain FileTime using portable functions + default: False + manual: True + +library + exposed-modules: + Development.Shake + Development.Shake.Classes + Development.Shake.Command + Development.Shake.Config + Development.Shake.FilePath + Development.Shake.Forward + Development.Shake.Rule + Development.Shake.Util + hs-source-dirs: src + other-modules: + Development.Ninja.Env + Development.Ninja.Lexer + Development.Ninja.Parse + Development.Ninja.Type + Development.Shake.Args + Development.Shake.ByteString + Development.Shake.Core + Development.Shake.CmdOption + Development.Shake.Database + Development.Shake.Demo + Development.Shake.Derived + Development.Shake.Errors + Development.Shake.FileInfo + Development.Shake.FilePattern + Development.Shake.Monad + Development.Shake.Pool + Development.Shake.Profile + Development.Shake.Progress + Development.Shake.Resource + Development.Shake.Rules.Directory + Development.Shake.Rules.File + Development.Shake.Rules.Files + Development.Shake.Rules.Oracle + Development.Shake.Rules.OrderOnly + Development.Shake.Rules.Rerun + Development.Shake.Shake + Development.Shake.Special + Development.Shake.Storage + Development.Shake.Types + Development.Shake.Value + General.Bilist + General.Binary + General.Cleanup + General.Concurrent + General.Extra + General.FileLock + General.Intern + General.Process + General.String + General.Template + General.Timing + Paths_shake + default-language: Haskell2010 + build-depends: + base >=4.5, + directory -any, + hashable >=1.1.2.3, + binary -any, + filepath -any, + process >=1.1, + unordered-containers >=0.2.1, + bytestring -any, + utf8-string >=0.3, + time -any, + random -any, + js-jquery -any, + js-flot -any, + transformers >=0.2, + extra >=1.4.8, + deepseq >=1.1 + + if flag(portable) + cpp-options: -DPORTABLE + + if impl(ghc <7.6) + build-depends: + old-time -any + else + + if !os(windows) + build-depends: + unix >=2.5.1 + + if !os(windows) + build-depends: + unix -any + +executable shake + main-is: Run.hs + hs-source-dirs: src + other-modules: + Development.Make.All + Development.Make.Env + Development.Make.Parse + Development.Make.Rules + Development.Make.Type + Development.Ninja.All + Development.Ninja.Env + Development.Ninja.Lexer + Development.Ninja.Parse + Development.Ninja.Type + Development.Shake + Development.Shake.Args + Development.Shake.ByteString + Development.Shake.Classes + Development.Shake.CmdOption + Development.Shake.Command + Development.Shake.Core + Development.Shake.Database + Development.Shake.Demo + Development.Shake.Derived + Development.Shake.Errors + Development.Shake.FileInfo + Development.Shake.FilePath + Development.Shake.FilePattern + Development.Shake.Forward + Development.Shake.Monad + Development.Shake.Pool + Development.Shake.Profile + Development.Shake.Progress + Development.Shake.Resource + Development.Shake.Rule + Development.Shake.Rules.Directory + Development.Shake.Rules.File + Development.Shake.Rules.Files + Development.Shake.Rules.Oracle + Development.Shake.Rules.OrderOnly + Development.Shake.Rules.Rerun + Development.Shake.Shake + Development.Shake.Special + Development.Shake.Storage + Development.Shake.Types + Development.Shake.Value + General.Bilist + General.Binary + General.Cleanup + General.Concurrent + General.Extra + General.FileLock + General.Intern + General.Process + General.String + General.Template + General.Timing + Paths_shake + Run + default-language: Haskell2010 + ghc-options: -main-is Run.main -rtsopts + build-depends: + base ==4.*, + directory -any, + hashable >=1.1.2.3, + binary -any, + filepath -any, + process >=1.1, + unordered-containers >=0.2.1, + bytestring -any, + utf8-string >=0.3, + time -any, + random -any, + js-jquery -any, + js-flot -any, + transformers >=0.2, + extra >=1.4.8, + deepseq >=1.1, + primitive -any + + if impl(ghc >=7.8) + ghc-options: -threaded "-with-rtsopts=-I0 -qg -qb" + + if flag(portable) + cpp-options: -DPORTABLE + + if impl(ghc <7.6) + build-depends: + old-time -any + else + + if !os(windows) + build-depends: + unix >=2.5.1 + + if !os(windows) + build-depends: + unix -any + +test-suite shake-test + type: exitcode-stdio-1.0 + main-is: Test.hs + hs-source-dirs: src + other-modules: + Development.Make.All + Development.Make.Env + Development.Make.Parse + Development.Make.Rules + Development.Make.Type + Development.Ninja.All + Development.Ninja.Env + Development.Ninja.Lexer + Development.Ninja.Parse + Development.Ninja.Type + Development.Shake + Development.Shake.Args + Development.Shake.ByteString + Development.Shake.Classes + Development.Shake.CmdOption + Development.Shake.Command + Development.Shake.Config + Development.Shake.Core + Development.Shake.Database + Development.Shake.Demo + Development.Shake.Derived + Development.Shake.Errors + Development.Shake.FileInfo + Development.Shake.FilePath + Development.Shake.FilePattern + Development.Shake.Forward + Development.Shake.Monad + Development.Shake.Pool + Development.Shake.Profile + Development.Shake.Progress + Development.Shake.Resource + Development.Shake.Rule + Development.Shake.Rules.Directory + Development.Shake.Rules.File + Development.Shake.Rules.Files + Development.Shake.Rules.Oracle + Development.Shake.Rules.OrderOnly + Development.Shake.Rules.Rerun + Development.Shake.Shake + Development.Shake.Special + Development.Shake.Storage + Development.Shake.Types + Development.Shake.Util + Development.Shake.Value + General.Bilist + General.Binary + General.Cleanup + General.Concurrent + General.Extra + General.FileLock + General.Intern + General.Process + General.String + General.Template + General.Timing + Paths_shake + Run + Test.Assume + Test.Basic + Test.Benchmark + Test.C + Test.Cache + Test.Command + Test.Config + Test.Digest + Test.Directory + Test.Docs + Test.Errors + Test.FileLock + Test.FilePath + Test.FilePattern + Test.Files + Test.Forward + Test.Journal + Test.Lint + Test.Live + Test.Makefile + Test.Manual + Test.Match + Test.Monad + Test.Ninja + Test.Oracle + Test.OrderOnly + Test.Parallel + Test.Pool + Test.Progress + Test.Random + Test.Resources + Test.Self + Test.Tar + Test.Tup + Test.Type + Test.Unicode + Test.Util + Test.Verbosity + Test.Version + default-language: Haskell2010 + ghc-options: -main-is Test.main -rtsopts + build-depends: + base ==4.*, + directory -any, + hashable >=1.1.2.3, + binary -any, + filepath -any, + process >=1.1, + unordered-containers >=0.2.1, + bytestring -any, + utf8-string >=0.3, + time -any, + random -any, + js-jquery -any, + js-flot -any, + transformers >=0.2, + deepseq >=1.1, + extra >=1.4.8, + QuickCheck >=2.0 + + if impl(ghc >=7.6) + ghc-options: -with-rtsopts=-K1K + + if impl(ghc >=7.8) + ghc-options: -threaded + + if flag(portable) + cpp-options: -DPORTABLE + + if impl(ghc <7.6) + build-depends: + old-time -any + else + + if !os(windows) + build-depends: + unix >=2.5.1 + + if !os(windows) + build-depends: + unix -any diff --git a/Cabal/tests/ParserTests/regressions/spdx-1.cabal b/Cabal/tests/ParserTests/regressions/spdx-1.cabal new file mode 100644 index 00000000..6792e035 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/spdx-1.cabal @@ -0,0 +1,9 @@ +cabal-version: 2.0 +name: spdx +version: 0 +synopsis: testing positive parsing of spdx identifiers +build-type: Simple +license: BSD3 + +library + default-language: Haskell2010 diff --git a/Cabal/tests/ParserTests/regressions/spdx-1.expr b/Cabal/tests/ParserTests/regressions/spdx-1.expr new file mode 100644 index 00000000..4ee877c5 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/spdx-1.expr @@ -0,0 +1,92 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [], + condTreeConstraints = [], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [], + genPackageFlags = [], + packageDescription = PackageDescription + {author = "", + benchmarks = [], + bugReports = "", + buildTypeRaw = Just Simple, + category = "", + copyright = "", + customFieldsPD = [], + dataDir = "", + dataFiles = [], + description = "", + executables = [], + extraDocFiles = [], + extraSrcFiles = [], + extraTmpFiles = [], + foreignLibs = [], + homepage = "", + library = Nothing, + licenseFiles = [], + licenseRaw = Right BSD3, + maintainer = "", + package = PackageIdentifier + {pkgName = `PackageName "spdx"`, + pkgVersion = `mkVersion [0]`}, + pkgUrl = "", + setupBuildInfo = Nothing, + sourceRepos = [], + specVersionRaw = Left `mkVersion [2,0]`, + stability = "", + subLibraries = [], + synopsis = "testing positive parsing of spdx identifiers", + testSuites = [], + testedWith = []}} diff --git a/Cabal/tests/ParserTests/regressions/spdx-1.format b/Cabal/tests/ParserTests/regressions/spdx-1.format new file mode 100644 index 00000000..69e9c5a6 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/spdx-1.format @@ -0,0 +1,9 @@ +cabal-version: 2.0 +name: spdx +version: 0 +license: BSD3 +synopsis: testing positive parsing of spdx identifiers +build-type: Simple + +library + default-language: Haskell2010 diff --git a/Cabal/tests/ParserTests/regressions/spdx-2.cabal b/Cabal/tests/ParserTests/regressions/spdx-2.cabal new file mode 100644 index 00000000..72cbe0cc --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/spdx-2.cabal @@ -0,0 +1,9 @@ +cabal-version: 2.2 +name: spdx +version: 0 +synopsis: testing positive parsing of spdx identifiers +build-type: Simple +license: AGPL-1.0 + +library + default-language: Haskell2010 diff --git a/Cabal/tests/ParserTests/regressions/spdx-2.expr b/Cabal/tests/ParserTests/regressions/spdx-2.expr new file mode 100644 index 00000000..954381d3 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/spdx-2.expr @@ -0,0 +1,93 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [], + condTreeConstraints = [], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [], + genPackageFlags = [], + packageDescription = PackageDescription + {author = "", + benchmarks = [], + bugReports = "", + buildTypeRaw = Just Simple, + category = "", + copyright = "", + customFieldsPD = [], + dataDir = "", + dataFiles = [], + description = "", + executables = [], + extraDocFiles = [], + extraSrcFiles = [], + extraTmpFiles = [], + foreignLibs = [], + homepage = "", + library = Nothing, + licenseFiles = [], + licenseRaw = Left + (License (ELicense (ELicenseId AGPL_1_0) Nothing)), + maintainer = "", + package = PackageIdentifier + {pkgName = `PackageName "spdx"`, + pkgVersion = `mkVersion [0]`}, + pkgUrl = "", + setupBuildInfo = Nothing, + sourceRepos = [], + specVersionRaw = Left `mkVersion [2,2]`, + stability = "", + subLibraries = [], + synopsis = "testing positive parsing of spdx identifiers", + testSuites = [], + testedWith = []}} diff --git a/Cabal/tests/ParserTests/regressions/spdx-2.format b/Cabal/tests/ParserTests/regressions/spdx-2.format new file mode 100644 index 00000000..e5da361c --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/spdx-2.format @@ -0,0 +1,9 @@ +cabal-version: 2.2 +name: spdx +version: 0 +license: AGPL-1.0 +synopsis: testing positive parsing of spdx identifiers +build-type: Simple + +library + default-language: Haskell2010 diff --git a/Cabal/tests/ParserTests/regressions/spdx-3.cabal b/Cabal/tests/ParserTests/regressions/spdx-3.cabal new file mode 100644 index 00000000..4ed7f6ed --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/spdx-3.cabal @@ -0,0 +1,9 @@ +cabal-version: 2.4 +name: spdx +version: 0 +synopsis: testing positive parsing of spdx identifiers +build-type: Simple +license: AGPL-1.0-only + +library + default-language: Haskell2010 diff --git a/Cabal/tests/ParserTests/regressions/spdx-3.expr b/Cabal/tests/ParserTests/regressions/spdx-3.expr new file mode 100644 index 00000000..2b13d358 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/spdx-3.expr @@ -0,0 +1,93 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [], + condTreeConstraints = [], + condTreeData = Library + {exposedModules = [], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [], + genPackageFlags = [], + packageDescription = PackageDescription + {author = "", + benchmarks = [], + bugReports = "", + buildTypeRaw = Just Simple, + category = "", + copyright = "", + customFieldsPD = [], + dataDir = "", + dataFiles = [], + description = "", + executables = [], + extraDocFiles = [], + extraSrcFiles = [], + extraTmpFiles = [], + foreignLibs = [], + homepage = "", + library = Nothing, + licenseFiles = [], + licenseRaw = Left + (License (ELicense (ELicenseId AGPL_1_0_only) Nothing)), + maintainer = "", + package = PackageIdentifier + {pkgName = `PackageName "spdx"`, + pkgVersion = `mkVersion [0]`}, + pkgUrl = "", + setupBuildInfo = Nothing, + sourceRepos = [], + specVersionRaw = Left `mkVersion [2,4]`, + stability = "", + subLibraries = [], + synopsis = "testing positive parsing of spdx identifiers", + testSuites = [], + testedWith = []}} diff --git a/Cabal/tests/ParserTests/regressions/spdx-3.format b/Cabal/tests/ParserTests/regressions/spdx-3.format new file mode 100644 index 00000000..3d9497e4 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/spdx-3.format @@ -0,0 +1,9 @@ +cabal-version: 2.4 +name: spdx +version: 0 +license: AGPL-1.0-only +synopsis: testing positive parsing of spdx identifiers +build-type: Simple + +library + default-language: Haskell2010 diff --git a/Cabal/tests/ParserTests/regressions/th-lift-instances.cabal b/Cabal/tests/ParserTests/regressions/th-lift-instances.cabal new file mode 100644 index 00000000..92f09c84 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/th-lift-instances.cabal @@ -0,0 +1,76 @@ +name: th-lift-instances +version: 0.1.4 +x-revision: 1 +license: BSD3 +cabal-version: >= 1.10 +license-file: LICENSE +author: Benno Fünfstück +maintainer: Benno Fünfstück +stability: experimental +homepage: http://github.com/bennofs/th-lift-instances/ +bug-reports: http://github.com/bennofs/th-lift-instances/issues +copyright: Copyright (C) 2013-2014 Benno Fünfstück +synopsis: Lift instances for template-haskell for common data types. +description: Most data types in haskell platform do not have Lift instances. This package provides orphan instances + for containers, text, bytestring and vector. +build-type: Custom +category: Template Haskell + +extra-source-files: + .ghci + .gitignore + .travis.yml + .vim.custom + README.md + +source-repository head + type: git + location: https://github.com/bennofs/th-lift-instances.git + +library + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall -fwarn-tabs + build-depends: + base >= 4.4 && < 5 + , template-haskell < 2.10 + , th-lift + , containers >= 0.4 && < 0.6 + , vector >= 0.9 && < 0.11 + , text >= 0.11 && < 1.3 + , bytestring >= 0.9 && < 0.11 + exposed-modules: + Instances.TH.Lift + other-extensions: TemplateHaskell + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Data + default-language: Haskell2010 + build-depends: + base + , template-haskell <2.10 + , containers >= 0.4 && < 0.6 + , vector >= 0.9 && < 0.11 + , text >= 0.11 && < 1.2 + , bytestring >= 0.9 && < 0.11 + , th-lift-instances + , QuickCheck >= 2.6 && < 2.8 + hs-source-dirs: tests + other-extensions: TemplateHaskell + +test-suite doctests + type: exitcode-stdio-1.0 + main-is: doctests.hs + default-language: Haskell2010 + build-depends: + base + , directory >= 1.0 + , doctest >= 0.9.1 + , filepath + ghc-options: -Wall -threaded + if impl(ghc<7.6.1) + ghc-options: -Werror + hs-source-dirs: tests diff --git a/Cabal/tests/ParserTests/regressions/th-lift-instances.expr b/Cabal/tests/ParserTests/regressions/th-lift-instances.expr new file mode 100644 index 00000000..0ca3462e --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/th-lift-instances.expr @@ -0,0 +1,497 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [4,4]`) + (EarlierVersion `mkVersion [5]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "template-haskell"` + (EarlierVersion `mkVersion [2,10]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "th-lift"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "containers"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [0,4]`) + (EarlierVersion `mkVersion [0,6]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "vector"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [0,9]`) + (EarlierVersion `mkVersion [0,11]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "text"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [0,11]`) + (EarlierVersion `mkVersion [1,3]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "bytestring"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [0,9]`) + (EarlierVersion `mkVersion [0,11]`)) + (Set.fromList [LMainLibName])], + condTreeData = Library + {exposedModules = [`ModuleName ["Instances","TH","Lift"]`], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = ["src"], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [_×_ + GHC + ["-Wall", "-fwarn-tabs"]], + otherExtensions = [EnableExtension + TemplateHaskell], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [4,4]`) + (EarlierVersion + `mkVersion [5]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "template-haskell"` + (EarlierVersion + `mkVersion [2,10]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "th-lift"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "containers"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [0,4]`) + (EarlierVersion + `mkVersion [0,6]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "vector"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [0,9]`) + (EarlierVersion + `mkVersion [0,11]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "text"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [0,11]`) + (EarlierVersion + `mkVersion [1,3]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "bytestring"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [0,9]`) + (EarlierVersion + `mkVersion [0,11]`)) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [_×_ + `UnqualComponentName "tests"` + CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "base"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "template-haskell"` + (EarlierVersion `mkVersion [2,10]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "containers"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [0,4]`) + (EarlierVersion `mkVersion [0,6]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "vector"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [0,9]`) + (EarlierVersion `mkVersion [0,11]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "text"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [0,11]`) + (EarlierVersion `mkVersion [1,2]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "bytestring"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [0,9]`) + (EarlierVersion `mkVersion [0,11]`)) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "th-lift-instances"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "QuickCheck"` + (IntersectVersionRanges + (OrLaterVersion `mkVersion [2,6]`) + (EarlierVersion `mkVersion [2,8]`)) + (Set.fromList [LMainLibName])], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = ["tests"], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [EnableExtension + TemplateHaskell], + otherLanguages = [], + otherModules = [`ModuleName ["Data"]`], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "template-haskell"` + (EarlierVersion + `mkVersion [2,10]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "containers"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [0,4]`) + (EarlierVersion + `mkVersion [0,6]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "vector"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [0,9]`) + (EarlierVersion + `mkVersion [0,11]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "text"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [0,11]`) + (EarlierVersion + `mkVersion [1,2]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "bytestring"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [0,9]`) + (EarlierVersion + `mkVersion [0,11]`)) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "th-lift-instances"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "QuickCheck"` + (IntersectVersionRanges + (OrLaterVersion + `mkVersion [2,6]`) + (EarlierVersion + `mkVersion [2,8]`)) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + testInterface = TestSuiteExeV10 + `mkVersion [1,0]` "Main.hs", + testName = `UnqualComponentName ""`}}, + _×_ + `UnqualComponentName "doctests"` + CondNode + {condTreeComponents = [CondBranch + {condBranchCondition = `Var (Impl GHC (EarlierVersion (mkVersion [7,6,1])))`, + condBranchIfFalse = Nothing, + condBranchIfTrue = CondNode + {condTreeComponents = [], + condTreeConstraints = [], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [_×_ + GHC + ["-Werror"]], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [], + virtualModules = []}, + testInterface = TestSuiteUnsupported + (TestTypeUnknown + "" + `mkVersion []`), + testName = `UnqualComponentName ""`}}}], + condTreeConstraints = [Dependency + `PackageName "base"` + AnyVersion + (Set.fromList [LMainLibName]), + Dependency + `PackageName "directory"` + (OrLaterVersion `mkVersion [1,0]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "doctest"` + (OrLaterVersion `mkVersion [0,9,1]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "filepath"` + AnyVersion + (Set.fromList [LMainLibName])], + condTreeData = TestSuite + {testBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Just Haskell2010, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = ["tests"], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [_×_ + GHC + ["-Wall", "-threaded"]], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + AnyVersion + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "directory"` + (OrLaterVersion + `mkVersion [1,0]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "doctest"` + (OrLaterVersion + `mkVersion [0,9,1]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "filepath"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + testInterface = TestSuiteExeV10 + `mkVersion [1,0]` "doctests.hs", + testName = `UnqualComponentName ""`}}], + genPackageFlags = [], + packageDescription = PackageDescription + {author = "Benno F\252nfst\252ck", + benchmarks = [], + bugReports = "http://github.com/bennofs/th-lift-instances/issues", + buildTypeRaw = Just Custom, + category = "Template Haskell", + copyright = "Copyright (C) 2013-2014 Benno F\252nfst\252ck", + customFieldsPD = [_×_ "x-revision" "1"], + dataDir = "", + dataFiles = [], + description = concat + ["Most data types in haskell platform do not have Lift instances. This package provides orphan instances\n", + "for containers, text, bytestring and vector."], + executables = [], + extraDocFiles = [], + extraSrcFiles = [".ghci", + ".gitignore", + ".travis.yml", + ".vim.custom", + "README.md"], + extraTmpFiles = [], + foreignLibs = [], + homepage = "http://github.com/bennofs/th-lift-instances/", + library = Nothing, + licenseFiles = ["LICENSE"], + licenseRaw = Right BSD3, + maintainer = "Benno F\252nfst\252ck ", + package = PackageIdentifier + {pkgName = `PackageName "th-lift-instances"`, + pkgVersion = `mkVersion [0,1,4]`}, + pkgUrl = "", + setupBuildInfo = Nothing, + sourceRepos = [SourceRepo + {repoBranch = Nothing, + repoKind = RepoHead, + repoLocation = Just + "https://github.com/bennofs/th-lift-instances.git", + repoModule = Nothing, + repoSubdir = Nothing, + repoTag = Nothing, + repoType = Just Git}], + specVersionRaw = Right (OrLaterVersion `mkVersion [1,10]`), + stability = "experimental", + subLibraries = [], + synopsis = "Lift instances for template-haskell for common data types.", + testSuites = [], + testedWith = []}} diff --git a/Cabal/tests/ParserTests/regressions/th-lift-instances.format b/Cabal/tests/ParserTests/regressions/th-lift-instances.format new file mode 100644 index 00000000..f32efc68 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/th-lift-instances.format @@ -0,0 +1,78 @@ +th-lift-instances.cabal:15:9: Tabs used as indentation at 15:9 +cabal-version: >=1.10 +name: th-lift-instances +version: 0.1.4 +license: BSD3 +license-file: LICENSE +copyright: Copyright (C) 2013-2014 Benno Fünfstück +maintainer: Benno Fünfstück +author: Benno Fünfstück +stability: experimental +homepage: http://github.com/bennofs/th-lift-instances/ +bug-reports: http://github.com/bennofs/th-lift-instances/issues +synopsis: Lift instances for template-haskell for common data types. +description: + Most data types in haskell platform do not have Lift instances. This package provides orphan instances + for containers, text, bytestring and vector. +category: Template Haskell +x-revision: 1 +build-type: Custom +extra-source-files: + .ghci + .gitignore + .travis.yml + .vim.custom + README.md + +source-repository head + type: git + location: https://github.com/bennofs/th-lift-instances.git + +library + exposed-modules: + Instances.TH.Lift + hs-source-dirs: src + default-language: Haskell2010 + other-extensions: TemplateHaskell + ghc-options: -Wall -fwarn-tabs + build-depends: + base >=4.4 && <5, + template-haskell <2.10, + th-lift -any, + containers >=0.4 && <0.6, + vector >=0.9 && <0.11, + text >=0.11 && <1.3, + bytestring >=0.9 && <0.11 + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: tests + other-modules: + Data + default-language: Haskell2010 + other-extensions: TemplateHaskell + build-depends: + base -any, + template-haskell <2.10, + containers >=0.4 && <0.6, + vector >=0.9 && <0.11, + text >=0.11 && <1.2, + bytestring >=0.9 && <0.11, + th-lift-instances -any, + QuickCheck >=2.6 && <2.8 + +test-suite doctests + type: exitcode-stdio-1.0 + main-is: doctests.hs + hs-source-dirs: tests + default-language: Haskell2010 + ghc-options: -Wall -threaded + build-depends: + base -any, + directory >=1.0, + doctest >=0.9.1, + filepath -any + + if impl(ghc <7.6.1) + ghc-options: -Werror diff --git a/Cabal/tests/ParserTests/regressions/wl-pprint-indef.cabal b/Cabal/tests/ParserTests/regressions/wl-pprint-indef.cabal new file mode 100644 index 00000000..a58d68d2 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/wl-pprint-indef.cabal @@ -0,0 +1,34 @@ +Name: wl-pprint-indef +Version: 1.2 +Cabal-Version: >=1.6 +Synopsis: The Wadler/Leijen Pretty Printer +Category: Text +Description: + This is a pretty printing library based on Wadler's paper "A Prettier + Printer". See the haddocks for full info. This version allows the + library user to declare overlapping instances of the 'Pretty' class. +License: BSD3 +License-file: LICENSE +Author: Daan Leijen +Maintainer: Noam Lewis +Build-Type: Simple + +Executable wl-pprint-string-example + Main-is: Main.hs + Hs-Source-Dirs: example-string + Other-Modules: StringImpl + Build-Depends: base < 5, + str-string >= 0.1.0.0, + wl-pprint-indef + Mixins: wl-pprint-indef requires (Text.PrettyPrint.Leijen.Str as StringImpl) + +Library + Exposed-Modules: Text.PrettyPrint.Leijen + Signatures: Text.PrettyPrint.Leijen.Str + Mixins: str-sig requires (Str as Text.PrettyPrint.Leijen.Str) + Build-Depends: base < 5, + str-sig >= 0.1.0.0 + +source-repository head + type: git + location: git@github.com:danidiaz/wl-pprint-indef.git diff --git a/Cabal/tests/ParserTests/regressions/wl-pprint-indef.expr b/Cabal/tests/ParserTests/regressions/wl-pprint-indef.expr new file mode 100644 index 00000000..624803cf --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/wl-pprint-indef.expr @@ -0,0 +1,198 @@ +GenericPackageDescription + {condBenchmarks = [], + condExecutables = [_×_ + `UnqualComponentName "wl-pprint-string-example"` + CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "base"` + (EarlierVersion `mkVersion [5]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "str-string"` + (OrLaterVersion `mkVersion [0,1,0,0]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "wl-pprint-indef"` + AnyVersion + (Set.fromList [LMainLibName])], + condTreeData = Executable + {buildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = ["example-string"], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [`ModuleName ["StringImpl"]`], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + (EarlierVersion + `mkVersion [5]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "str-string"` + (OrLaterVersion + `mkVersion [0,1,0,0]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "wl-pprint-indef"` + AnyVersion + (Set.fromList + [LMainLibName])], + virtualModules = []}, + exeName = `UnqualComponentName "wl-pprint-string-example"`, + exeScope = ExecutablePublic, + modulePath = "Main.hs"}}], + condForeignLibs = [], + condLibrary = Just + CondNode + {condTreeComponents = [], + condTreeConstraints = [Dependency + `PackageName "base"` + (EarlierVersion `mkVersion [5]`) + (Set.fromList [LMainLibName]), + Dependency + `PackageName "str-sig"` + (OrLaterVersion `mkVersion [0,1,0,0]`) + (Set.fromList [LMainLibName])], + condTreeData = Library + {exposedModules = [`ModuleName ["Text","PrettyPrint","Leijen"]`], + libBuildInfo = BuildInfo + {asmOptions = [], + asmSources = [], + autogenModules = [], + buildToolDepends = [], + buildTools = [], + buildable = True, + cSources = [], + ccOptions = [], + cmmOptions = [], + cmmSources = [], + cppOptions = [], + customFieldsBI = [], + cxxOptions = [], + cxxSources = [], + defaultExtensions = [], + defaultLanguage = Nothing, + extraBundledLibs = [], + extraFrameworkDirs = [], + extraGHCiLibs = [], + extraLibDirs = [], + extraLibFlavours = [], + extraLibs = [], + frameworks = [], + hsSourceDirs = [], + includeDirs = [], + includes = [], + installIncludes = [], + jsSources = [], + ldOptions = [], + mixins = [], + oldExtensions = [], + options = [], + otherExtensions = [], + otherLanguages = [], + otherModules = [], + pkgconfigDepends = [], + profOptions = [], + sharedOptions = [], + staticOptions = [], + targetBuildDepends = [Dependency + `PackageName "base"` + (EarlierVersion + `mkVersion [5]`) + (Set.fromList + [LMainLibName]), + Dependency + `PackageName "str-sig"` + (OrLaterVersion + `mkVersion [0,1,0,0]`) + (Set.fromList + [LMainLibName])], + virtualModules = []}, + libExposed = True, + libName = Nothing, + reexportedModules = [], + signatures = []}}, + condSubLibraries = [], + condTestSuites = [], + genPackageFlags = [], + packageDescription = PackageDescription + {author = "Daan Leijen", + benchmarks = [], + bugReports = "", + buildTypeRaw = Just Simple, + category = "Text", + copyright = "", + customFieldsPD = [], + dataDir = "", + dataFiles = [], + description = concat + ["This is a pretty printing library based on Wadler's paper \"A Prettier\n", + "Printer\". See the haddocks for full info. This version allows the\n", + "library user to declare overlapping instances of the 'Pretty' class."], + executables = [], + extraDocFiles = [], + extraSrcFiles = [], + extraTmpFiles = [], + foreignLibs = [], + homepage = "", + library = Nothing, + licenseFiles = ["LICENSE"], + licenseRaw = Right BSD3, + maintainer = "Noam Lewis ", + package = PackageIdentifier + {pkgName = `PackageName "wl-pprint-indef"`, + pkgVersion = `mkVersion [1,2]`}, + pkgUrl = "", + setupBuildInfo = Nothing, + sourceRepos = [SourceRepo + {repoBranch = Nothing, + repoKind = RepoHead, + repoLocation = Just + "git@github.com:danidiaz/wl-pprint-indef.git", + repoModule = Nothing, + repoSubdir = Nothing, + repoTag = Nothing, + repoType = Just Git}], + specVersionRaw = Right (OrLaterVersion `mkVersion [1,6]`), + stability = "", + subLibraries = [], + synopsis = "The Wadler/Leijen Pretty Printer", + testSuites = [], + testedWith = []}} diff --git a/Cabal/tests/ParserTests/regressions/wl-pprint-indef.format b/Cabal/tests/ParserTests/regressions/wl-pprint-indef.format new file mode 100644 index 00000000..64a5c54c --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/wl-pprint-indef.format @@ -0,0 +1,38 @@ +wl-pprint-indef.cabal:28:3: The field "mixins" is available since Cabal [2,0] +wl-pprint-indef.cabal:27:3: The field "signatures" is available since Cabal [2,0] +wl-pprint-indef.cabal:23:3: The field "mixins" is available since Cabal [2,0] +cabal-version: >=1.6 +name: wl-pprint-indef +version: 1.2 +license: BSD3 +license-file: LICENSE +maintainer: Noam Lewis +author: Daan Leijen +synopsis: The Wadler/Leijen Pretty Printer +description: + This is a pretty printing library based on Wadler's paper "A Prettier + Printer". See the haddocks for full info. This version allows the + library user to declare overlapping instances of the 'Pretty' class. +category: Text +build-type: Simple + +source-repository head + type: git + location: git@github.com:danidiaz/wl-pprint-indef.git + +library + exposed-modules: + Text.PrettyPrint.Leijen + build-depends: + base <5, + str-sig >=0.1.0.0 + +executable wl-pprint-string-example + main-is: Main.hs + hs-source-dirs: example-string + other-modules: + StringImpl + build-depends: + base <5, + str-string >=0.1.0.0, + wl-pprint-indef -any diff --git a/Cabal/tests/ParserTests/warnings/bom.cabal b/Cabal/tests/ParserTests/warnings/bom.cabal new file mode 100644 index 00000000..647fe2de --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/bom.cabal @@ -0,0 +1,7 @@ +name: bom +version: 1 +cabal-version: >= 1.6 + +library + build-depends: base >= 4.9 && <4.10 + hs-source-dirs: . diff --git a/Cabal/tests/ParserTests/warnings/bool.cabal b/Cabal/tests/ParserTests/warnings/bool.cabal new file mode 100644 index 00000000..e38d26ce --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/bool.cabal @@ -0,0 +1,12 @@ +name: bool +version: 1 +cabal-version: >= 1.6 + +flag foo + manual: true + +library + build-depends: base >= 4.9 && <4.10 + if flag(foo) + build-depends: containers + hs-source-dirs: . diff --git a/Cabal/tests/ParserTests/warnings/deprecatedfield.cabal b/Cabal/tests/ParserTests/warnings/deprecatedfield.cabal new file mode 100644 index 00000000..19283567 --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/deprecatedfield.cabal @@ -0,0 +1,7 @@ +name: deprecatedfield +version: 1 +cabal-version: >= 1.6 + +library + build-depends: base >= 4.9 && <4.10 + hs-source-dir: . diff --git a/Cabal/tests/ParserTests/warnings/doubledash.cabal b/Cabal/tests/ParserTests/warnings/doubledash.cabal new file mode 100644 index 00000000..e6347bef --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/doubledash.cabal @@ -0,0 +1,9 @@ +name: bool +version: 1 +cabal-version: >= 1.6 +extra-source-files: + README.md -- we include it + +library + build-depends: base >= 4.9 && <4.10 + hs-source-dirs: . diff --git a/Cabal/tests/ParserTests/warnings/extratestmodule.cabal b/Cabal/tests/ParserTests/warnings/extratestmodule.cabal new file mode 100644 index 00000000..4d509afb --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/extratestmodule.cabal @@ -0,0 +1,11 @@ +name: extramainis +version: 1 +cabal-version: >= 1.6 + +library + build-depends: base >= 4.9 && <4.10 + hs-source-dirs: . + +test-suite tests + type: exitcode-stdio-1.0 + test-module: Tests diff --git a/Cabal/tests/ParserTests/warnings/gluedop.cabal b/Cabal/tests/ParserTests/warnings/gluedop.cabal new file mode 100644 index 00000000..a3e17bda --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/gluedop.cabal @@ -0,0 +1,9 @@ +name: gluedop +version: 1 +cabal-version: >= 1.6 + +library + build-depends: base >= 4.9 && <4.10 + if os(windows) &&!impl(ghc) + build-depends: containers + hs-source-dirs: . diff --git a/Cabal/tests/ParserTests/warnings/multiplesingular.cabal b/Cabal/tests/ParserTests/warnings/multiplesingular.cabal new file mode 100644 index 00000000..bb41d951 --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/multiplesingular.cabal @@ -0,0 +1,8 @@ +name: multiplesingular +name: multiplesingular2 +version: 1 +cabal-version: >= 1.6 + +library + build-depends: base >= 4.9 && <4.10 + hs-source-dirs: . diff --git a/Cabal/tests/ParserTests/warnings/nbsp.cabal b/Cabal/tests/ParserTests/warnings/nbsp.cabal new file mode 100644 index 00000000..6c147005 --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/nbsp.cabal @@ -0,0 +1,7 @@ +name: nbsp +version: 1 +cabal-version: >= 1.6 + +library +  build-depends: base >= 4.9 && <4.10 + hs-source-dirs: . diff --git a/Cabal/tests/ParserTests/warnings/newsyntax.cabal b/Cabal/tests/ParserTests/warnings/newsyntax.cabal new file mode 100644 index 00000000..2b37110f --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/newsyntax.cabal @@ -0,0 +1,6 @@ +name: newsyntax +version: 1 + +library + build-depends: base >= 4.9 && <4.10 + hs-source-dirs: . diff --git a/Cabal/tests/ParserTests/warnings/oldsyntax.cabal b/Cabal/tests/ParserTests/warnings/oldsyntax.cabal new file mode 100644 index 00000000..6b6aa1c8 --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/oldsyntax.cabal @@ -0,0 +1,6 @@ +name: oldsyntax +version: 1 +cabal-version: >= 1.6 + +build-depends: base >= 4.9 && <4.10 +hs-source-dirs: . diff --git a/Cabal/tests/ParserTests/warnings/subsection.cabal b/Cabal/tests/ParserTests/warnings/subsection.cabal new file mode 100644 index 00000000..ee66d140 --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/subsection.cabal @@ -0,0 +1,9 @@ +name: subsection +version: 1 +cabal-version: >= 1.6 + +library + build-depends: base >= 4.9 && <4.10 + hs-source-dirs: . + iff os(windows) + build-depends: containers diff --git a/Cabal/tests/ParserTests/warnings/tab.cabal b/Cabal/tests/ParserTests/warnings/tab.cabal new file mode 100644 index 00000000..cddedd9d --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/tab.cabal @@ -0,0 +1,12 @@ +name: tab +version: 1 +cabal-version: >= 1.6 + +library + build-depends: { base >= 4.9 && <4.10 } + hs-source-dirs: . + +test-suite tests { + type: exitcode-stdio-1.0 + main-is: Main.hs +} diff --git a/Cabal/tests/ParserTests/warnings/trailingfield.cabal b/Cabal/tests/ParserTests/warnings/trailingfield.cabal new file mode 100644 index 00000000..955b903a --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/trailingfield.cabal @@ -0,0 +1,9 @@ +name: trailingfield +version: 1 +cabal-version: >= 1.6 + +library + build-depends: base >= 4.9 && <4.10 + hs-source-dirs: . + +description: No fields after sections diff --git a/Cabal/tests/ParserTests/warnings/unknownfield.cabal b/Cabal/tests/ParserTests/warnings/unknownfield.cabal new file mode 100644 index 00000000..95373003 --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/unknownfield.cabal @@ -0,0 +1,8 @@ +name: unknownfield +version: 1 +cabal-version: >= 1.6 + +library + build-depends: base >= 4.9 && <4.10 + hs-source-dirs: . + xfield: x diff --git a/Cabal/tests/ParserTests/warnings/unknownsection.cabal b/Cabal/tests/ParserTests/warnings/unknownsection.cabal new file mode 100644 index 00000000..7b3e4194 --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/unknownsection.cabal @@ -0,0 +1,10 @@ +name: unknownsection +version: 1 +cabal-version: >= 1.6 + +library + build-depends: base >= 4.9 && <4.10 + hs-source-dirs: . + +z + z-field: z diff --git a/Cabal/tests/ParserTests/warnings/utf8.cabal b/Cabal/tests/ParserTests/warnings/utf8.cabal new file mode 100644 index 00000000..b84fe0c0 --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/utf8.cabal @@ -0,0 +1,8 @@ +name: utf8 +author: Oleg Grönroos +version: 1 +cabal-version: >= 1.6 + +library + build-depends: base >= 4.9 && <4.10 + hs-source-dirs: . diff --git a/Cabal/tests/ParserTests/warnings/versiontag.cabal b/Cabal/tests/ParserTests/warnings/versiontag.cabal new file mode 100644 index 00000000..c22b4804 --- /dev/null +++ b/Cabal/tests/ParserTests/warnings/versiontag.cabal @@ -0,0 +1,7 @@ +name: versiontag +version: 1 +cabal-version: >= 1.6 + +library + build-depends: base >= 4.9 && <4.10-rc1 + hs-source-dirs: . diff --git a/Cabal/tests/README.md b/Cabal/tests/README.md new file mode 100644 index 00000000..0fea7bcd --- /dev/null +++ b/Cabal/tests/README.md @@ -0,0 +1,5 @@ +Unit tests +========== + +Ordinary unit tests. If you're looking for the package tests, +they live in cabal-testsuite now. diff --git a/Cabal/tests/Test/Laws.hs b/Cabal/tests/Test/Laws.hs new file mode 100644 index 00000000..22ae1ae5 --- /dev/null +++ b/Cabal/tests/Test/Laws.hs @@ -0,0 +1,79 @@ +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +module Test.Laws where + +import Prelude hiding (Num((+), (*))) +import Data.Monoid (Monoid(..), Endo(..)) +import qualified Data.Foldable as Foldable + +idempotent_unary f x = f fx == fx where fx = f x + +-- Basic laws on binary operators + +idempotent_binary (+) x = x + x == x + +commutative (+) x y = x + y == y + x + +associative (+) x y z = (x + y) + z == x + (y + z) + +distributive_left (*) (+) x y z = x * (y + z) == (x * y) + (x * z) + +distributive_right (*) (+) x y z = (y + z) * x == (y * x) + (z * x) + + +-- | The first 'fmap' law +-- +-- > fmap id == id +-- +fmap_1 :: (Eq (f a), Functor f) => f a -> Bool +fmap_1 x = fmap id x == x + +-- | The second 'fmap' law +-- +-- > fmap (f . g) == fmap f . fmap g +-- +fmap_2 :: (Eq (f c), Functor f) => (b -> c) -> (a -> b) -> f a -> Bool +fmap_2 f g x = fmap (f . g) x == (fmap f . fmap g) x + + +-- | The monoid identity law, 'mempty' is a left and right identity of +-- 'mappend': +-- +-- > mempty `mappend` x = x +-- > x `mappend` mempty = x +-- +monoid_1 :: (Eq a, Data.Monoid.Monoid a) => a -> Bool +monoid_1 x = mempty `mappend` x == x + && x `mappend` mempty == x + +-- | The monoid associativity law, 'mappend' must be associative. +-- +-- > (x `mappend` y) `mappend` z = x `mappend` (y `mappend` z) +-- +monoid_2 :: (Eq a, Data.Monoid.Monoid a) => a -> a -> a -> Bool +monoid_2 x y z = (x `mappend` y) `mappend` z + == x `mappend` (y `mappend` z) + +-- | The 'mconcat' definition. It can be overidden for the sake of effeciency +-- but it must still satisfy the property given by the default definition: +-- +-- > mconcat = foldr mappend mempty +-- +monoid_3 :: (Eq a, Data.Monoid.Monoid a) => [a] -> Bool +monoid_3 xs = mconcat xs == foldr mappend mempty xs + + +-- | First 'Foldable' law +-- +-- > Foldable.fold = Foldable.foldr mappend mempty +-- +foldable_1 :: (Foldable.Foldable t, Monoid m, Eq m) => t m -> Bool +foldable_1 x = Foldable.fold x == Foldable.foldr mappend mempty x + +-- | Second 'Foldable' law +-- +-- > foldr f z t = appEndo (foldMap (Endo . f) t) z +-- +foldable_2 :: (Foldable.Foldable t, Eq b) + => (a -> b -> b) -> b -> t a -> Bool +foldable_2 f z t = Foldable.foldr f z t + == appEndo (Foldable.foldMap (Endo . f) t) z diff --git a/Cabal/tests/Test/QuickCheck/Utils.hs b/Cabal/tests/Test/QuickCheck/Utils.hs new file mode 100644 index 00000000..72b517be --- /dev/null +++ b/Cabal/tests/Test/QuickCheck/Utils.hs @@ -0,0 +1,29 @@ +module Test.QuickCheck.Utils where + +import Test.QuickCheck.Gen + + +-- | Adjust the size of the generated value. +-- +-- In general the size gets bigger and bigger linearly. For some types +-- it is not appropriate to generate ever bigger values but instead +-- to generate lots of intermediate sized values. You could do that using: +-- +-- > adjustSize (\n -> min n 5) +-- +-- Similarly, for some types the linear size growth may mean getting too big +-- too quickly relative to other values. So you may want to adjust how +-- quickly the size grows. For example dividing by a constant, or even +-- something like the integer square root or log. +-- +-- > adjustSize (\n -> n `div` 2) +-- +-- Putting this together we can make for example a relatively short list: +-- +-- > adjustSize (\n -> min 5 (n `div` 3)) (listOf1 arbitrary) +-- +-- Not only do we put a limit on the length but we also scale the growth to +-- prevent it from hitting the maximum size quite so early. +-- +adjustSize :: (Int -> Int) -> Gen a -> Gen a +adjustSize adjust gen = sized (\n -> resize (adjust n) gen) diff --git a/Cabal/tests/UnitTests.hs b/Cabal/tests/UnitTests.hs new file mode 100644 index 00000000..7df187c6 --- /dev/null +++ b/Cabal/tests/UnitTests.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module Main + ( main + ) where + +import Test.Tasty +import Test.Tasty.Options + +import Data.Proxy +import Data.Typeable + +import Distribution.Simple.Utils +import Distribution.Verbosity +import Distribution.Compat.Time + +import qualified UnitTests.Distribution.Compat.CreatePipe +import qualified UnitTests.Distribution.Compat.ReadP +import qualified UnitTests.Distribution.Compat.Time +import qualified UnitTests.Distribution.Compat.Graph +import qualified UnitTests.Distribution.Simple.Glob +import qualified UnitTests.Distribution.Simple.Program.Internal +import qualified UnitTests.Distribution.Simple.Utils +import qualified UnitTests.Distribution.System +import qualified UnitTests.Distribution.Utils.Generic +import qualified UnitTests.Distribution.Utils.NubList +import qualified UnitTests.Distribution.Utils.ShortText +import qualified UnitTests.Distribution.Version (versionTests) +import qualified UnitTests.Distribution.SPDX (spdxTests) +import qualified UnitTests.Distribution.Types.GenericPackageDescription + +tests :: Int -> TestTree +tests mtimeChangeCalibrated = + askOption $ \(OptionMtimeChangeDelay mtimeChangeProvided) -> + let mtimeChange = if mtimeChangeProvided /= 0 + then mtimeChangeProvided + else mtimeChangeCalibrated + in + testGroup "Unit Tests" $ + [ testGroup "Distribution.Compat.CreatePipe" + UnitTests.Distribution.Compat.CreatePipe.tests + , testGroup "Distribution.Compat.ReadP" + UnitTests.Distribution.Compat.ReadP.tests + , testGroup "Distribution.Compat.Time" + (UnitTests.Distribution.Compat.Time.tests mtimeChange) + , testGroup "Distribution.Compat.Graph" + UnitTests.Distribution.Compat.Graph.tests + , testGroup "Distribution.Simple.Glob" + UnitTests.Distribution.Simple.Glob.tests + , testGroup "Distribution.Simple.Program.Internal" + UnitTests.Distribution.Simple.Program.Internal.tests + , testGroup "Distribution.Simple.Utils" + UnitTests.Distribution.Simple.Utils.tests + , testGroup "Distribution.Utils.Generic" + UnitTests.Distribution.Utils.Generic.tests + , testGroup "Distribution.Utils.NubList" + UnitTests.Distribution.Utils.NubList.tests + , testGroup "Distribution.Utils.ShortText" + UnitTests.Distribution.Utils.ShortText.tests + , testGroup "Distribution.System" + UnitTests.Distribution.System.tests + , testGroup "Distribution.Types.GenericPackageDescription" + UnitTests.Distribution.Types.GenericPackageDescription.tests + , testGroup "Distribution.Version" + UnitTests.Distribution.Version.versionTests + , testGroup "Distribution.SPDX" + UnitTests.Distribution.SPDX.spdxTests + ] + +extraOptions :: [OptionDescription] +extraOptions = + [ Option (Proxy :: Proxy OptionMtimeChangeDelay) + ] + +newtype OptionMtimeChangeDelay = OptionMtimeChangeDelay Int + deriving Typeable + +instance IsOption OptionMtimeChangeDelay where + defaultValue = OptionMtimeChangeDelay 0 + parseValue = fmap OptionMtimeChangeDelay . safeRead + optionName = return "mtime-change-delay" + optionHelp = return $ "How long to wait before attempting to detect" + ++ "file modification, in microseconds" + +main :: IO () +main = do + (mtimeChange, mtimeChange') <- calibrateMtimeChangeDelay + let toMillis :: Int -> Double + toMillis x = fromIntegral x / 1000.0 + notice normal $ "File modification time resolution calibration completed, " + ++ "maximum delay observed: " + ++ (show . toMillis $ mtimeChange ) ++ " ms. " + ++ "Will be using delay of " ++ (show . toMillis $ mtimeChange') + ++ " for test runs." + defaultMainWithIngredients + (includingOptions extraOptions : defaultIngredients) + (tests mtimeChange') diff --git a/Cabal/tests/UnitTests/Distribution/Compat/CreatePipe.hs b/Cabal/tests/UnitTests/Distribution/Compat/CreatePipe.hs new file mode 100644 index 00000000..2e7929d3 --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Compat/CreatePipe.hs @@ -0,0 +1,19 @@ +module UnitTests.Distribution.Compat.CreatePipe (tests) where + +import Distribution.Compat.CreatePipe +import System.IO (hClose, hGetContents, hPutStr, hSetEncoding, localeEncoding) +import Test.Tasty +import Test.Tasty.HUnit + +tests :: [TestTree] +tests = [testCase "Locale Encoding" case_Locale_Encoding] + +case_Locale_Encoding :: Assertion +case_Locale_Encoding = do + let str = "\0252" + (r, w) <- createPipe + hSetEncoding w localeEncoding + out <- hGetContents r + hPutStr w str + hClose w + assertEqual "createPipe should support Unicode roundtripping" str out diff --git a/Cabal/tests/UnitTests/Distribution/Compat/Graph.hs b/Cabal/tests/UnitTests/Distribution/Compat/Graph.hs new file mode 100644 index 00000000..68763a81 --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Compat/Graph.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module UnitTests.Distribution.Compat.Graph + ( tests + , arbitraryGraph + ) where + +import Distribution.Compat.Graph + +import qualified Prelude +import Prelude hiding (null) +import Test.Tasty +import Test.Tasty.QuickCheck +import qualified Data.Set as Set +import Control.Monad +import qualified Data.Graph as G +import Data.Array ((!)) +import Data.Maybe +import Data.List (sort) + +tests :: [TestTree] +tests = + [ testProperty "arbitrary unbroken" (prop_arbitrary_unbroken :: Graph (Node Int ()) -> Bool) + , testProperty "nodes consistent" (prop_nodes_consistent :: Graph (Node Int ()) -> Bool) + , testProperty "edges consistent" (prop_edges_consistent :: Graph (Node Int ()) -> Property) + , testProperty "closure consistent" (prop_closure_consistent :: Graph (Node Int ()) -> Property) + ] + +-- Our arbitrary instance does not generate broken graphs +prop_arbitrary_unbroken :: Graph a -> Bool +prop_arbitrary_unbroken g = Prelude.null (broken g) + +-- Every node from 'toList' maps to a vertex which +-- is present in the constructed graph, and maps back +-- to a node correctly. +prop_nodes_consistent :: (Eq a, IsNode a) => Graph a -> Bool +prop_nodes_consistent g = all p (toList g) + where + (_, vtn, ktv) = toGraph g + p n = case ktv (nodeKey n) of + Just v -> vtn v == n + Nothing -> False + +-- A non-broken graph has the 'nodeNeighbors' of each node +-- equal the recorded adjacent edges in the node graph. +prop_edges_consistent :: IsNode a => Graph a -> Property +prop_edges_consistent g = Prelude.null (broken g) ==> all p (toList g) + where + (gr, vtn, ktv) = toGraph g + p n = sort (nodeNeighbors n) + == sort (map (nodeKey . vtn) (gr ! fromJust (ktv (nodeKey n)))) + +-- Closure is consistent with reachable +prop_closure_consistent :: (Show a, IsNode a) => Graph a -> Property +prop_closure_consistent g = + not (null g) ==> + forAll (elements (toList g)) $ \n -> + Set.fromList (map nodeKey (fromJust (closure g [nodeKey n]))) + == Set.fromList (map (nodeKey . vtn) (G.reachable gr (fromJust (ktv (nodeKey n))))) + where + (gr, vtn, ktv) = toGraph g + +hasNoDups :: Ord a => [a] -> Bool +hasNoDups = loop Set.empty + where + loop _ [] = True + loop s (x:xs) | s' <- Set.insert x s, Set.size s' > Set.size s + = loop s' xs + | otherwise + = False + +-- | Produces a graph of size @len@. We sample with 'suchThat'; if we +-- dropped duplicate entries our size could be smaller. +arbitraryGraph :: (Ord k, Show k, Arbitrary k, Arbitrary a) + => Int -> Gen (Graph (Node k a)) +arbitraryGraph len = do + -- Careful! Assume k is much larger than size. + ks <- vectorOf len arbitrary `suchThat` hasNoDups + ns <- forM ks $ \k -> do + a <- arbitrary + ns <- listOf (elements ks) + -- Allow duplicates! + return (N a k ns) + return (fromDistinctList ns) + +instance (Ord k, Show k, Arbitrary k, Arbitrary a) + => Arbitrary (Graph (Node k a)) where + arbitrary = sized $ \n -> do + len <- choose (0, n) + arbitraryGraph len diff --git a/Cabal/tests/UnitTests/Distribution/Compat/ReadP.hs b/Cabal/tests/UnitTests/Distribution/Compat/ReadP.hs new file mode 100644 index 00000000..6fefc3a4 --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Compat/ReadP.hs @@ -0,0 +1,153 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Compat.ReadP +-- Copyright : (c) The University of Glasgow 2002 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Portability : portable +-- +-- This code was originally in Distribution.Compat.ReadP. Please see that file +-- for provenance. The tests have been integrated into the test framework. +-- Some properties cannot be tested, as they hold over arbitrary ReadP values, +-- and we don't have a good Arbitrary instance (nor Show instance) for ReadP. +-- +module UnitTests.Distribution.Compat.ReadP + ( tests + -- * Properties + -- $properties + ) where + +import Data.List +import Distribution.Compat.ReadP +import Test.Tasty +import Test.Tasty.QuickCheck + +tests :: [TestTree] +tests = + [ testProperty "Get Nil" prop_Get_Nil + , testProperty "Get Cons" prop_Get_Cons + , testProperty "Look" prop_Look + , testProperty "Fail" prop_Fail + , testProperty "Return" prop_Return + --, testProperty "Bind" prop_Bind + --, testProperty "Plus" prop_Plus + --, testProperty "LeftPlus" prop_LeftPlus + --, testProperty "Gather" prop_Gather + , testProperty "String Yes" prop_String_Yes + , testProperty "String Maybe" prop_String_Maybe + , testProperty "Munch" (prop_Munch evenChar) + , testProperty "Munch1" (prop_Munch1 evenChar) + --, testProperty "Choice" prop_Choice + --, testProperty "ReadS" prop_ReadS + ] + +-- --------------------------------------------------------------------------- +-- QuickCheck properties that hold for the combinators + +{- $properties +The following are QuickCheck specifications of what the combinators do. +These can be seen as formal specifications of the behavior of the +combinators. + +We use bags to give semantics to the combinators. +-} + +type Bag a = [a] + +-- Equality on bags does not care about the order of elements. + +(=~) :: Ord a => Bag a -> Bag a -> Bool +xs =~ ys = sort xs == sort ys + +-- A special equality operator to avoid unresolved overloading +-- when testing the properties. + +(=~.) :: Bag (Int,String) -> Bag (Int,String) -> Bool +(=~.) = (=~) + +-- Here follow the properties: + +prop_Get_Nil :: Bool +prop_Get_Nil = + readP_to_S get [] =~ [] + +prop_Get_Cons :: Char -> [Char] -> Bool +prop_Get_Cons c s = + readP_to_S get (c:s) =~ [(c,s)] + +prop_Look :: String -> Bool +prop_Look s = + readP_to_S look s =~ [(s,s)] + +prop_Fail :: String -> Bool +prop_Fail s = + readP_to_S pfail s =~. [] + +prop_Return :: Int -> String -> Bool +prop_Return x s = + readP_to_S (return x) s =~. [(x,s)] + +{- +prop_Bind p k s = + readP_to_S (p >>= k) s =~. + [ ys'' + | (x,s') <- readP_to_S p s + , ys'' <- readP_to_S (k (x::Int)) s' + ] + +prop_Plus :: ReadP Int Int -> ReadP Int Int -> String -> Bool +prop_Plus p q s = + readP_to_S (p +++ q) s =~. + (readP_to_S p s ++ readP_to_S q s) + +prop_LeftPlus :: ReadP Int Int -> ReadP Int Int -> String -> Bool +prop_LeftPlus p q s = + readP_to_S (p <++ q) s =~. + (readP_to_S p s +<+ readP_to_S q s) + where + [] +<+ ys = ys + xs +<+ _ = xs + +prop_Gather s = + forAll readPWithoutReadS $ \p -> + readP_to_S (gather p) s =~ + [ ((pre,x::Int),s') + | (x,s') <- readP_to_S p s + , let pre = take (length s - length s') s + ] +-} + +prop_String_Yes :: String -> [Char] -> Bool +prop_String_Yes this s = + readP_to_S (string this) (this ++ s) =~ + [(this,s)] + +prop_String_Maybe :: String -> String -> Bool +prop_String_Maybe this s = + readP_to_S (string this) s =~ + [(this, drop (length this) s) | this `isPrefixOf` s] + +prop_Munch :: (Char -> Bool) -> String -> Bool +prop_Munch p s = + readP_to_S (munch p) s =~ + [(takeWhile p s, dropWhile p s)] + +prop_Munch1 :: (Char -> Bool) -> String -> Bool +prop_Munch1 p s = + readP_to_S (munch1 p) s =~ + [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)] + +{- +prop_Choice :: [ReadP Int Int] -> String -> Bool +prop_Choice ps s = + readP_to_S (choice ps) s =~. + readP_to_S (foldr (+++) pfail ps) s + +prop_ReadS :: ReadS Int -> String -> Bool +prop_ReadS r s = + readP_to_S (readS_to_P r) s =~. r s +-} + +evenChar :: Char -> Bool +evenChar = even . fromEnum diff --git a/Cabal/tests/UnitTests/Distribution/Compat/Time.hs b/Cabal/tests/UnitTests/Distribution/Compat/Time.hs new file mode 100644 index 00000000..db656db0 --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Compat/Time.hs @@ -0,0 +1,49 @@ +module UnitTests.Distribution.Compat.Time (tests) where + +import Control.Concurrent (threadDelay) +import System.FilePath + +import Distribution.Simple.Utils (withTempDirectory) +import Distribution.Verbosity + +import Distribution.Compat.Time + +import Test.Tasty +import Test.Tasty.HUnit + +tests :: Int -> [TestTree] +tests mtimeChange = + [ testCase "getModTime has sub-second resolution" $ getModTimeTest mtimeChange + , testCase "getCurTime works as expected" $ getCurTimeTest mtimeChange + ] + +getModTimeTest :: Int -> Assertion +getModTimeTest mtimeChange = + withTempDirectory silent "." "getmodtime-" $ \dir -> do + let fileName = dir "foo" + writeFile fileName "bar" + t0 <- getModTime fileName + threadDelay mtimeChange + writeFile fileName "baz" + t1 <- getModTime fileName + assertBool "expected different file mtimes" (t1 > t0) + + +getCurTimeTest :: Int -> Assertion +getCurTimeTest mtimeChange = + withTempDirectory silent "." "getmodtime-" $ \dir -> do + let fileName = dir "foo" + writeFile fileName "bar" + t0 <- getModTime fileName + threadDelay mtimeChange + t1 <- getCurTime + assertBool("expected file mtime (" ++ show t0 + ++ ") to be earlier than current time (" ++ show t1 ++ ")") + (t0 < t1) + + threadDelay mtimeChange + writeFile fileName "baz" + t2 <- getModTime fileName + assertBool ("expected current time (" ++ show t1 + ++ ") to be earlier than file mtime (" ++ show t2 ++ ")") + (t1 < t2) diff --git a/Cabal/tests/UnitTests/Distribution/SPDX.hs b/Cabal/tests/UnitTests/Distribution/SPDX.hs new file mode 100644 index 00000000..cc32c93c --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/SPDX.hs @@ -0,0 +1,158 @@ +{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-deprecations #-} +module UnitTests.Distribution.SPDX (spdxTests) where + +import Distribution.Compat.Prelude.Internal +import Prelude () + +import Distribution.SPDX +import Distribution.Parsec.Class (eitherParsec) +import Distribution.Pretty (prettyShow) + +import Test.Tasty +import Test.Tasty.QuickCheck + +spdxTests :: [TestTree] +spdxTests = + [ testProperty "LicenseId roundtrip" licenseIdRoundtrip + , testProperty "LicenseExceptionId roundtrip" licenseExceptionIdRoundtrip + , testProperty "LicenseRef roundtrip" licenseRefRoundtrip + , testProperty "SimpleLicenseExpression roundtrip" simpleLicenseExpressionRoundtrip + , testProperty "LicenseExpression roundtrip" licenseExpressionRoundtrip + , testProperty "isAcceptableLicense l = True" shouldAcceptProp + , testProperty "isAcceptableLicense l = False" shouldRejectProp + ] + +licenseIdRoundtrip :: LicenseId -> Property +licenseIdRoundtrip x = + counterexample (prettyShow x) $ + Right x === eitherParsec (prettyShow x) + +licenseExceptionIdRoundtrip :: LicenseExceptionId -> Property +licenseExceptionIdRoundtrip x = + counterexample (prettyShow x) $ + Right x === eitherParsec (prettyShow x) + +licenseRefRoundtrip :: LicenseRef -> Property +licenseRefRoundtrip x = + counterexample (prettyShow x) $ + Right x === eitherParsec (prettyShow x) + +simpleLicenseExpressionRoundtrip :: SimpleLicenseExpression -> Property +simpleLicenseExpressionRoundtrip x = + counterexample (prettyShow x) $ + Right x === eitherParsec (prettyShow x) + +licenseExpressionRoundtrip :: LicenseExpression -> Property +licenseExpressionRoundtrip x = + counterexample (prettyShow x) $ + Right (reassoc x) === eitherParsec (prettyShow x) + +-- Parser produces right biased trees of and/or expressions +reassoc :: LicenseExpression -> LicenseExpression +reassoc (EOr a b) = case reassoc a of + EOr x y -> EOr x (reassoc (EOr y b)) + x -> EOr x (reassoc b) +reassoc (EAnd a b) = case reassoc a of + EAnd x y -> EAnd x (reassoc (EAnd y b)) + x -> EAnd x (reassoc b) +reassoc l = l + +------------------------------------------------------------------------------- +-- isAcceptableLicence +------------------------------------------------------------------------------- + +shouldAccept :: [License] +shouldAccept = map License + [ simpleLicenseExpression GPL_2_0_only + , simpleLicenseExpression GPL_2_0_or_later + , simpleLicenseExpression BSD_2_Clause + , simpleLicenseExpression BSD_3_Clause + , simpleLicenseExpression MIT + , simpleLicenseExpression ISC + , simpleLicenseExpression MPL_2_0 + , simpleLicenseExpression Apache_2_0 + , simpleLicenseExpression CC0_1_0 + , simpleLicenseExpression BSD_4_Clause `EOr` simpleLicenseExpression MIT + ] + +shouldReject :: [License] +shouldReject = map License + [ simpleLicenseExpression BSD_4_Clause + , simpleLicenseExpression BSD_4_Clause `EAnd` simpleLicenseExpression MIT + ] + +-- | A sketch of what Hackage could accept +-- +-- * NONE is rejected +-- +-- * "or later" syntax (+ postfix) is rejected +-- +-- * "WITH exc" exceptions are rejected +-- +-- * There should be a way to interpert license as (conjunction of) +-- OSI-accepted licenses or CC0 +-- +isAcceptableLicense :: License -> Bool +isAcceptableLicense NONE = False +isAcceptableLicense (License expr) = goExpr expr + where + goExpr (EAnd a b) = goExpr a && goExpr b + goExpr (EOr a b) = goExpr a || goExpr b + goExpr (ELicense _ (Just _)) = False -- Don't allow exceptions + goExpr (ELicense s Nothing) = goSimple s + + goSimple (ELicenseRef _) = False -- don't allow referenced licenses + goSimple (ELicenseIdPlus _) = False -- don't allow + licenses (use GPL-3.0-or-later e.g.) + goSimple (ELicenseId CC0_1_0) = True -- CC0 isn't OSI approved, but we allow it as "PublicDomain", this is eg. PublicDomain in http://hackage.haskell.org/package/string-qq-0.0.2/src/LICENSE + goSimple (ELicenseId lid) = licenseIsOsiApproved lid -- allow only OSI approved licenses. + +shouldAcceptProp :: Property +shouldAcceptProp = conjoin $ + map (\l -> counterexample (prettyShow l) (isAcceptableLicense l)) shouldAccept + +shouldRejectProp :: Property +shouldRejectProp = conjoin $ + map (\l -> counterexample (prettyShow l) (not $ isAcceptableLicense l)) shouldReject + +------------------------------------------------------------------------------- +-- Instances +------------------------------------------------------------------------------- + +instance Arbitrary LicenseId where + arbitrary = elements $ licenseIdList LicenseListVersion_3_2 + +instance Arbitrary LicenseExceptionId where + arbitrary = elements $ licenseExceptionIdList LicenseListVersion_3_2 + +instance Arbitrary LicenseRef where + arbitrary = mkLicenseRef' <$> ids' <*> ids + where + ids = listOf1 $ elements $ ['a'..'z'] ++ ['A' .. 'Z'] ++ ['0'..'9'] ++ "_-" + ids' = oneof [ pure Nothing, Just <$> ids ] + +instance Arbitrary SimpleLicenseExpression where + arbitrary = oneof + [ ELicenseId <$> arbitrary + , ELicenseIdPlus <$> arbitrary + , ELicenseRef <$> arbitrary + ] + +instance Arbitrary LicenseExpression where + arbitrary = sized arb + where + arb n + | n <= 0 = ELicense <$> arbitrary <*> pure Nothing + | otherwise = oneof + [ ELicense <$> arbitrary <*> arbitrary + , EAnd <$> arbA <*> arbB + , EOr <$> arbA <*> arbB + ] + where + m = n `div` 2 + arbA = arb m + arbB = arb (n - m) + + shrink (EAnd a b) = a : b : map (uncurry EAnd) (shrink (a, b)) + shrink (EOr a b) = a : b : map (uncurry EOr) (shrink (a, b)) + shrink _ = [] + diff --git a/Cabal/tests/UnitTests/Distribution/Simple/Glob.hs b/Cabal/tests/UnitTests/Distribution/Simple/Glob.hs new file mode 100644 index 00000000..08e242b0 --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Simple/Glob.hs @@ -0,0 +1,164 @@ +module UnitTests.Distribution.Simple.Glob + ( tests + ) where + +import Control.Monad +import Data.Foldable (for_) +import Data.Function (on) +import Data.List (sort) +import Data.Maybe (mapMaybe) +import Distribution.Simple.Glob +import qualified Distribution.Verbosity as Verbosity +import Distribution.Version +import System.Directory (createDirectoryIfMissing) +import System.FilePath ((), splitFileName, normalise) +import System.IO.Temp (withSystemTempDirectory) +import Test.Tasty +import Test.Tasty.HUnit + +sampleFileNames :: [FilePath] +sampleFileNames = + [ "a" + , "a.html" + , "b.html" + , "b.html.gz" + , "foo/.blah.html" + , "foo/.html" + , "foo/a" + , "foo/a.html" + , "foo/a.html.gz" + , "foo/a.tex" + , "foo/a.tex.gz" + , "foo/b.html" + , "foo/b.html.gz" + , "foo/x.gz" + , "foo/bar/.html" + , "foo/bar/a.html" + , "foo/bar/a.html.gz" + , "foo/bar/a.tex" + , "foo/bar/a.tex.gz" + , "foo/bar/b.html" + , "foo/bar/b.html.gz" + , "foo/c.html/blah" + , "xyz/foo/a.html" + ] + +makeSampleFiles :: FilePath -> IO () +makeSampleFiles dir = for_ sampleFileNames $ \filename -> do + let (dir', name) = splitFileName filename + createDirectoryIfMissing True (dir dir') + writeFile (dir dir' name) $ "This is " ++ filename + +compatibilityTests :: Version -> [TestTree] +compatibilityTests version = + [ testCase "literal match" $ + testMatches "foo/a" [GlobMatch "foo/a"] + , testCase "literal no match on prefix" $ + testMatches "foo/c.html" [] + , testCase "literal no match on suffix" $ + testMatches "foo/a.html" [GlobMatch "foo/a.html"] + , testCase "literal no prefix" $ + testMatches "a" [GlobMatch "a"] + , testCase "literal multiple prefix" $ + testMatches "foo/bar/a.html" [GlobMatch "foo/bar/a.html"] + , testCase "glob" $ + testMatches "*.html" [GlobMatch "a.html", GlobMatch "b.html"] + , testCase "glob in subdir" $ + testMatches "foo/*.html" [GlobMatch "foo/a.html", GlobMatch "foo/b.html"] + , testCase "glob multiple extensions" $ + testMatches "foo/*.html.gz" [GlobMatch "foo/a.html.gz", GlobMatch "foo/b.html.gz"] + , testCase "glob in deep subdir" $ + testMatches "foo/bar/*.tex" [GlobMatch "foo/bar/a.tex"] + , testCase "star in directory" $ + testFailParse "blah/*/foo" StarInDirectory + , testCase "star plus text in segment" $ + testFailParse "xyz*/foo" StarInDirectory + , testCase "star in filename plus text" $ + testFailParse "foo*.bar" StarInFileName + , testCase "no extension on star" $ + testFailParse "foo/*" NoExtensionOnStar + , testCase "star in extension" $ + testFailParse "foo.*.gz" StarInExtension + ] + where + testMatches = testMatchesVersion version + testFailParse = testFailParseVersion version + +-- For efficiency reasons, matchDirFileGlob isn't a simple call to +-- getDirectoryContentsRecursive and then a filter with +-- fileGlobMatches. So test both that naive approach and the actual +-- approach to make sure they are both correct. +-- +-- TODO: Work out how to construct the sample tree once for all tests, +-- rather than once for each test. +testMatchesVersion :: Version -> FilePath -> [GlobResult FilePath] -> Assertion +testMatchesVersion version pat expected = do + globPat <- case parseFileGlob version pat of + Left _ -> assertFailure "Couldn't compile the pattern." + Right globPat -> return globPat + checkPure globPat + checkIO globPat + where + isEqual = (==) `on` (sort . fmap (fmap normalise)) + checkPure globPat = do + let actual = mapMaybe (fileGlobMatches globPat) sampleFileNames + unless (sort expected == sort actual) $ + assertFailure $ "Unexpected result (pure matcher): " ++ show actual + checkIO globPat = + withSystemTempDirectory "globstar-sample" $ \tmpdir -> do + makeSampleFiles tmpdir + actual <- runDirFileGlob Verbosity.normal tmpdir globPat + unless (isEqual actual expected) $ + assertFailure $ "Unexpected result (impure matcher): " ++ show actual + +testFailParseVersion :: Version -> FilePath -> GlobSyntaxError -> Assertion +testFailParseVersion version pat expected = + case parseFileGlob version pat of + Left err -> unless (expected == err) $ + assertFailure $ "Unexpected error: " ++ show err + Right _ -> assertFailure "Unexpected success in parsing." + +globstarTests :: [TestTree] +globstarTests = + [ testCase "fails to parse on early spec version" $ + testFailParseVersion (mkVersion [2,2]) "**/*.html" VersionDoesNotSupportGlobStar + , testCase "out-of-place double star" $ + testFailParse "blah/**/blah/*.foo" StarInDirectory + , testCase "multiple double star" $ + testFailParse "blah/**/**/*.foo" StarInDirectory + , testCase "fails with literal filename" $ + testFailParse "**/a.html" LiteralFileNameGlobStar + , testCase "with glob filename" $ + testMatches "**/*.html" [GlobMatch "a.html", GlobMatch "b.html", GlobMatch "foo/a.html", GlobMatch "foo/b.html", GlobMatch "foo/bar/a.html", GlobMatch "foo/bar/b.html", GlobMatch "xyz/foo/a.html"] + , testCase "glob with prefix" $ + testMatches "foo/**/*.html" [GlobMatch "foo/a.html", GlobMatch "foo/b.html", GlobMatch "foo/bar/a.html", GlobMatch "foo/bar/b.html"] + ] + where + testFailParse = testFailParseVersion (mkVersion [2,4]) + testMatches = testMatchesVersion (mkVersion [2,4]) + +multiDotTests :: [TestTree] +multiDotTests = + [ testCase "pre-2.4 single extension not matching multiple" $ + testMatchesVersion (mkVersion [2,2]) "foo/*.gz" [GlobWarnMultiDot "foo/a.html.gz", GlobWarnMultiDot "foo/a.tex.gz", GlobWarnMultiDot "foo/b.html.gz", GlobMatch "foo/x.gz"] + , testCase "doesn't match literal" $ + testMatches "foo/a.tex" [GlobMatch "foo/a.tex"] + , testCase "works" $ + testMatches "foo/*.gz" [GlobMatch "foo/a.html.gz", GlobMatch "foo/a.tex.gz", GlobMatch "foo/b.html.gz", GlobMatch "foo/x.gz"] + , testCase "works with globstar" $ + testMatches "foo/**/*.gz" [GlobMatch "foo/a.html.gz", GlobMatch "foo/a.tex.gz", GlobMatch "foo/b.html.gz", GlobMatch "foo/x.gz", GlobMatch "foo/bar/a.html.gz", GlobMatch "foo/bar/a.tex.gz", GlobMatch "foo/bar/b.html.gz"] + ] + where + testMatches = testMatchesVersion (mkVersion [2,4]) + +tests :: [TestTree] +tests = + [ testGroup "pre-2.4 compatibility" $ + compatibilityTests (mkVersion [2,2]) + , testGroup "post-2.4 compatibility" $ + compatibilityTests (mkVersion [2,4]) + , testGroup "globstar" globstarTests + , testCase "pre-1.6 rejects globbing" $ + testFailParseVersion (mkVersion [1,4]) "foo/*.bar" VersionDoesNotSupportGlob + , testGroup "multi-dot globbing" multiDotTests + ] diff --git a/Cabal/tests/UnitTests/Distribution/Simple/Program/Internal.hs b/Cabal/tests/UnitTests/Distribution/Simple/Program/Internal.hs new file mode 100644 index 00000000..4766cbb3 --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Simple/Program/Internal.hs @@ -0,0 +1,36 @@ +module UnitTests.Distribution.Simple.Program.Internal + ( tests + ) where + +import Distribution.Simple.Program.Internal ( stripExtractVersion ) + +import Test.Tasty +import Test.Tasty.HUnit + +v :: String +v = "GNU strip (GNU Binutils; openSUSE 13.2) 2.24.0.20140403-6.1\nCopyright 2013\ + \ Free Software Foundation, Inc.\nThis program is free software; you may\ + \ redistribute it under the terms of\nthe GNU General Public License version 3\ + \ or (at your option) any later version.\nThis program has absolutely no\ + \ warranty.\n" + +v' :: String +v' = "GNU strip 2.17.50.0.6-26.el5 20061020" + +v'' :: String +v'' = "GNU strip (openSUSE-13.2) 2.23.50.0.6-26.el5 20061020" + +v''' :: String +v''' = "GNU strip (GNU (Binutils for) Ubuntu 12.04 ) 2.22" + +tests :: [TestTree] +tests = + [ testCase "Handles parentheses" $ + (stripExtractVersion v) @=? "2.24" + , testCase "Handles dashes and alphabetic characters" $ + (stripExtractVersion v') @=? "2.17" + , testCase "Handles single-word parenthetical expressions" $ + (stripExtractVersion v'') @=? "2.23" + , testCase "Handles nested parentheses" $ + (stripExtractVersion v''') @=? "2.22" + ] diff --git a/Cabal/tests/UnitTests/Distribution/Simple/Utils.hs b/Cabal/tests/UnitTests/Distribution/Simple/Utils.hs new file mode 100644 index 00000000..c0461690 --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Simple/Utils.hs @@ -0,0 +1,101 @@ +module UnitTests.Distribution.Simple.Utils + ( tests + ) where + +import Distribution.Simple.Utils +import Distribution.Verbosity + +import Data.IORef +import System.Directory ( doesDirectoryExist, doesFileExist + , getTemporaryDirectory + , removeDirectoryRecursive, removeFile ) +import System.IO (hClose, localeEncoding, hPutStrLn) +import System.IO.Error +import qualified Control.Exception as Exception + +import Test.Tasty +import Test.Tasty.HUnit + +withTempFileTest :: Assertion +withTempFileTest = do + fileName <- newIORef "" + tempDir <- getTemporaryDirectory + withTempFile tempDir ".foo" $ \fileName' _handle -> do + writeIORef fileName fileName' + fileExists <- readIORef fileName >>= doesFileExist + assertBool "Temporary file not deleted by 'withTempFile'!" (not fileExists) + +withTempFileRemovedTest :: Assertion +withTempFileRemovedTest = do + tempDir <- getTemporaryDirectory + withTempFile tempDir ".foo" $ \fileName handle -> do + hClose handle + removeFile fileName + +withTempDirTest :: Assertion +withTempDirTest = do + dirName <- newIORef "" + tempDir <- getTemporaryDirectory + withTempDirectory normal tempDir "foo" $ \dirName' -> do + writeIORef dirName dirName' + dirExists <- readIORef dirName >>= doesDirectoryExist + assertBool "Temporary directory not deleted by 'withTempDirectory'!" + (not dirExists) + +withTempDirRemovedTest :: Assertion +withTempDirRemovedTest = do + tempDir <- getTemporaryDirectory + withTempDirectory normal tempDir "foo" $ \dirPath -> do + removeDirectoryRecursive dirPath + +rawSystemStdInOutTextDecodingTest :: Assertion +rawSystemStdInOutTextDecodingTest + -- We can only get this exception when the locale encoding is UTF-8 + -- so skip the test if it's not. + | show localeEncoding /= "UTF-8" = return () + | otherwise = do + tempDir <- getTemporaryDirectory + res <- withTempFile tempDir ".hs" $ \filenameHs handleHs -> do + withTempFile tempDir ".exe" $ \filenameExe handleExe -> do + -- Small program printing not utf8 + hPutStrLn handleHs "import Data.ByteString" + hPutStrLn handleHs "main = Data.ByteString.putStr (Data.ByteString.pack [32, 32, 255])" + hClose handleHs + + -- We need to close exe handle as well, otherwise compilation (writing) may fail + hClose handleExe + + -- Compile + (IODataText resOutput, resErrors, resExitCode) <- rawSystemStdInOut normal + "ghc" ["-o", filenameExe, filenameHs] + Nothing Nothing Nothing + IODataModeText + print (resOutput, resErrors, resExitCode) + + -- Execute + Exception.try $ do + rawSystemStdInOut normal + filenameExe [] + Nothing Nothing Nothing + IODataModeText -- not binary mode output, ie utf8 text mode so try to decode + case res of + Right (IODataText x1, x2, x3) -> assertFailure $ "expected IO decoding exception: " ++ show (x1,x2,x3) + Right (IODataBinary _, _, _) -> assertFailure "internal error" + Left err | isDoesNotExistError err -> Exception.throwIO err -- no ghc! + | otherwise -> return () + + + +tests :: [TestTree] +tests = + [ testCase "withTempFile works as expected" $ + withTempFileTest + , testCase "withTempFile can handle removed files" $ + withTempFileRemovedTest + , testCase "withTempDirectory works as expected" $ + withTempDirTest + , testCase "withTempDirectory can handle removed directories" $ + withTempDirRemovedTest + , testCase "rawSystemStdInOut reports text decoding errors" $ + rawSystemStdInOutTextDecodingTest + ] diff --git a/Cabal/tests/UnitTests/Distribution/System.hs b/Cabal/tests/UnitTests/Distribution/System.hs new file mode 100644 index 00000000..ce644962 --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/System.hs @@ -0,0 +1,29 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +module UnitTests.Distribution.System + ( tests + ) where + +import Control.Monad (liftM2) +import Distribution.Text (Text(..), display, simpleParse) +import Distribution.System +import Test.Tasty +import Test.Tasty.QuickCheck + +textRoundtrip :: (Show a, Eq a, Text a) => a -> Property +textRoundtrip x = simpleParse (display x) === Just x + +tests :: [TestTree] +tests = + [ testProperty "Text OS round trip" (textRoundtrip :: OS -> Property) + , testProperty "Text Arch round trip" (textRoundtrip :: Arch -> Property) + , testProperty "Text Platform round trip" (textRoundtrip :: Platform -> Property) + ] + +instance Arbitrary OS where + arbitrary = elements knownOSs + +instance Arbitrary Arch where + arbitrary = elements knownArches + +instance Arbitrary Platform where + arbitrary = liftM2 Platform arbitrary arbitrary diff --git a/Cabal/tests/UnitTests/Distribution/Types/GenericPackageDescription.hs b/Cabal/tests/UnitTests/Distribution/Types/GenericPackageDescription.hs new file mode 100644 index 00000000..65bd55cb --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Types/GenericPackageDescription.hs @@ -0,0 +1,37 @@ +{-# OPTIONS_GHC -fno-warn-deprecations #-} -- for importing "Distribution.Compat.Prelude.Internal" + +module UnitTests.Distribution.Types.GenericPackageDescription where + +import Prelude () +import Distribution.Compat.Prelude.Internal +import Distribution.Types.GenericPackageDescription + +import Test.Tasty +import Test.Tasty.HUnit +import qualified Control.Exception as C + +tests :: [TestTree] +tests = + [ testCase "GenericPackageDescription deepseq" gpdDeepseq + ] + +gpdFields :: [(String, GenericPackageDescription -> GenericPackageDescription)] +gpdFields = + [ ("packageDescription", \gpd -> gpd { packageDescription = undefined }) + , ("genPackageFlags", \gpd -> gpd { genPackageFlags = undefined }) + , ("condLibrary", \gpd -> gpd { condLibrary = undefined }) + , ("condSubLibraries", \gpd -> gpd { condSubLibraries = undefined }) + , ("condForeignLibs", \gpd -> gpd { condForeignLibs = undefined }) + , ("condExecutables", \gpd -> gpd { condExecutables = undefined }) + , ("condTestSuites", \gpd -> gpd { condTestSuites = undefined }) + , ("condBenchmarks", \gpd -> gpd { condBenchmarks = undefined }) + ] + +gpdDeepseq :: Assertion +gpdDeepseq = sequence_ + [ throwsUndefined msg (f emptyGenericPackageDescription) | (msg, f) <- gpdFields ] + +throwsUndefined :: NFData a => String -> a -> Assertion +throwsUndefined field a = + C.catch (C.evaluate (rnf a) >> assertFailure ("Deepseq failed to evaluate " ++ show field)) + (\(C.ErrorCall _) -> return ()) diff --git a/Cabal/tests/UnitTests/Distribution/Utils/Generic.hs b/Cabal/tests/UnitTests/Distribution/Utils/Generic.hs new file mode 100644 index 00000000..3eecc3c2 --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Utils/Generic.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- to suppress WARNING in "Distribution.Compat.Prelude.Internal" +{-# OPTIONS_GHC -fno-warn-deprecations #-} + +module UnitTests.Distribution.Utils.Generic ( tests ) where + +import Prelude () +import Distribution.Compat.Prelude.Internal + +import Distribution.Utils.Generic + +import qualified Data.ByteString.Char8 as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck + +tests :: [TestTree] +tests = + [ -- fromUTF8BS / toUTF8BS + testCase "fromUTF8BS mempty" testFromUTF8BSEmpty + , testCase "toUTF8BS mempty" testToUTF8BSEmpty + , testCase "toUTF8BS [U+D800..U+DFFF]" testToUTF8BSSurr + , testCase "toUTF8BS [U+0000..U+7F]" testToUTF8BSAscii + , testCase "toUTF8BS [U+0000..U+10FFFF]" testToUTF8BSText + , testCase "fromUTF8BS.toUTF8BS [U+0000..U+10FFFF]" testToFromUTF8BS + + , testProperty "fromUTF8BS.toUTF8BS == id" prop_toFromUTF8BS + , testProperty "toUTF8BS == encodeUtf8" prop_toUTF8BS + + , testProperty "Nothing = validateUtf8 (encodeUtf8 x)" prop_validateUtf8 + ] + +testFromUTF8BSEmpty :: Assertion +testFromUTF8BSEmpty = mempty @=? fromUTF8BS mempty + +testToUTF8BSEmpty :: Assertion +testToUTF8BSEmpty = mempty @=? toUTF8BS mempty + +testToUTF8BSSurr :: Assertion +testToUTF8BSSurr = BS.concat (replicate 2048 u_fffd) @=? toUTF8BS surrogates + where + surrogates = ['\xD800'..'\xDFFF'] + u_fffd = "\xEF\xBF\xBD" + +testToUTF8BSText :: Assertion +testToUTF8BSText = T.encodeUtf8 (T.pack txt) @=? toUTF8BS txt + where + txt = ['\x00'..'\x10FFFF'] + +testToUTF8BSAscii :: Assertion +testToUTF8BSAscii = BS.pack txt @=? toUTF8BS txt + where + txt = ['\x00'..'\x7F'] + +testToFromUTF8BS :: Assertion +testToFromUTF8BS = txt @=? (fromUTF8BS . toUTF8BS) txt + where + txt = ['\x0000'..'\xD7FF'] ++ ['\xE000'..'\x10FFFF'] + +prop_toFromUTF8BS :: [Char] -> Property +prop_toFromUTF8BS txt = txt === (fromUTF8BS . toUTF8BS) txt + +prop_toUTF8BS :: [Char] -> Property +prop_toUTF8BS txt = T.encodeUtf8 (T.pack txt) === toUTF8BS txt + +prop_validateUtf8 :: [Char] -> Property +prop_validateUtf8 txt = Nothing === validateUTF8 (toUTF8BS txt) diff --git a/Cabal/tests/UnitTests/Distribution/Utils/NubList.hs b/Cabal/tests/UnitTests/Distribution/Utils/NubList.hs new file mode 100644 index 00000000..61e25eec --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Utils/NubList.hs @@ -0,0 +1,76 @@ +-- to suppress WARNING in "Distribution.Compat.Prelude.Internal" +{-# OPTIONS_GHC -fno-warn-deprecations #-} +module UnitTests.Distribution.Utils.NubList + ( tests + ) where + +import Prelude () +import Distribution.Compat.Prelude.Internal + +import Distribution.Utils.NubList +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck + +tests :: [TestTree] +tests = + [ testCase "NubList retains ordering example" testOrdering + , testCase "NubList removes duplicates example" testDeDupe + , testProperty "NubList retains ordering" prop_Ordering + , testProperty "NubList removes duplicates" prop_DeDupe + , testProperty "fromNubList . toNubList = nub" prop_Nub + , testProperty "Monoid NubList Identity" prop_Identity + , testProperty "Monoid NubList Associativity" prop_Associativity + -- NubListR + , testProperty "NubListR removes duplicates from the right" prop_DeDupeR + ] + +someIntList :: [Int] +-- This list must not have duplicate entries. +someIntList = [ 1, 3, 4, 2, 0, 7, 6, 5, 9, -1 ] + +testOrdering :: Assertion +testOrdering = + assertBool "Maintains element ordering:" $ + fromNubList (toNubList someIntList) == someIntList + +testDeDupe :: Assertion +testDeDupe = + assertBool "De-duplicates a list:" $ + fromNubList (toNubList (someIntList ++ someIntList)) == someIntList + +-- --------------------------------------------------------------------------- +-- QuickCheck properties for NubList + +prop_Ordering :: [Int] -> Property +prop_Ordering xs = + mempty <> toNubList xs' === toNubList xs' <> mempty + where + xs' = nub xs + +prop_DeDupe :: [Int] -> Property +prop_DeDupe xs = + fromNubList (toNubList (xs' ++ xs)) === xs' -- Note, we append primeless xs + where + xs' = nub xs + +prop_DeDupeR :: [Int] -> Property +prop_DeDupeR xs = + fromNubListR (toNubListR (xs ++ xs')) === xs' -- Note, we prepend primeless xs + where + xs' = nub xs + +prop_Nub :: [Int] -> Property +prop_Nub xs = rhs === lhs + where + rhs = fromNubList (toNubList xs) + lhs = nub xs + +prop_Identity :: [Int] -> Bool +prop_Identity xs = + mempty `mappend` toNubList xs == toNubList xs `mappend` mempty + +prop_Associativity :: [Int] -> [Int] -> [Int] -> Bool +prop_Associativity xs ys zs = + (toNubList xs `mappend` toNubList ys) `mappend` toNubList zs + == toNubList xs `mappend` (toNubList ys `mappend` toNubList zs) diff --git a/Cabal/tests/UnitTests/Distribution/Utils/ShortText.hs b/Cabal/tests/UnitTests/Distribution/Utils/ShortText.hs new file mode 100644 index 00000000..73298f36 --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Utils/ShortText.hs @@ -0,0 +1,33 @@ +module UnitTests.Distribution.Utils.ShortText + ( tests + ) where + +import Data.Monoid as Mon +import Test.Tasty +import Test.Tasty.QuickCheck + +import Distribution.Compat.Binary (encode, decode) + +import Distribution.Utils.ShortText + +prop_ShortTextOrd :: String -> String -> Bool +prop_ShortTextOrd a b = compare a b == compare (toShortText a) (toShortText b) + +prop_ShortTextMonoid :: String -> String -> Bool +prop_ShortTextMonoid a b = Mon.mappend a b == fromShortText (mappend (toShortText a) (toShortText b)) + +prop_ShortTextId :: String -> Bool +prop_ShortTextId a = (fromShortText . toShortText) a == a + +prop_ShortTextBinaryId :: String -> Bool +prop_ShortTextBinaryId a = (decode . encode) a' == a' + where + a' = toShortText a + +tests :: [TestTree] +tests = + [ testProperty "ShortText Id" prop_ShortTextId + , testProperty "ShortText Ord" prop_ShortTextOrd + , testProperty "ShortText Monoid" prop_ShortTextMonoid + , testProperty "ShortText BinaryId" prop_ShortTextBinaryId + ] diff --git a/Cabal/tests/UnitTests/Distribution/Version.hs b/Cabal/tests/UnitTests/Distribution/Version.hs new file mode 100644 index 00000000..17fc3238 --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Version.hs @@ -0,0 +1,782 @@ +{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-} +{-# OPTIONS_GHC -fno-warn-orphans + -fno-warn-incomplete-patterns + -fno-warn-deprecations + -fno-warn-unused-binds #-} --FIXME +module UnitTests.Distribution.Version (versionTests) where + +import Distribution.Compat.Prelude.Internal +import Prelude () + +import Distribution.Version +import Distribution.Text +import Distribution.Parsec.Class (simpleParsec) + +import Data.Typeable (typeOf) +import Math.NumberTheory.Logarithms (intLog2) +import Text.PrettyPrint as Disp (text, render, parens, hcat + ,punctuate, int, char, (<+>)) +import Test.Tasty +import Test.Tasty.QuickCheck +import qualified Test.Laws as Laws + +import Test.QuickCheck.Utils + +import Data.Maybe (fromJust) +import Data.Function (on) +import Text.Read (readMaybe) + +versionTests :: [TestTree] +versionTests = + -- test 'Version' type + [ tp "versionNumbers . mkVersion = id @[NonNegative Int]" prop_VersionId + , tp "versionNumbers . mkVersion = id @Base.Version" prop_VersionId2 + , tp "(==) = (==) `on` versionNumbers" prop_VersionEq + , tp "(==) = (==) `on` mkVersion" prop_VersionEq2 + , tp "compare = compare `on` versionNumbers" prop_VersionOrd + , tp "compare = compare `on` mkVersion" prop_VersionOrd2 + + , tp "readMaybe . show = Just" prop_ShowRead + , tp "read example" prop_ShowRead_example + + , tp "normaliseVersionRange involutive" prop_normalise_inv + , tp "parse . display involutive" prop_parse_disp_inv + , tp "parsec . display involutive" prop_parsec_disp_inv + + , tp "simpleParsec . display = Just" prop_parse_disp + ] + + ++ + zipWith + (\n (rep, p) -> testProperty ("Range Property " ++ show n ++ " (" ++ show rep ++ ")") p) + [1::Int ..] + -- properties to validate the test framework + [ typProperty prop_nonNull + , typProperty prop_gen_intervals1 + , typProperty prop_gen_intervals2 + --, typProperty prop_equivalentVersionRange --FIXME: runs out of test cases + , typProperty prop_intermediateVersion + + , typProperty prop_anyVersion + , typProperty prop_noVersion + , typProperty prop_thisVersion + , typProperty prop_notThisVersion + , typProperty prop_laterVersion + , typProperty prop_orLaterVersion + , typProperty prop_earlierVersion + , typProperty prop_orEarlierVersion + , typProperty prop_unionVersionRanges + , typProperty prop_intersectVersionRanges + , typProperty prop_differenceVersionRanges + , typProperty prop_invertVersionRange + , typProperty prop_withinVersion + , typProperty prop_foldVersionRange + , typProperty prop_foldVersionRange' + + -- the semantic query functions + --, typProperty prop_isAnyVersion1 --FIXME: runs out of test cases + --, typProperty prop_isAnyVersion2 --FIXME: runs out of test cases + --, typProperty prop_isNoVersion --FIXME: runs out of test cases + --, typProperty prop_isSpecificVersion1 --FIXME: runs out of test cases + --, typProperty prop_isSpecificVersion2 --FIXME: runs out of test cases + , typProperty prop_simplifyVersionRange1 + , typProperty prop_simplifyVersionRange1' + --, typProperty prop_simplifyVersionRange2 --FIXME: runs out of test cases + --, typProperty prop_simplifyVersionRange2' --FIXME: runs out of test cases + --, typProperty prop_simplifyVersionRange2'' --FIXME: actually wrong + + -- converting between version ranges and version intervals + , typProperty prop_to_intervals + --, typProperty prop_to_intervals_canonical --FIXME: runs out of test cases + --, typProperty prop_to_intervals_canonical' --FIXME: runs out of test cases + , typProperty prop_from_intervals + , typProperty prop_to_from_intervals + , typProperty prop_from_to_intervals + , typProperty prop_from_to_intervals' + + -- union and intersection of version intervals + , typProperty prop_unionVersionIntervals + , typProperty prop_unionVersionIntervals_idempotent + , typProperty prop_unionVersionIntervals_commutative + , typProperty prop_unionVersionIntervals_associative + , typProperty prop_intersectVersionIntervals + , typProperty prop_intersectVersionIntervals_idempotent + , typProperty prop_intersectVersionIntervals_commutative + , typProperty prop_intersectVersionIntervals_associative + , typProperty prop_union_intersect_distributive + , typProperty prop_intersect_union_distributive + + -- inversion of version intervals + , typProperty prop_invertVersionIntervals + , typProperty prop_invertVersionIntervalsTwice + ] + where + tp :: Testable p => String -> p -> TestTree + tp = testProperty + + typProperty p = (typeOf p, property p) + + +-- parseTests :: [TestTree] +-- parseTests = +-- zipWith (\n p -> testProperty ("Parse Property " ++ show n) p) [1::Int ..] +-- -- parsing and pretty printing +-- [ -- property prop_parse_disp1 --FIXME: actually wrong + +-- -- These are also wrong, see +-- -- https://github.com/haskell/cabal/issues/3037#issuecomment-177671011 + +-- -- property prop_parse_disp2 +-- -- , property prop_parse_disp3 +-- -- , property prop_parse_disp4 +-- -- , property prop_parse_disp5 +-- ] + +instance Arbitrary Version where + arbitrary = do + branch <- smallListOf1 $ + frequency [(3, return 0) + ,(3, return 1) + ,(2, return 2) + ,(2, return 3) + ,(1, return 0xfffd) + ,(1, return 0xfffe) -- max fitting into packed W64 + ,(1, return 0xffff) + ,(1, return 0x10000)] + return (mkVersion branch) + where + smallListOf1 = adjustSize (\n -> min 6 (n `div` 3)) . listOf1 + + shrink ver = [ mkVersion ns | ns <- shrink (versionNumbers ver) + , not (null ns) ] + +newtype VersionArb = VersionArb [Int] + deriving (Eq,Ord,Show) + +-- | 'Version' instance as used by QC 2.9 +instance Arbitrary VersionArb where + arbitrary = sized $ \n -> + do k <- choose (0, log2 n) + xs <- vectorOf (k+1) arbitrarySizedNatural + return (VersionArb xs) + where + log2 :: Int -> Int + log2 n | n <= 1 = 0 + | otherwise = 1 + log2 (n `div` 2) + + shrink (VersionArb xs) = + [ VersionArb xs' + | xs' <- shrink xs + , length xs' > 0 + , all (>=0) xs' + ] + +instance Arbitrary VersionRange where + arbitrary = sized verRangeExp + where + verRangeExp n = frequency $ + [ (2, return anyVersion) + , (1, liftM thisVersion arbitrary) + , (1, liftM laterVersion arbitrary) + , (1, liftM orLaterVersion arbitrary) + , (1, liftM orLaterVersion' arbitrary) + , (1, liftM earlierVersion arbitrary) + , (1, liftM orEarlierVersion arbitrary) + , (1, liftM orEarlierVersion' arbitrary) + , (1, liftM withinVersion arbitrary) + , (1, liftM majorBoundVersion arbitrary) + , (2, liftM VersionRangeParens arbitrary) + ] ++ if n == 0 then [] else + [ (2, liftM2 unionVersionRanges verRangeExp2 verRangeExp2) + , (2, liftM2 intersectVersionRanges verRangeExp2 verRangeExp2) + ] + where + verRangeExp2 = verRangeExp (n `div` 2) + + orLaterVersion' v = + unionVersionRanges (LaterVersion v) (ThisVersion v) + orEarlierVersion' v = + unionVersionRanges (EarlierVersion v) (ThisVersion v) + + shrink AnyVersion = [] + shrink (ThisVersion v) = map ThisVersion (shrink v) + shrink (LaterVersion v) = map LaterVersion (shrink v) + shrink (EarlierVersion v) = map EarlierVersion (shrink v) + shrink (OrLaterVersion v) = LaterVersion v : map OrLaterVersion (shrink v) + shrink (OrEarlierVersion v) = EarlierVersion v : map OrEarlierVersion (shrink v) + shrink (WildcardVersion v) = map WildcardVersion ( shrink v) + shrink (MajorBoundVersion v) = map MajorBoundVersion (shrink v) + shrink (VersionRangeParens vr) = vr : map VersionRangeParens (shrink vr) + shrink (UnionVersionRanges a b) = a : b : map (uncurry UnionVersionRanges) (shrink (a, b)) + shrink (IntersectVersionRanges a b) = a : b : map (uncurry IntersectVersionRanges) (shrink (a, b)) + +--------------------- +-- Version properties +-- + +prop_VersionId :: [NonNegative Int] -> Bool +prop_VersionId lst0 = + (versionNumbers . mkVersion) lst == lst + where + lst = map getNonNegative lst0 + +prop_VersionId2 :: VersionArb -> Bool +prop_VersionId2 (VersionArb lst) = + (versionNumbers . mkVersion) lst == lst + +prop_VersionEq :: Version -> Version -> Bool +prop_VersionEq v1 v2 = (==) v1 v2 == ((==) `on` versionNumbers) v1 v2 + +prop_VersionEq2 :: VersionArb -> VersionArb -> Bool +prop_VersionEq2 (VersionArb v1) (VersionArb v2) = + (==) v1 v2 == ((==) `on` mkVersion) v1 v2 + +prop_VersionOrd :: Version -> Version -> Bool +prop_VersionOrd v1 v2 = + compare v1 v2 == (compare `on` versionNumbers) v1 v2 + +prop_VersionOrd2 :: VersionArb -> VersionArb -> Bool +prop_VersionOrd2 (VersionArb v1) (VersionArb v2) = + (==) v1 v2 == ((==) `on` mkVersion) v1 v2 + +prop_ShowRead :: Version -> Property +prop_ShowRead v = Just v === readMaybe (show v) + +prop_ShowRead_example :: Bool +prop_ShowRead_example = show (mkVersion [1,2,3]) == "mkVersion [1,2,3]" + +--------------------------- +-- VersionRange properties +-- + +prop_normalise_inv :: VersionRange -> Property +prop_normalise_inv vr = + normaliseVersionRange vr === normaliseVersionRange (normaliseVersionRange vr) + +prop_nonNull :: Version -> Bool +prop_nonNull = (/= nullVersion) + +prop_anyVersion :: Version -> Bool +prop_anyVersion v' = + withinRange v' anyVersion + +prop_noVersion :: Version -> Bool +prop_noVersion v' = + withinRange v' noVersion == False + +prop_thisVersion :: Version -> Version -> Bool +prop_thisVersion v v' = + withinRange v' (thisVersion v) + == (v' == v) + +prop_notThisVersion :: Version -> Version -> Bool +prop_notThisVersion v v' = + withinRange v' (notThisVersion v) + == (v' /= v) + +prop_laterVersion :: Version -> Version -> Bool +prop_laterVersion v v' = + withinRange v' (laterVersion v) + == (v' > v) + +prop_orLaterVersion :: Version -> Version -> Bool +prop_orLaterVersion v v' = + withinRange v' (orLaterVersion v) + == (v' >= v) + +prop_earlierVersion :: Version -> Version -> Bool +prop_earlierVersion v v' = + withinRange v' (earlierVersion v) + == (v' < v) + +prop_orEarlierVersion :: Version -> Version -> Bool +prop_orEarlierVersion v v' = + withinRange v' (orEarlierVersion v) + == (v' <= v) + +prop_unionVersionRanges :: VersionRange -> VersionRange -> Version -> Bool +prop_unionVersionRanges vr1 vr2 v' = + withinRange v' (unionVersionRanges vr1 vr2) + == (withinRange v' vr1 || withinRange v' vr2) + +prop_intersectVersionRanges :: VersionRange -> VersionRange -> Version -> Bool +prop_intersectVersionRanges vr1 vr2 v' = + withinRange v' (intersectVersionRanges vr1 vr2) + == (withinRange v' vr1 && withinRange v' vr2) + +prop_differenceVersionRanges :: VersionRange -> VersionRange -> Version -> Bool +prop_differenceVersionRanges vr1 vr2 v' = + withinRange v' (differenceVersionRanges vr1 vr2) + == (withinRange v' vr1 && not (withinRange v' vr2)) + +prop_invertVersionRange :: VersionRange -> Version -> Bool +prop_invertVersionRange vr v' = + withinRange v' (invertVersionRange vr) + == not (withinRange v' vr) + +prop_withinVersion :: Version -> Version -> Bool +prop_withinVersion v v' = + withinRange v' (withinVersion v) + == (v' >= v && v' < upper v) + where + upper = alterVersion $ \numbers -> init numbers ++ [last numbers + 1] + +prop_foldVersionRange :: VersionRange -> Property +prop_foldVersionRange range = + expandVR range + === foldVersionRange anyVersion thisVersion + laterVersion earlierVersion + unionVersionRanges intersectVersionRanges + range + where + expandVR (WildcardVersion v) = + intersectVersionRanges (expandVR (orLaterVersion v)) (earlierVersion (wildcardUpperBound v)) + expandVR (MajorBoundVersion v) = + intersectVersionRanges (expandVR (orLaterVersion v)) (earlierVersion (majorUpperBound v)) + expandVR (OrEarlierVersion v) = + unionVersionRanges (thisVersion v) (earlierVersion v) + expandVR (OrLaterVersion v) = + unionVersionRanges (thisVersion v) (laterVersion v) + expandVR (UnionVersionRanges v1 v2) = + UnionVersionRanges (expandVR v1) (expandVR v2) + expandVR (IntersectVersionRanges v1 v2) = + IntersectVersionRanges (expandVR v1) (expandVR v2) + expandVR (VersionRangeParens v) = expandVR v + expandVR v = v + + upper = alterVersion $ \numbers -> init numbers ++ [last numbers + 1] + +prop_foldVersionRange' :: VersionRange -> Property +prop_foldVersionRange' range = + normaliseVersionRange srange + === foldVersionRange' anyVersion thisVersion + laterVersion earlierVersion + orLaterVersion orEarlierVersion + (\v _ -> withinVersion v) + (\v _ -> majorBoundVersion v) + unionVersionRanges intersectVersionRanges id + srange + where + srange = stripParensVersionRange range + +prop_isAnyVersion1 :: VersionRange -> Version -> Property +prop_isAnyVersion1 range version = + isAnyVersion range ==> withinRange version range + +prop_isAnyVersion2 :: VersionRange -> Property +prop_isAnyVersion2 range = + isAnyVersion range ==> + foldVersionRange True (\_ -> False) (\_ -> False) (\_ -> False) + (\_ _ -> False) (\_ _ -> False) + (simplifyVersionRange range) + +prop_isNoVersion :: VersionRange -> Version -> Property +prop_isNoVersion range version = + isNoVersion range ==> not (withinRange version range) + +prop_isSpecificVersion1 :: VersionRange -> NonEmptyList Version -> Property +prop_isSpecificVersion1 range (NonEmpty versions) = + isJust version && not (null versions') ==> + allEqual (fromJust version : versions') + where + version = isSpecificVersion range + versions' = filter (`withinRange` range) versions + allEqual xs = and (zipWith (==) xs (tail xs)) + +prop_isSpecificVersion2 :: VersionRange -> Property +prop_isSpecificVersion2 range = + isJust version ==> + foldVersionRange Nothing Just (\_ -> Nothing) (\_ -> Nothing) + (\_ _ -> Nothing) (\_ _ -> Nothing) + (simplifyVersionRange range) + == version + + where + version = isSpecificVersion range + +-- | 'simplifyVersionRange' is a semantic identity on 'VersionRange'. +-- +prop_simplifyVersionRange1 :: VersionRange -> Version -> Bool +prop_simplifyVersionRange1 range version = + withinRange version range == withinRange version (simplifyVersionRange range) + +prop_simplifyVersionRange1' :: VersionRange -> Bool +prop_simplifyVersionRange1' range = + range `equivalentVersionRange` (simplifyVersionRange range) + +-- | 'simplifyVersionRange' produces a canonical form for ranges with +-- equivalent semantics. +-- +prop_simplifyVersionRange2 :: VersionRange -> VersionRange -> Version -> Property +prop_simplifyVersionRange2 r r' v = + r /= r' && simplifyVersionRange r == simplifyVersionRange r' ==> + withinRange v r == withinRange v r' + +prop_simplifyVersionRange2' :: VersionRange -> VersionRange -> Property +prop_simplifyVersionRange2' r r' = + r /= r' && simplifyVersionRange r == simplifyVersionRange r' ==> + r `equivalentVersionRange` r' + +--FIXME: see equivalentVersionRange for details +prop_simplifyVersionRange2'' :: VersionRange -> VersionRange -> Property +prop_simplifyVersionRange2'' r r' = + r /= r' && r `equivalentVersionRange` r' ==> + simplifyVersionRange r == simplifyVersionRange r' + || isNoVersion r + || isNoVersion r' + +-------------------- +-- VersionIntervals +-- + +-- | Generating VersionIntervals +-- +-- This is a tad tricky as VersionIntervals is an abstract type, so we first +-- make a local type for generating the internal representation. Then we check +-- that this lets us construct valid 'VersionIntervals'. +-- + +instance Arbitrary VersionIntervals where + arbitrary = fmap mkVersionIntervals' arbitrary + where + mkVersionIntervals' :: [(Version, Bound)] -> VersionIntervals + mkVersionIntervals' = mkVersionIntervals . go version0 + where + go :: Version -> [(Version, Bound)] -> [VersionInterval] + go _ [] = [] + go v [(lv, lb)] = + [(LowerBound (addVersion lv v) lb, NoUpperBound)] + go v ((lv, lb) : (uv, ub) : rest) = + (LowerBound lv' lb, UpperBound uv' ub) : go uv' rest + where + lv' = addVersion v lv + uv' = addVersion lv' uv + + addVersion :: Version -> Version -> Version + addVersion xs ys = mkVersion $ z (versionNumbers xs) (versionNumbers ys) + where + z [] ys' = ys' + z xs' [] = xs' + z (x : xs') (y : ys') = x + y : z xs' ys' + +instance Arbitrary Bound where + arbitrary = elements [ExclusiveBound, InclusiveBound] + +-- | Check that our VersionIntervals' arbitrary instance generates intervals +-- that satisfies the invariant. +-- +prop_gen_intervals1 :: VersionIntervals -> Property +prop_gen_intervals1 i + = label ("length i ≈ 2 ^ " ++ show metric ++ " - 1") + $ xs === ys + where + metric = intLog2 (length xs + 1) + + xs = versionIntervals i + ys = versionIntervals (mkVersionIntervals xs) +-- | Check that constructing our intervals type and converting it to a +-- 'VersionRange' and then into the true intervals type gives us back +-- the exact same sequence of intervals. This tells us that our arbitrary +-- instance for 'VersionIntervals'' is ok. +-- +prop_gen_intervals2 :: VersionIntervals -> Property +prop_gen_intervals2 intervals = + toVersionIntervals (fromVersionIntervals intervals) === intervals + +-- | Check that 'VersionIntervals' models 'VersionRange' via +-- 'toVersionIntervals'. +-- +prop_to_intervals :: VersionRange -> Version -> Bool +prop_to_intervals range version = + withinRange version range == withinIntervals version intervals + where + intervals = toVersionIntervals range + +-- | Check that semantic equality on 'VersionRange's is the same as converting +-- to 'VersionIntervals' and doing syntactic equality. +-- +prop_to_intervals_canonical :: VersionRange -> VersionRange -> Property +prop_to_intervals_canonical r r' = + r /= r' && r `equivalentVersionRange` r' ==> + toVersionIntervals r == toVersionIntervals r' + +prop_to_intervals_canonical' :: VersionRange -> VersionRange -> Property +prop_to_intervals_canonical' r r' = + r /= r' && toVersionIntervals r == toVersionIntervals r' ==> + r `equivalentVersionRange` r' + +-- | Check that 'VersionIntervals' models 'VersionRange' via +-- 'fromVersionIntervals'. +-- +prop_from_intervals :: VersionIntervals -> Version -> Bool +prop_from_intervals intervals version = + withinRange version range == withinIntervals version intervals + where + range = fromVersionIntervals intervals + +-- | @'toVersionIntervals' . 'fromVersionIntervals'@ is an exact identity on +-- 'VersionIntervals'. +-- +prop_to_from_intervals :: VersionIntervals -> Bool +prop_to_from_intervals intervals = + toVersionIntervals (fromVersionIntervals intervals) == intervals + +-- | @'fromVersionIntervals' . 'toVersionIntervals'@ is a semantic identity on +-- 'VersionRange', though not necessarily a syntactic identity. +-- +prop_from_to_intervals :: VersionRange -> Bool +prop_from_to_intervals range = + range' `equivalentVersionRange` range + where + range' = fromVersionIntervals (toVersionIntervals range) + +-- | Equivalent of 'prop_from_to_intervals' +-- +prop_from_to_intervals' :: VersionRange -> Version -> Bool +prop_from_to_intervals' range version = + withinRange version range' == withinRange version range + where + range' = fromVersionIntervals (toVersionIntervals range) + +-- | The semantics of 'unionVersionIntervals' is (||). +-- +prop_unionVersionIntervals :: VersionIntervals -> VersionIntervals + -> Version -> Bool +prop_unionVersionIntervals is1 is2 v = + withinIntervals v (unionVersionIntervals is1 is2) + == (withinIntervals v is1 || withinIntervals v is2) + +-- | 'unionVersionIntervals' is idempotent +-- +prop_unionVersionIntervals_idempotent :: VersionIntervals -> Bool +prop_unionVersionIntervals_idempotent = + Laws.idempotent_binary unionVersionIntervals + +-- | 'unionVersionIntervals' is commutative +-- +prop_unionVersionIntervals_commutative :: VersionIntervals + -> VersionIntervals -> Bool +prop_unionVersionIntervals_commutative = + Laws.commutative unionVersionIntervals + +-- | 'unionVersionIntervals' is associative +-- +prop_unionVersionIntervals_associative :: VersionIntervals + -> VersionIntervals + -> VersionIntervals -> Bool +prop_unionVersionIntervals_associative = + Laws.associative unionVersionIntervals + +-- | The semantics of 'intersectVersionIntervals' is (&&). +-- +prop_intersectVersionIntervals :: VersionIntervals -> VersionIntervals + -> Version -> Bool +prop_intersectVersionIntervals is1 is2 v = + withinIntervals v (intersectVersionIntervals is1 is2) + == (withinIntervals v is1 && withinIntervals v is2) + +-- | 'intersectVersionIntervals' is idempotent +-- +prop_intersectVersionIntervals_idempotent :: VersionIntervals -> Bool +prop_intersectVersionIntervals_idempotent = + Laws.idempotent_binary intersectVersionIntervals + +-- | 'intersectVersionIntervals' is commutative +-- +prop_intersectVersionIntervals_commutative :: VersionIntervals + -> VersionIntervals -> Bool +prop_intersectVersionIntervals_commutative = + Laws.commutative intersectVersionIntervals + +-- | 'intersectVersionIntervals' is associative +-- +prop_intersectVersionIntervals_associative :: VersionIntervals + -> VersionIntervals + -> VersionIntervals -> Bool +prop_intersectVersionIntervals_associative = + Laws.associative intersectVersionIntervals + +-- | 'unionVersionIntervals' distributes over 'intersectVersionIntervals' +-- +prop_union_intersect_distributive :: Property +prop_union_intersect_distributive = + Laws.distributive_left unionVersionIntervals intersectVersionIntervals + .&. Laws.distributive_right unionVersionIntervals intersectVersionIntervals + +-- | 'intersectVersionIntervals' distributes over 'unionVersionIntervals' +-- +prop_intersect_union_distributive :: Property +prop_intersect_union_distributive = + Laws.distributive_left intersectVersionIntervals unionVersionIntervals + .&. Laws.distributive_right intersectVersionIntervals unionVersionIntervals + +-- | The semantics of 'invertVersionIntervals' is 'not'. +-- +prop_invertVersionIntervals :: VersionIntervals + -> Version -> Bool +prop_invertVersionIntervals vi v = + withinIntervals v (invertVersionIntervals vi) + == not (withinIntervals v vi) + +-- | Double application of 'invertVersionIntervals' is the identity function +prop_invertVersionIntervalsTwice :: VersionIntervals -> Bool +prop_invertVersionIntervalsTwice vi = + invertVersionIntervals (invertVersionIntervals vi) == vi + + + +-------------------------------- +-- equivalentVersionRange helper + +prop_equivalentVersionRange :: VersionRange -> VersionRange + -> Version -> Property +prop_equivalentVersionRange range range' version = + equivalentVersionRange range range' && range /= range' ==> + withinRange version range == withinRange version range' + +--FIXME: this is wrong. consider version ranges "<=1" and "<1.0" +-- this algorithm cannot distinguish them because there is no version +-- that is included by one that is excluded by the other. +-- Alternatively we must reconsider the semantics of '<' and '<=' +-- in version ranges / version intervals. Perhaps the canonical +-- representation should use just < v and interpret "<= v" as "< v.0". +equivalentVersionRange :: VersionRange -> VersionRange -> Bool +equivalentVersionRange vr1 vr2 = + let allVersionsUsed = nub (sort (versionsUsed vr1 ++ versionsUsed vr2)) + minPoint = mkVersion [0] + maxPoint | null allVersionsUsed = minPoint + | otherwise = alterVersion (++[1]) (maximum allVersionsUsed) + probeVersions = minPoint : maxPoint + : intermediateVersions allVersionsUsed + + in all (\v -> withinRange v vr1 == withinRange v vr2) probeVersions + + where + versionsUsed = foldVersionRange [] (\x->[x]) (\x->[x]) (\x->[x]) (++) (++) + intermediateVersions (v1:v2:vs) = v1 : intermediateVersion v1 v2 + : intermediateVersions (v2:vs) + intermediateVersions vs = vs + +intermediateVersion :: Version -> Version -> Version +intermediateVersion v1 v2 | v1 >= v2 = error "intermediateVersion: v1 >= v2" +intermediateVersion v1 v2 = + mkVersion (intermediateList (versionNumbers v1) (versionNumbers v2)) + where + intermediateList :: [Int] -> [Int] -> [Int] + intermediateList [] (_:_) = [0] + intermediateList (x:xs) (y:ys) + | x < y = x : xs ++ [0] + | otherwise = x : intermediateList xs ys + +prop_intermediateVersion :: Version -> Version -> Property +prop_intermediateVersion v1 v2 = + (v1 /= v2) && not (adjacentVersions v1 v2) ==> + if v1 < v2 + then let v = intermediateVersion v1 v2 + in (v1 < v && v < v2) + else let v = intermediateVersion v2 v1 + in v1 > v && v > v2 + +adjacentVersions :: Version -> Version -> Bool +adjacentVersions ver1 ver2 = v1 ++ [0] == v2 || v2 ++ [0] == v1 + where + v1 = versionNumbers ver1 + v2 = versionNumbers ver2 + +-------------------------------- +-- Parsing and pretty printing +-- + +prop_parse_disp_inv :: VersionRange -> Property +prop_parse_disp_inv vr = + parseDisp vr === (parseDisp vr >>= parseDisp) + where + parseDisp = simpleParse . display + +prop_parsec_disp_inv :: VersionRange -> Property +prop_parsec_disp_inv vr = + parseDisp vr === (parseDisp vr >>= parseDisp) + where + parseDisp = simpleParsec . display + +prop_parse_disp :: VersionRange -> Property +prop_parse_disp vr = counterexample (show (display vr')) $ + fmap s (simpleParse (display vr')) === Just vr' + .&&. + fmap s (simpleParsec (display vr')) === Just vr' + where + -- we have to strip parens, because arbitrary 'VersionRange' may have + -- too little parens constructors. + s = stripParensVersionRange + vr' = s vr + +prop_parse_disp1 :: VersionRange -> Bool +prop_parse_disp1 vr = + fmap stripParens (simpleParse (display vr)) == Just (normaliseVersionRange vr) + where + stripParens :: VersionRange -> VersionRange + stripParens (VersionRangeParens v) = stripParens v + stripParens (UnionVersionRanges v1 v2) = + UnionVersionRanges (stripParens v1) (stripParens v2) + stripParens (IntersectVersionRanges v1 v2) = + IntersectVersionRanges (stripParens v1) (stripParens v2) + stripParens v = v + +prop_parse_disp2 :: VersionRange -> Property +prop_parse_disp2 vr = + let b = fmap (display :: VersionRange -> String) (simpleParse (display vr)) + a = Just (display vr) + in + counterexample ("Expected: " ++ show a) $ + counterexample ("But got: " ++ show b) $ + b == a + +prop_parse_disp3 :: VersionRange -> Property +prop_parse_disp3 vr = + let a = Just (display vr) + b = fmap displayRaw (simpleParse (display vr)) + in + counterexample ("Expected: " ++ show a) $ + counterexample ("But got: " ++ show b) $ + b == a + +prop_parse_disp4 :: VersionRange -> Property +prop_parse_disp4 vr = + let a = Just vr + b = (simpleParse (display vr)) + in + counterexample ("Expected: " ++ show a) $ + counterexample ("But got: " ++ show b) $ + b == a + +prop_parse_disp5 :: VersionRange -> Property +prop_parse_disp5 vr = + let a = Just vr + b = simpleParse (displayRaw vr) + in + counterexample ("Expected: " ++ show a) $ + counterexample ("But got: " ++ show b) $ + b == a + +displayRaw :: VersionRange -> String +displayRaw = + Disp.render + . foldVersionRange' -- precedence: + -- All the same as the usual pretty printer, except for the parens + ( Disp.text "-any") + (\v -> Disp.text "==" <<>> disp v) + (\v -> Disp.char '>' <<>> disp v) + (\v -> Disp.char '<' <<>> disp v) + (\v -> Disp.text ">=" <<>> disp v) + (\v -> Disp.text "<=" <<>> disp v) + (\v _ -> Disp.text "==" <<>> dispWild v) + (\v _ -> Disp.text "^>=" <<>> disp v) + (\r1 r2 -> r1 <+> Disp.text "||" <+> r2) + (\r1 r2 -> r1 <+> Disp.text "&&" <+> r2) + (\r -> Disp.parens r) -- parens + + where + dispWild v = + Disp.hcat (Disp.punctuate (Disp.char '.') + (map Disp.int (versionNumbers v))) + <<>> Disp.text ".*" diff --git a/Cabal/tests/custom-setup/CabalDoctestSetup.hs b/Cabal/tests/custom-setup/CabalDoctestSetup.hs new file mode 100644 index 00000000..2ed94bf9 --- /dev/null +++ b/Cabal/tests/custom-setup/CabalDoctestSetup.hs @@ -0,0 +1,475 @@ +-- This is Distribution.Extra.Doctest module from cabal-doctest-1.0.4 +-- This isn't technically a Custom-Setup script, but it /was/. + +{- + +Copyright (c) 2017, Oleg Grenrus + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Oleg Grenrus nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +-- | The provided 'generateBuildModule' generates 'Build_doctests' module. +-- That module exports enough configuration, so your doctests could be simply +-- +-- @ +-- module Main where +-- +-- import Build_doctests (flags, pkgs, module_sources) +-- import Data.Foldable (traverse_) +-- import Test.Doctest (doctest) +-- +-- main :: IO () +-- main = do +-- traverse_ putStrLn args -- optionally print arguments +-- doctest args +-- where +-- args = flags ++ pkgs ++ module_sources +-- @ +-- +-- To use this library in the @Setup.hs@, you should specify a @custom-setup@ +-- section in the cabal file, for example: +-- +-- @ +-- custom-setup +-- setup-depends: +-- base >= 4 && <5, +-- cabal-doctest >= 1 && <1.1 +-- @ +-- +-- /Note:/ you don't need to depend on @Cabal@ if you use only +-- 'defaultMainWithDoctests' in the @Setup.hs@. +-- +module CabalDoctestSetup ( + defaultMainWithDoctests, + defaultMainAutoconfWithDoctests, + addDoctestsUserHook, + doctestsUserHooks, + generateBuildModule, + ) where + +-- Hacky way to suppress few deprecation warnings. +#if MIN_VERSION_Cabal(1,24,0) +#define InstalledPackageId UnitId +#endif + +import Control.Monad + (when) +import Data.List + (nub) +import Data.Maybe + (maybeToList, mapMaybe) +import Data.String + (fromString) +import qualified Data.Foldable as F + (for_) +import qualified Data.Traversable as T + (traverse) +import qualified Distribution.ModuleName as ModuleName + (fromString) +import Distribution.ModuleName + (ModuleName) +import Distribution.Package + (InstalledPackageId) +import Distribution.Package + (Package (..), PackageId, packageVersion) +import Distribution.PackageDescription + (BuildInfo (..), Executable (..), Library (..), + PackageDescription (), TestSuite (..)) +import Distribution.Simple + (UserHooks (..), autoconfUserHooks, defaultMainWithHooks, simpleUserHooks) +import Distribution.Simple.BuildPaths + (autogenModulesDir) +import Distribution.Simple.Compiler + (PackageDB (..), showCompilerId) +import Distribution.Simple.LocalBuildInfo + (ComponentLocalBuildInfo (componentPackageDeps), LocalBuildInfo (), + compiler, withExeLBI, withLibLBI, withPackageDB, withTestLBI) +import Distribution.Simple.Setup + (BuildFlags (buildDistPref, buildVerbosity), fromFlag) +import Distribution.Simple.Utils + (createDirectoryIfMissingVerbose, findFile, rewriteFile) +import Distribution.Text + (display, simpleParse) +import System.FilePath + ((), (<.>), dropExtension) + +import Data.IORef (newIORef, modifyIORef, readIORef) + +#if MIN_VERSION_Cabal(1,25,0) +import Distribution.Simple.BuildPaths + (autogenComponentModulesDir) +#endif +#if MIN_VERSION_Cabal(2,0,0) +import Distribution.Types.MungedPackageId + (MungedPackageId) +import Distribution.Types.UnqualComponentName + (unUnqualComponentName) +#endif + +#if MIN_VERSION_directory(1,2,2) +import System.Directory + (makeAbsolute) +#else +import System.Directory + (getCurrentDirectory) +import System.FilePath + (isAbsolute) + +makeAbsolute :: FilePath -> IO FilePath +makeAbsolute p | isAbsolute p = return p + | otherwise = do + cwd <- getCurrentDirectory + return $ cwd p +#endif + +-- | A default main with doctests: +-- +-- @ +-- import Distribution.Extra.Doctest +-- (defaultMainWithDoctests) +-- +-- main :: IO () +-- main = defaultMainWithDoctests "doctests" +-- @ +defaultMainWithDoctests + :: String -- ^ doctests test-suite name + -> IO () +defaultMainWithDoctests = defaultMainWithHooks . doctestsUserHooks + +-- | Like 'defaultMainWithDoctests', for 'build-type: Configure' packages. +-- +-- @since 1.0.2 +defaultMainAutoconfWithDoctests + :: String -- ^ doctests test-suite name + -> IO () +defaultMainAutoconfWithDoctests n = + defaultMainWithHooks (addDoctestsUserHook n autoconfUserHooks) + +-- | 'simpleUserHooks' with 'generateBuildModule' prepended to the 'buildHook'. +doctestsUserHooks + :: String -- ^ doctests test-suite name + -> UserHooks +doctestsUserHooks testsuiteName = + addDoctestsUserHook testsuiteName simpleUserHooks + +-- | +-- +-- @since 1.0.2 +addDoctestsUserHook :: String -> UserHooks -> UserHooks +addDoctestsUserHook testsuiteName uh = uh + { buildHook = \pkg lbi hooks flags -> do + generateBuildModule testsuiteName flags pkg lbi + buildHook uh pkg lbi hooks flags + } + +data Name = NameLib (Maybe String) | NameExe String deriving (Eq, Show) + +nameToString :: Name -> String +nameToString n = case n of + NameLib x -> maybe "" (("_lib_" ++) . map fixchar) x + NameExe x -> "_exe_" ++ map fixchar x + where + -- Taken from Cabal: + -- https://github.com/haskell/cabal/blob/20de0bfea72145ba1c37e3f500cee5258cc18e51/Cabal/Distribution/Simple/Build/Macros.hs#L156-L158 + -- + -- Needed to fix component names with hyphens in them, as hyphens aren't + -- allowed in Haskell identifier names. + fixchar :: Char -> Char + fixchar '-' = '_' + fixchar c = c + +data Component = Component Name [String] [String] [String] + deriving Show + +-- | Generate a build module for the test suite. +-- +-- @ +-- import Distribution.Simple +-- (defaultMainWithHooks, UserHooks(..), simpleUserHooks) +-- import Distribution.Extra.Doctest +-- (generateBuildModule) +-- +-- main :: IO () +-- main = defaultMainWithHooks simpleUserHooks +-- { buildHook = \pkg lbi hooks flags -> do +-- generateBuildModule "doctests" flags pkg lbi +-- buildHook simpleUserHooks pkg lbi hooks flags +-- } +-- @ +generateBuildModule + :: String -- ^ doctests test-suite name + -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO () +generateBuildModule testSuiteName flags pkg lbi = do + let verbosity = fromFlag (buildVerbosity flags) + let distPref = fromFlag (buildDistPref flags) + + -- Package DBs + let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref "package.conf.inplace" ] + let dbFlags = "-hide-all-packages" : packageDbArgs dbStack + + withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testSuiteName) $ do +#if MIN_VERSION_Cabal(1,25,0) + let testAutogenDir = autogenComponentModulesDir lbi suitecfg +#else + let testAutogenDir = autogenModulesDir lbi +#endif + + createDirectoryIfMissingVerbose verbosity True testAutogenDir + + let buildDoctestsFile = testAutogenDir "Build_doctests.hs" + + -- First, we create the autogen'd module Build_doctests. + -- Initially populate Build_doctests with a simple preamble. + writeFile buildDoctestsFile $ unlines + [ "module Build_doctests where" + , "" + , "import Prelude" + , "" + , "data Name = NameLib (Maybe String) | NameExe String deriving (Eq, Show)" + , "data Component = Component Name [String] [String] [String] deriving (Eq, Show)" + , "" + ] + + -- we cannot traverse, only traverse_ + -- so we use IORef to collect components + componentsRef <- newIORef [] + + let testBI = testBuildInfo suite + + -- TODO: `words` is not proper parser (no support for quotes) + let additionalFlags = maybe [] words + $ lookup "x-doctest-options" + $ customFieldsBI testBI + + let additionalModules = maybe [] words + $ lookup "x-doctest-modules" + $ customFieldsBI testBI + + let additionalDirs' = maybe [] words + $ lookup "x-doctest-source-dirs" + $ customFieldsBI testBI + + additionalDirs <- mapM (fmap ("-i" ++) . makeAbsolute) additionalDirs' + + -- Next, for each component (library or executable), we get to Build_doctests + -- the sets of flags needed to run doctest on that component. + let getBuildDoctests withCompLBI mbCompName compExposedModules compMainIs compBuildInfo = + withCompLBI pkg lbi $ \comp compCfg -> do + let compBI = compBuildInfo comp + + -- modules + let modules = compExposedModules comp ++ otherModules compBI + -- it seems that doctest is happy to take in module names, not actual files! + let module_sources = modules + + -- We need the directory with the component's cabal_macros.h! +#if MIN_VERSION_Cabal(1,25,0) + let compAutogenDir = autogenComponentModulesDir lbi compCfg +#else + let compAutogenDir = autogenModulesDir lbi +#endif + + -- Lib sources and includes + iArgsNoPrefix + <- mapM makeAbsolute + $ compAutogenDir -- autogenerated files + : (distPref ++ "/build") -- preprocessed files (.hsc -> .hs); "build" is hardcoded in Cabal. + : hsSourceDirs compBI + includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs compBI + -- We clear all includes, so the CWD isn't used. + let iArgs' = map ("-i"++) iArgsNoPrefix + iArgs = "-i" : iArgs' + + -- default-extensions + let extensionArgs = map (("-X"++) . display) $ defaultExtensions compBI + + -- CPP includes, i.e. include cabal_macros.h + let cppFlags = map ("-optP"++) $ + [ "-include", compAutogenDir ++ "/cabal_macros.h" ] + ++ cppOptions compBI + + -- Unlike other modules, the main-is module of an executable is not + -- guaranteed to share a module name with its filepath name. That is, + -- even though the main-is module is named Main, its filepath might + -- actually be Something.hs. To account for this possibility, we simply + -- pass the full path to the main-is module instead. + mainIsPath <- T.traverse (findFile iArgsNoPrefix) (compMainIs comp) + + let all_sources = map display module_sources + ++ additionalModules + ++ maybeToList mainIsPath + + let component = Component + (mbCompName comp) + (formatDeps $ testDeps compCfg suitecfg) + (concat + [ iArgs + , additionalDirs + , includeArgs + , dbFlags + , cppFlags + , extensionArgs + , additionalFlags + ]) + all_sources + + -- modify IORef, append component + modifyIORef componentsRef (\cs -> cs ++ [component]) + + -- For now, we only check for doctests in libraries and executables. + getBuildDoctests withLibLBI mbLibraryName exposedModules (const Nothing) libBuildInfo + getBuildDoctests withExeLBI (NameExe . executableName) (const []) (Just . modulePath) buildInfo + + components <- readIORef componentsRef + F.for_ components $ \(Component name pkgs flags sources) -> do + let compSuffix = nameToString name + pkgs_comp = "pkgs" ++ compSuffix + flags_comp = "flags" ++ compSuffix + module_sources_comp = "module_sources" ++ compSuffix + + -- write autogen'd file + appendFile buildDoctestsFile $ unlines + [ -- -package-id etc. flags + pkgs_comp ++ " :: [String]" + , pkgs_comp ++ " = " ++ show pkgs + , "" + , flags_comp ++ " :: [String]" + , flags_comp ++ " = " ++ show flags + , "" + , module_sources_comp ++ " :: [String]" + , module_sources_comp ++ " = " ++ show sources + , "" + ] + + -- write enabled components, i.e. x-doctest-components + -- if none enabled, pick library + let enabledComponents = maybe [NameLib Nothing] (mapMaybe parseComponentName . words) + $ lookup "x-doctest-components" + $ customFieldsBI testBI + + let components' = + filter (\(Component n _ _ _) -> n `elem` enabledComponents) components + appendFile buildDoctestsFile $ unlines + [ "-- " ++ show enabledComponents + , "components :: [Component]" + , "components = " ++ show components' + ] + + where + parseComponentName :: String -> Maybe Name + parseComponentName "lib" = Just (NameLib Nothing) + parseComponentName ('l' : 'i' : 'b' : ':' : x) = Just (NameLib (Just x)) + parseComponentName ('e' : 'x' : 'e' : ':' : x) = Just (NameExe x) + parseComponentName _ = Nothing + + -- we do this check in Setup, as then doctests don't need to depend on Cabal + isOldCompiler = maybe False id $ do + a <- simpleParse $ showCompilerId $ compiler lbi + b <- simpleParse "7.5" + return $ packageVersion (a :: PackageId) < b + + formatDeps = map formatOne + formatOne (installedPkgId, pkgId) + -- The problem is how different cabal executables handle package databases + -- when doctests depend on the library + -- + -- If the pkgId is current package, we don't output the full package-id + -- but only the name + -- + -- Because of MungedPackageId we compare display version of identifiers + -- not the identifiers themfselves. + | display (packageId pkg) == display pkgId = "-package=" ++ display pkgId + | otherwise = "-package-id=" ++ display installedPkgId + + -- From Distribution.Simple.Program.GHC + packageDbArgs :: [PackageDB] -> [String] + packageDbArgs | isOldCompiler = packageDbArgsConf + | otherwise = packageDbArgsDb + + -- GHC <7.6 uses '-package-conf' instead of '-package-db'. + packageDbArgsConf :: [PackageDB] -> [String] + packageDbArgsConf dbstack = case dbstack of + (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs + (GlobalPackageDB:dbs) -> ("-no-user-package-conf") + : concatMap specific dbs + _ -> ierror + where + specific (SpecificPackageDB db) = [ "-package-conf=" ++ db ] + specific _ = ierror + ierror = error $ "internal error: unexpected package db stack: " + ++ show dbstack + + -- GHC >= 7.6 uses the '-package-db' flag. See + -- https://ghc.haskell.org/trac/ghc/ticket/5977. + packageDbArgsDb :: [PackageDB] -> [String] + -- special cases to make arguments prettier in common scenarios + packageDbArgsDb dbstack = case dbstack of + (GlobalPackageDB:UserPackageDB:dbs) + | all isSpecific dbs -> concatMap single dbs + (GlobalPackageDB:dbs) + | all isSpecific dbs -> "-no-user-package-db" + : concatMap single dbs + dbs -> "-clear-package-db" + : concatMap single dbs + where + single (SpecificPackageDB db) = [ "-package-db=" ++ db ] + single GlobalPackageDB = [ "-global-package-db" ] + single UserPackageDB = [ "-user-package-db" ] + isSpecific (SpecificPackageDB _) = True + isSpecific _ = False + + mbLibraryName :: Library -> Name +#if MIN_VERSION_Cabal(2,0,0) + -- Cabal-2.0 introduced internal libraries, which are named. + mbLibraryName = NameLib . fmap unUnqualComponentName . libName +#else + -- Before that, there was only ever at most one library per + -- .cabal file, which has no name. + mbLibraryName _ = NameLib Nothing +#endif + + executableName :: Executable -> String +#if MIN_VERSION_Cabal(2,0,0) + executableName = unUnqualComponentName . exeName +#else + executableName = exeName +#endif + +-- | In compat settings it's better to omit the type-signature +testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo +#if MIN_VERSION_Cabal(2,0,0) + -> [(InstalledPackageId, MungedPackageId)] +#else + -> [(InstalledPackageId, PackageId)] +#endif +testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys diff --git a/Cabal/tests/custom-setup/CustomSetupTests.hs b/Cabal/tests/custom-setup/CustomSetupTests.hs new file mode 100644 index 00000000..ef989a3b --- /dev/null +++ b/Cabal/tests/custom-setup/CustomSetupTests.hs @@ -0,0 +1,8 @@ +-- This test-suite verifies some custom-setup scripts compile ok +-- so we don't break them by accident, i.e. when breakage can be prevented. +module Main (main) where +import CabalDoctestSetup () +import IdrisSetup () + +main :: IO () +main = return () diff --git a/Cabal/tests/custom-setup/IdrisSetup.hs b/Cabal/tests/custom-setup/IdrisSetup.hs new file mode 100644 index 00000000..b26b0038 --- /dev/null +++ b/Cabal/tests/custom-setup/IdrisSetup.hs @@ -0,0 +1,383 @@ +-- This is Setup.hs script from idris-1.1.1 + +{- + +Copyright (c) 2011 Edwin Brady + School of Computer Science, University of St Andrews +All rights reserved. + +This code is derived from software written by Edwin Brady +(eb@cs.st-andrews.ac.uk). + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. None of the names of the copyright holders may be used to endorse + or promote products derived from this software without specific + prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ``AS IS'' AND ANY +EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR +BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE +OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN +IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +*** End of disclaimer. *** + +-} + +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} +module IdrisSetup (main) where + +#if !defined(MIN_VERSION_Cabal) +# define MIN_VERSION_Cabal(x,y,z) 0 +#endif + +#if !defined(MIN_VERSION_base) +# define MIN_VERSION_base(x,y,z) 0 +#endif + +import Control.Monad +import Data.IORef +import Control.Exception (SomeException, catch) +import Data.String (fromString) + +import Distribution.Simple +import Distribution.Simple.BuildPaths +import Distribution.Simple.InstallDirs as I +import Distribution.Simple.LocalBuildInfo as L +import qualified Distribution.Simple.Setup as S +import qualified Distribution.Simple.Program as P +import Distribution.Simple.Utils (createDirectoryIfMissingVerbose, rewriteFile, notice, installOrdinaryFiles) +import Distribution.Compiler +import Distribution.PackageDescription +import Distribution.Text + +import System.Environment +import System.Exit +import System.FilePath ((), splitDirectories,isAbsolute) +import System.Directory +import qualified System.FilePath.Posix as Px +import System.Process + +-- This is difference from vanilla idris-1.1.1 +configConfigurationsFlags :: S.ConfigFlags -> [(FlagName, Bool)] +#if MIN_VERSION_Cabal(2,1,0) +configConfigurationsFlags = unFlagAssignment . S.configConfigurationsFlags +#else +configConfigurationsFlags = S.configConfigurationsFlags +#endif + +#if !MIN_VERSION_base(4,6,0) +lookupEnv :: String -> IO (Maybe String) +lookupEnv v = lookup v `fmap` getEnvironment +#endif + +-- After Idris is built, we need to check and install the prelude and other libs + +-- ----------------------------------------------------------------------------- +-- Idris Command Path + +-- make on mingw32 exepects unix style separators +#ifdef mingw32_HOST_OS +() = (Px.) +idrisCmd local = Px.joinPath $ splitDirectories $ ".." ".." buildDir local "idris" "idris" +#else +idrisCmd local = ".." ".." buildDir local "idris" "idris" +#endif + +-- ----------------------------------------------------------------------------- +-- Make Commands + +-- use GNU make on FreeBSD +#if defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS)\ + || defined(openbsd_HOST_OS) || defined(netbsd_HOST_OS) +mymake = "gmake" +#else +mymake = "make" +#endif +make verbosity = + P.runProgramInvocation verbosity . P.simpleProgramInvocation mymake + +#ifdef mingw32_HOST_OS +windres verbosity = P.runProgramInvocation verbosity . P.simpleProgramInvocation "windres" +#endif +-- ----------------------------------------------------------------------------- +-- Flags + +usesGMP :: S.ConfigFlags -> Bool +usesGMP flags = + case lookup (mkFlagName "gmp") (configConfigurationsFlags flags) of + Just True -> True + Just False -> False + Nothing -> False + +execOnly :: S.ConfigFlags -> Bool +execOnly flags = + case lookup (mkFlagName "execonly") (configConfigurationsFlags flags) of + Just True -> True + Just False -> False + Nothing -> False + +isRelease :: S.ConfigFlags -> Bool +isRelease flags = + case lookup (mkFlagName "release") (configConfigurationsFlags flags) of + Just True -> True + Just False -> False + Nothing -> False + +isFreestanding :: S.ConfigFlags -> Bool +isFreestanding flags = + case lookup (mkFlagName "freestanding") (configConfigurationsFlags flags) of + Just True -> True + Just False -> False + Nothing -> False + +#if !(MIN_VERSION_Cabal(2,0,0)) +mkFlagName :: String -> FlagName +mkFlagName = FlagName +#endif + +-- ----------------------------------------------------------------------------- +-- Clean + +idrisClean _ flags _ _ = cleanStdLib + where + verbosity = S.fromFlag $ S.cleanVerbosity flags + + cleanStdLib = makeClean "libs" + + makeClean dir = make verbosity [ "-C", dir, "clean", "IDRIS=idris" ] + +-- ----------------------------------------------------------------------------- +-- Configure + +gitHash :: IO String +gitHash = do h <- Control.Exception.catch (readProcess "git" ["rev-parse", "--short", "HEAD"] "") + (\e -> let e' = (e :: SomeException) in return "PRE") + return $ takeWhile (/= '\n') h + +-- Put the Git hash into a module for use in the program +-- For release builds, just put the empty string in the module +generateVersionModule verbosity dir release = do + hash <- gitHash + let versionModulePath = dir "Version_idris" Px.<.> "hs" + putStrLn $ "Generating " ++ versionModulePath ++ + if release then " for release" else " for prerelease " ++ hash + createDirectoryIfMissingVerbose verbosity True dir + rewriteFile versionModulePath (versionModuleContents hash) + + where versionModuleContents h = "module Version_idris where\n\n" ++ + "gitHash :: String\n" ++ + if release + then "gitHash = \"\"\n" + else "gitHash = \"git:" ++ h ++ "\"\n" + +-- Generate a module that contains the lib path for a freestanding Idris +generateTargetModule verbosity dir targetDir = do + let absPath = isAbsolute targetDir + let targetModulePath = dir "Target_idris" Px.<.> "hs" + putStrLn $ "Generating " ++ targetModulePath + createDirectoryIfMissingVerbose verbosity True dir + rewriteFile targetModulePath (versionModuleContents absPath targetDir) + where versionModuleContents absolute td = "module Target_idris where\n\n" ++ + "import System.FilePath\n" ++ + "import System.Environment\n" ++ + "getDataDir :: IO String\n" ++ + if absolute + then "getDataDir = return \"" ++ td ++ "\"\n" + else "getDataDir = do \n" ++ + " expath <- getExecutablePath\n" ++ + " execDir <- return $ dropFileName expath\n" ++ + " return $ execDir ++ \"" ++ td ++ "\"\n" + ++ "getDataFileName :: FilePath -> IO FilePath\n" + ++ "getDataFileName name = do\n" + ++ " dir <- getDataDir\n" + ++ " return (dir ++ \"/\" ++ name)" + +-- a module that has info about existence and location of a bundled toolchain +generateToolchainModule verbosity srcDir toolDir = do + let commonContent = "module Tools_idris where\n\n" + let toolContent = case toolDir of + Just dir -> "hasBundledToolchain = True\n" ++ + "getToolchainDir = \"" ++ dir ++ "\"\n" + Nothing -> "hasBundledToolchain = False\n" ++ + "getToolchainDir = \"\"" + let toolPath = srcDir "Tools_idris" Px.<.> "hs" + createDirectoryIfMissingVerbose verbosity True srcDir + rewriteFile toolPath (commonContent ++ toolContent) + +idrisConfigure _ flags pkgdesc local = do + configureRTS + withLibLBI pkgdesc local $ \_ libcfg -> do + let libAutogenDir = autogenComponentModulesDir local libcfg + generateVersionModule verbosity libAutogenDir (isRelease (configFlags local)) + if isFreestanding $ configFlags local + then do + toolDir <- lookupEnv "IDRIS_TOOLCHAIN_DIR" + generateToolchainModule verbosity libAutogenDir toolDir + targetDir <- lookupEnv "IDRIS_LIB_DIR" + case targetDir of + Just d -> generateTargetModule verbosity libAutogenDir d + Nothing -> error $ "Trying to build freestanding without a target directory." + ++ " Set it by defining IDRIS_LIB_DIR." + else + generateToolchainModule verbosity libAutogenDir Nothing + where + verbosity = S.fromFlag $ S.configVerbosity flags + version = pkgVersion . package $ localPkgDescr local + + -- This is a hack. I don't know how to tell cabal that a data file needs + -- installing but shouldn't be in the distribution. And it won't make the + -- distribution if it's not there, so instead I just delete + -- the file after configure. + configureRTS = make verbosity ["-C", "rts", "clean"] + +#if !(MIN_VERSION_Cabal(2,0,0)) + autogenComponentModulesDir lbi _ = autogenModulesDir lbi +#endif + +idrisPreSDist args flags = do + let dir = S.fromFlag (S.sDistDirectory flags) + let verb = S.fromFlag (S.sDistVerbosity flags) + generateVersionModule verb "src" True + generateTargetModule verb "src" "./libs" + generateToolchainModule verb "src" Nothing + preSDist simpleUserHooks args flags + +idrisSDist sdist pkgDesc bi hooks flags = do + pkgDesc' <- addGitFiles pkgDesc + sdist pkgDesc' bi hooks flags + where + addGitFiles :: PackageDescription -> IO PackageDescription + addGitFiles pkgDesc = do + files <- gitFiles + return $ pkgDesc { extraSrcFiles = extraSrcFiles pkgDesc ++ files} + gitFiles :: IO [FilePath] + gitFiles = liftM lines (readProcess "git" ["ls-files"] "") + +idrisPostSDist args flags desc lbi = do + Control.Exception.catch (do let file = "src" "Version_idris" Px.<.> "hs" + let targetFile = "src" "Target_idris" Px.<.> "hs" + putStrLn $ "Removing generated modules:\n " + ++ file ++ "\n" ++ targetFile + removeFile file + removeFile targetFile) + (\e -> let e' = (e :: SomeException) in return ()) + postSDist simpleUserHooks args flags desc lbi + +-- ----------------------------------------------------------------------------- +-- Build + +getVersion :: Args -> S.BuildFlags -> IO HookedBuildInfo +getVersion args flags = do + hash <- gitHash + let buildinfo = (emptyBuildInfo { cppOptions = ["-DVERSION="++hash] }) :: BuildInfo + return (Just buildinfo, []) + +idrisPreBuild args flags = do +#ifdef mingw32_HOST_OS + createDirectoryIfMissingVerbose verbosity True dir + windres verbosity ["icons/idris_icon.rc","-o", dir++"/idris_icon.o"] + return (Nothing, [(fromString "idris", emptyBuildInfo { ldOptions = [dir ++ "/idris_icon.o"] })]) + where + verbosity = S.fromFlag $ S.buildVerbosity flags + dir = S.fromFlagOrDefault "dist" $ S.buildDistPref flags +#else + return (Nothing, []) +#endif + +idrisBuild _ flags _ local + = if (execOnly (configFlags local)) then buildRTS + else do buildStdLib + buildRTS + where + verbosity = S.fromFlag $ S.buildVerbosity flags + + buildStdLib = do + putStrLn "Building libraries..." + makeBuild "libs" + where + makeBuild dir = make verbosity [ "-C", dir, "build" , "IDRIS=" ++ idrisCmd local] + + buildRTS = make verbosity (["-C", "rts", "build"] ++ + gmpflag (usesGMP (configFlags local))) + + gmpflag False = [] + gmpflag True = ["GMP=-DIDRIS_GMP"] + +-- ----------------------------------------------------------------------------- +-- Copy/Install + +idrisInstall verbosity copy pkg local + = if (execOnly (configFlags local)) then installRTS + else do installStdLib + installRTS + installManPage + where + target = datadir $ L.absoluteInstallDirs pkg local copy + + installStdLib = do + let target' = target -- "libs" + putStrLn $ "Installing libraries in " ++ target' + makeInstall "libs" target' + + installRTS = do + let target' = target "rts" + putStrLn $ "Installing run time system in " ++ target' + makeInstall "rts" target' + + installManPage = do + let mandest = mandir (L.absoluteInstallDirs pkg local copy) ++ "/man1" + notice verbosity $ unwords ["Copying man page to", mandest] + installOrdinaryFiles verbosity mandest [("man", "idris.1")] + + makeInstall src target = + make verbosity [ "-C", src, "install" , "TARGET=" ++ target, "IDRIS=" ++ idrisCmd local] + +-- ----------------------------------------------------------------------------- +-- Test + +-- There are two "dataDir" in cabal, and they don't relate to each other. +-- When fetching modules, idris uses the second path (in the pkg record), +-- which by default is the root folder of the project. +-- We want it to be the install directory where we put the idris libraries. +fixPkg pkg target = pkg { dataDir = target } + +idrisTestHook args pkg local hooks flags = do + let target = datadir $ L.absoluteInstallDirs pkg local NoCopyDest + testHook simpleUserHooks args (fixPkg pkg target) local hooks flags + +-- ----------------------------------------------------------------------------- +-- Main + +-- Install libraries during both copy and install +-- See https://github.com/haskell/cabal/issues/709 +main = defaultMainWithHooks $ simpleUserHooks + { postClean = idrisClean + , postConf = idrisConfigure + , preBuild = idrisPreBuild + , postBuild = idrisBuild + , postCopy = \_ flags pkg local -> + idrisInstall (S.fromFlag $ S.copyVerbosity flags) + (S.fromFlag $ S.copyDest flags) pkg local + , postInst = \_ flags pkg local -> + idrisInstall (S.fromFlag $ S.installVerbosity flags) + NoCopyDest pkg local + , preSDist = idrisPreSDist + , sDistHook = idrisSDist (sDistHook simpleUserHooks) + , postSDist = idrisPostSDist + , testHook = idrisTestHook + } diff --git a/Cabal/tests/hackage/check.sh b/Cabal/tests/hackage/check.sh new file mode 100644 index 00000000..cbd512d0 --- /dev/null +++ b/Cabal/tests/hackage/check.sh @@ -0,0 +1,25 @@ +#!/bin/sh + +base_version=1.4.0.2 +test_version=1.5.6 + +for setup in archive/*/*/Setup.hs archive/*/*/Setup.lhs; do + + pkgname=$(basename ${setup}) + + if test $(wc -w < ${setup}) -gt 21; then + if ghc -package Cabal-${base_version} -S ${setup} -o /dev/null 2> /dev/null; then + + if ghc -package Cabal-${test_version} -S ${setup} -o /dev/null 2> /dev/null; then + echo "OK ${setup}" + else + echo "FAIL ${setup} does not compile with Cabal-${test_version}" + fi + else + echo "OK ${setup} (does not compile with Cabal-${base_version})" + fi + else + echo "trivial ${setup}" + fi + +done diff --git a/Cabal/tests/hackage/download.sh b/Cabal/tests/hackage/download.sh new file mode 100644 index 00000000..9a6a509f --- /dev/null +++ b/Cabal/tests/hackage/download.sh @@ -0,0 +1,19 @@ +#!/bin/sh + +if test ! -f archive/archive.tar; then + + wget http://hackage.haskell.org/cgi-bin/hackage-scripts/archive.tar + mkdir -p archive + mv archive.tar archive/ + tar -C archive -xf archive/archive.tar + +fi + +if test ! -f archive/00-index.tar.gz; then + + wget http://hackage.haskell.org/packages/archive/00-index.tar.gz + mkdir -p archive + mv 00-index.tar.gz archive/ + tar -C archive -xzf archive/00-index.tar.gz + +fi diff --git a/Cabal/tests/hackage/unpack.sh b/Cabal/tests/hackage/unpack.sh new file mode 100644 index 00000000..8155f7ee --- /dev/null +++ b/Cabal/tests/hackage/unpack.sh @@ -0,0 +1,16 @@ +#!/bin/sh + +for tarball in archive/*/*/*.tar.gz; do + + pkgdir=$(dirname ${tarball}) + pkgname=$(basename ${tarball} .tar.gz) + + if tar -tzf ${tarball} ${pkgname}/Setup.hs 2> /dev/null; then + tar -xzf ${tarball} ${pkgname}/Setup.hs -O > ${pkgdir}/Setup.hs + elif tar -tzf ${tarball} ${pkgname}/Setup.lhs 2> /dev/null; then + tar -xzf ${tarball} ${pkgname}/Setup.lhs -O > ${pkgdir}/Setup.lhs + else + echo "${pkgname} has no Setup.hs or .lhs at all!!?!" + fi + +done diff --git a/Cabal/tests/misc/ghc-supported-languages.hs b/Cabal/tests/misc/ghc-supported-languages.hs new file mode 100644 index 00000000..1101c290 --- /dev/null +++ b/Cabal/tests/misc/ghc-supported-languages.hs @@ -0,0 +1,97 @@ +-- | A test program to check that ghc has got all of its extensions registered +-- +module Main where + +import Language.Haskell.Extension +import Distribution.Text +import Distribution.Simple.Utils +import Distribution.Verbosity + +import Data.List ((\\)) +import Data.Maybe +import Control.Applicative +import Control.Monad +import System.Environment +import System.Exit + +-- | A list of GHC extensions that are deliberately not registered, +-- e.g. due to being experimental and not ready for public consumption +-- +exceptions = map readExtension [] + +checkProblems :: [Extension] -> [String] +checkProblems implemented = + + let unregistered = + [ ext | ext <- implemented -- extensions that ghc knows about + , not (registered ext) -- but that are not registered + , ext `notElem` exceptions ] -- except for the exceptions + + -- check if someone has forgotten to update the exceptions list... + + -- exceptions that are not implemented + badExceptions = exceptions \\ implemented + + -- exceptions that are now registered + badExceptions' = filter registered exceptions + + in catMaybes + [ check unregistered $ unlines + [ "The following extensions are known to GHC but are not in the " + , "extension registry in Language.Haskell.Extension." + , " " ++ intercalate "\n " (map display unregistered) + , "If these extensions are ready for public consumption then they " + , "should be registered. If they are still experimental and you " + , "think they are not ready to be registered then please add them " + , "to the exceptions list in this test program along with an " + , "explanation." + ] + , check badExceptions $ unlines + [ "Error in the extension exception list. The following extensions" + , "are listed as exceptions but are not even implemented by GHC:" + , " " ++ intercalate "\n " (map display badExceptions) + , "Please fix this test program by correcting the list of" + , "exceptions." + ] + , check badExceptions' $ unlines + [ "Error in the extension exception list. The following extensions" + , "are listed as exceptions to registration but they are in fact" + , "now registered in Language.Haskell.Extension:" + , " " ++ intercalate "\n " (map display badExceptions') + , "Please fix this test program by correcting the list of" + , "exceptions." + ] + ] + where + registered (UnknownExtension _) = False + registered _ = True + + check [] _ = Nothing + check _ i = Just i + + +main = topHandler $ do + [ghcPath] <- getArgs + exts <- getExtensions ghcPath + let problems = checkProblems exts + putStrLn (intercalate "\n" problems) + if null problems + then exitSuccess + else exitFailure + +getExtensions :: FilePath -> IO [Extension] +getExtensions ghcPath = + map readExtension . lines + <$> rawSystemStdout normal ghcPath ["--supported-languages"] + +readExtension :: String -> Extension +readExtension str = handleNoParse $ do + -- GHC defines extensions in a positive way, Cabal defines them + -- relative to H98 so we try parsing ("No" ++ extName) first + ext <- simpleParse ("No" ++ str) + case ext of + UnknownExtension _ -> simpleParse str + _ -> return ext + where + handleNoParse :: Maybe Extension -> Extension + handleNoParse = fromMaybe (error $ "unparsable extension " ++ show str) diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs new file mode 100644 index 00000000..5fc08105 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2.hs @@ -0,0 +1,1721 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE OverloadedStrings #-} + +-- For the handy instance IsString PackageIdentifier +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module IntegrationTests2 where + +import Distribution.Client.DistDirLayout +import Distribution.Client.ProjectConfig +import Distribution.Client.Config (getCabalDir) +import Distribution.Client.TargetSelector hiding (DirActions(..)) +import qualified Distribution.Client.TargetSelector as TS (DirActions(..)) +import Distribution.Client.ProjectPlanning +import Distribution.Client.ProjectPlanning.Types +import Distribution.Client.ProjectBuilding +import Distribution.Client.ProjectOrchestration + ( resolveTargets, TargetProblemCommon(..), distinctTargetComponents ) +import Distribution.Client.Types + ( PackageLocation(..), UnresolvedSourcePackage + , PackageSpecifier(..) ) +import Distribution.Client.Targets + ( UserConstraint(..), UserConstraintScope(UserAnyQualifier) ) +import qualified Distribution.Client.InstallPlan as InstallPlan +import Distribution.Solver.Types.SourcePackage as SP +import Distribution.Solver.Types.ConstraintSource + ( ConstraintSource(ConstraintSourceUnknown) ) +import Distribution.Solver.Types.PackageConstraint + ( PackageProperty(PackagePropertySource) ) + +import qualified Distribution.Client.CmdBuild as CmdBuild +import qualified Distribution.Client.CmdRepl as CmdRepl +import qualified Distribution.Client.CmdRun as CmdRun +import qualified Distribution.Client.CmdTest as CmdTest +import qualified Distribution.Client.CmdBench as CmdBench +import qualified Distribution.Client.CmdHaddock as CmdHaddock + +import Distribution.Package +import Distribution.PackageDescription +import qualified Distribution.Types.GenericPackageDescription as GPG +import Distribution.InstalledPackageInfo (InstalledPackageInfo) +import Distribution.Simple.Setup (toFlag, HaddockFlags(..), defaultHaddockFlags) +import Distribution.Simple.Compiler +import Distribution.System +import Distribution.Version +import Distribution.ModuleName (ModuleName) +import Distribution.Verbosity +import Distribution.Text + +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid (mempty, mappend) +#endif +import Data.List (sort) +import Data.String (IsString(..)) +import qualified Data.Map as Map +import qualified Data.Set as Set +import Control.Monad +import Control.Exception hiding (assert) +import System.FilePath +import System.Directory + +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Options +import Data.Tagged (Tagged(..)) +import Data.Proxy (Proxy(..)) +import Data.Typeable (Typeable) + + +main :: IO () +main = + defaultMainWithIngredients + (defaultIngredients ++ [includingOptions projectConfigOptionDescriptions]) + (withProjectConfig $ \config -> + testGroup "Integration tests (internal)" + (tests config)) + + +tests :: ProjectConfig -> [TestTree] +tests config = + --TODO: tests for: + -- * normal success + -- * dry-run tests with changes + [ testGroup "Discovery and planning" $ + [ testCase "find root" testFindProjectRoot + , testCase "find root fail" testExceptionFindProjectRoot + , testCase "no package" (testExceptionInFindingPackage config) + , testCase "no package2" (testExceptionInFindingPackage2 config) + , testCase "proj conf1" (testExceptionInProjectConfig config) + ] + , testGroup "Target selectors" $ + [ testCaseSteps "valid" testTargetSelectors + , testCase "bad syntax" testTargetSelectorBadSyntax + , testCaseSteps "ambiguous syntax" testTargetSelectorAmbiguous + , testCase "no current pkg" testTargetSelectorNoCurrentPackage + , testCase "no targets" testTargetSelectorNoTargets + , testCase "project empty" testTargetSelectorProjectEmpty + , testCase "problems (common)" (testTargetProblemsCommon config) + , testCaseSteps "problems (build)" (testTargetProblemsBuild config) + , testCaseSteps "problems (repl)" (testTargetProblemsRepl config) + , testCaseSteps "problems (run)" (testTargetProblemsRun config) + , testCaseSteps "problems (test)" (testTargetProblemsTest config) + , testCaseSteps "problems (bench)" (testTargetProblemsBench config) + , testCaseSteps "problems (haddock)" (testTargetProblemsHaddock config) + ] + , testGroup "Exceptions during building (local inplace)" $ + [ testCase "configure" (testExceptionInConfigureStep config) + , testCase "build" (testExceptionInBuildStep config) +-- , testCase "register" testExceptionInRegisterStep + ] + --TODO: need to repeat for packages for the store + --TODO: need to check we can build sub-libs, foreign libs and exes + -- components for non-local packages / packages in the store. + + , testGroup "Successful builds" $ + [ testCaseSteps "Setup script styles" (testSetupScriptStyles config) + , testCase "keep-going" (testBuildKeepGoing config) + , testCase "local tarball" (testBuildLocalTarball config) + ] + + , testGroup "Regression tests" $ + [ testCase "issue #3324" (testRegressionIssue3324 config) + ] + ] + + +testFindProjectRoot :: Assertion +testFindProjectRoot = do + Left (BadProjectRootExplicitFile file) <- findProjectRoot (Just testdir) + (Just testfile) + file @?= testfile + where + testdir = basedir "exception" "no-pkg2" + testfile = "bklNI8O1OpOUuDu3F4Ij4nv3oAqN" + + +testExceptionFindProjectRoot :: Assertion +testExceptionFindProjectRoot = do + Right (ProjectRootExplicit dir _) <- findProjectRoot (Just testdir) Nothing + cwd <- getCurrentDirectory + dir @?= cwd testdir + where + testdir = basedir "exception" "no-pkg2" + + +testTargetSelectors :: (String -> IO ()) -> Assertion +testTargetSelectors reportSubCase = do + (_, _, _, localPackages, _) <- configureProject testdir config + let readTargetSelectors' = readTargetSelectorsWith (dirActions testdir) + localPackages + Nothing + + reportSubCase "cwd" + do Right ts <- readTargetSelectors' [] + ts @?= [TargetPackage TargetImplicitCwd ["p-0.1"] Nothing] + + reportSubCase "all" + do Right ts <- readTargetSelectors' + ["all", ":all"] + ts @?= replicate 2 (TargetAllPackages Nothing) + + reportSubCase "filter" + do Right ts <- readTargetSelectors' + [ "libs", ":cwd:libs" + , "flibs", ":cwd:flibs" + , "exes", ":cwd:exes" + , "tests", ":cwd:tests" + , "benchmarks", ":cwd:benchmarks"] + zipWithM_ (@?=) ts + [ TargetPackage TargetImplicitCwd ["p-0.1"] (Just kind) + | kind <- concatMap (replicate 2) [LibKind .. ] + ] + + reportSubCase "all:filter" + do Right ts <- readTargetSelectors' + [ "all:libs", ":all:libs" + , "all:flibs", ":all:flibs" + , "all:exes", ":all:exes" + , "all:tests", ":all:tests" + , "all:benchmarks", ":all:benchmarks"] + zipWithM_ (@?=) ts + [ TargetAllPackages (Just kind) + | kind <- concatMap (replicate 2) [LibKind .. ] + ] + + reportSubCase "pkg" + do Right ts <- readTargetSelectors' + [ ":pkg:p", ".", "./", "p.cabal" + , "q", ":pkg:q", "q/", "./q/", "q/q.cabal"] + ts @?= replicate 4 (mkTargetPackage "p-0.1") + ++ replicate 5 (mkTargetPackage "q-0.1") + + reportSubCase "pkg:filter" + do Right ts <- readTargetSelectors' + [ "p:libs", ".:libs", ":pkg:p:libs" + , "p:flibs", ".:flibs", ":pkg:p:flibs" + , "p:exes", ".:exes", ":pkg:p:exes" + , "p:tests", ".:tests", ":pkg:p:tests" + , "p:benchmarks", ".:benchmarks", ":pkg:p:benchmarks" + , "q:libs", "q/:libs", ":pkg:q:libs" + , "q:flibs", "q/:flibs", ":pkg:q:flibs" + , "q:exes", "q/:exes", ":pkg:q:exes" + , "q:tests", "q/:tests", ":pkg:q:tests" + , "q:benchmarks", "q/:benchmarks", ":pkg:q:benchmarks"] + zipWithM_ (@?=) ts $ + [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just kind) + | kind <- concatMap (replicate 3) [LibKind .. ] + ] ++ + [ TargetPackage TargetExplicitNamed ["q-0.1"] (Just kind) + | kind <- concatMap (replicate 3) [LibKind .. ] + ] + + reportSubCase "component" + do Right ts <- readTargetSelectors' + [ "p", "lib:p", "p:lib:p", ":pkg:p:lib:p" + , "lib:q", "q:lib:q", ":pkg:q:lib:q" ] + ts @?= replicate 4 (TargetComponent "p-0.1" (CLibName LMainLibName) WholeComponent) + ++ replicate 3 (TargetComponent "q-0.1" (CLibName LMainLibName) WholeComponent) + + reportSubCase "module" + do Right ts <- readTargetSelectors' + [ "P", "lib:p:P", "p:p:P", ":pkg:p:lib:p:module:P" + , "QQ", "lib:q:QQ", "q:q:QQ", ":pkg:q:lib:q:module:QQ" + , "pexe:PMain" -- p:P or q:QQ would be ambiguous here + , "qexe:QMain" -- package p vs component p + ] + ts @?= replicate 4 (TargetComponent "p-0.1" (CLibName LMainLibName) (ModuleTarget "P")) + ++ replicate 4 (TargetComponent "q-0.1" (CLibName LMainLibName) (ModuleTarget "QQ")) + ++ [ TargetComponent "p-0.1" (CExeName "pexe") (ModuleTarget "PMain") + , TargetComponent "q-0.1" (CExeName "qexe") (ModuleTarget "QMain") + ] + + reportSubCase "file" + do Right ts <- readTargetSelectors' + [ "./P.hs", "p:P.lhs", "lib:p:P.hsc", "p:p:P.hsc", + ":pkg:p:lib:p:file:P.y" + , "q/QQ.hs", "q:QQ.lhs", "lib:q:QQ.hsc", "q:q:QQ.hsc", + ":pkg:q:lib:q:file:QQ.y" + ] + ts @?= replicate 5 (TargetComponent "p-0.1" (CLibName LMainLibName) (FileTarget "P")) + ++ replicate 5 (TargetComponent "q-0.1" (CLibName LMainLibName) (FileTarget "QQ")) + -- Note there's a bit of an inconsistency here: for the single-part + -- syntax the target has to point to a file that exists, whereas for + -- all the other forms we don't require that. + + cleanProject testdir + where + testdir = "targets/simple" + config = mempty + + +testTargetSelectorBadSyntax :: Assertion +testTargetSelectorBadSyntax = do + (_, _, _, localPackages, _) <- configureProject testdir config + let targets = [ "foo bar", " foo" + , "foo:", "foo::bar" + , "foo: ", "foo: :bar" + , "a:b:c:d:e:f", "a:b:c:d:e:f:g:h" ] + Left errs <- readTargetSelectors localPackages Nothing targets + zipWithM_ (@?=) errs (map TargetSelectorUnrecognised targets) + cleanProject testdir + where + testdir = "targets/empty" + config = mempty + + +testTargetSelectorAmbiguous :: (String -> IO ()) -> Assertion +testTargetSelectorAmbiguous reportSubCase = do + + -- 'all' is ambiguous with packages and cwd components + reportSubCase "ambiguous: all vs pkg" + assertAmbiguous "all" + [mkTargetPackage "all", mkTargetAllPackages] + [mkpkg "all" []] + + reportSubCase "ambiguous: all vs cwd component" + assertAmbiguous "all" + [mkTargetComponent "other" (CExeName "all"), mkTargetAllPackages] + [mkpkg "other" [mkexe "all"]] + + -- but 'all' is not ambiguous with non-cwd components, modules or files + reportSubCase "unambiguous: all vs non-cwd comp, mod, file" + assertUnambiguous "All" + mkTargetAllPackages + [ mkpkgAt "foo" [mkexe "All"] "foo" + , mkpkg "bar" [ mkexe "bar" `withModules` ["All"] + , mkexe "baz" `withCFiles` ["All"] ] + ] + + -- filters 'libs', 'exes' etc are ambiguous with packages and + -- local components + reportSubCase "ambiguous: cwd-pkg filter vs pkg" + assertAmbiguous "libs" + [ mkTargetPackage "libs" + , TargetPackage TargetImplicitCwd ["libs"] (Just LibKind) ] + [mkpkg "libs" []] + + reportSubCase "ambiguous: filter vs cwd component" + assertAmbiguous "exes" + [ mkTargetComponent "other" (CExeName "exes") + , TargetPackage TargetImplicitCwd ["other"] (Just ExeKind) ] + [mkpkg "other" [mkexe "exes"]] + + -- but filters are not ambiguous with non-cwd components, modules or files + reportSubCase "unambiguous: filter vs non-cwd comp, mod, file" + assertUnambiguous "Libs" + (TargetPackage TargetImplicitCwd ["bar"] (Just LibKind)) + [ mkpkgAt "foo" [mkexe "Libs"] "foo" + , mkpkg "bar" [ mkexe "bar" `withModules` ["Libs"] + , mkexe "baz" `withCFiles` ["Libs"] ] + ] + + -- local components shadow packages and other components + reportSubCase "unambiguous: cwd comp vs pkg, non-cwd comp" + assertUnambiguous "foo" + (mkTargetComponent "other" (CExeName "foo")) + [ mkpkg "other" [mkexe "foo"] + , mkpkgAt "other2" [mkexe "foo"] "other2" -- shadows non-local foo + , mkpkg "foo" [] ] -- shadows package foo + + -- local components shadow modules and files + reportSubCase "unambiguous: cwd comp vs module, file" + assertUnambiguous "Foo" + (mkTargetComponent "bar" (CExeName "Foo")) + [ mkpkg "bar" [mkexe "Foo"] + , mkpkg "other" [ mkexe "other" `withModules` ["Foo"] + , mkexe "other2" `withCFiles` ["Foo"] ] + ] + + -- packages shadow non-local components + reportSubCase "unambiguous: pkg vs non-cwd comp" + assertUnambiguous "foo" + (mkTargetPackage "foo") + [ mkpkg "foo" [] + , mkpkgAt "other" [mkexe "foo"] "other" -- shadows non-local foo + ] + + -- packages shadow modules and files + reportSubCase "unambiguous: pkg vs module, file" + assertUnambiguous "Foo" + (mkTargetPackage "Foo") + [ mkpkgAt "Foo" [] "foo" + , mkpkg "other" [ mkexe "other" `withModules` ["Foo"] + , mkexe "other2" `withCFiles` ["Foo"] ] + ] + + -- non-exact case packages and components are ambiguous + reportSubCase "ambiguous: non-exact-case pkg names" + assertAmbiguous "Foo" + [ mkTargetPackage "foo", mkTargetPackage "FOO" ] + [ mkpkg "foo" [], mkpkg "FOO" [] ] + reportSubCase "ambiguous: non-exact-case comp names" + assertAmbiguous "Foo" + [ mkTargetComponent "bar" (CExeName "foo") + , mkTargetComponent "bar" (CExeName "FOO") ] + [ mkpkg "bar" [mkexe "foo", mkexe "FOO"] ] + + -- exact-case Module or File over non-exact case package or component + reportSubCase "unambiguous: module vs non-exact-case pkg, comp" + assertUnambiguous "Baz" + (mkTargetModule "other" (CExeName "other") "Baz") + [ mkpkg "baz" [mkexe "BAZ"] + , mkpkg "other" [ mkexe "other" `withModules` ["Baz"] ] + ] + reportSubCase "unambiguous: file vs non-exact-case pkg, comp" + assertUnambiguous "Baz" + (mkTargetFile "other" (CExeName "other") "Baz") + [ mkpkg "baz" [mkexe "BAZ"] + , mkpkg "other" [ mkexe "other" `withCFiles` ["Baz"] ] + ] + where + assertAmbiguous :: String + -> [TargetSelector] + -> [SourcePackage (PackageLocation a)] + -> Assertion + assertAmbiguous str tss pkgs = do + res <- readTargetSelectorsWith + fakeDirActions + (map SpecificSourcePackage pkgs) + Nothing + [str] + case res of + Left [TargetSelectorAmbiguous _ tss'] -> + sort (map snd tss') @?= sort tss + _ -> assertFailure $ "expected Left [TargetSelectorAmbiguous _ _], " + ++ "got " ++ show res + + assertUnambiguous :: String + -> TargetSelector + -> [SourcePackage (PackageLocation a)] + -> Assertion + assertUnambiguous str ts pkgs = do + res <- readTargetSelectorsWith + fakeDirActions + (map SpecificSourcePackage pkgs) + Nothing + [str] + case res of + Right [ts'] -> ts' @?= ts + _ -> assertFailure $ "expected Right [Target...], " + ++ "got " ++ show res + + fakeDirActions = TS.DirActions { + TS.doesFileExist = \_p -> return True, + TS.doesDirectoryExist = \_p -> return True, + TS.canonicalizePath = \p -> return ("/" p), -- FilePath.Unix. ? + TS.getCurrentDirectory = return "/" + } + + mkpkg :: String -> [Executable] -> SourcePackage (PackageLocation a) + mkpkg pkgidstr exes = mkpkgAt pkgidstr exes "" + + mkpkgAt :: String -> [Executable] -> FilePath + -> SourcePackage (PackageLocation a) + mkpkgAt pkgidstr exes loc = + SourcePackage { + packageInfoId = pkgid, + packageSource = LocalUnpackedPackage loc, + packageDescrOverride = Nothing, + SP.packageDescription = GenericPackageDescription { + GPG.packageDescription = emptyPackageDescription { package = pkgid }, + genPackageFlags = [], + condLibrary = Nothing, + condSubLibraries = [], + condForeignLibs = [], + condExecutables = [ ( exeName exe, CondNode exe [] [] ) + | exe <- exes ], + condTestSuites = [], + condBenchmarks = [] + } + } + where + Just pkgid = simpleParse pkgidstr + + mkexe :: String -> Executable + mkexe name = mempty { exeName = fromString name } + + withModules :: Executable -> [String] -> Executable + withModules exe mods = + exe { buildInfo = (buildInfo exe) { otherModules = map fromString mods } } + + withCFiles :: Executable -> [FilePath] -> Executable + withCFiles exe files = + exe { buildInfo = (buildInfo exe) { cSources = files } } + + +mkTargetPackage :: PackageId -> TargetSelector +mkTargetPackage pkgid = + TargetPackage TargetExplicitNamed [pkgid] Nothing + +mkTargetComponent :: PackageId -> ComponentName -> TargetSelector +mkTargetComponent pkgid cname = + TargetComponent pkgid cname WholeComponent + +mkTargetModule :: PackageId -> ComponentName -> ModuleName -> TargetSelector +mkTargetModule pkgid cname mname = + TargetComponent pkgid cname (ModuleTarget mname) + +mkTargetFile :: PackageId -> ComponentName -> String -> TargetSelector +mkTargetFile pkgid cname fname = + TargetComponent pkgid cname (FileTarget fname) + +mkTargetAllPackages :: TargetSelector +mkTargetAllPackages = TargetAllPackages Nothing + +instance IsString PackageIdentifier where + fromString pkgidstr = pkgid + where Just pkgid = simpleParse pkgidstr + + +testTargetSelectorNoCurrentPackage :: Assertion +testTargetSelectorNoCurrentPackage = do + (_, _, _, localPackages, _) <- configureProject testdir config + let readTargetSelectors' = readTargetSelectorsWith (dirActions testdir) + localPackages + Nothing + targets = [ "libs", ":cwd:libs" + , "flibs", ":cwd:flibs" + , "exes", ":cwd:exes" + , "tests", ":cwd:tests" + , "benchmarks", ":cwd:benchmarks"] + Left errs <- readTargetSelectors' targets + zipWithM_ (@?=) errs + [ TargetSelectorNoCurrentPackage ts + | target <- targets + , let Just ts = parseTargetString target + ] + cleanProject testdir + where + testdir = "targets/complex" + config = mempty + + +testTargetSelectorNoTargets :: Assertion +testTargetSelectorNoTargets = do + (_, _, _, localPackages, _) <- configureProject testdir config + Left errs <- readTargetSelectors localPackages Nothing [] + errs @?= [TargetSelectorNoTargetsInCwd] + cleanProject testdir + where + testdir = "targets/complex" + config = mempty + + +testTargetSelectorProjectEmpty :: Assertion +testTargetSelectorProjectEmpty = do + (_, _, _, localPackages, _) <- configureProject testdir config + Left errs <- readTargetSelectors localPackages Nothing [] + errs @?= [TargetSelectorNoTargetsInProject] + cleanProject testdir + where + testdir = "targets/empty" + config = mempty + + +testTargetProblemsCommon :: ProjectConfig -> Assertion +testTargetProblemsCommon config0 = do + (_,elaboratedPlan,_) <- planProject testdir config + + let pkgIdMap :: Map.Map PackageName PackageId + pkgIdMap = Map.fromList + [ (packageName p, packageId p) + | p <- InstallPlan.toList elaboratedPlan ] + + cases :: [( TargetSelector -> CmdBuild.TargetProblem + , TargetSelector + )] + cases = + [ -- Cannot resolve packages outside of the project + ( \_ -> CmdBuild.TargetProblemCommon $ + TargetProblemNoSuchPackage "foobar" + , mkTargetPackage "foobar" ) + + -- We cannot currently build components like testsuites or + -- benchmarks from packages that are not local to the project + , ( \_ -> CmdBuild.TargetProblemCommon $ + TargetComponentNotProjectLocal + (pkgIdMap Map.! "filepath") (CTestName "filepath-tests") + WholeComponent + , mkTargetComponent (pkgIdMap Map.! "filepath") + (CTestName "filepath-tests") ) + + -- Components can be explicitly @buildable: False@ + , ( \_ -> CmdBuild.TargetProblemCommon $ + TargetComponentNotBuildable "q-0.1" (CExeName "buildable-false") WholeComponent + , mkTargetComponent "q-0.1" (CExeName "buildable-false") ) + + -- Testsuites and benchmarks can be disabled by the solver if it + -- cannot satisfy deps + , ( \_ -> CmdBuild.TargetProblemCommon $ + TargetOptionalStanzaDisabledBySolver "q-0.1" (CTestName "solver-disabled") WholeComponent + , mkTargetComponent "q-0.1" (CTestName "solver-disabled") ) + + -- Testsuites and benchmarks can be disabled explicitly by the + -- user via config + , ( \_ -> CmdBuild.TargetProblemCommon $ + TargetOptionalStanzaDisabledByUser + "q-0.1" (CBenchName "user-disabled") WholeComponent + , mkTargetComponent "q-0.1" (CBenchName "user-disabled") ) + + -- An unknown package. The target selector resolution should only + -- produce known packages, so this should not happen with the + -- output from 'readTargetSelectors'. + , ( \_ -> CmdBuild.TargetProblemCommon $ + TargetProblemNoSuchPackage "foobar" + , mkTargetPackage "foobar" ) + + -- An unknown component of a known package. The target selector + -- resolution should only produce known packages, so this should + -- not happen with the output from 'readTargetSelectors'. + , ( \_ -> CmdBuild.TargetProblemCommon $ + TargetProblemNoSuchComponent "q-0.1" (CExeName "no-such") + , mkTargetComponent "q-0.1" (CExeName "no-such") ) + ] + assertTargetProblems + elaboratedPlan + CmdBuild.selectPackageTargets + CmdBuild.selectComponentTarget + CmdBuild.TargetProblemCommon + cases + where + testdir = "targets/complex" + config = config0 { + projectConfigLocalPackages = (projectConfigLocalPackages config0) { + packageConfigBenchmarks = toFlag False + } + , projectConfigShared = (projectConfigShared config0) { + projectConfigConstraints = + [( UserConstraint (UserAnyQualifier "filepath") PackagePropertySource + , ConstraintSourceUnknown )] + } + } + + +testTargetProblemsBuild :: ProjectConfig -> (String -> IO ()) -> Assertion +testTargetProblemsBuild config reportSubCase = do + + reportSubCase "empty-pkg" + assertProjectTargetProblems + "targets/empty-pkg" config + CmdBuild.selectPackageTargets + CmdBuild.selectComponentTarget + CmdBuild.TargetProblemCommon + [ ( CmdBuild.TargetProblemNoTargets, mkTargetPackage "p-0.1" ) + ] + + reportSubCase "all-disabled" + assertProjectTargetProblems + "targets/all-disabled" + config { + projectConfigLocalPackages = (projectConfigLocalPackages config) { + packageConfigBenchmarks = toFlag False + } + } + CmdBuild.selectPackageTargets + CmdBuild.selectComponentTarget + CmdBuild.TargetProblemCommon + [ ( flip CmdBuild.TargetProblemNoneEnabled + [ AvailableTarget "p-0.1" (CBenchName "user-disabled") + TargetDisabledByUser True + , AvailableTarget "p-0.1" (CTestName "solver-disabled") + TargetDisabledBySolver True + , AvailableTarget "p-0.1" (CExeName "buildable-false") + TargetNotBuildable True + , AvailableTarget "p-0.1" (CLibName LMainLibName) + TargetNotBuildable True + ] + , mkTargetPackage "p-0.1" ) + ] + + reportSubCase "enabled component kinds" + -- When we explicitly enable all the component kinds then selecting the + -- whole package selects those component kinds too + do (_,elaboratedPlan,_) <- planProject "targets/variety" config { + projectConfigLocalPackages = (projectConfigLocalPackages config) { + packageConfigTests = toFlag True, + packageConfigBenchmarks = toFlag True + } + } + assertProjectDistinctTargets + elaboratedPlan + CmdBuild.selectPackageTargets + CmdBuild.selectComponentTarget + CmdBuild.TargetProblemCommon + [ mkTargetPackage "p-0.1" ] + [ ("p-0.1-inplace", (CLibName LMainLibName)) + , ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark") + , ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite") + , ("p-0.1-inplace-an-exe", CExeName "an-exe") + , ("p-0.1-inplace-libp", CFLibName "libp") + ] + + reportSubCase "disabled component kinds" + -- When we explicitly disable all the component kinds then selecting the + -- whole package only selects the library, foreign lib and exes + do (_,elaboratedPlan,_) <- planProject "targets/variety" config { + projectConfigLocalPackages = (projectConfigLocalPackages config) { + packageConfigTests = toFlag False, + packageConfigBenchmarks = toFlag False + } + } + assertProjectDistinctTargets + elaboratedPlan + CmdBuild.selectPackageTargets + CmdBuild.selectComponentTarget + CmdBuild.TargetProblemCommon + [ mkTargetPackage "p-0.1" ] + [ ("p-0.1-inplace", (CLibName LMainLibName)) + , ("p-0.1-inplace-an-exe", CExeName "an-exe") + , ("p-0.1-inplace-libp", CFLibName "libp") + ] + + reportSubCase "requested component kinds" + -- When we selecting the package with an explicit filter then we get those + -- components even though we did not explicitly enable tests/benchmarks + do (_,elaboratedPlan,_) <- planProject "targets/variety" config + assertProjectDistinctTargets + elaboratedPlan + CmdBuild.selectPackageTargets + CmdBuild.selectComponentTarget + CmdBuild.TargetProblemCommon + [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind) + , TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind) + ] + [ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark") + , ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite") + ] + + +testTargetProblemsRepl :: ProjectConfig -> (String -> IO ()) -> Assertion +testTargetProblemsRepl config reportSubCase = do + + reportSubCase "multiple-libs" + assertProjectTargetProblems + "targets/multiple-libs" config + CmdRepl.selectPackageTargets + CmdRepl.selectComponentTarget + CmdRepl.TargetProblemCommon + [ ( flip CmdRepl.TargetProblemMatchesMultiple + [ AvailableTarget "p-0.1" (CLibName LMainLibName) + (TargetBuildable () TargetRequestedByDefault) True + , AvailableTarget "q-0.1" (CLibName LMainLibName) + (TargetBuildable () TargetRequestedByDefault) True + ] + , mkTargetAllPackages ) + ] + + reportSubCase "multiple-exes" + assertProjectTargetProblems + "targets/multiple-exes" config + CmdRepl.selectPackageTargets + CmdRepl.selectComponentTarget + CmdRepl.TargetProblemCommon + [ ( flip CmdRepl.TargetProblemMatchesMultiple + [ AvailableTarget "p-0.1" (CExeName "p2") + (TargetBuildable () TargetRequestedByDefault) True + , AvailableTarget "p-0.1" (CExeName "p1") + (TargetBuildable () TargetRequestedByDefault) True + ] + , mkTargetPackage "p-0.1" ) + ] + + reportSubCase "multiple-tests" + assertProjectTargetProblems + "targets/multiple-tests" config + CmdRepl.selectPackageTargets + CmdRepl.selectComponentTarget + CmdRepl.TargetProblemCommon + [ ( flip CmdRepl.TargetProblemMatchesMultiple + [ AvailableTarget "p-0.1" (CTestName "p2") + (TargetBuildable () TargetNotRequestedByDefault) True + , AvailableTarget "p-0.1" (CTestName "p1") + (TargetBuildable () TargetNotRequestedByDefault) True + ] + , TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind) ) + ] + + reportSubCase "multiple targets" + do (_,elaboratedPlan,_) <- planProject "targets/multiple-exes" config + assertProjectDistinctTargets + elaboratedPlan + CmdRepl.selectPackageTargets + CmdRepl.selectComponentTarget + CmdRepl.TargetProblemCommon + [ mkTargetComponent "p-0.1" (CExeName "p1") + , mkTargetComponent "p-0.1" (CExeName "p2") + ] + [ ("p-0.1-inplace-p1", CExeName "p1") + , ("p-0.1-inplace-p2", CExeName "p2") + ] + + reportSubCase "libs-disabled" + assertProjectTargetProblems + "targets/libs-disabled" config + CmdRepl.selectPackageTargets + CmdRepl.selectComponentTarget + CmdRepl.TargetProblemCommon + [ ( flip CmdRepl.TargetProblemNoneEnabled + [ AvailableTarget "p-0.1" (CLibName LMainLibName) TargetNotBuildable True ] + , mkTargetPackage "p-0.1" ) + ] + + reportSubCase "exes-disabled" + assertProjectTargetProblems + "targets/exes-disabled" config + CmdRepl.selectPackageTargets + CmdRepl.selectComponentTarget + CmdRepl.TargetProblemCommon + [ ( flip CmdRepl.TargetProblemNoneEnabled + [ AvailableTarget "p-0.1" (CExeName "p") TargetNotBuildable True + ] + , mkTargetPackage "p-0.1" ) + ] + + reportSubCase "test-only" + assertProjectTargetProblems + "targets/test-only" config + CmdRepl.selectPackageTargets + CmdRepl.selectComponentTarget + CmdRepl.TargetProblemCommon + [ ( flip CmdRepl.TargetProblemNoneEnabled + [ AvailableTarget "p-0.1" (CTestName "pexe") + (TargetBuildable () TargetNotRequestedByDefault) True + ] + , mkTargetPackage "p-0.1" ) + ] + + reportSubCase "empty-pkg" + assertProjectTargetProblems + "targets/empty-pkg" config + CmdRepl.selectPackageTargets + CmdRepl.selectComponentTarget + CmdRepl.TargetProblemCommon + [ ( CmdRepl.TargetProblemNoTargets, mkTargetPackage "p-0.1" ) + ] + + reportSubCase "requested component kinds" + do (_,elaboratedPlan,_) <- planProject "targets/variety" config + -- by default we only get the lib + assertProjectDistinctTargets + elaboratedPlan + CmdRepl.selectPackageTargets + CmdRepl.selectComponentTarget + CmdRepl.TargetProblemCommon + [ TargetPackage TargetExplicitNamed ["p-0.1"] Nothing ] + [ ("p-0.1-inplace", (CLibName LMainLibName)) ] + -- When we select the package with an explicit filter then we get those + -- components even though we did not explicitly enable tests/benchmarks + assertProjectDistinctTargets + elaboratedPlan + CmdRepl.selectPackageTargets + CmdRepl.selectComponentTarget + CmdRepl.TargetProblemCommon + [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind) ] + [ ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite") ] + assertProjectDistinctTargets + elaboratedPlan + CmdRepl.selectPackageTargets + CmdRepl.selectComponentTarget + CmdRepl.TargetProblemCommon + [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind) ] + [ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark") ] + + +testTargetProblemsRun :: ProjectConfig -> (String -> IO ()) -> Assertion +testTargetProblemsRun config reportSubCase = do + + reportSubCase "multiple-exes" + assertProjectTargetProblems + "targets/multiple-exes" config + CmdRun.selectPackageTargets + CmdRun.selectComponentTarget + CmdRun.TargetProblemCommon + [ ( flip CmdRun.TargetProblemMatchesMultiple + [ AvailableTarget "p-0.1" (CExeName "p2") + (TargetBuildable () TargetRequestedByDefault) True + , AvailableTarget "p-0.1" (CExeName "p1") + (TargetBuildable () TargetRequestedByDefault) True + ] + , mkTargetPackage "p-0.1" ) + ] + + reportSubCase "multiple targets" + do (_,elaboratedPlan,_) <- planProject "targets/multiple-exes" config + assertProjectDistinctTargets + elaboratedPlan + CmdRun.selectPackageTargets + CmdRun.selectComponentTarget + CmdRun.TargetProblemCommon + [ mkTargetComponent "p-0.1" (CExeName "p1") + , mkTargetComponent "p-0.1" (CExeName "p2") + ] + [ ("p-0.1-inplace-p1", CExeName "p1") + , ("p-0.1-inplace-p2", CExeName "p2") + ] + + reportSubCase "exes-disabled" + assertProjectTargetProblems + "targets/exes-disabled" config + CmdRun.selectPackageTargets + CmdRun.selectComponentTarget + CmdRun.TargetProblemCommon + [ ( flip CmdRun.TargetProblemNoneEnabled + [ AvailableTarget "p-0.1" (CExeName "p") TargetNotBuildable True + ] + , mkTargetPackage "p-0.1" ) + ] + + reportSubCase "empty-pkg" + assertProjectTargetProblems + "targets/empty-pkg" config + CmdRun.selectPackageTargets + CmdRun.selectComponentTarget + CmdRun.TargetProblemCommon + [ ( CmdRun.TargetProblemNoTargets, mkTargetPackage "p-0.1" ) + ] + + reportSubCase "lib-only" + assertProjectTargetProblems + "targets/lib-only" config + CmdRun.selectPackageTargets + CmdRun.selectComponentTarget + CmdRun.TargetProblemCommon + [ ( CmdRun.TargetProblemNoExes, mkTargetPackage "p-0.1" ) + ] + + +testTargetProblemsTest :: ProjectConfig -> (String -> IO ()) -> Assertion +testTargetProblemsTest config reportSubCase = do + + reportSubCase "disabled by config" + assertProjectTargetProblems + "targets/tests-disabled" + config { + projectConfigLocalPackages = (projectConfigLocalPackages config) { + packageConfigTests = toFlag False + } + } + CmdTest.selectPackageTargets + CmdTest.selectComponentTarget + CmdTest.TargetProblemCommon + [ ( flip CmdTest.TargetProblemNoneEnabled + [ AvailableTarget "p-0.1" (CTestName "user-disabled") + TargetDisabledByUser True + , AvailableTarget "p-0.1" (CTestName "solver-disabled") + TargetDisabledByUser True + ] + , mkTargetPackage "p-0.1" ) + ] + + reportSubCase "disabled by solver & buildable false" + assertProjectTargetProblems + "targets/tests-disabled" + config + CmdTest.selectPackageTargets + CmdTest.selectComponentTarget + CmdTest.TargetProblemCommon + [ ( flip CmdTest.TargetProblemNoneEnabled + [ AvailableTarget "p-0.1" (CTestName "user-disabled") + TargetDisabledBySolver True + , AvailableTarget "p-0.1" (CTestName "solver-disabled") + TargetDisabledBySolver True + ] + , mkTargetPackage "p-0.1" ) + + , ( flip CmdTest.TargetProblemNoneEnabled + [ AvailableTarget "q-0.1" (CTestName "buildable-false") + TargetNotBuildable True + ] + , mkTargetPackage "q-0.1" ) + ] + + reportSubCase "empty-pkg" + assertProjectTargetProblems + "targets/empty-pkg" config + CmdTest.selectPackageTargets + CmdTest.selectComponentTarget + CmdTest.TargetProblemCommon + [ ( CmdTest.TargetProblemNoTargets, mkTargetPackage "p-0.1" ) + ] + + reportSubCase "no tests" + assertProjectTargetProblems + "targets/simple" + config + CmdTest.selectPackageTargets + CmdTest.selectComponentTarget + CmdTest.TargetProblemCommon + [ ( CmdTest.TargetProblemNoTests, mkTargetPackage "p-0.1" ) + , ( CmdTest.TargetProblemNoTests, mkTargetPackage "q-0.1" ) + ] + + reportSubCase "not a test" + assertProjectTargetProblems + "targets/variety" + config + CmdTest.selectPackageTargets + CmdTest.selectComponentTarget + CmdTest.TargetProblemCommon $ + [ ( const (CmdTest.TargetProblemComponentNotTest + "p-0.1" (CLibName LMainLibName)) + , mkTargetComponent "p-0.1" (CLibName LMainLibName) ) + + , ( const (CmdTest.TargetProblemComponentNotTest + "p-0.1" (CExeName "an-exe")) + , mkTargetComponent "p-0.1" (CExeName "an-exe") ) + + , ( const (CmdTest.TargetProblemComponentNotTest + "p-0.1" (CFLibName "libp")) + , mkTargetComponent "p-0.1" (CFLibName "libp") ) + + , ( const (CmdTest.TargetProblemComponentNotTest + "p-0.1" (CBenchName "a-benchmark")) + , mkTargetComponent "p-0.1" (CBenchName "a-benchmark") ) + ] ++ + [ ( const (CmdTest.TargetProblemIsSubComponent + "p-0.1" cname (ModuleTarget modname)) + , mkTargetModule "p-0.1" cname modname ) + | (cname, modname) <- [ (CTestName "a-testsuite", "TestModule") + , (CBenchName "a-benchmark", "BenchModule") + , (CExeName "an-exe", "ExeModule") + , ((CLibName LMainLibName), "P") + ] + ] ++ + [ ( const (CmdTest.TargetProblemIsSubComponent + "p-0.1" cname (FileTarget fname)) + , mkTargetFile "p-0.1" cname fname) + | (cname, fname) <- [ (CTestName "a-testsuite", "Test.hs") + , (CBenchName "a-benchmark", "Bench.hs") + , (CExeName "an-exe", "Main.hs") + ] + ] + + +testTargetProblemsBench :: ProjectConfig -> (String -> IO ()) -> Assertion +testTargetProblemsBench config reportSubCase = do + + reportSubCase "disabled by config" + assertProjectTargetProblems + "targets/benchmarks-disabled" + config { + projectConfigLocalPackages = (projectConfigLocalPackages config) { + packageConfigBenchmarks = toFlag False + } + } + CmdBench.selectPackageTargets + CmdBench.selectComponentTarget + CmdBench.TargetProblemCommon + [ ( flip CmdBench.TargetProblemNoneEnabled + [ AvailableTarget "p-0.1" (CBenchName "user-disabled") + TargetDisabledByUser True + , AvailableTarget "p-0.1" (CBenchName "solver-disabled") + TargetDisabledByUser True + ] + , mkTargetPackage "p-0.1" ) + ] + + reportSubCase "disabled by solver & buildable false" + assertProjectTargetProblems + "targets/benchmarks-disabled" + config + CmdBench.selectPackageTargets + CmdBench.selectComponentTarget + CmdBench.TargetProblemCommon + [ ( flip CmdBench.TargetProblemNoneEnabled + [ AvailableTarget "p-0.1" (CBenchName "user-disabled") + TargetDisabledBySolver True + , AvailableTarget "p-0.1" (CBenchName "solver-disabled") + TargetDisabledBySolver True + ] + , mkTargetPackage "p-0.1" ) + + , ( flip CmdBench.TargetProblemNoneEnabled + [ AvailableTarget "q-0.1" (CBenchName "buildable-false") + TargetNotBuildable True + ] + , mkTargetPackage "q-0.1" ) + ] + + reportSubCase "empty-pkg" + assertProjectTargetProblems + "targets/empty-pkg" config + CmdBench.selectPackageTargets + CmdBench.selectComponentTarget + CmdBench.TargetProblemCommon + [ ( CmdBench.TargetProblemNoTargets, mkTargetPackage "p-0.1" ) + ] + + reportSubCase "no benchmarks" + assertProjectTargetProblems + "targets/simple" + config + CmdBench.selectPackageTargets + CmdBench.selectComponentTarget + CmdBench.TargetProblemCommon + [ ( CmdBench.TargetProblemNoBenchmarks, mkTargetPackage "p-0.1" ) + , ( CmdBench.TargetProblemNoBenchmarks, mkTargetPackage "q-0.1" ) + ] + + reportSubCase "not a benchmark" + assertProjectTargetProblems + "targets/variety" + config + CmdBench.selectPackageTargets + CmdBench.selectComponentTarget + CmdBench.TargetProblemCommon $ + [ ( const (CmdBench.TargetProblemComponentNotBenchmark + "p-0.1" (CLibName LMainLibName)) + , mkTargetComponent "p-0.1" (CLibName LMainLibName) ) + + , ( const (CmdBench.TargetProblemComponentNotBenchmark + "p-0.1" (CExeName "an-exe")) + , mkTargetComponent "p-0.1" (CExeName "an-exe") ) + + , ( const (CmdBench.TargetProblemComponentNotBenchmark + "p-0.1" (CFLibName "libp")) + , mkTargetComponent "p-0.1" (CFLibName "libp") ) + + , ( const (CmdBench.TargetProblemComponentNotBenchmark + "p-0.1" (CTestName "a-testsuite")) + , mkTargetComponent "p-0.1" (CTestName "a-testsuite") ) + ] ++ + [ ( const (CmdBench.TargetProblemIsSubComponent + "p-0.1" cname (ModuleTarget modname)) + , mkTargetModule "p-0.1" cname modname ) + | (cname, modname) <- [ (CTestName "a-testsuite", "TestModule") + , (CBenchName "a-benchmark", "BenchModule") + , (CExeName "an-exe", "ExeModule") + , ((CLibName LMainLibName), "P") + ] + ] ++ + [ ( const (CmdBench.TargetProblemIsSubComponent + "p-0.1" cname (FileTarget fname)) + , mkTargetFile "p-0.1" cname fname) + | (cname, fname) <- [ (CTestName "a-testsuite", "Test.hs") + , (CBenchName "a-benchmark", "Bench.hs") + , (CExeName "an-exe", "Main.hs") + ] + ] + + +testTargetProblemsHaddock :: ProjectConfig -> (String -> IO ()) -> Assertion +testTargetProblemsHaddock config reportSubCase = do + + reportSubCase "all-disabled" + assertProjectTargetProblems + "targets/all-disabled" + config + (let haddockFlags = mkHaddockFlags False True True False + in CmdHaddock.selectPackageTargets haddockFlags) + CmdHaddock.selectComponentTarget + CmdHaddock.TargetProblemCommon + [ ( flip CmdHaddock.TargetProblemNoneEnabled + [ AvailableTarget "p-0.1" (CBenchName "user-disabled") + TargetDisabledByUser True + , AvailableTarget "p-0.1" (CTestName "solver-disabled") + TargetDisabledBySolver True + , AvailableTarget "p-0.1" (CExeName "buildable-false") + TargetNotBuildable True + , AvailableTarget "p-0.1" (CLibName LMainLibName) + TargetNotBuildable True + ] + , mkTargetPackage "p-0.1" ) + ] + + reportSubCase "empty-pkg" + assertProjectTargetProblems + "targets/empty-pkg" config + (let haddockFlags = mkHaddockFlags False False False False + in CmdHaddock.selectPackageTargets haddockFlags) + CmdHaddock.selectComponentTarget + CmdHaddock.TargetProblemCommon + [ ( CmdHaddock.TargetProblemNoTargets, mkTargetPackage "p-0.1" ) + ] + + reportSubCase "enabled component kinds" + -- When we explicitly enable all the component kinds then selecting the + -- whole package selects those component kinds too + (_,elaboratedPlan,_) <- planProject "targets/variety" config + let haddockFlags = mkHaddockFlags True True True True + in assertProjectDistinctTargets + elaboratedPlan + (CmdHaddock.selectPackageTargets haddockFlags) + CmdHaddock.selectComponentTarget + CmdHaddock.TargetProblemCommon + [ mkTargetPackage "p-0.1" ] + [ ("p-0.1-inplace", (CLibName LMainLibName)) + , ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark") + , ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite") + , ("p-0.1-inplace-an-exe", CExeName "an-exe") + , ("p-0.1-inplace-libp", CFLibName "libp") + ] + + reportSubCase "disabled component kinds" + -- When we explicitly disable all the component kinds then selecting the + -- whole package only selects the library + let haddockFlags = mkHaddockFlags False False False False + in assertProjectDistinctTargets + elaboratedPlan + (CmdHaddock.selectPackageTargets haddockFlags) + CmdHaddock.selectComponentTarget + CmdHaddock.TargetProblemCommon + [ mkTargetPackage "p-0.1" ] + [ ("p-0.1-inplace", (CLibName LMainLibName)) ] + + reportSubCase "requested component kinds" + -- When we selecting the package with an explicit filter then it does not + -- matter if the config was to disable all the component kinds + let haddockFlags = mkHaddockFlags False False False False + in assertProjectDistinctTargets + elaboratedPlan + (CmdHaddock.selectPackageTargets haddockFlags) + CmdHaddock.selectComponentTarget + CmdHaddock.TargetProblemCommon + [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just FLibKind) + , TargetPackage TargetExplicitNamed ["p-0.1"] (Just ExeKind) + , TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind) + , TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind) + ] + [ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark") + , ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite") + , ("p-0.1-inplace-an-exe", CExeName "an-exe") + , ("p-0.1-inplace-libp", CFLibName "libp") + ] + where + mkHaddockFlags flib exe test bench = + defaultHaddockFlags { + haddockForeignLibs = toFlag flib, + haddockExecutables = toFlag exe, + haddockTestSuites = toFlag test, + haddockBenchmarks = toFlag bench + } + +assertProjectDistinctTargets + :: forall err. (Eq err, Show err) => + ElaboratedInstallPlan + -> (forall k. TargetSelector -> [AvailableTarget k] -> Either err [k]) + -> (forall k. SubComponentTarget -> AvailableTarget k -> Either err k ) + -> (TargetProblemCommon -> err) + -> [TargetSelector] + -> [(UnitId, ComponentName)] + -> Assertion +assertProjectDistinctTargets elaboratedPlan + selectPackageTargets + selectComponentTarget + liftProblem + targetSelectors + expectedTargets + | Right targets <- results + = distinctTargetComponents targets @?= Set.fromList expectedTargets + + | otherwise + = assertFailure $ "assertProjectDistinctTargets: expected " + ++ "(Right targets) but got " ++ show results + where + results = resolveTargets + selectPackageTargets + selectComponentTarget + liftProblem + elaboratedPlan + Nothing + targetSelectors + + +assertProjectTargetProblems + :: forall err. (Eq err, Show err) => + FilePath -> ProjectConfig + -> (forall k. TargetSelector + -> [AvailableTarget k] + -> Either err [k]) + -> (forall k. SubComponentTarget + -> AvailableTarget k + -> Either err k ) + -> (TargetProblemCommon -> err) + -> [(TargetSelector -> err, TargetSelector)] + -> Assertion +assertProjectTargetProblems testdir config + selectPackageTargets + selectComponentTarget + liftProblem + cases = do + (_,elaboratedPlan,_) <- planProject testdir config + assertTargetProblems + elaboratedPlan + selectPackageTargets + selectComponentTarget + liftProblem + cases + + +assertTargetProblems + :: forall err. (Eq err, Show err) => + ElaboratedInstallPlan + -> (forall k. TargetSelector -> [AvailableTarget k] -> Either err [k]) + -> (forall k. SubComponentTarget -> AvailableTarget k -> Either err k ) + -> (TargetProblemCommon -> err) + -> [(TargetSelector -> err, TargetSelector)] + -> Assertion +assertTargetProblems elaboratedPlan + selectPackageTargets + selectComponentTarget + liftProblem = + mapM_ (uncurry assertTargetProblem) + where + assertTargetProblem expected targetSelector = + let res = resolveTargets selectPackageTargets selectComponentTarget + liftProblem elaboratedPlan Nothing + [targetSelector] in + case res of + Left [problem] -> + problem @?= expected targetSelector + + unexpected -> + assertFailure $ "expected resolveTargets result: (Left [problem]) " + ++ "but got: " ++ show unexpected + + +testExceptionInFindingPackage :: ProjectConfig -> Assertion +testExceptionInFindingPackage config = do + BadPackageLocations _ locs <- expectException "BadPackageLocations" $ + void $ planProject testdir config + case locs of + [BadLocGlobEmptyMatch "./*.cabal"] -> return () + _ -> assertFailure "expected BadLocGlobEmptyMatch" + cleanProject testdir + where + testdir = "exception/no-pkg" + + +testExceptionInFindingPackage2 :: ProjectConfig -> Assertion +testExceptionInFindingPackage2 config = do + BadPackageLocations _ locs <- expectException "BadPackageLocations" $ + void $ planProject testdir config + case locs of + [BadPackageLocationFile (BadLocDirNoCabalFile ".")] -> return () + _ -> assertFailure $ "expected BadLocDirNoCabalFile, got " ++ show locs + cleanProject testdir + where + testdir = "exception/no-pkg2" + + +testExceptionInProjectConfig :: ProjectConfig -> Assertion +testExceptionInProjectConfig config = do + BadPerPackageCompilerPaths ps <- expectException "BadPerPackageCompilerPaths" $ + void $ planProject testdir config + case ps of + [(pn,"ghc")] | "foo" == pn -> return () + _ -> assertFailure $ "expected (PackageName \"foo\",\"ghc\"), got " + ++ show ps + cleanProject testdir + where + testdir = "exception/bad-config" + + +testExceptionInConfigureStep :: ProjectConfig -> Assertion +testExceptionInConfigureStep config = do + (plan, res) <- executePlan =<< planProject testdir config + (_pkga1, failure) <- expectPackageFailed plan res pkgidA1 + case buildFailureReason failure of + ConfigureFailed _ -> return () + _ -> assertFailure $ "expected ConfigureFailed, got " ++ show failure + cleanProject testdir + where + testdir = "exception/configure" + pkgidA1 = PackageIdentifier "a" (mkVersion [1]) + + +testExceptionInBuildStep :: ProjectConfig -> Assertion +testExceptionInBuildStep config = do + (plan, res) <- executePlan =<< planProject testdir config + (_pkga1, failure) <- expectPackageFailed plan res pkgidA1 + expectBuildFailed failure + where + testdir = "exception/build" + pkgidA1 = PackageIdentifier "a" (mkVersion [1]) + +testSetupScriptStyles :: ProjectConfig -> (String -> IO ()) -> Assertion +testSetupScriptStyles config reportSubCase = do + + reportSubCase (show SetupCustomExplicitDeps) + + plan0@(_,_,sharedConfig) <- planProject testdir1 config + + let isOSX (Platform _ OSX) = True + isOSX _ = False + -- Skip the Custom tests when the shipped Cabal library is buggy + unless (isOSX (pkgConfigPlatform sharedConfig) + && compilerVersion (pkgConfigCompiler sharedConfig) < mkVersion [7,10]) $ do + + (plan1, res1) <- executePlan plan0 + (pkg1, _) <- expectPackageInstalled plan1 res1 pkgidA + elabSetupScriptStyle pkg1 @?= SetupCustomExplicitDeps + hasDefaultSetupDeps pkg1 @?= Just False + marker1 <- readFile (basedir testdir1 "marker") + marker1 @?= "ok" + removeFile (basedir testdir1 "marker") + + -- implicit deps implies 'Cabal < 2' which conflicts w/ GHC 8.2 or later + when (compilerVersion (pkgConfigCompiler sharedConfig) < mkVersion [8,2]) $ do + reportSubCase (show SetupCustomImplicitDeps) + (plan2, res2) <- executePlan =<< planProject testdir2 config + (pkg2, _) <- expectPackageInstalled plan2 res2 pkgidA + elabSetupScriptStyle pkg2 @?= SetupCustomImplicitDeps + hasDefaultSetupDeps pkg2 @?= Just True + marker2 <- readFile (basedir testdir2 "marker") + marker2 @?= "ok" + removeFile (basedir testdir2 "marker") + + reportSubCase (show SetupNonCustomInternalLib) + (plan3, res3) <- executePlan =<< planProject testdir3 config + (pkg3, _) <- expectPackageInstalled plan3 res3 pkgidA + elabSetupScriptStyle pkg3 @?= SetupNonCustomInternalLib +{- + --TODO: the SetupNonCustomExternalLib case is hard to test since it + -- requires a version of Cabal that's later than the one we're testing + -- e.g. needs a .cabal file that specifies cabal-version: >= 2.0 + -- and a corresponding Cabal package that we can use to try and build a + -- default Setup.hs. + reportSubCase (show SetupNonCustomExternalLib) + (plan4, res4) <- executePlan =<< planProject testdir4 config + (pkg4, _) <- expectPackageInstalled plan4 res4 pkgidA + pkgSetupScriptStyle pkg4 @?= SetupNonCustomExternalLib +-} + where + testdir1 = "build/setup-custom1" + testdir2 = "build/setup-custom2" + testdir3 = "build/setup-simple" + pkgidA = PackageIdentifier "a" (mkVersion [0,1]) + -- The solver fills in default setup deps explicitly, but marks them as such + hasDefaultSetupDeps = fmap defaultSetupDepends + . setupBuildInfo . elabPkgDescription + +-- | Test the behaviour with and without @--keep-going@ +-- +testBuildKeepGoing :: ProjectConfig -> Assertion +testBuildKeepGoing config = do + -- P is expected to fail, Q does not depend on P but without + -- parallel build and without keep-going then we don't build Q yet. + (plan1, res1) <- executePlan =<< planProject testdir (config `mappend` keepGoing False) + (_, failure1) <- expectPackageFailed plan1 res1 "p-0.1" + expectBuildFailed failure1 + _ <- expectPackageConfigured plan1 res1 "q-0.1" + + -- With keep-going then we should go on to sucessfully build Q + (plan2, res2) <- executePlan + =<< planProject testdir (config `mappend` keepGoing True) + (_, failure2) <- expectPackageFailed plan2 res2 "p-0.1" + expectBuildFailed failure2 + _ <- expectPackageInstalled plan2 res2 "q-0.1" + return () + where + testdir = "build/keep-going" + keepGoing kg = + mempty { + projectConfigBuildOnly = mempty { + projectConfigKeepGoing = toFlag kg + } + } + +-- | Test we can successfully build packages from local tarball files. +-- +testBuildLocalTarball :: ProjectConfig -> Assertion +testBuildLocalTarball config = do + -- P is a tarball package, Q is a local dir package that depends on it. + (plan, res) <- executePlan =<< planProject testdir config + _ <- expectPackageInstalled plan res "p-0.1" + _ <- expectPackageInstalled plan res "q-0.1" + return () + where + testdir = "build/local-tarball" + +-- | See +-- +testRegressionIssue3324 :: ProjectConfig -> Assertion +testRegressionIssue3324 config = do + -- expected failure first time due to missing dep + (plan1, res1) <- executePlan =<< planProject testdir config + (_pkgq, failure) <- expectPackageFailed plan1 res1 "q-0.1" + expectBuildFailed failure + + -- add the missing dep, now it should work + let qcabal = basedir testdir "q" "q.cabal" + withFileFinallyRestore qcabal $ do + appendFile qcabal (" build-depends: p\n") + (plan2, res2) <- executePlan =<< planProject testdir config + _ <- expectPackageInstalled plan2 res2 "p-0.1" + _ <- expectPackageInstalled plan2 res2 "q-0.1" + return () + where + testdir = "regression/3324" + + +--------------------------------- +-- Test utils to plan and build +-- + +basedir :: FilePath +basedir = "tests" "IntegrationTests2" + +dirActions :: FilePath -> TS.DirActions IO +dirActions testdir = + defaultDirActions { + TS.doesFileExist = \p -> + TS.doesFileExist defaultDirActions (virtcwd p), + + TS.doesDirectoryExist = \p -> + TS.doesDirectoryExist defaultDirActions (virtcwd p), + + TS.canonicalizePath = \p -> + TS.canonicalizePath defaultDirActions (virtcwd p), + + TS.getCurrentDirectory = + TS.canonicalizePath defaultDirActions virtcwd + } + where + virtcwd = basedir testdir + +type ProjDetails = (DistDirLayout, + CabalDirLayout, + ProjectConfig, + [PackageSpecifier UnresolvedSourcePackage], + BuildTimeSettings) + +configureProject :: FilePath -> ProjectConfig -> IO ProjDetails +configureProject testdir cliConfig = do + cabalDir <- getCabalDir + let cabalDirLayout = defaultCabalDirLayout cabalDir + + projectRootDir <- canonicalizePath (basedir testdir) + isexplict <- doesFileExist (projectRootDir "cabal.project") + let projectRoot + | isexplict = ProjectRootExplicit projectRootDir + (projectRootDir "cabal.project") + | otherwise = ProjectRootImplicit projectRootDir + distDirLayout = defaultDistDirLayout projectRoot Nothing + + -- Clear state between test runs. The state remains if the previous run + -- ended in an exception (as we leave the files to help with debugging). + cleanProject testdir + + (projectConfig, localPackages) <- + rebuildProjectConfig verbosity + distDirLayout + cliConfig + + let buildSettings = resolveBuildTimeSettings + verbosity cabalDirLayout + projectConfig + + return (distDirLayout, + cabalDirLayout, + projectConfig, + localPackages, + buildSettings) + +type PlanDetails = (ProjDetails, + ElaboratedInstallPlan, + ElaboratedSharedConfig) + +planProject :: FilePath -> ProjectConfig -> IO PlanDetails +planProject testdir cliConfig = do + + projDetails@ + (distDirLayout, + cabalDirLayout, + projectConfig, + localPackages, + _buildSettings) <- configureProject testdir cliConfig + + (elaboratedPlan, _, elaboratedShared) <- + rebuildInstallPlan verbosity + distDirLayout cabalDirLayout + projectConfig + localPackages + + return (projDetails, + elaboratedPlan, + elaboratedShared) + +executePlan :: PlanDetails -> IO (ElaboratedInstallPlan, BuildOutcomes) +executePlan ((distDirLayout, cabalDirLayout, _, _, buildSettings), + elaboratedPlan, + elaboratedShared) = do + + let targets :: Map.Map UnitId [ComponentTarget] + targets = + Map.fromList + [ (unitid, [ComponentTarget cname WholeComponent]) + | ts <- Map.elems (availableTargets elaboratedPlan) + , AvailableTarget { + availableTargetStatus = TargetBuildable (unitid, cname) _ + } <- ts + ] + elaboratedPlan' = pruneInstallPlanToTargets + TargetActionBuild targets + elaboratedPlan + + pkgsBuildStatus <- + rebuildTargetsDryRun distDirLayout elaboratedShared + elaboratedPlan' + + let elaboratedPlan'' = improveInstallPlanWithUpToDatePackages + pkgsBuildStatus elaboratedPlan' + + buildOutcomes <- + rebuildTargets verbosity + distDirLayout + (cabalStoreDirLayout cabalDirLayout) + elaboratedPlan'' + elaboratedShared + pkgsBuildStatus + -- Avoid trying to use act-as-setup mode: + buildSettings { buildSettingNumJobs = 1 } + + return (elaboratedPlan'', buildOutcomes) + +cleanProject :: FilePath -> IO () +cleanProject testdir = do + alreadyExists <- doesDirectoryExist distDir + when alreadyExists $ removeDirectoryRecursive distDir + where + projectRoot = ProjectRootImplicit (basedir testdir) + distDirLayout = defaultDistDirLayout projectRoot Nothing + distDir = distDirectory distDirLayout + + +verbosity :: Verbosity +verbosity = minBound --normal --verbose --maxBound --minBound + + + +------------------------------------------- +-- Tasty integration to adjust the config +-- + +withProjectConfig :: (ProjectConfig -> TestTree) -> TestTree +withProjectConfig testtree = + askOption $ \ghcPath -> + testtree (mkProjectConfig ghcPath) + +mkProjectConfig :: GhcPath -> ProjectConfig +mkProjectConfig (GhcPath ghcPath) = + mempty { + projectConfigShared = mempty { + projectConfigHcPath = maybeToFlag ghcPath + }, + projectConfigBuildOnly = mempty { + projectConfigNumJobs = toFlag (Just 1) + } + } + where + maybeToFlag = maybe mempty toFlag + + +data GhcPath = GhcPath (Maybe FilePath) + deriving Typeable + +instance IsOption GhcPath where + defaultValue = GhcPath Nothing + optionName = Tagged "with-ghc" + optionHelp = Tagged "The ghc compiler to use" + parseValue = Just . GhcPath . Just + +projectConfigOptionDescriptions :: [OptionDescription] +projectConfigOptionDescriptions = [Option (Proxy :: Proxy GhcPath)] + + +--------------------------------------- +-- HUint style utils for this context +-- + +expectException :: Exception e => String -> IO a -> IO e +expectException expected action = do + res <- try action + case res of + Left e -> return e + Right _ -> throwIO $ HUnitFailure Nothing $ "expected an exception " ++ expected + +expectPackagePreExisting :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId + -> IO InstalledPackageInfo +expectPackagePreExisting plan buildOutcomes pkgid = do + planpkg <- expectPlanPackage plan pkgid + case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of + (InstallPlan.PreExisting pkg, Nothing) + -> return pkg + (_, buildResult) -> unexpectedBuildResult "PreExisting" planpkg buildResult + +expectPackageConfigured :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId + -> IO ElaboratedConfiguredPackage +expectPackageConfigured plan buildOutcomes pkgid = do + planpkg <- expectPlanPackage plan pkgid + case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of + (InstallPlan.Configured pkg, Nothing) + -> return pkg + (_, buildResult) -> unexpectedBuildResult "Configured" planpkg buildResult + +expectPackageInstalled :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId + -> IO (ElaboratedConfiguredPackage, BuildResult) +expectPackageInstalled plan buildOutcomes pkgid = do + planpkg <- expectPlanPackage plan pkgid + case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of + (InstallPlan.Configured pkg, Just (Right result)) + -> return (pkg, result) + (_, buildResult) -> unexpectedBuildResult "Installed" planpkg buildResult + +expectPackageFailed :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId + -> IO (ElaboratedConfiguredPackage, BuildFailure) +expectPackageFailed plan buildOutcomes pkgid = do + planpkg <- expectPlanPackage plan pkgid + case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of + (InstallPlan.Configured pkg, Just (Left failure)) + -> return (pkg, failure) + (_, buildResult) -> unexpectedBuildResult "Failed" planpkg buildResult + +unexpectedBuildResult :: String -> ElaboratedPlanPackage + -> Maybe (Either BuildFailure BuildResult) -> IO a +unexpectedBuildResult expected planpkg buildResult = + throwIO $ HUnitFailure Nothing $ + "expected to find " ++ display (packageId planpkg) ++ " in the " + ++ expected ++ " state, but it is actually in the " ++ actual ++ " state." + where + actual = case (buildResult, planpkg) of + (Nothing, InstallPlan.PreExisting{}) -> "PreExisting" + (Nothing, InstallPlan.Configured{}) -> "Configured" + (Just (Right _), InstallPlan.Configured{}) -> "Installed" + (Just (Left _), InstallPlan.Configured{}) -> "Failed" + _ -> "Impossible!" + +expectPlanPackage :: ElaboratedInstallPlan -> PackageId + -> IO ElaboratedPlanPackage +expectPlanPackage plan pkgid = + case [ pkg + | pkg <- InstallPlan.toList plan + , packageId pkg == pkgid ] of + [pkg] -> return pkg + [] -> throwIO $ HUnitFailure Nothing $ + "expected to find " ++ display pkgid + ++ " in the install plan but it's not there" + _ -> throwIO $ HUnitFailure Nothing $ + "expected to find only one instance of " ++ display pkgid + ++ " in the install plan but there's several" + +expectBuildFailed :: BuildFailure -> IO () +expectBuildFailed (BuildFailure _ (BuildFailed _)) = return () +expectBuildFailed (BuildFailure _ reason) = + assertFailure $ "expected BuildFailed, got " ++ show reason + +--------------------------------------- +-- Other utils +-- + +-- | Allow altering a file during a test, but then restore it afterwards +-- +withFileFinallyRestore :: FilePath -> IO a -> IO a +withFileFinallyRestore file action = do + copyFile file backup + action `finally` renameFile backup file + where + backup = file <.> "backup" diff --git a/cabal-install/tests/IntegrationTests2/build/keep-going/cabal.project b/cabal-install/tests/IntegrationTests2/build/keep-going/cabal.project new file mode 100644 index 00000000..085b1161 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/keep-going/cabal.project @@ -0,0 +1 @@ +packages: p q diff --git a/cabal-install/tests/IntegrationTests2/build/keep-going/p/P.hs b/cabal-install/tests/IntegrationTests2/build/keep-going/p/P.hs new file mode 100644 index 00000000..671dabe8 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/keep-going/p/P.hs @@ -0,0 +1,4 @@ +module P where + +p :: Int +p = this_is_not_expected_to_compile diff --git a/cabal-install/tests/IntegrationTests2/build/keep-going/p/p.cabal b/cabal-install/tests/IntegrationTests2/build/keep-going/p/p.cabal new file mode 100644 index 00000000..6a10e9f9 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/keep-going/p/p.cabal @@ -0,0 +1,8 @@ +name: p +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: P + build-depends: base diff --git a/cabal-install/tests/IntegrationTests2/build/keep-going/q/Q.hs b/cabal-install/tests/IntegrationTests2/build/keep-going/q/Q.hs new file mode 100644 index 00000000..3ff2e292 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/keep-going/q/Q.hs @@ -0,0 +1,4 @@ +module Q where + +q :: Int +q = 42 diff --git a/cabal-install/tests/IntegrationTests2/build/keep-going/q/q.cabal b/cabal-install/tests/IntegrationTests2/build/keep-going/q/q.cabal new file mode 100644 index 00000000..0e040e0c --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/keep-going/q/q.cabal @@ -0,0 +1,9 @@ +name: q +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: Q + build-depends: base + diff --git a/cabal-install/tests/IntegrationTests2/build/local-tarball/cabal.project b/cabal-install/tests/IntegrationTests2/build/local-tarball/cabal.project new file mode 100644 index 00000000..f1295f0e --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/local-tarball/cabal.project @@ -0,0 +1,2 @@ +packages: p-0.1.tar.gz + q/ diff --git a/cabal-install/tests/IntegrationTests2/build/local-tarball/p-0.1.tar.gz b/cabal-install/tests/IntegrationTests2/build/local-tarball/p-0.1.tar.gz new file mode 100644 index 00000000..ba8b45a9 Binary files /dev/null and b/cabal-install/tests/IntegrationTests2/build/local-tarball/p-0.1.tar.gz differ diff --git a/cabal-install/tests/IntegrationTests2/build/local-tarball/q/Q.hs b/cabal-install/tests/IntegrationTests2/build/local-tarball/q/Q.hs new file mode 100644 index 00000000..d144e58c --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/local-tarball/q/Q.hs @@ -0,0 +1,5 @@ +module Q where + +import P + +q = p ++ " world" diff --git a/cabal-install/tests/IntegrationTests2/build/local-tarball/q/q.cabal b/cabal-install/tests/IntegrationTests2/build/local-tarball/q/q.cabal new file mode 100644 index 00000000..6021a0be --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/local-tarball/q/q.cabal @@ -0,0 +1,8 @@ +name: q +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: Q + build-depends: base, p diff --git a/cabal-install/tests/IntegrationTests2/build/setup-custom1/A.hs b/cabal-install/tests/IntegrationTests2/build/setup-custom1/A.hs new file mode 100644 index 00000000..9dcbc075 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/setup-custom1/A.hs @@ -0,0 +1,4 @@ +module A where + +a :: Int +a = 42 diff --git a/cabal-install/tests/IntegrationTests2/build/setup-custom1/Setup.hs b/cabal-install/tests/IntegrationTests2/build/setup-custom1/Setup.hs new file mode 100644 index 00000000..ebab708a --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/setup-custom1/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain >> writeFile "marker" "ok" diff --git a/cabal-install/tests/IntegrationTests2/build/setup-custom1/a.cabal b/cabal-install/tests/IntegrationTests2/build/setup-custom1/a.cabal new file mode 100644 index 00000000..c3778a7b --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/setup-custom1/a.cabal @@ -0,0 +1,13 @@ +name: a +version: 0.1 +build-type: Custom +cabal-version: >= 1.10 + +-- explicit setup deps: +custom-setup + setup-depends: base, Cabal >= 1.18 + +library + exposed-modules: A + build-depends: base + default-language: Haskell2010 diff --git a/cabal-install/tests/IntegrationTests2/build/setup-custom2/A.hs b/cabal-install/tests/IntegrationTests2/build/setup-custom2/A.hs new file mode 100644 index 00000000..9dcbc075 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/setup-custom2/A.hs @@ -0,0 +1,4 @@ +module A where + +a :: Int +a = 42 diff --git a/cabal-install/tests/IntegrationTests2/build/setup-custom2/Setup.hs b/cabal-install/tests/IntegrationTests2/build/setup-custom2/Setup.hs new file mode 100644 index 00000000..ebab708a --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/setup-custom2/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain >> writeFile "marker" "ok" diff --git a/cabal-install/tests/IntegrationTests2/build/setup-custom2/a.cabal b/cabal-install/tests/IntegrationTests2/build/setup-custom2/a.cabal new file mode 100644 index 00000000..e3c9ed6b --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/setup-custom2/a.cabal @@ -0,0 +1,11 @@ +name: a +version: 0.1 +build-type: Custom +cabal-version: >= 1.10 + +-- no explicit setup deps + +library + exposed-modules: A + build-depends: base + default-language: Haskell2010 diff --git a/cabal-install/tests/IntegrationTests2/build/setup-simple/A.hs b/cabal-install/tests/IntegrationTests2/build/setup-simple/A.hs new file mode 100644 index 00000000..9dcbc075 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/setup-simple/A.hs @@ -0,0 +1,4 @@ +module A where + +a :: Int +a = 42 diff --git a/cabal-install/tests/IntegrationTests2/build/setup-simple/Setup.hs b/cabal-install/tests/IntegrationTests2/build/setup-simple/Setup.hs new file mode 100644 index 00000000..9a994af6 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/setup-simple/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cabal-install/tests/IntegrationTests2/build/setup-simple/a.cabal b/cabal-install/tests/IntegrationTests2/build/setup-simple/a.cabal new file mode 100644 index 00000000..f4760048 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/build/setup-simple/a.cabal @@ -0,0 +1,9 @@ +name: a +version: 0.1 +build-type: Simple +cabal-version: >= 1.10 + +library + exposed-modules: A + build-depends: base + default-language: Haskell2010 diff --git a/cabal-install/tests/IntegrationTests2/exception/bad-config/cabal.project b/cabal-install/tests/IntegrationTests2/exception/bad-config/cabal.project new file mode 100644 index 00000000..42cd62e7 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/exception/bad-config/cabal.project @@ -0,0 +1,4 @@ +packages: + +package foo + ghc-location: bar diff --git a/cabal-install/tests/IntegrationTests2/exception/build/Main.hs b/cabal-install/tests/IntegrationTests2/exception/build/Main.hs new file mode 100644 index 00000000..f45e02d0 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/exception/build/Main.hs @@ -0,0 +1 @@ +main = thisNameDoesNotExist diff --git a/cabal-install/tests/IntegrationTests2/exception/build/a.cabal b/cabal-install/tests/IntegrationTests2/exception/build/a.cabal new file mode 100644 index 00000000..1c44505c --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/exception/build/a.cabal @@ -0,0 +1,8 @@ +name: a +version: 1 +build-type: Simple +cabal-version: >= 1.2 + +executable a + main-is: Main.hs + build-depends: base diff --git a/cabal-install/tests/IntegrationTests2/exception/configure/a.cabal b/cabal-install/tests/IntegrationTests2/exception/configure/a.cabal new file mode 100644 index 00000000..f0bf220b --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/exception/configure/a.cabal @@ -0,0 +1,9 @@ +name: a +version: 1 +build-type: Simple +-- This used to be a blank package with no components, +-- but I refactored new-build so that if a package has +-- no buildable components, we skip configuring it. +-- So put in a (failing) component so that we try to +-- configure. +executable a diff --git a/cabal-install/tests/IntegrationTests2/exception/no-pkg/empty.in b/cabal-install/tests/IntegrationTests2/exception/no-pkg/empty.in new file mode 100644 index 00000000..30bfff1d --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/exception/no-pkg/empty.in @@ -0,0 +1 @@ +this is just here to ensure the source control creates the dir diff --git a/cabal-install/tests/IntegrationTests2/exception/no-pkg2/cabal.project b/cabal-install/tests/IntegrationTests2/exception/no-pkg2/cabal.project new file mode 100644 index 00000000..6f920794 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/exception/no-pkg2/cabal.project @@ -0,0 +1 @@ +packages: ./ diff --git a/cabal-install/tests/IntegrationTests2/regression/3324/cabal.project b/cabal-install/tests/IntegrationTests2/regression/3324/cabal.project new file mode 100644 index 00000000..085b1161 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/regression/3324/cabal.project @@ -0,0 +1 @@ +packages: p q diff --git a/cabal-install/tests/IntegrationTests2/regression/3324/p/P.hs b/cabal-install/tests/IntegrationTests2/regression/3324/p/P.hs new file mode 100644 index 00000000..7fdc3231 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/regression/3324/p/P.hs @@ -0,0 +1,4 @@ +module P where + +p :: Int +p = 42 diff --git a/cabal-install/tests/IntegrationTests2/regression/3324/p/p.cabal b/cabal-install/tests/IntegrationTests2/regression/3324/p/p.cabal new file mode 100644 index 00000000..6a10e9f9 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/regression/3324/p/p.cabal @@ -0,0 +1,8 @@ +name: p +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: P + build-depends: base diff --git a/cabal-install/tests/IntegrationTests2/regression/3324/q/Q.hs b/cabal-install/tests/IntegrationTests2/regression/3324/q/Q.hs new file mode 100644 index 00000000..7a66f617 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/regression/3324/q/Q.hs @@ -0,0 +1,6 @@ +module Q where + +import P + +q :: Int +q = p diff --git a/cabal-install/tests/IntegrationTests2/regression/3324/q/q.cabal b/cabal-install/tests/IntegrationTests2/regression/3324/q/q.cabal new file mode 100644 index 00000000..d1b75535 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/regression/3324/q/q.cabal @@ -0,0 +1,9 @@ +name: q +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: Q + build-depends: base + -- missing a dep on p here, so expect failure initially diff --git a/cabal-install/tests/IntegrationTests2/targets/all-disabled/cabal.project b/cabal-install/tests/IntegrationTests2/targets/all-disabled/cabal.project new file mode 100644 index 00000000..6f920794 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/all-disabled/cabal.project @@ -0,0 +1 @@ +packages: ./ diff --git a/cabal-install/tests/IntegrationTests2/targets/all-disabled/p.cabal b/cabal-install/tests/IntegrationTests2/targets/all-disabled/p.cabal new file mode 100644 index 00000000..ac511205 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/all-disabled/p.cabal @@ -0,0 +1,23 @@ +name: p +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: Q + build-depends: base, filepath + buildable: False + +executable buildable-false + main-is: Main.hs + buildable: False + +test-suite solver-disabled + type: exitcode-stdio-1.0 + main-is: Test.hs + build-depends: a-package-that-does-not-exist + +benchmark user-disabled + type: exitcode-stdio-1.0 + main-is: Test.hs + diff --git a/cabal-install/tests/IntegrationTests2/targets/benchmarks-disabled/cabal.project b/cabal-install/tests/IntegrationTests2/targets/benchmarks-disabled/cabal.project new file mode 100644 index 00000000..5382e5df --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/benchmarks-disabled/cabal.project @@ -0,0 +1 @@ +packages: ./ ./q/ diff --git a/cabal-install/tests/IntegrationTests2/targets/benchmarks-disabled/p.cabal b/cabal-install/tests/IntegrationTests2/targets/benchmarks-disabled/p.cabal new file mode 100644 index 00000000..c3f2b537 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/benchmarks-disabled/p.cabal @@ -0,0 +1,15 @@ +name: p +version: 0.1 +build-type: Simple +cabal-version: >= 1.10 + +benchmark solver-disabled + type: exitcode-stdio-1.0 + main-is: Test.hs + build-depends: a-package-that-does-not-exist + +benchmark user-disabled + type: exitcode-stdio-1.0 + main-is: Test.hs + build-depends: base + diff --git a/cabal-install/tests/IntegrationTests2/targets/benchmarks-disabled/q/q.cabal b/cabal-install/tests/IntegrationTests2/targets/benchmarks-disabled/q/q.cabal new file mode 100644 index 00000000..79b4d5f1 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/benchmarks-disabled/q/q.cabal @@ -0,0 +1,10 @@ +name: q +version: 0.1 +build-type: Simple +cabal-version: >= 1.10 + +benchmark buildable-false + type: exitcode-stdio-1.0 + main-is: Main.hs + buildable: False + diff --git a/cabal-install/tests/IntegrationTests2/targets/complex/cabal.project b/cabal-install/tests/IntegrationTests2/targets/complex/cabal.project new file mode 100644 index 00000000..c58dcdd9 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/complex/cabal.project @@ -0,0 +1 @@ +packages: q/ diff --git a/cabal-install/tests/IntegrationTests2/targets/complex/q/Q.hs b/cabal-install/tests/IntegrationTests2/targets/complex/q/Q.hs new file mode 100644 index 00000000..e69de29b diff --git a/cabal-install/tests/IntegrationTests2/targets/complex/q/q.cabal b/cabal-install/tests/IntegrationTests2/targets/complex/q/q.cabal new file mode 100644 index 00000000..556fa4a4 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/complex/q/q.cabal @@ -0,0 +1,22 @@ +name: q +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: Q + build-depends: base, filepath + +executable buildable-false + main-is: Main.hs + buildable: False + +test-suite solver-disabled + type: exitcode-stdio-1.0 + main-is: Test.hs + build-depends: a-package-that-does-not-exist + +benchmark user-disabled + type: exitcode-stdio-1.0 + main-is: Test.hs + diff --git a/cabal-install/tests/IntegrationTests2/targets/empty-pkg/cabal.project b/cabal-install/tests/IntegrationTests2/targets/empty-pkg/cabal.project new file mode 100644 index 00000000..6f920794 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/empty-pkg/cabal.project @@ -0,0 +1 @@ +packages: ./ diff --git a/cabal-install/tests/IntegrationTests2/targets/empty-pkg/p.cabal b/cabal-install/tests/IntegrationTests2/targets/empty-pkg/p.cabal new file mode 100644 index 00000000..6a3b6740 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/empty-pkg/p.cabal @@ -0,0 +1,5 @@ +name: p +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + diff --git a/cabal-install/tests/IntegrationTests2/targets/empty/cabal.project b/cabal-install/tests/IntegrationTests2/targets/empty/cabal.project new file mode 100644 index 00000000..9186b109 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/empty/cabal.project @@ -0,0 +1 @@ +packages: diff --git a/cabal-install/tests/IntegrationTests2/targets/empty/foo.hs b/cabal-install/tests/IntegrationTests2/targets/empty/foo.hs new file mode 100644 index 00000000..e69de29b diff --git a/cabal-install/tests/IntegrationTests2/targets/exes-disabled/cabal.project b/cabal-install/tests/IntegrationTests2/targets/exes-disabled/cabal.project new file mode 100644 index 00000000..36c6791d --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/exes-disabled/cabal.project @@ -0,0 +1 @@ +packages: p/ q/ diff --git a/cabal-install/tests/IntegrationTests2/targets/exes-disabled/p/p.cabal b/cabal-install/tests/IntegrationTests2/targets/exes-disabled/p/p.cabal new file mode 100644 index 00000000..b3746da7 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/exes-disabled/p/p.cabal @@ -0,0 +1,9 @@ +name: p +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +executable p + main-is: P.hs + build-depends: base + buildable: False diff --git a/cabal-install/tests/IntegrationTests2/targets/exes-disabled/q/q.cabal b/cabal-install/tests/IntegrationTests2/targets/exes-disabled/q/q.cabal new file mode 100644 index 00000000..5dd6d489 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/exes-disabled/q/q.cabal @@ -0,0 +1,9 @@ +name: q +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +executable q + main-is: Q.hs + build-depends: base + buildable: False diff --git a/cabal-install/tests/IntegrationTests2/targets/lib-only/p.cabal b/cabal-install/tests/IntegrationTests2/targets/lib-only/p.cabal new file mode 100644 index 00000000..6a10e9f9 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/lib-only/p.cabal @@ -0,0 +1,8 @@ +name: p +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: P + build-depends: base diff --git a/cabal-install/tests/IntegrationTests2/targets/libs-disabled/cabal.project b/cabal-install/tests/IntegrationTests2/targets/libs-disabled/cabal.project new file mode 100644 index 00000000..36c6791d --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/libs-disabled/cabal.project @@ -0,0 +1 @@ +packages: p/ q/ diff --git a/cabal-install/tests/IntegrationTests2/targets/libs-disabled/p/p.cabal b/cabal-install/tests/IntegrationTests2/targets/libs-disabled/p/p.cabal new file mode 100644 index 00000000..1ee5f2b1 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/libs-disabled/p/p.cabal @@ -0,0 +1,9 @@ +name: p +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: P + build-depends: base + buildable: False diff --git a/cabal-install/tests/IntegrationTests2/targets/libs-disabled/q/q.cabal b/cabal-install/tests/IntegrationTests2/targets/libs-disabled/q/q.cabal new file mode 100644 index 00000000..8f75859e --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/libs-disabled/q/q.cabal @@ -0,0 +1,9 @@ +name: q +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: Q + build-depends: base + buildable: False diff --git a/cabal-install/tests/IntegrationTests2/targets/multiple-exes/cabal.project b/cabal-install/tests/IntegrationTests2/targets/multiple-exes/cabal.project new file mode 100644 index 00000000..6f920794 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/multiple-exes/cabal.project @@ -0,0 +1 @@ +packages: ./ diff --git a/cabal-install/tests/IntegrationTests2/targets/multiple-exes/p.cabal b/cabal-install/tests/IntegrationTests2/targets/multiple-exes/p.cabal new file mode 100644 index 00000000..5f3edf5c --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/multiple-exes/p.cabal @@ -0,0 +1,12 @@ +name: p +version: 0.1 +build-type: Simple +cabal-version: >= 1.10 + +executable p1 + main-is: P1.hs + build-depends: base + +executable p2 + main-is: P2.hs + build-depends: base diff --git a/cabal-install/tests/IntegrationTests2/targets/multiple-libs/cabal.project b/cabal-install/tests/IntegrationTests2/targets/multiple-libs/cabal.project new file mode 100644 index 00000000..36c6791d --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/multiple-libs/cabal.project @@ -0,0 +1 @@ +packages: p/ q/ diff --git a/cabal-install/tests/IntegrationTests2/targets/multiple-libs/p/p.cabal b/cabal-install/tests/IntegrationTests2/targets/multiple-libs/p/p.cabal new file mode 100644 index 00000000..6a10e9f9 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/multiple-libs/p/p.cabal @@ -0,0 +1,8 @@ +name: p +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: P + build-depends: base diff --git a/cabal-install/tests/IntegrationTests2/targets/multiple-libs/q/q.cabal b/cabal-install/tests/IntegrationTests2/targets/multiple-libs/q/q.cabal new file mode 100644 index 00000000..30331517 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/multiple-libs/q/q.cabal @@ -0,0 +1,8 @@ +name: q +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: Q + build-depends: base diff --git a/cabal-install/tests/IntegrationTests2/targets/multiple-tests/cabal.project b/cabal-install/tests/IntegrationTests2/targets/multiple-tests/cabal.project new file mode 100644 index 00000000..6f920794 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/multiple-tests/cabal.project @@ -0,0 +1 @@ +packages: ./ diff --git a/cabal-install/tests/IntegrationTests2/targets/multiple-tests/p.cabal b/cabal-install/tests/IntegrationTests2/targets/multiple-tests/p.cabal new file mode 100644 index 00000000..2816cf2d --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/multiple-tests/p.cabal @@ -0,0 +1,14 @@ +name: p +version: 0.1 +build-type: Simple +cabal-version: >= 1.10 + +test-suite p1 + type: exitcode-stdio-1.0 + main-is: P1.hs + build-depends: base + +test-suite p2 + type: exitcode-stdio-1.0 + main-is: P2.hs + build-depends: base diff --git a/cabal-install/tests/IntegrationTests2/targets/simple/P.hs b/cabal-install/tests/IntegrationTests2/targets/simple/P.hs new file mode 100644 index 00000000..e69de29b diff --git a/cabal-install/tests/IntegrationTests2/targets/simple/cabal.project b/cabal-install/tests/IntegrationTests2/targets/simple/cabal.project new file mode 100644 index 00000000..97e14438 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/simple/cabal.project @@ -0,0 +1 @@ +packages: ./ q/ diff --git a/cabal-install/tests/IntegrationTests2/targets/simple/p.cabal b/cabal-install/tests/IntegrationTests2/targets/simple/p.cabal new file mode 100644 index 00000000..4f7f5e38 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/simple/p.cabal @@ -0,0 +1,12 @@ +name: p +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: P + build-depends: base + +executable pexe + main-is: Main.hs + other-modules: PMain diff --git a/cabal-install/tests/IntegrationTests2/targets/simple/q/QQ.hs b/cabal-install/tests/IntegrationTests2/targets/simple/q/QQ.hs new file mode 100644 index 00000000..e69de29b diff --git a/cabal-install/tests/IntegrationTests2/targets/simple/q/q.cabal b/cabal-install/tests/IntegrationTests2/targets/simple/q/q.cabal new file mode 100644 index 00000000..d8a3609d --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/simple/q/q.cabal @@ -0,0 +1,12 @@ +name: q +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: QQ + build-depends: base + +executable qexe + main-is: Main.hs + other-modules: QMain diff --git a/cabal-install/tests/IntegrationTests2/targets/test-only/p.cabal b/cabal-install/tests/IntegrationTests2/targets/test-only/p.cabal new file mode 100644 index 00000000..ed911644 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/test-only/p.cabal @@ -0,0 +1,9 @@ +name: p +version: 0.1 +build-type: Simple +cabal-version: >= 1.2 + +test-suite pexe + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: PMain diff --git a/cabal-install/tests/IntegrationTests2/targets/tests-disabled/cabal.project b/cabal-install/tests/IntegrationTests2/targets/tests-disabled/cabal.project new file mode 100644 index 00000000..5382e5df --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/tests-disabled/cabal.project @@ -0,0 +1 @@ +packages: ./ ./q/ diff --git a/cabal-install/tests/IntegrationTests2/targets/tests-disabled/p.cabal b/cabal-install/tests/IntegrationTests2/targets/tests-disabled/p.cabal new file mode 100644 index 00000000..81bbd121 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/tests-disabled/p.cabal @@ -0,0 +1,15 @@ +name: p +version: 0.1 +build-type: Simple +cabal-version: >= 1.10 + +test-suite solver-disabled + type: exitcode-stdio-1.0 + main-is: Test.hs + build-depends: a-package-that-does-not-exist + +test-suite user-disabled + type: exitcode-stdio-1.0 + main-is: Test.hs + build-depends: base + diff --git a/cabal-install/tests/IntegrationTests2/targets/tests-disabled/q/q.cabal b/cabal-install/tests/IntegrationTests2/targets/tests-disabled/q/q.cabal new file mode 100644 index 00000000..ae848c35 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/tests-disabled/q/q.cabal @@ -0,0 +1,10 @@ +name: q +version: 0.1 +build-type: Simple +cabal-version: >= 1.10 + +test-suite buildable-false + type: exitcode-stdio-1.0 + main-is: Main.hs + buildable: False + diff --git a/cabal-install/tests/IntegrationTests2/targets/variety/cabal.project b/cabal-install/tests/IntegrationTests2/targets/variety/cabal.project new file mode 100644 index 00000000..6f920794 --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/variety/cabal.project @@ -0,0 +1 @@ +packages: ./ diff --git a/cabal-install/tests/IntegrationTests2/targets/variety/p.cabal b/cabal-install/tests/IntegrationTests2/targets/variety/p.cabal new file mode 100644 index 00000000..d00e3a5a --- /dev/null +++ b/cabal-install/tests/IntegrationTests2/targets/variety/p.cabal @@ -0,0 +1,27 @@ +name: p +version: 0.1 +build-type: Simple +cabal-version: >= 1.10 + +library + exposed-modules: P + build-depends: base + +foreign-library libp + type: native-shared + other-modules: FLib + +executable an-exe + main-is: Main.hs + other-modules: AModule + +test-suite a-testsuite + type: exitcode-stdio-1.0 + main-is: Test.hs + other-modules: AModule + +benchmark a-benchmark + type: exitcode-stdio-1.0 + main-is: Test.hs + other-modules: AModule + diff --git a/cabal-install/tests/MemoryUsageTests.hs b/cabal-install/tests/MemoryUsageTests.hs new file mode 100644 index 00000000..e2222349 --- /dev/null +++ b/cabal-install/tests/MemoryUsageTests.hs @@ -0,0 +1,15 @@ +module MemoryUsageTests where + +import Test.Tasty + +import qualified UnitTests.Distribution.Solver.Modular.MemoryUsage + +tests :: TestTree +tests = + testGroup "Memory Usage" + [ testGroup "UnitTests.Distribution.Solver.Modular.MemoryUsage" + UnitTests.Distribution.Solver.Modular.MemoryUsage.tests + ] + +main :: IO () +main = defaultMain tests diff --git a/cabal-install/tests/README.md b/cabal-install/tests/README.md new file mode 100644 index 00000000..6d877b4a --- /dev/null +++ b/cabal-install/tests/README.md @@ -0,0 +1,27 @@ +Integration Tests +================= + +Each test is a shell script. Tests that share files (e.g., `.cabal` files) are +grouped under a common sub-directory of [IntegrationTests]. The framework +copies the whole group's directory before running each test, which allows tests +to reuse files, yet run independently. A group's tests are further divided into +`should_run` and `should_fail` directories, based on the expected exit status. +For example, the test +`IntegrationTests/exec/should_fail/exit_with_failure_without_args.sh` has access +to all files under `exec` and is expected to fail. + +Tests can specify their expected output. For a test named `x.sh`, `x.out` +specifies `stdout` and `x.err` specifies `stderr`. Both files are optional. +The framework expects an exact match between lines in the file and output, +except for lines beginning with "RE:", which are interpreted as regular +expressions. + +[IntegrationTests.hs] defines several environment variables: + +* `CABAL` - The path to the executable being tested. +* `GHC_PKG` - The path to ghc-pkg. +* `CABAL_ARGS` - A common set of arguments for running cabal. +* `CABAL_ARGS_NO_CONFIG_FILE` - `CABAL_ARGS` without `--config-file`. + +[IntegrationTests]: IntegrationTests +[IntegrationTests.hs]: IntegrationTests.hs diff --git a/cabal-install/tests/SolverQuickCheck.hs b/cabal-install/tests/SolverQuickCheck.hs new file mode 100644 index 00000000..8167f723 --- /dev/null +++ b/cabal-install/tests/SolverQuickCheck.hs @@ -0,0 +1,16 @@ +module SolverQuickCheck where + +import Test.Tasty + +import qualified UnitTests.Distribution.Solver.Modular.QuickCheck + + +tests :: TestTree +tests = + testGroup "Solver QuickCheck" + [ testGroup "UnitTests.Distribution.Solver.Modular.QuickCheck" + UnitTests.Distribution.Solver.Modular.QuickCheck.tests + ] + +main :: IO () +main = defaultMain tests diff --git a/cabal-install/tests/UnitTests.hs b/cabal-install/tests/UnitTests.hs new file mode 100644 index 00000000..345e9d60 --- /dev/null +++ b/cabal-install/tests/UnitTests.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module UnitTests where + +import Test.Tasty + +import Distribution.Simple.Utils +import Distribution.Verbosity + +import Distribution.Compat.Time + +import qualified UnitTests.Distribution.Solver.Modular.Builder +import qualified UnitTests.Distribution.Solver.Modular.WeightedPSQ +import qualified UnitTests.Distribution.Solver.Modular.Solver +import qualified UnitTests.Distribution.Solver.Modular.RetryLog +import qualified UnitTests.Distribution.Client.FileMonitor +import qualified UnitTests.Distribution.Client.Glob +import qualified UnitTests.Distribution.Client.GZipUtils +import qualified UnitTests.Distribution.Client.Sandbox +import qualified UnitTests.Distribution.Client.Sandbox.Timestamp +import qualified UnitTests.Distribution.Client.Store +import qualified UnitTests.Distribution.Client.Tar +import qualified UnitTests.Distribution.Client.Targets +import qualified UnitTests.Distribution.Client.UserConfig +import qualified UnitTests.Distribution.Client.ProjectConfig +import qualified UnitTests.Distribution.Client.JobControl +import qualified UnitTests.Distribution.Client.IndexUtils.Timestamp +import qualified UnitTests.Distribution.Client.InstallPlan +import qualified UnitTests.Distribution.Client.VCS +import qualified UnitTests.Distribution.Client.Get + +import UnitTests.Options + + +tests :: Int -> TestTree +tests mtimeChangeCalibrated = + askOption $ \(OptionMtimeChangeDelay mtimeChangeProvided) -> + let mtimeChange = if mtimeChangeProvided /= 0 + then mtimeChangeProvided + else mtimeChangeCalibrated + in + testGroup "Unit Tests" + [ testGroup "UnitTests.Distribution.Solver.Modular.Builder" + UnitTests.Distribution.Solver.Modular.Builder.tests + , testGroup "UnitTests.Distribution.Solver.Modular.WeightedPSQ" + UnitTests.Distribution.Solver.Modular.WeightedPSQ.tests + , testGroup "UnitTests.Distribution.Solver.Modular.Solver" + UnitTests.Distribution.Solver.Modular.Solver.tests + , testGroup "UnitTests.Distribution.Solver.Modular.RetryLog" + UnitTests.Distribution.Solver.Modular.RetryLog.tests + , testGroup "UnitTests.Distribution.Client.FileMonitor" $ + UnitTests.Distribution.Client.FileMonitor.tests mtimeChange + , testGroup "UnitTests.Distribution.Client.Glob" + UnitTests.Distribution.Client.Glob.tests + , testGroup "Distribution.Client.GZipUtils" + UnitTests.Distribution.Client.GZipUtils.tests + , testGroup "Distribution.Client.Sandbox" + UnitTests.Distribution.Client.Sandbox.tests + , testGroup "Distribution.Client.Sandbox.Timestamp" + UnitTests.Distribution.Client.Sandbox.Timestamp.tests + , testGroup "Distribution.Client.Store" + UnitTests.Distribution.Client.Store.tests + , testGroup "Distribution.Client.Tar" + UnitTests.Distribution.Client.Tar.tests + , testGroup "Distribution.Client.Targets" + UnitTests.Distribution.Client.Targets.tests + , testGroup "UnitTests.Distribution.Client.UserConfig" + UnitTests.Distribution.Client.UserConfig.tests + , testGroup "UnitTests.Distribution.Client.ProjectConfig" + UnitTests.Distribution.Client.ProjectConfig.tests + , testGroup "UnitTests.Distribution.Client.JobControl" + UnitTests.Distribution.Client.JobControl.tests + , testGroup "UnitTests.Distribution.Client.IndexUtils.Timestamp" + UnitTests.Distribution.Client.IndexUtils.Timestamp.tests + , testGroup "UnitTests.Distribution.Client.InstallPlan" + UnitTests.Distribution.Client.InstallPlan.tests + , testGroup "UnitTests.Distribution.Client.VCS" $ + UnitTests.Distribution.Client.VCS.tests mtimeChange + , testGroup "UnitTests.Distribution.Client.Get" + UnitTests.Distribution.Client.Get.tests + ] + +main :: IO () +main = do + (mtimeChange, mtimeChange') <- calibrateMtimeChangeDelay + let toMillis :: Int -> Double + toMillis x = fromIntegral x / 1000.0 + notice normal $ "File modification time resolution calibration completed, " + ++ "maximum delay observed: " + ++ (show . toMillis $ mtimeChange ) ++ " ms. " + ++ "Will be using delay of " ++ (show . toMillis $ mtimeChange') + ++ " for test runs." + defaultMainWithIngredients + (includingOptions extraOptions : defaultIngredients) + (tests mtimeChange') + diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs b/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs new file mode 100644 index 00000000..9df876cb --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs @@ -0,0 +1,193 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module UnitTests.Distribution.Client.ArbitraryInstances ( + adjustSize, + shortListOf, + shortListOf1, + arbitraryFlag, + ShortToken(..), + arbitraryShortToken, + NonMEmpty(..), + NoShrink(..), + ) where + +import Data.Char +import Data.List +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid +import Control.Applicative +#endif +import Control.Monad + +import Distribution.Version +import Distribution.Types.Dependency +import Distribution.Types.PackageVersionConstraint +import Distribution.Types.UnqualComponentName +import Distribution.Types.LibraryName +import Distribution.Package +import Distribution.System +import Distribution.Verbosity + +import Distribution.Simple.Setup +import Distribution.Simple.InstallDirs + +import Distribution.Utils.NubList + +import Distribution.Client.IndexUtils.Timestamp + +import Test.QuickCheck + + +adjustSize :: (Int -> Int) -> Gen a -> Gen a +adjustSize adjust gen = sized (\n -> resize (adjust n) gen) + +shortListOf :: Int -> Gen a -> Gen [a] +shortListOf bound gen = + sized $ \n -> do + k <- choose (0, (n `div` 2) `min` bound) + vectorOf k gen + +shortListOf1 :: Int -> Gen a -> Gen [a] +shortListOf1 bound gen = + sized $ \n -> do + k <- choose (1, 1 `max` ((n `div` 2) `min` bound)) + vectorOf k gen + +newtype ShortToken = ShortToken { getShortToken :: String } + deriving Show + +instance Arbitrary ShortToken where + arbitrary = + ShortToken <$> + (shortListOf1 5 (choose ('#', '~')) + `suchThat` (not . ("[]" `isPrefixOf`))) + --TODO: [code cleanup] need to replace parseHaskellString impl to stop + -- accepting Haskell list syntax [], ['a'] etc, just allow String syntax. + -- Workaround, don't generate [] as this does not round trip. + + + shrink (ShortToken cs) = + [ ShortToken cs' | cs' <- shrink cs, not (null cs') ] + +arbitraryShortToken :: Gen String +arbitraryShortToken = getShortToken <$> arbitrary + +instance Arbitrary Version where + arbitrary = do + branch <- shortListOf1 4 $ + frequency [(3, return 0) + ,(3, return 1) + ,(2, return 2) + ,(1, return 3)] + return (mkVersion branch) + where + + shrink ver = [ mkVersion branch' | branch' <- shrink (versionNumbers ver) + , not (null branch') ] + +instance Arbitrary VersionRange where + arbitrary = canonicaliseVersionRange <$> sized verRangeExp + where + verRangeExp n = frequency $ + [ (2, return anyVersion) + , (1, liftM thisVersion arbitrary) + , (1, liftM laterVersion arbitrary) + , (1, liftM orLaterVersion arbitrary) + , (1, liftM orLaterVersion' arbitrary) + , (1, liftM earlierVersion arbitrary) + , (1, liftM orEarlierVersion arbitrary) + , (1, liftM orEarlierVersion' arbitrary) + , (1, liftM withinVersion arbitrary) + , (2, liftM VersionRangeParens arbitrary) + ] ++ if n == 0 then [] else + [ (2, liftM2 unionVersionRanges verRangeExp2 verRangeExp2) + , (2, liftM2 intersectVersionRanges verRangeExp2 verRangeExp2) + ] + where + verRangeExp2 = verRangeExp (n `div` 2) + + orLaterVersion' v = + unionVersionRanges (laterVersion v) (thisVersion v) + orEarlierVersion' v = + unionVersionRanges (earlierVersion v) (thisVersion v) + + canonicaliseVersionRange = fromVersionIntervals . toVersionIntervals + +instance Arbitrary PackageName where + arbitrary = mkPackageName . intercalate "-" <$> shortListOf1 2 nameComponent + where + nameComponent = shortListOf1 5 (elements packageChars) + `suchThat` (not . all isDigit) + packageChars = filter isAlphaNum ['\0'..'\127'] + +instance Arbitrary Dependency where + arbitrary = Dependency <$> arbitrary <*> arbitrary <*> fmap getNonMEmpty arbitrary + +instance Arbitrary PackageVersionConstraint where + arbitrary = PackageVersionConstraint <$> arbitrary <*> arbitrary + +instance Arbitrary UnqualComponentName where + -- same rules as package names + arbitrary = packageNameToUnqualComponentName <$> arbitrary + +instance Arbitrary LibraryName where + arbitrary = elements =<< sequenceA [LSubLibName <$> arbitrary, pure LMainLibName] + +instance Arbitrary OS where + arbitrary = elements knownOSs + +instance Arbitrary Arch where + arbitrary = elements knownArches + +instance Arbitrary Platform where + arbitrary = Platform <$> arbitrary <*> arbitrary + +instance Arbitrary a => Arbitrary (Flag a) where + arbitrary = arbitraryFlag arbitrary + shrink NoFlag = [] + shrink (Flag x) = NoFlag : [ Flag x' | x' <- shrink x ] + +arbitraryFlag :: Gen a -> Gen (Flag a) +arbitraryFlag genA = + sized $ \sz -> + case sz of + 0 -> pure NoFlag + _ -> frequency [ (1, pure NoFlag) + , (3, Flag <$> genA) ] + + +instance (Arbitrary a, Ord a) => Arbitrary (NubList a) where + arbitrary = toNubList <$> arbitrary + shrink xs = [ toNubList [] | (not . null) (fromNubList xs) ] + -- try empty, otherwise don't shrink as it can loop + +instance Arbitrary Verbosity where + arbitrary = elements [minBound..maxBound] + +instance Arbitrary PathTemplate where + arbitrary = toPathTemplate <$> arbitraryShortToken + shrink t = [ toPathTemplate s | s <- shrink (fromPathTemplate t), not (null s) ] + + +newtype NonMEmpty a = NonMEmpty { getNonMEmpty :: a } + deriving (Eq, Ord, Show) + +instance (Arbitrary a, Monoid a, Eq a) => Arbitrary (NonMEmpty a) where + arbitrary = NonMEmpty <$> (arbitrary `suchThat` (/= mempty)) + shrink (NonMEmpty x) = [ NonMEmpty x' | x' <- shrink x, x' /= mempty ] + +newtype NoShrink a = NoShrink { getNoShrink :: a } + deriving (Eq, Ord, Show) + +instance Arbitrary a => Arbitrary (NoShrink a) where + arbitrary = NoShrink <$> arbitrary + shrink _ = [] + +instance Arbitrary Timestamp where + arbitrary = (maybe (toEnum 0) id . epochTimeToTimestamp) <$> arbitrary + +instance Arbitrary IndexState where + arbitrary = frequency [ (1, pure IndexStateHead) + , (50, IndexStateTime <$> arbitrary) + ] diff --git a/cabal-install/tests/UnitTests/Distribution/Client/FileMonitor.hs b/cabal-install/tests/UnitTests/Distribution/Client/FileMonitor.hs new file mode 100644 index 00000000..0e2ed81b --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/FileMonitor.hs @@ -0,0 +1,857 @@ +module UnitTests.Distribution.Client.FileMonitor (tests) where + +import Control.Monad +import Control.Exception +import Control.Concurrent (threadDelay) +import qualified Data.Set as Set +import System.FilePath +import qualified System.Directory as IO +import Prelude hiding (writeFile) +import qualified Prelude as IO (writeFile) + +import Distribution.Text (simpleParse) +import Distribution.Compat.Binary +import Distribution.Simple.Utils (withTempDirectory) +import Distribution.Verbosity (silent) + +import Distribution.Client.FileMonitor +import Distribution.Compat.Time + +import Test.Tasty +import Test.Tasty.HUnit + + +tests :: Int -> [TestTree] +tests mtimeChange = + [ testCase "sanity check mtimes" $ testFileMTimeSanity mtimeChange + , testCase "sanity check dirs" $ testDirChangeSanity mtimeChange + , testCase "no monitor cache" testNoMonitorCache + , testCase "corrupt monitor cache" testCorruptMonitorCache + , testCase "empty monitor" testEmptyMonitor + , testCase "missing file" testMissingFile + , testCase "change file" $ testChangedFile mtimeChange + , testCase "file mtime vs content" $ testChangedFileMtimeVsContent mtimeChange + , testCase "update during action" $ testUpdateDuringAction mtimeChange + , testCase "remove file" testRemoveFile + , testCase "non-existent file" testNonExistentFile + , testCase "changed file type" $ testChangedFileType mtimeChange + , testCase "several monitor kinds" $ testMultipleMonitorKinds mtimeChange + + , testGroup "glob matches" + [ testCase "no change" testGlobNoChange + , testCase "add match" $ testGlobAddMatch mtimeChange + , testCase "remove match" $ testGlobRemoveMatch mtimeChange + , testCase "change match" $ testGlobChangeMatch mtimeChange + + , testCase "add match subdir" $ testGlobAddMatchSubdir mtimeChange + , testCase "remove match subdir" $ testGlobRemoveMatchSubdir mtimeChange + , testCase "change match subdir" $ testGlobChangeMatchSubdir mtimeChange + + , testCase "match toplevel dir" $ testGlobMatchTopDir mtimeChange + , testCase "add non-match" $ testGlobAddNonMatch mtimeChange + , testCase "remove non-match" $ testGlobRemoveNonMatch mtimeChange + + , testCase "add non-match" $ testGlobAddNonMatchSubdir mtimeChange + , testCase "remove non-match" $ testGlobRemoveNonMatchSubdir mtimeChange + + , testCase "invariant sorted 1" $ testInvariantMonitorStateGlobFiles + mtimeChange + , testCase "invariant sorted 2" $ testInvariantMonitorStateGlobDirs + mtimeChange + + , testCase "match dirs" $ testGlobMatchDir mtimeChange + , testCase "match dirs only" $ testGlobMatchDirOnly mtimeChange + , testCase "change file type" $ testGlobChangeFileType mtimeChange + , testCase "absolute paths" $ testGlobAbsolutePath mtimeChange + ] + + , testCase "value unchanged" testValueUnchanged + , testCase "value changed" testValueChanged + , testCase "value & file changed" $ testValueAndFileChanged mtimeChange + , testCase "value updated" testValueUpdated + ] + +-- Check the file system behaves the way we expect it to + +-- we rely on file mtimes having a reasonable resolution +testFileMTimeSanity :: Int -> Assertion +testFileMTimeSanity mtimeChange = + withTempDirectory silent "." "file-status-" $ \dir -> do + replicateM_ 10 $ do + IO.writeFile (dir "a") "content" + t1 <- getModTime (dir "a") + threadDelay mtimeChange + IO.writeFile (dir "a") "content" + t2 <- getModTime (dir "a") + assertBool "expected different file mtimes" (t2 > t1) + +-- We rely on directories changing mtime when entries are added or removed +testDirChangeSanity :: Int -> Assertion +testDirChangeSanity mtimeChange = + withTempDirectory silent "." "dir-mtime-" $ \dir -> do + + expectMTimeChange dir "file add" $ + IO.writeFile (dir "file") "content" + + expectMTimeSame dir "file content change" $ + IO.writeFile (dir "file") "new content" + + expectMTimeChange dir "file del" $ + IO.removeFile (dir "file") + + expectMTimeChange dir "subdir add" $ + IO.createDirectory (dir "dir") + + expectMTimeSame dir "subdir file add" $ + IO.writeFile (dir "dir" "file") "content" + + expectMTimeChange dir "subdir file move in" $ + IO.renameFile (dir "dir" "file") (dir "file") + + expectMTimeChange dir "subdir file move out" $ + IO.renameFile (dir "file") (dir "dir" "file") + + expectMTimeSame dir "subdir dir add" $ + IO.createDirectory (dir "dir" "subdir") + + expectMTimeChange dir "subdir dir move in" $ + IO.renameDirectory (dir "dir" "subdir") (dir "subdir") + + expectMTimeChange dir "subdir dir move out" $ + IO.renameDirectory (dir "subdir") (dir "dir" "subdir") + + where + expectMTimeChange, expectMTimeSame :: FilePath -> String -> IO () + -> Assertion + + expectMTimeChange dir descr action = do + t <- getModTime dir + threadDelay mtimeChange + action + t' <- getModTime dir + assertBool ("expected dir mtime change on " ++ descr) (t' > t) + + expectMTimeSame dir descr action = do + t <- getModTime dir + threadDelay mtimeChange + action + t' <- getModTime dir + assertBool ("expected same dir mtime on " ++ descr) (t' == t) + + +-- Now for the FileMonitor tests proper... + +-- first run, where we don't even call updateMonitor +testNoMonitorCache :: Assertion +testNoMonitorCache = + withFileMonitor $ \root monitor -> do + reason <- expectMonitorChanged root (monitor :: FileMonitor () ()) () + reason @?= MonitorFirstRun + +-- write garbage into the binary cache file +testCorruptMonitorCache :: Assertion +testCorruptMonitorCache = + withFileMonitor $ \root monitor -> do + IO.writeFile (fileMonitorCacheFile monitor) "broken" + reason <- expectMonitorChanged root monitor () + reason @?= MonitorCorruptCache + + updateMonitor root monitor [] () () + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [] + + IO.writeFile (fileMonitorCacheFile monitor) "broken" + reason2 <- expectMonitorChanged root monitor () + reason2 @?= MonitorCorruptCache + +-- no files to monitor +testEmptyMonitor :: Assertion +testEmptyMonitor = + withFileMonitor $ \root monitor -> do + touchFile root "a" + updateMonitor root monitor [] () () + touchFile root "b" + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [] + +-- monitor a file that is expected to exist +testMissingFile :: Assertion +testMissingFile = do + test monitorFile touchFile "a" + test monitorFileHashed touchFile "a" + test monitorFile touchFile ("dir" "a") + test monitorFileHashed touchFile ("dir" "a") + test monitorDirectory touchDir "a" + test monitorDirectory touchDir ("dir" "a") + where + test :: (FilePath -> MonitorFilePath) + -> (RootPath -> FilePath -> IO ()) + -> FilePath + -> IO () + test monitorKind touch file = + withFileMonitor $ \root monitor -> do + -- a file that doesn't exist at snapshot time is considered to have + -- changed + updateMonitor root monitor [monitorKind file] () () + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged file + + -- a file doesn't exist at snapshot time, but gets added afterwards is + -- also considered to have changed + updateMonitor root monitor [monitorKind file] () () + touch root file + reason2 <- expectMonitorChanged root monitor () + reason2 @?= MonitoredFileChanged file + + +testChangedFile :: Int -> Assertion +testChangedFile mtimeChange = do + test monitorFile touchFile touchFile "a" + test monitorFileHashed touchFile touchFileContent "a" + test monitorFile touchFile touchFile ("dir" "a") + test monitorFileHashed touchFile touchFileContent ("dir" "a") + test monitorDirectory touchDir touchDir "a" + test monitorDirectory touchDir touchDir ("dir" "a") + where + test :: (FilePath -> MonitorFilePath) + -> (RootPath -> FilePath -> IO ()) + -> (RootPath -> FilePath -> IO ()) + -> FilePath + -> IO () + test monitorKind touch touch' file = + withFileMonitor $ \root monitor -> do + touch root file + updateMonitor root monitor [monitorKind file] () () + threadDelay mtimeChange + touch' root file + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged file + + +testChangedFileMtimeVsContent :: Int -> Assertion +testChangedFileMtimeVsContent mtimeChange = + withFileMonitor $ \root monitor -> do + -- if we don't touch the file, it's unchanged + touchFile root "a" + updateMonitor root monitor [monitorFile "a"] () () + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [monitorFile "a"] + + -- if we do touch the file, it's changed if we only consider mtime + updateMonitor root monitor [monitorFile "a"] () () + threadDelay mtimeChange + touchFile root "a" + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged "a" + + -- but if we touch the file, it's unchanged if we consider content hash + updateMonitor root monitor [monitorFileHashed "a"] () () + threadDelay mtimeChange + touchFile root "a" + (res2, files2) <- expectMonitorUnchanged root monitor () + res2 @?= () + files2 @?= [monitorFileHashed "a"] + + -- finally if we change the content it's changed + updateMonitor root monitor [monitorFileHashed "a"] () () + threadDelay mtimeChange + touchFileContent root "a" + reason2 <- expectMonitorChanged root monitor () + reason2 @?= MonitoredFileChanged "a" + + +testUpdateDuringAction :: Int -> Assertion +testUpdateDuringAction mtimeChange = do + test (monitorFile "a") touchFile "a" + test (monitorFileHashed "a") touchFile "a" + test (monitorDirectory "a") touchDir "a" + test (monitorFileGlobStr "*") touchFile "a" + test (monitorFileGlobStr "*") { monitorKindDir = DirModTime } + touchDir "a" + where + test :: MonitorFilePath + -> (RootPath -> FilePath -> IO ()) + -> FilePath + -> IO () + test monitorSpec touch file = + withFileMonitor $ \root monitor -> do + touch root file + updateMonitor root monitor [monitorSpec] () () + + -- start doing an update action... + threadDelay mtimeChange -- some time passes + touch root file -- a file gets updates during the action + threadDelay mtimeChange -- some time passes then we finish + updateMonitor root monitor [monitorSpec] () () + -- we don't notice this change since we took the timestamp after the + -- action finished + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [monitorSpec] + + -- Let's try again, this time taking the timestamp before the action + timestamp' <- beginUpdateFileMonitor + threadDelay mtimeChange -- some time passes + touch root file -- a file gets updates during the action + threadDelay mtimeChange -- some time passes then we finish + updateMonitorWithTimestamp root monitor timestamp' [monitorSpec] () () + -- now we do notice the change since we took the snapshot before the + -- action finished + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged file + + +testRemoveFile :: Assertion +testRemoveFile = do + test monitorFile touchFile removeFile "a" + test monitorFileHashed touchFile removeFile "a" + test monitorFile touchFile removeFile ("dir" "a") + test monitorFileHashed touchFile removeFile ("dir" "a") + test monitorDirectory touchDir removeDir "a" + test monitorDirectory touchDir removeDir ("dir" "a") + where + test :: (FilePath -> MonitorFilePath) + -> (RootPath -> FilePath -> IO ()) + -> (RootPath -> FilePath -> IO ()) + -> FilePath + -> IO () + test monitorKind touch remove file = + withFileMonitor $ \root monitor -> do + touch root file + updateMonitor root monitor [monitorKind file] () () + remove root file + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged file + + +-- monitor a file that we expect not to exist +testNonExistentFile :: Assertion +testNonExistentFile = + withFileMonitor $ \root monitor -> do + -- a file that doesn't exist at snapshot time or check time is unchanged + updateMonitor root monitor [monitorNonExistentFile "a"] () () + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [monitorNonExistentFile "a"] + + -- if the file then exists it has changed + touchFile root "a" + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged "a" + + -- if the file then exists at snapshot and check time it has changed + updateMonitor root monitor [monitorNonExistentFile "a"] () () + reason2 <- expectMonitorChanged root monitor () + reason2 @?= MonitoredFileChanged "a" + + -- but if the file existed at snapshot time and doesn't exist at check time + -- it is consider unchanged. This is unlike files we expect to exist, but + -- that's because files that exist can have different content and actions + -- can depend on that content, whereas if the action expected a file not to + -- exist and it now does not, it'll give the same result, irrespective of + -- the fact that the file might have existed in the meantime. + updateMonitor root monitor [monitorNonExistentFile "a"] () () + removeFile root "a" + (res2, files2) <- expectMonitorUnchanged root monitor () + res2 @?= () + files2 @?= [monitorNonExistentFile "a"] + + +testChangedFileType :: Int-> Assertion +testChangedFileType mtimeChange = do + test (monitorFile "a") touchFile removeFile createDir + test (monitorFileHashed "a") touchFile removeFile createDir + + test (monitorDirectory "a") createDir removeDir touchFile + test (monitorFileOrDirectory "a") createDir removeDir touchFile + + test (monitorFileGlobStr "*") { monitorKindDir = DirModTime } + touchFile removeFile createDir + test (monitorFileGlobStr "*") { monitorKindDir = DirModTime } + createDir removeDir touchFile + where + test :: MonitorFilePath + -> (RootPath -> String -> IO ()) + -> (RootPath -> String -> IO ()) + -> (RootPath -> String -> IO ()) + -> IO () + test monitorKind touch remove touch' = + withFileMonitor $ \root monitor -> do + touch root "a" + updateMonitor root monitor [monitorKind] () () + threadDelay mtimeChange + remove root "a" + touch' root "a" + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged "a" + +-- Monitoring the same file with two different kinds of monitor should work +-- both should be kept, and both checked for changes. +-- We had a bug where only one monitor kind was kept per file. +-- https://github.com/haskell/cabal/pull/3863#issuecomment-248495178 +testMultipleMonitorKinds :: Int -> Assertion +testMultipleMonitorKinds mtimeChange = + withFileMonitor $ \root monitor -> do + touchFile root "a" + updateMonitor root monitor [monitorFile "a", monitorFileHashed "a"] () () + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [monitorFile "a", monitorFileHashed "a"] + threadDelay mtimeChange + touchFile root "a" -- not changing content, just mtime + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged "a" + + createDir root "dir" + updateMonitor root monitor [monitorDirectory "dir", + monitorDirectoryExistence "dir"] () () + (res2, files2) <- expectMonitorUnchanged root monitor () + res2 @?= () + files2 @?= [monitorDirectory "dir", monitorDirectoryExistence "dir"] + threadDelay mtimeChange + touchFile root ("dir" "a") -- changing dir mtime, not existence + reason2 <- expectMonitorChanged root monitor () + reason2 @?= MonitoredFileChanged "dir" + + +------------------ +-- globs +-- + +testGlobNoChange :: Assertion +testGlobNoChange = + withFileMonitor $ \root monitor -> do + touchFile root ("dir" "good-a") + touchFile root ("dir" "good-b") + updateMonitor root monitor [monitorFileGlobStr "dir/good-*"] () () + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [monitorFileGlobStr "dir/good-*"] + +testGlobAddMatch :: Int -> Assertion +testGlobAddMatch mtimeChange = + withFileMonitor $ \root monitor -> do + touchFile root ("dir" "good-a") + updateMonitor root monitor [monitorFileGlobStr "dir/good-*"] () () + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [monitorFileGlobStr "dir/good-*"] + threadDelay mtimeChange + touchFile root ("dir" "good-b") + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged ("dir" "good-b") + +testGlobRemoveMatch :: Int -> Assertion +testGlobRemoveMatch mtimeChange = + withFileMonitor $ \root monitor -> do + touchFile root ("dir" "good-a") + touchFile root ("dir" "good-b") + updateMonitor root monitor [monitorFileGlobStr "dir/good-*"] () () + threadDelay mtimeChange + removeFile root "dir/good-a" + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged ("dir" "good-a") + +testGlobChangeMatch :: Int -> Assertion +testGlobChangeMatch mtimeChange = + withFileMonitor $ \root monitor -> do + touchFile root ("dir" "good-a") + touchFile root ("dir" "good-b") + updateMonitor root monitor [monitorFileGlobStr "dir/good-*"] () () + threadDelay mtimeChange + touchFile root ("dir" "good-b") + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [monitorFileGlobStr "dir/good-*"] + + touchFileContent root ("dir" "good-b") + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged ("dir" "good-b") + +testGlobAddMatchSubdir :: Int -> Assertion +testGlobAddMatchSubdir mtimeChange = + withFileMonitor $ \root monitor -> do + touchFile root ("dir" "a" "good-a") + updateMonitor root monitor [monitorFileGlobStr "dir/*/good-*"] () () + threadDelay mtimeChange + touchFile root ("dir" "b" "good-b") + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged ("dir" "b" "good-b") + +testGlobRemoveMatchSubdir :: Int -> Assertion +testGlobRemoveMatchSubdir mtimeChange = + withFileMonitor $ \root monitor -> do + touchFile root ("dir" "a" "good-a") + touchFile root ("dir" "b" "good-b") + updateMonitor root monitor [monitorFileGlobStr "dir/*/good-*"] () () + threadDelay mtimeChange + removeDir root ("dir" "a") + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged ("dir" "a" "good-a") + +testGlobChangeMatchSubdir :: Int -> Assertion +testGlobChangeMatchSubdir mtimeChange = + withFileMonitor $ \root monitor -> do + touchFile root ("dir" "a" "good-a") + touchFile root ("dir" "b" "good-b") + updateMonitor root monitor [monitorFileGlobStr "dir/*/good-*"] () () + threadDelay mtimeChange + touchFile root ("dir" "b" "good-b") + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [monitorFileGlobStr "dir/*/good-*"] + + touchFileContent root "dir/b/good-b" + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged ("dir" "b" "good-b") + +-- check nothing goes squiffy with matching in the top dir +testGlobMatchTopDir :: Int -> Assertion +testGlobMatchTopDir mtimeChange = + withFileMonitor $ \root monitor -> do + updateMonitor root monitor [monitorFileGlobStr "*"] () () + threadDelay mtimeChange + touchFile root "a" + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged "a" + +testGlobAddNonMatch :: Int -> Assertion +testGlobAddNonMatch mtimeChange = + withFileMonitor $ \root monitor -> do + touchFile root ("dir" "good-a") + updateMonitor root monitor [monitorFileGlobStr "dir/good-*"] () () + threadDelay mtimeChange + touchFile root ("dir" "bad") + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [monitorFileGlobStr "dir/good-*"] + +testGlobRemoveNonMatch :: Int -> Assertion +testGlobRemoveNonMatch mtimeChange = + withFileMonitor $ \root monitor -> do + touchFile root ("dir" "good-a") + touchFile root ("dir" "bad") + updateMonitor root monitor [monitorFileGlobStr "dir/good-*"] () () + threadDelay mtimeChange + removeFile root "dir/bad" + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [monitorFileGlobStr "dir/good-*"] + +testGlobAddNonMatchSubdir :: Int -> Assertion +testGlobAddNonMatchSubdir mtimeChange = + withFileMonitor $ \root monitor -> do + touchFile root ("dir" "a" "good-a") + updateMonitor root monitor [monitorFileGlobStr "dir/*/good-*"] () () + threadDelay mtimeChange + touchFile root ("dir" "b" "bad") + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [monitorFileGlobStr "dir/*/good-*"] + +testGlobRemoveNonMatchSubdir :: Int -> Assertion +testGlobRemoveNonMatchSubdir mtimeChange = + withFileMonitor $ \root monitor -> do + touchFile root ("dir" "a" "good-a") + touchFile root ("dir" "b" "bad") + updateMonitor root monitor [monitorFileGlobStr "dir/*/good-*"] () () + threadDelay mtimeChange + removeDir root ("dir" "b") + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [monitorFileGlobStr "dir/*/good-*"] + + +-- try and tickle a bug that happens if we don't maintain the invariant that +-- MonitorStateGlobFiles entries are sorted +testInvariantMonitorStateGlobFiles :: Int -> Assertion +testInvariantMonitorStateGlobFiles mtimeChange = + withFileMonitor $ \root monitor -> do + touchFile root ("dir" "a") + touchFile root ("dir" "b") + touchFile root ("dir" "c") + touchFile root ("dir" "d") + updateMonitor root monitor [monitorFileGlobStr "dir/*"] () () + threadDelay mtimeChange + -- so there should be no change (since we're doing content checks) + -- but if we can get the dir entries to appear in the wrong order + -- then if the sorted invariant is not maintained then we can fool + -- the 'probeGlobStatus' into thinking there's changes + removeFile root ("dir" "a") + removeFile root ("dir" "b") + removeFile root ("dir" "c") + removeFile root ("dir" "d") + touchFile root ("dir" "d") + touchFile root ("dir" "c") + touchFile root ("dir" "b") + touchFile root ("dir" "a") + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [monitorFileGlobStr "dir/*"] + +-- same thing for the subdirs case +testInvariantMonitorStateGlobDirs :: Int -> Assertion +testInvariantMonitorStateGlobDirs mtimeChange = + withFileMonitor $ \root monitor -> do + touchFile root ("dir" "a" "file") + touchFile root ("dir" "b" "file") + touchFile root ("dir" "c" "file") + touchFile root ("dir" "d" "file") + updateMonitor root monitor [monitorFileGlobStr "dir/*/file"] () () + threadDelay mtimeChange + removeDir root ("dir" "a") + removeDir root ("dir" "b") + removeDir root ("dir" "c") + removeDir root ("dir" "d") + touchFile root ("dir" "d" "file") + touchFile root ("dir" "c" "file") + touchFile root ("dir" "b" "file") + touchFile root ("dir" "a" "file") + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [monitorFileGlobStr "dir/*/file"] + +-- ensure that a glob can match a directory as well as a file +testGlobMatchDir :: Int -> Assertion +testGlobMatchDir mtimeChange = + withFileMonitor $ \root monitor -> do + createDir root ("dir" "a") + updateMonitor root monitor [monitorFileGlobStr "dir/*"] () () + threadDelay mtimeChange + -- nothing changed yet + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [monitorFileGlobStr "dir/*"] + -- expect dir/b to match and be detected as changed + createDir root ("dir" "b") + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged ("dir" "b") + -- now remove dir/a and expect it to be detected as changed + updateMonitor root monitor [monitorFileGlobStr "dir/*"] () () + threadDelay mtimeChange + removeDir root ("dir" "a") + reason2 <- expectMonitorChanged root monitor () + reason2 @?= MonitoredFileChanged ("dir" "a") + +testGlobMatchDirOnly :: Int -> Assertion +testGlobMatchDirOnly mtimeChange = + withFileMonitor $ \root monitor -> do + updateMonitor root monitor [monitorFileGlobStr "dir/*/"] () () + threadDelay mtimeChange + -- expect file dir/a to not match, so not detected as changed + touchFile root ("dir" "a") + (res, files) <- expectMonitorUnchanged root monitor () + res @?= () + files @?= [monitorFileGlobStr "dir/*/"] + -- note that checking the file monitor for changes can updates the + -- cached dir mtimes (when it has to record that there's new matches) + -- so we need an extra mtime delay + threadDelay mtimeChange + -- but expect dir/b to match + createDir root ("dir" "b") + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged ("dir" "b") + +testGlobChangeFileType :: Int -> Assertion +testGlobChangeFileType mtimeChange = + withFileMonitor $ \root monitor -> do + -- change file to dir + touchFile root ("dir" "a") + updateMonitor root monitor [monitorFileGlobStr "dir/*"] () () + threadDelay mtimeChange + removeFile root ("dir" "a") + createDir root ("dir" "a") + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged ("dir" "a") + -- change dir to file + updateMonitor root monitor [monitorFileGlobStr "dir/*"] () () + threadDelay mtimeChange + removeDir root ("dir" "a") + touchFile root ("dir" "a") + reason2 <- expectMonitorChanged root monitor () + reason2 @?= MonitoredFileChanged ("dir" "a") + +testGlobAbsolutePath :: Int -> Assertion +testGlobAbsolutePath mtimeChange = + withFileMonitor $ \root monitor -> do + root' <- absoluteRoot root + -- absolute glob, removing a file + touchFile root ("dir/good-a") + touchFile root ("dir/good-b") + updateMonitor root monitor [monitorFileGlobStr (root' "dir/good-*")] () () + threadDelay mtimeChange + removeFile root "dir/good-a" + reason <- expectMonitorChanged root monitor () + reason @?= MonitoredFileChanged (root' "dir/good-a") + -- absolute glob, adding a file + updateMonitor root monitor [monitorFileGlobStr (root' "dir/good-*")] () () + threadDelay mtimeChange + touchFile root ("dir/good-a") + reason2 <- expectMonitorChanged root monitor () + reason2 @?= MonitoredFileChanged (root' "dir/good-a") + -- absolute glob, changing a file + updateMonitor root monitor [monitorFileGlobStr (root' "dir/good-*")] () () + threadDelay mtimeChange + touchFileContent root "dir/good-b" + reason3 <- expectMonitorChanged root monitor () + reason3 @?= MonitoredFileChanged (root' "dir/good-b") + + +------------------ +-- value changes +-- + +testValueUnchanged :: Assertion +testValueUnchanged = + withFileMonitor $ \root monitor -> do + touchFile root "a" + updateMonitor root monitor [monitorFile "a"] (42 :: Int) "ok" + (res, files) <- expectMonitorUnchanged root monitor 42 + res @?= "ok" + files @?= [monitorFile "a"] + +testValueChanged :: Assertion +testValueChanged = + withFileMonitor $ \root monitor -> do + touchFile root "a" + updateMonitor root monitor [monitorFile "a"] (42 :: Int) "ok" + reason <- expectMonitorChanged root monitor 43 + reason @?= MonitoredValueChanged 42 + +testValueAndFileChanged :: Int -> Assertion +testValueAndFileChanged mtimeChange = + withFileMonitor $ \root monitor -> do + touchFile root "a" + + -- we change the value and the file, and the value change is reported + updateMonitor root monitor [monitorFile "a"] (42 :: Int) "ok" + threadDelay mtimeChange + touchFile root "a" + reason <- expectMonitorChanged root monitor 43 + reason @?= MonitoredValueChanged 42 + + -- if fileMonitorCheckIfOnlyValueChanged then if only the value changed + -- then it's reported as MonitoredValueChanged + let monitor' :: FileMonitor Int String + monitor' = monitor { fileMonitorCheckIfOnlyValueChanged = True } + updateMonitor root monitor' [monitorFile "a"] 42 "ok" + reason2 <- expectMonitorChanged root monitor' 43 + reason2 @?= MonitoredValueChanged 42 + + -- but if a file changed too then we don't report MonitoredValueChanged + updateMonitor root monitor' [monitorFile "a"] 42 "ok" + threadDelay mtimeChange + touchFile root "a" + reason3 <- expectMonitorChanged root monitor' 43 + reason3 @?= MonitoredFileChanged "a" + +testValueUpdated :: Assertion +testValueUpdated = + withFileMonitor $ \root monitor -> do + touchFile root "a" + + let monitor' :: FileMonitor (Set.Set Int) String + monitor' = (monitor :: FileMonitor (Set.Set Int) String) { + fileMonitorCheckIfOnlyValueChanged = True, + fileMonitorKeyValid = Set.isSubsetOf + } + + updateMonitor root monitor' [monitorFile "a"] (Set.fromList [42,43]) "ok" + (res,_files) <- expectMonitorUnchanged root monitor' (Set.fromList [42]) + res @?= "ok" + + reason <- expectMonitorChanged root monitor' (Set.fromList [42,44]) + reason @?= MonitoredValueChanged (Set.fromList [42,43]) + + +------------- +-- Utils + +newtype RootPath = RootPath FilePath + +touchFile :: RootPath -> FilePath -> IO () +touchFile (RootPath root) fname = do + let path = root fname + IO.createDirectoryIfMissing True (takeDirectory path) + IO.writeFile path "touched" + +touchFileContent :: RootPath -> FilePath -> IO () +touchFileContent (RootPath root) fname = do + let path = root fname + IO.createDirectoryIfMissing True (takeDirectory path) + IO.writeFile path "different" + +removeFile :: RootPath -> FilePath -> IO () +removeFile (RootPath root) fname = IO.removeFile (root fname) + +touchDir :: RootPath -> FilePath -> IO () +touchDir root@(RootPath rootdir) dname = do + IO.createDirectoryIfMissing True (rootdir dname) + touchFile root (dname "touch") + removeFile root (dname "touch") + +createDir :: RootPath -> FilePath -> IO () +createDir (RootPath root) dname = do + let path = root dname + IO.createDirectoryIfMissing True (takeDirectory path) + IO.createDirectory path + +removeDir :: RootPath -> FilePath -> IO () +removeDir (RootPath root) dname = IO.removeDirectoryRecursive (root dname) + +absoluteRoot :: RootPath -> IO FilePath +absoluteRoot (RootPath root) = IO.canonicalizePath root + +monitorFileGlobStr :: String -> MonitorFilePath +monitorFileGlobStr globstr + | Just glob <- simpleParse globstr = monitorFileGlob glob + | otherwise = error $ "Failed to parse " ++ globstr + + +expectMonitorChanged :: (Binary a, Binary b) + => RootPath -> FileMonitor a b -> a + -> IO (MonitorChangedReason a) +expectMonitorChanged root monitor key = do + res <- checkChanged root monitor key + case res of + MonitorChanged reason -> return reason + MonitorUnchanged _ _ -> throwIO $ HUnitFailure Nothing "expected change" + +expectMonitorUnchanged :: (Binary a, Binary b) + => RootPath -> FileMonitor a b -> a + -> IO (b, [MonitorFilePath]) +expectMonitorUnchanged root monitor key = do + res <- checkChanged root monitor key + case res of + MonitorChanged _reason -> throwIO $ HUnitFailure Nothing "expected no change" + MonitorUnchanged b files -> return (b, files) + +checkChanged :: (Binary a, Binary b) + => RootPath -> FileMonitor a b + -> a -> IO (MonitorChanged a b) +checkChanged (RootPath root) monitor key = + checkFileMonitorChanged monitor root key + +updateMonitor :: (Binary a, Binary b) + => RootPath -> FileMonitor a b + -> [MonitorFilePath] -> a -> b -> IO () +updateMonitor (RootPath root) monitor files key result = + updateFileMonitor monitor root Nothing files key result + +updateMonitorWithTimestamp :: (Binary a, Binary b) + => RootPath -> FileMonitor a b -> MonitorTimestamp + -> [MonitorFilePath] -> a -> b -> IO () +updateMonitorWithTimestamp (RootPath root) monitor timestamp files key result = + updateFileMonitor monitor root (Just timestamp) files key result + +withFileMonitor :: Eq a => (RootPath -> FileMonitor a b -> IO c) -> IO c +withFileMonitor action = do + withTempDirectory silent "." "file-status-" $ \root -> do + let file = root <.> "monitor" + monitor = newFileMonitor file + finally (action (RootPath root) monitor) $ do + exists <- IO.doesFileExist file + when exists $ IO.removeFile file diff --git a/cabal-install/tests/UnitTests/Distribution/Client/GZipUtils.hs b/cabal-install/tests/UnitTests/Distribution/Client/GZipUtils.hs new file mode 100644 index 00000000..cab64fb8 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/GZipUtils.hs @@ -0,0 +1,60 @@ +module UnitTests.Distribution.Client.GZipUtils ( + tests + ) where + +import Codec.Compression.GZip as GZip +import Codec.Compression.Zlib as Zlib +import Control.Exception.Base (evaluate) +import Control.Exception (try, SomeException) +import Control.Monad (void) +import Data.ByteString as BS (null) +import Data.ByteString.Lazy as BSL (pack, toChunks) +import Data.ByteString.Lazy.Char8 as BSLL (pack, init, length) +import Data.Monoid ((<>)) +import Distribution.Client.GZipUtils (maybeDecompress) +import Data.Word (Word8) + +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck + +tests :: [TestTree] +tests = [ testCase "maybeDecompress" maybeDecompressUnitTest + -- "decompress plain" property is non-trivial to state, + -- maybeDecompress returns input bytestring only if error occurs right at the beginning of the decompression process + -- generating such input would essentially duplicate maybeDecompress implementation + , testProperty "decompress zlib" prop_maybeDecompress_zlib + , testProperty "decompress gzip" prop_maybeDecompress_gzip + ] + +maybeDecompressUnitTest :: Assertion +maybeDecompressUnitTest = + assertBool "decompress plain" (maybeDecompress original == original) + >> assertBool "decompress zlib (with show)" (show (maybeDecompress compressedZlib) == show original) + >> assertBool "decompress gzip (with show)" (show (maybeDecompress compressedGZip) == show original) + >> assertBool "decompress zlib" (maybeDecompress compressedZlib == original) + >> assertBool "decompress gzip" (maybeDecompress compressedGZip == original) + >> assertBool "have no empty chunks" (Prelude.all (not . BS.null) . BSL.toChunks . maybeDecompress $ compressedZlib) + >> (runBrokenStream >>= assertBool "decompress broken stream" . isLeft) + where + original = BSLL.pack "original uncompressed input" + compressedZlib = Zlib.compress original + compressedGZip = GZip.compress original + + runBrokenStream :: IO (Either SomeException ()) + runBrokenStream = try . void . evaluate . BSLL.length $ maybeDecompress (BSLL.init compressedZlib <> BSLL.pack "*") + +prop_maybeDecompress_zlib :: [Word8] -> Property +prop_maybeDecompress_zlib ws = property $ maybeDecompress compressedZlib === original + where original = BSL.pack ws + compressedZlib = Zlib.compress original + +prop_maybeDecompress_gzip :: [Word8] -> Property +prop_maybeDecompress_gzip ws = property $ maybeDecompress compressedGZip === original + where original = BSL.pack ws + compressedGZip = GZip.compress original + +-- (Only available from "Data.Either" since 7.8.) +isLeft :: Either a b -> Bool +isLeft (Right _) = False +isLeft (Left _) = True diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Get.hs b/cabal-install/tests/UnitTests/Distribution/Client/Get.hs new file mode 100644 index 00000000..98689603 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/Get.hs @@ -0,0 +1,234 @@ +{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-} +module UnitTests.Distribution.Client.Get (tests) where + +import Distribution.Client.Get + +import Distribution.Types.PackageId +import Distribution.Types.PackageName +import Distribution.Types.SourceRepo +import Distribution.Verbosity as Verbosity +import Distribution.Version + +import Control.Monad +import Control.Exception +import Data.Typeable +import System.FilePath +import System.Directory +import System.Exit +import System.IO.Error + +import Test.Tasty +import Test.Tasty.HUnit +import UnitTests.Options (RunNetworkTests (..)) +import UnitTests.TempTestDir (withTestDir) + + +tests :: [TestTree] +tests = + [ testGroup "forkPackages" + [ testCase "no repos" testNoRepos + , testCase "no repos of requested kind" testNoReposOfKind + , testCase "no repo type specified" testNoRepoType + , testCase "unsupported repo type" testUnsupportedRepoType + , testCase "no repo location specified" testNoRepoLocation + , testCase "correct repo kind selection" testSelectRepoKind + , testCase "repo destination exists" testRepoDestinationExists + , testCase "git fetch failure" testGitFetchFailed + ] + , askOption $ \(RunNetworkTests doRunNetTests) -> + testGroup "forkPackages, network tests" $ + includeTestsIf doRunNetTests $ + [ testCase "git clone" testNetworkGitClone + ] + ] + where + includeTestsIf True xs = xs + includeTestsIf False _ = [] + + + +verbosity :: Verbosity +verbosity = Verbosity.silent -- for debugging try verbose + +pkgidfoo :: PackageId +pkgidfoo = PackageIdentifier (mkPackageName "foo") (mkVersion [1,0]) + + +-- ------------------------------------------------------------ +-- * Unit tests +-- ------------------------------------------------------------ + +testNoRepos :: Assertion +testNoRepos = do + e <- assertException $ + clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos + e @?= ClonePackageNoSourceRepos pkgidfoo + where + pkgrepos = [(pkgidfoo, [])] + + +testNoReposOfKind :: Assertion +testNoReposOfKind = do + e <- assertException $ + clonePackagesFromSourceRepo verbosity "." repokind pkgrepos + e @?= ClonePackageNoSourceReposOfKind pkgidfoo repokind + where + pkgrepos = [(pkgidfoo, [repo])] + repo = emptySourceRepo RepoHead + repokind = Just RepoThis + + +testNoRepoType :: Assertion +testNoRepoType = do + e <- assertException $ + clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos + e @?= ClonePackageNoRepoType pkgidfoo repo + where + pkgrepos = [(pkgidfoo, [repo])] + repo = emptySourceRepo RepoHead + + +testUnsupportedRepoType :: Assertion +testUnsupportedRepoType = do + e <- assertException $ + clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos + e @?= ClonePackageUnsupportedRepoType pkgidfoo repo repotype + where + pkgrepos = [(pkgidfoo, [repo])] + repo = (emptySourceRepo RepoHead) { + repoType = Just repotype + } + repotype = OtherRepoType "baz" + + +testNoRepoLocation :: Assertion +testNoRepoLocation = do + e <- assertException $ + clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos + e @?= ClonePackageNoRepoLocation pkgidfoo repo + where + pkgrepos = [(pkgidfoo, [repo])] + repo = (emptySourceRepo RepoHead) { + repoType = Just repotype + } + repotype = Darcs + + +testSelectRepoKind :: Assertion +testSelectRepoKind = + sequence_ + [ do e <- test requestedRepoType pkgrepos + e @?= ClonePackageNoRepoType pkgidfoo expectedRepo + + e' <- test requestedRepoType (reverse pkgrepos) + e' @?= ClonePackageNoRepoType pkgidfoo expectedRepo + | let test rt rs = assertException $ + clonePackagesFromSourceRepo verbosity "." rt rs + , (requestedRepoType, expectedRepo) <- cases + ] + where + pkgrepos = [(pkgidfoo, [repo1, repo2, repo3])] + repo1 = emptySourceRepo RepoThis + repo2 = emptySourceRepo RepoHead + repo3 = emptySourceRepo (RepoKindUnknown "bar") + cases = [ (Nothing, repo1) + , (Just RepoThis, repo1) + , (Just RepoHead, repo2) + , (Just (RepoKindUnknown "bar"), repo3) + ] + + +testRepoDestinationExists :: Assertion +testRepoDestinationExists = + withTestDir verbosity "repos" $ \tmpdir -> do + let pkgdir = tmpdir "foo" + createDirectory pkgdir + e1 <- assertException $ + clonePackagesFromSourceRepo verbosity tmpdir Nothing pkgrepos + e1 @?= ClonePackageDestinationExists pkgidfoo pkgdir True {- isdir -} + + removeDirectory pkgdir + + writeFile pkgdir "" + e2 <- assertException $ + clonePackagesFromSourceRepo verbosity tmpdir Nothing pkgrepos + e2 @?= ClonePackageDestinationExists pkgidfoo pkgdir False {- isfile -} + where + pkgrepos = [(pkgidfoo, [repo])] + repo = (emptySourceRepo RepoHead) { + repoType = Just Darcs, + repoLocation = Just "" + } + + +testGitFetchFailed :: Assertion +testGitFetchFailed = + withTestDir verbosity "repos" $ \tmpdir -> do + let srcdir = tmpdir "src" + repo = (emptySourceRepo RepoHead) { + repoType = Just Git, + repoLocation = Just srcdir + } + pkgrepos = [(pkgidfoo, [repo])] + e1 <- assertException $ + clonePackagesFromSourceRepo verbosity tmpdir Nothing pkgrepos + e1 @?= ClonePackageFailedWithExitCode pkgidfoo repo "git" (ExitFailure 128) + + +testNetworkGitClone :: Assertion +testNetworkGitClone = + withTestDir verbosity "repos" $ \tmpdir -> do + let repo1 = (emptySourceRepo RepoHead) { + repoType = Just Git, + repoLocation = Just "https://github.com/haskell/zlib.git" + } + clonePackagesFromSourceRepo verbosity tmpdir Nothing + [(mkpkgid "zlib1", [repo1])] + assertFileContains (tmpdir "zlib1/zlib.cabal") ["name:", "zlib"] + + let repo2 = (emptySourceRepo RepoHead) { + repoType = Just Git, + repoLocation = Just (tmpdir "zlib1") + } + clonePackagesFromSourceRepo verbosity tmpdir Nothing + [(mkpkgid "zlib2", [repo2])] + assertFileContains (tmpdir "zlib2/zlib.cabal") ["name:", "zlib"] + + let repo3 = (emptySourceRepo RepoHead) { + repoType = Just Git, + repoLocation = Just (tmpdir "zlib1"), + repoTag = Just "0.5.0.0" + } + clonePackagesFromSourceRepo verbosity tmpdir Nothing + [(mkpkgid "zlib3", [repo3])] + assertFileContains (tmpdir "zlib3/zlib.cabal") ["version:", "0.5.0.0"] + where + mkpkgid nm = PackageIdentifier (mkPackageName nm) (mkVersion []) + + +-- ------------------------------------------------------------ +-- * HUnit utils +-- ------------------------------------------------------------ + +assertException :: forall e a. (Exception e, HasCallStack) => IO a -> IO e +assertException action = do + r <- try action + case r of + Left e -> return e + Right _ -> assertFailure $ "expected exception of type " + ++ show (typeOf (undefined :: e)) + + +-- | Expect that one line in a file matches exactly the given words (i.e. at +-- least insensitive to whitespace) +-- +assertFileContains :: HasCallStack => FilePath -> [String] -> Assertion +assertFileContains file expected = do + c <- readFile file `catch` \e -> + if isDoesNotExistError e + then assertFailure $ "expected a file to exist: " ++ file + else throwIO e + unless (expected `elem` map words (lines c)) $ + assertFailure $ "expected the file " ++ file ++ " to contain " + ++ show (take 100 expected) + diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Glob.hs b/cabal-install/tests/UnitTests/Distribution/Client/Glob.hs new file mode 100644 index 00000000..8cd446d6 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/Glob.hs @@ -0,0 +1,203 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module UnitTests.Distribution.Client.Glob (tests) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif +import Data.Char +import Data.List +import Distribution.Text (display, parse, simpleParse) +import Distribution.Compat.ReadP + +import Distribution.Client.Glob +import UnitTests.Distribution.Client.ArbitraryInstances + +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit +import Control.Exception + + +tests :: [TestTree] +tests = + [ testProperty "print/parse roundtrip" prop_roundtrip_printparse + , testCase "parse examples" testParseCases + ] + +--TODO: [nice to have] tests for trivial globs, tests for matching, +-- tests for windows style file paths + +prop_roundtrip_printparse :: FilePathGlob -> Bool +prop_roundtrip_printparse pathglob = + -- can't use simpleParse because it mis-handles trailing spaces + case [ x | (x, []) <- readP_to_S parse (display pathglob) ] of + xs@(_:_) -> last xs == pathglob + _ -> False + +-- first run, where we don't even call updateMonitor +testParseCases :: Assertion +testParseCases = do + + FilePathGlob (FilePathRoot "/") GlobDirTrailing <- testparse "/" + FilePathGlob FilePathHomeDir GlobDirTrailing <- testparse "~/" + + FilePathGlob (FilePathRoot "A:\\") GlobDirTrailing <- testparse "A:/" + FilePathGlob (FilePathRoot "Z:\\") GlobDirTrailing <- testparse "z:/" + FilePathGlob (FilePathRoot "C:\\") GlobDirTrailing <- testparse "C:\\" + FilePathGlob FilePathRelative (GlobFile [Literal "_:"]) <- testparse "_:" + + FilePathGlob FilePathRelative + (GlobFile [Literal "."]) <- testparse "." + + FilePathGlob FilePathRelative + (GlobFile [Literal "~"]) <- testparse "~" + + FilePathGlob FilePathRelative + (GlobDir [Literal "."] GlobDirTrailing) <- testparse "./" + + FilePathGlob FilePathRelative + (GlobFile [Literal "foo"]) <- testparse "foo" + + FilePathGlob FilePathRelative + (GlobDir [Literal "foo"] + (GlobFile [Literal "bar"])) <- testparse "foo/bar" + + FilePathGlob FilePathRelative + (GlobDir [Literal "foo"] + (GlobDir [Literal "bar"] GlobDirTrailing)) <- testparse "foo/bar/" + + FilePathGlob (FilePathRoot "/") + (GlobDir [Literal "foo"] + (GlobDir [Literal "bar"] GlobDirTrailing)) <- testparse "/foo/bar/" + + FilePathGlob FilePathRelative + (GlobFile [WildCard]) <- testparse "*" + + FilePathGlob FilePathRelative + (GlobFile [WildCard,WildCard]) <- testparse "**" -- not helpful but valid + + FilePathGlob FilePathRelative + (GlobFile [WildCard, Literal "foo", WildCard]) <- testparse "*foo*" + + FilePathGlob FilePathRelative + (GlobFile [Literal "foo", WildCard, Literal "bar"]) <- testparse "foo*bar" + + FilePathGlob FilePathRelative + (GlobFile [Union [[WildCard], [Literal "foo"]]]) <- testparse "{*,foo}" + + parseFail "{" + parseFail "}" + parseFail "," + parseFail "{" + parseFail "{{}" + parseFail "{}" + parseFail "{,}" + parseFail "{foo,}" + parseFail "{,foo}" + + return () + +testparse :: String -> IO FilePathGlob +testparse s = + case simpleParse s of + Just p -> return p + Nothing -> throwIO $ HUnitFailure Nothing ("expected parse of: " ++ s) + +parseFail :: String -> Assertion +parseFail s = + case simpleParse s :: Maybe FilePathGlob of + Just _ -> throwIO $ HUnitFailure Nothing ("expected no parse of: " ++ s) + Nothing -> return () + +instance Arbitrary FilePathGlob where + arbitrary = (FilePathGlob <$> arbitrary <*> arbitrary) + `suchThat` validFilePathGlob + + shrink (FilePathGlob root pathglob) = + [ FilePathGlob root' pathglob' + | (root', pathglob') <- shrink (root, pathglob) + , validFilePathGlob (FilePathGlob root' pathglob') ] + +validFilePathGlob :: FilePathGlob -> Bool +validFilePathGlob (FilePathGlob FilePathRelative pathglob) = + case pathglob of + GlobDirTrailing -> False + GlobDir [Literal "~"] _ -> False + GlobDir [Literal (d:":")] _ + | isLetter d -> False + _ -> True +validFilePathGlob _ = True + +instance Arbitrary FilePathRoot where + arbitrary = + frequency + [ (3, pure FilePathRelative) + , (1, pure (FilePathRoot unixroot)) + , (1, FilePathRoot <$> windrive) + , (1, pure FilePathHomeDir) + ] + where + unixroot = "/" + windrive = do d <- choose ('A', 'Z'); return (d : ":\\") + + shrink FilePathRelative = [] + shrink (FilePathRoot _) = [FilePathRelative] + shrink FilePathHomeDir = [FilePathRelative] + + +instance Arbitrary FilePathGlobRel where + arbitrary = sized $ \sz -> + oneof $ take (max 1 sz) + [ pure GlobDirTrailing + , GlobFile <$> (getGlobPieces <$> arbitrary) + , GlobDir <$> (getGlobPieces <$> arbitrary) + <*> resize (sz `div` 2) arbitrary + ] + + shrink GlobDirTrailing = [] + shrink (GlobFile glob) = + GlobDirTrailing + : [ GlobFile (getGlobPieces glob') | glob' <- shrink (GlobPieces glob) ] + shrink (GlobDir glob pathglob) = + pathglob + : GlobFile glob + : [ GlobDir (getGlobPieces glob') pathglob' + | (glob', pathglob') <- shrink (GlobPieces glob, pathglob) ] + +newtype GlobPieces = GlobPieces { getGlobPieces :: [GlobPiece] } + deriving Eq + +instance Arbitrary GlobPieces where + arbitrary = GlobPieces . mergeLiterals <$> shortListOf1 5 arbitrary + + shrink (GlobPieces glob) = + [ GlobPieces (mergeLiterals (getNonEmpty glob')) + | glob' <- shrink (NonEmpty glob) ] + +mergeLiterals :: [GlobPiece] -> [GlobPiece] +mergeLiterals (Literal a : Literal b : ps) = mergeLiterals (Literal (a++b) : ps) +mergeLiterals (Union as : ps) = Union (map mergeLiterals as) : mergeLiterals ps +mergeLiterals (p:ps) = p : mergeLiterals ps +mergeLiterals [] = [] + +instance Arbitrary GlobPiece where + arbitrary = sized $ \sz -> + frequency + [ (3, Literal <$> shortListOf1 10 (elements globLiteralChars)) + , (1, pure WildCard) + , (1, Union <$> resize (sz `div` 2) (shortListOf1 5 (shortListOf1 5 arbitrary))) + ] + + shrink (Literal str) = [ Literal str' + | str' <- shrink str + , not (null str') + , all (`elem` globLiteralChars) str' ] + shrink WildCard = [] + shrink (Union as) = [ Union (map getGlobPieces (getNonEmpty as')) + | as' <- shrink (NonEmpty (map GlobPieces as)) ] + +globLiteralChars :: [Char] +globLiteralChars = ['\0'..'\128'] \\ "*{},/\\" + diff --git a/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs b/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs new file mode 100644 index 00000000..aa77ea60 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs @@ -0,0 +1,60 @@ +module UnitTests.Distribution.Client.IndexUtils.Timestamp (tests) where + +import Distribution.Text +import Data.Time +import Data.Time.Clock.POSIX + +import Distribution.Client.IndexUtils.Timestamp + +import Test.Tasty +import Test.Tasty.QuickCheck + +tests :: [TestTree] +tests = + [ testProperty "Timestamp1" prop_timestamp1 + , testProperty "Timestamp2" prop_timestamp2 + , testProperty "Timestamp3" prop_timestamp3 + , testProperty "Timestamp4" prop_timestamp4 + , testProperty "Timestamp5" prop_timestamp5 + ] + +-- test unixtime format parsing +prop_timestamp1 :: Int -> Bool +prop_timestamp1 t0 = Just t == simpleParse ('@':show t0) + where + t = toEnum t0 :: Timestamp + +-- test display/simpleParse roundtrip +prop_timestamp2 :: Int -> Bool +prop_timestamp2 t0 + | t /= nullTimestamp = simpleParse (display t) == Just t + | otherwise = display t == "" + where + t = toEnum t0 :: Timestamp + +-- test display against reference impl +prop_timestamp3 :: Int -> Bool +prop_timestamp3 t0 + | t /= nullTimestamp = refDisp t == display t + | otherwise = display t == "" + where + t = toEnum t0 :: Timestamp + + refDisp = maybe undefined (formatTime undefined "%FT%TZ") + . timestampToUTCTime + +-- test utcTimeToTimestamp/timestampToUTCTime roundtrip +prop_timestamp4 :: Int -> Bool +prop_timestamp4 t0 + | t /= nullTimestamp = (utcTimeToTimestamp =<< timestampToUTCTime t) == Just t + | otherwise = timestampToUTCTime t == Nothing + where + t = toEnum t0 :: Timestamp + +prop_timestamp5 :: Int -> Bool +prop_timestamp5 t0 + | t /= nullTimestamp = timestampToUTCTime t == Just ut + | otherwise = timestampToUTCTime t == Nothing + where + t = toEnum t0 :: Timestamp + ut = posixSecondsToUTCTime (fromIntegral t0) diff --git a/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs b/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs new file mode 100644 index 00000000..ceee8742 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs @@ -0,0 +1,312 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE NoMonoLocalBinds #-} +{-# LANGUAGE ConstraintKinds #-} +module UnitTests.Distribution.Client.InstallPlan (tests) where + +import Distribution.Package +import Distribution.Version +import qualified Distribution.Client.InstallPlan as InstallPlan +import Distribution.Client.InstallPlan (GenericInstallPlan, IsUnit) +import qualified Distribution.Compat.Graph as Graph +import Distribution.Compat.Graph (IsNode(..)) +import Distribution.Solver.Types.Settings +import Distribution.Solver.Types.PackageFixedDeps +import qualified Distribution.Solver.Types.ComponentDeps as CD +import Distribution.Client.Types +import Distribution.Client.JobControl + +import Data.Graph +import Data.Array hiding (index) +import Data.List +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Set (Set) +import Data.IORef +import Control.Monad +import Control.Concurrent (threadDelay) +import System.Random +import Test.QuickCheck + +import Test.Tasty +import Test.Tasty.QuickCheck + + +tests :: [TestTree] +tests = + [ testProperty "reverseTopologicalOrder" prop_reverseTopologicalOrder + , testProperty "executionOrder" prop_executionOrder + , testProperty "execute serial" prop_execute_serial + , testProperty "execute parallel" prop_execute_parallel + , testProperty "execute/executionOrder" prop_execute_vs_executionOrder + ] + +prop_reverseTopologicalOrder :: TestInstallPlan -> Bool +prop_reverseTopologicalOrder (TestInstallPlan plan graph toVertex _) = + isReverseTopologicalOrder + graph + (map (toVertex . installedUnitId) + (InstallPlan.reverseTopologicalOrder plan)) + +-- | @executionOrder@ is in reverse topological order +prop_executionOrder :: TestInstallPlan -> Bool +prop_executionOrder (TestInstallPlan plan graph toVertex _) = + isReversePartialTopologicalOrder graph (map toVertex pkgids) + && allConfiguredPackages plan == Set.fromList pkgids + where + pkgids = map installedUnitId (InstallPlan.executionOrder plan) + +-- | @execute@ is in reverse topological order +prop_execute_serial :: TestInstallPlan -> Property +prop_execute_serial tplan@(TestInstallPlan plan graph toVertex _) = + ioProperty $ do + jobCtl <- newSerialJobControl + pkgids <- executeTestInstallPlan jobCtl tplan (\_ -> return ()) + return $ isReversePartialTopologicalOrder graph (map toVertex pkgids) + && allConfiguredPackages plan == Set.fromList pkgids + +prop_execute_parallel :: Positive (Small Int) -> TestInstallPlan -> Property +prop_execute_parallel (Positive (Small maxJobLimit)) + tplan@(TestInstallPlan plan graph toVertex _) = + ioProperty $ do + jobCtl <- newParallelJobControl maxJobLimit + pkgids <- executeTestInstallPlan jobCtl tplan $ \_ -> do + delay <- randomRIO (0,1000) + threadDelay delay + return $ isReversePartialTopologicalOrder graph (map toVertex pkgids) + && allConfiguredPackages plan == Set.fromList pkgids + +-- | return the packages that are visited by execute, in order. +executeTestInstallPlan :: JobControl IO (UnitId, Either () ()) + -> TestInstallPlan + -> (TestPkg -> IO ()) + -> IO [UnitId] +executeTestInstallPlan jobCtl (TestInstallPlan plan _ _ _) visit = do + resultsRef <- newIORef [] + _ <- InstallPlan.execute jobCtl False (const ()) + plan $ \(ReadyPackage pkg) -> do + visit pkg + atomicModifyIORef resultsRef $ \pkgs -> (installedUnitId pkg:pkgs, ()) + return (Right ()) + fmap reverse (readIORef resultsRef) + +-- | @execute@ visits the packages in the same order as @executionOrder@ +prop_execute_vs_executionOrder :: TestInstallPlan -> Property +prop_execute_vs_executionOrder tplan@(TestInstallPlan plan _ _ _) = + ioProperty $ do + jobCtl <- newSerialJobControl + pkgids <- executeTestInstallPlan jobCtl tplan (\_ -> return ()) + let pkgids' = map installedUnitId (InstallPlan.executionOrder plan) + return (pkgids == pkgids') + + +-------------------------- +-- Property helper utils +-- + +-- | A graph topological ordering is a linear ordering of its vertices such +-- that for every directed edge uv from vertex u to vertex v, u comes before v +-- in the ordering. +-- +-- A reverse topological ordering is the swapped: for every directed edge uv +-- from vertex u to vertex v, v comes before u in the ordering. +-- +isReverseTopologicalOrder :: Graph -> [Vertex] -> Bool +isReverseTopologicalOrder g vs = + and [ ixs ! u > ixs ! v + | let ixs = array (bounds g) (zip vs [0::Int ..]) + , (u,v) <- edges g ] + +isReversePartialTopologicalOrder :: Graph -> [Vertex] -> Bool +isReversePartialTopologicalOrder g vs = + and [ case (ixs ! u, ixs ! v) of + (Just ixu, Just ixv) -> ixu > ixv + _ -> True + | let ixs = array (bounds g) + (zip (range (bounds g)) (repeat Nothing) ++ + zip vs (map Just [0::Int ..])) + , (u,v) <- edges g ] + +allConfiguredPackages :: HasUnitId srcpkg + => GenericInstallPlan ipkg srcpkg -> Set UnitId +allConfiguredPackages plan = + Set.fromList + [ installedUnitId pkg + | InstallPlan.Configured pkg <- InstallPlan.toList plan ] + + +-------------------- +-- Test generators +-- + +data TestInstallPlan = TestInstallPlan + (GenericInstallPlan TestPkg TestPkg) + Graph + (UnitId -> Vertex) + (Vertex -> UnitId) + +instance Show TestInstallPlan where + show (TestInstallPlan plan _ _ _) = InstallPlan.showInstallPlan plan + +data TestPkg = TestPkg PackageId UnitId [UnitId] + deriving (Eq, Show) + +instance IsNode TestPkg where + type Key TestPkg = UnitId + nodeKey (TestPkg _ ipkgid _) = ipkgid + nodeNeighbors (TestPkg _ _ deps) = deps + + +instance Package TestPkg where + packageId (TestPkg pkgid _ _) = pkgid + +instance HasUnitId TestPkg where + installedUnitId (TestPkg _ ipkgid _) = ipkgid + +instance PackageFixedDeps TestPkg where + depends (TestPkg _ _ deps) = CD.singleton CD.ComponentLib deps + +instance PackageInstalled TestPkg where + installedDepends (TestPkg _ _ deps) = deps + +instance Arbitrary TestInstallPlan where + arbitrary = arbitraryTestInstallPlan + +arbitraryTestInstallPlan :: Gen TestInstallPlan +arbitraryTestInstallPlan = do + graph <- arbitraryAcyclicGraph + (choose (2,5)) + (choose (1,5)) + 0.3 + + plan <- arbitraryInstallPlan mkTestPkg mkTestPkg 0.5 graph + + let toVertexMap = Map.fromList [ (mkUnitIdV v, v) | v <- vertices graph ] + fromVertexMap = Map.fromList [ (v, mkUnitIdV v) | v <- vertices graph ] + toVertex = (toVertexMap Map.!) + fromVertex = (fromVertexMap Map.!) + + return (TestInstallPlan plan graph toVertex fromVertex) + where + mkTestPkg pkgv depvs = + return (TestPkg pkgid ipkgid deps) + where + pkgid = mkPkgId pkgv + ipkgid = mkUnitIdV pkgv + deps = map mkUnitIdV depvs + mkUnitIdV = mkUnitId . show + mkPkgId v = PackageIdentifier (mkPackageName ("pkg" ++ show v)) + (mkVersion [1]) + + +-- | Generate a random 'InstallPlan' following the structure of an existing +-- 'Graph'. +-- +-- It takes generators for installed and source packages and the chance that +-- each package is installed (for those packages with no prerequisites). +-- +arbitraryInstallPlan :: (IsUnit ipkg, + IsUnit srcpkg) + => (Vertex -> [Vertex] -> Gen ipkg) + -> (Vertex -> [Vertex] -> Gen srcpkg) + -> Float + -> Graph + -> Gen (InstallPlan.GenericInstallPlan ipkg srcpkg) +arbitraryInstallPlan mkIPkg mkSrcPkg ipkgProportion graph = do + + (ipkgvs, srcpkgvs) <- + fmap ((\(ipkgs, srcpkgs) -> (map fst ipkgs, map fst srcpkgs)) + . partition snd) $ + sequence + [ do isipkg <- if isRoot then pick ipkgProportion + else return False + return (v, isipkg) + | (v,n) <- assocs (outdegree graph) + , let isRoot = n == 0 ] + + ipkgs <- sequence + [ mkIPkg pkgv depvs + | pkgv <- ipkgvs + , let depvs = graph ! pkgv + ] + srcpkgs <- sequence + [ mkSrcPkg pkgv depvs + | pkgv <- srcpkgvs + , let depvs = graph ! pkgv + ] + let index = Graph.fromDistinctList + (map InstallPlan.PreExisting ipkgs + ++ map InstallPlan.Configured srcpkgs) + return $ InstallPlan.new (IndependentGoals False) index + + +-- | Generate a random directed acyclic graph, based on the algorithm presented +-- here +-- +-- It generates a DAG based on ranks of nodes. Nodes in each rank can only +-- have edges to nodes in subsequent ranks. +-- +-- The generator is paramterised by a generator for the number of ranks and +-- the number of nodes within each rank. It is also paramterised by the +-- chance that each node in each rank will have an edge from each node in +-- each previous rank. Thus a higher chance will produce a more densely +-- connected graph. +-- +arbitraryAcyclicGraph :: Gen Int -> Gen Int -> Float -> Gen Graph +arbitraryAcyclicGraph genNRanks genNPerRank edgeChance = do + nranks <- genNRanks + rankSizes <- replicateM nranks genNPerRank + let rankStarts = scanl (+) 0 rankSizes + rankRanges = drop 1 (zip rankStarts (tail rankStarts)) + totalRange = sum rankSizes + rankEdges <- mapM (uncurry genRank) rankRanges + return $ buildG (0, totalRange-1) (concat rankEdges) + where + genRank :: Vertex -> Vertex -> Gen [Edge] + genRank rankStart rankEnd = + filterM (const (pick edgeChance)) + [ (i,j) + | i <- [0..rankStart-1] + , j <- [rankStart..rankEnd-1] + ] + +pick :: Float -> Gen Bool +pick chance = do + p <- choose (0,1) + return (p < chance) + + +-------------------------------- +-- Inspecting generated graphs +-- + +{- +-- Handy util for checking the generated graphs look sensible +writeDotFile :: FilePath -> Graph -> IO () +writeDotFile file = writeFile file . renderDotGraph + +renderDotGraph :: Graph -> String +renderDotGraph graph = + unlines ( + [header + ,graphDefaultAtribs + ,nodeDefaultAtribs + ,edgeDefaultAtribs] + ++ map renderNode (vertices graph) + ++ map renderEdge (edges graph) + ++ [footer] + ) + where + renderNode n = "\t" ++ show n ++ " [label=\"" ++ show n ++ "\"];" + + renderEdge (n, n') = "\t" ++ show n ++ " -> " ++ show n' ++ "[];" + + +header, footer, graphDefaultAtribs, nodeDefaultAtribs, edgeDefaultAtribs :: String + +header = "digraph packages {" +footer = "}" + +graphDefaultAtribs = "\tgraph [fontsize=14, fontcolor=black, color=black];" +nodeDefaultAtribs = "\tnode [label=\"\\N\", width=\"0.75\", shape=ellipse];" +edgeDefaultAtribs = "\tedge [fontsize=10];" +-} diff --git a/cabal-install/tests/UnitTests/Distribution/Client/JobControl.hs b/cabal-install/tests/UnitTests/Distribution/Client/JobControl.hs new file mode 100644 index 00000000..56f2e2b2 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/JobControl.hs @@ -0,0 +1,193 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module UnitTests.Distribution.Client.JobControl (tests) where + +import Distribution.Client.JobControl + +import Data.List +import Data.Maybe +import Data.IORef +import Control.Monad +import Control.Concurrent (threadDelay) +import Control.Exception (Exception, try, throwIO) +import Data.Typeable (Typeable) +import qualified Data.Set as Set + +import Test.Tasty +import Test.Tasty.QuickCheck hiding (collect) + + +tests :: [TestTree] +tests = + [ testGroup "serial" + [ testProperty "submit batch" prop_submit_serial + , testProperty "submit batch" prop_remaining_serial + , testProperty "submit interleaved" prop_interleaved_serial + , testProperty "concurrent jobs" prop_concurrent_serial + , testProperty "cancel" prop_cancel_serial + , testProperty "exceptions" prop_exception_serial + ] + , testGroup "parallel" + [ testProperty "submit batch" prop_submit_parallel + , testProperty "submit batch" prop_remaining_parallel + , testProperty "submit interleaved" prop_interleaved_parallel + , testProperty "concurrent jobs" prop_concurrent_parallel + , testProperty "cancel" prop_cancel_parallel + , testProperty "exceptions" prop_exception_parallel + ] + ] + + +prop_submit_serial :: [Int] -> Property +prop_submit_serial xs = + ioProperty $ do + jobCtl <- newSerialJobControl + prop_submit jobCtl xs + +prop_submit_parallel :: Positive (Small Int) -> [Int] -> Property +prop_submit_parallel (Positive (Small maxJobLimit)) xs = + ioProperty $ do + jobCtl <- newParallelJobControl maxJobLimit + prop_submit jobCtl xs + +prop_remaining_serial :: [Int] -> Property +prop_remaining_serial xs = + ioProperty $ do + jobCtl <- newSerialJobControl + prop_remaining jobCtl xs + +prop_remaining_parallel :: Positive (Small Int) -> [Int] -> Property +prop_remaining_parallel (Positive (Small maxJobLimit)) xs = + ioProperty $ do + jobCtl <- newParallelJobControl maxJobLimit + prop_remaining jobCtl xs + +prop_interleaved_serial :: [Int] -> Property +prop_interleaved_serial xs = + ioProperty $ do + jobCtl <- newSerialJobControl + prop_submit_interleaved jobCtl xs + +prop_interleaved_parallel :: Positive (Small Int) -> [Int] -> Property +prop_interleaved_parallel (Positive (Small maxJobLimit)) xs = + ioProperty $ do + jobCtl <- newParallelJobControl maxJobLimit + prop_submit_interleaved jobCtl xs + +prop_submit :: JobControl IO Int -> [Int] -> IO Bool +prop_submit jobCtl xs = do + mapM_ (\x -> spawnJob jobCtl (return x)) xs + xs' <- mapM (\_ -> collectJob jobCtl) xs + return (sort xs == sort xs') + +prop_remaining :: JobControl IO Int -> [Int] -> IO Bool +prop_remaining jobCtl xs = do + mapM_ (\x -> spawnJob jobCtl (return x)) xs + xs' <- collectRemainingJobs jobCtl + return (sort xs == sort xs') + +collectRemainingJobs :: Monad m => JobControl m a -> m [a] +collectRemainingJobs jobCtl = go [] + where + go xs = do + remaining <- remainingJobs jobCtl + if remaining + then do x <- collectJob jobCtl + go (x:xs) + else return xs + +prop_submit_interleaved :: JobControl IO (Maybe Int) -> [Int] -> IO Bool +prop_submit_interleaved jobCtl xs = do + xs' <- sequence + [ spawn >> collect + | let spawns = map (\x -> spawnJob jobCtl (return (Just x))) xs + ++ repeat (return ()) + collects = replicate 5 (return Nothing) + ++ map (\_ -> collectJob jobCtl) xs + , (spawn, collect) <- zip spawns collects + ] + return (sort xs == sort (catMaybes xs')) + +prop_concurrent_serial :: NonNegative (Small Int) -> Property +prop_concurrent_serial (NonNegative (Small ntasks)) = + ioProperty $ do + jobCtl <- newSerialJobControl + countRef <- newIORef (0 :: Int) + replicateM_ ntasks (spawnJob jobCtl (task countRef)) + counts <- replicateM ntasks (collectJob jobCtl) + return $ length counts == ntasks + && all (\(n0, n1) -> n0 == 0 && n1 == 1) counts + where + task countRef = do + n0 <- atomicModifyIORef countRef (\n -> (n+1, n)) + threadDelay 100 + n1 <- atomicModifyIORef countRef (\n -> (n-1, n)) + return (n0, n1) + +prop_concurrent_parallel :: Positive (Small Int) -> NonNegative Int -> Property +prop_concurrent_parallel (Positive (Small maxJobLimit)) (NonNegative ntasks) = + ioProperty $ do + jobCtl <- newParallelJobControl maxJobLimit + countRef <- newIORef (0 :: Int) + replicateM_ ntasks (spawnJob jobCtl (task countRef)) + counts <- replicateM ntasks (collectJob jobCtl) + return $ length counts == ntasks + && all (\(n0, n1) -> n0 >= 0 && n0 < maxJobLimit + && n1 > 0 && n1 <= maxJobLimit) counts + -- we do hit the concurrency limit (in the right circumstances) + && if ntasks >= maxJobLimit*2 -- give us enough of a margin + then any (\(_,n1) -> n1 == maxJobLimit) counts + else True + where + task countRef = do + n0 <- atomicModifyIORef countRef (\n -> (n+1, n)) + threadDelay 100 + n1 <- atomicModifyIORef countRef (\n -> (n-1, n)) + return (n0, n1) + +prop_cancel_serial :: [Int] -> [Int] -> Property +prop_cancel_serial xs ys = + ioProperty $ do + jobCtl <- newSerialJobControl + mapM_ (\x -> spawnJob jobCtl (return x)) (xs++ys) + xs' <- mapM (\_ -> collectJob jobCtl) xs + cancelJobs jobCtl + ys' <- collectRemainingJobs jobCtl + return (sort xs == sort xs' && null ys') + +prop_cancel_parallel :: Positive (Small Int) -> [Int] -> [Int] -> Property +prop_cancel_parallel (Positive (Small maxJobLimit)) xs ys = do + ioProperty $ do + jobCtl <- newParallelJobControl maxJobLimit + mapM_ (\x -> spawnJob jobCtl (threadDelay 100 >> return x)) (xs++ys) + xs' <- mapM (\_ -> collectJob jobCtl) xs + cancelJobs jobCtl + ys' <- collectRemainingJobs jobCtl + return $ Set.fromList (xs'++ys') `Set.isSubsetOf` Set.fromList (xs++ys) + +data TestException = TestException Int + deriving (Typeable, Show) + +instance Exception TestException + +prop_exception_serial :: [Either Int Int] -> Property +prop_exception_serial xs = + ioProperty $ do + jobCtl <- newSerialJobControl + prop_exception jobCtl xs + +prop_exception_parallel :: Positive (Small Int) -> [Either Int Int] -> Property +prop_exception_parallel (Positive (Small maxJobLimit)) xs = + ioProperty $ do + jobCtl <- newParallelJobControl maxJobLimit + prop_exception jobCtl xs + +prop_exception :: JobControl IO Int -> [Either Int Int] -> IO Bool +prop_exception jobCtl xs = do + mapM_ (\x -> spawnJob jobCtl (either (throwIO . TestException) return x)) xs + xs' <- replicateM (length xs) $ do + mx <- try (collectJob jobCtl) + return $ case mx of + Left (TestException n) -> Left n + Right n -> Right n + return (sort xs == sort xs') + diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs new file mode 100644 index 00000000..6649e3f6 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs @@ -0,0 +1,901 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module UnitTests.Distribution.Client.ProjectConfig (tests) where + +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid +import Control.Applicative +#endif +import Data.Map (Map) +import qualified Data.Map as Map +import Data.List + +import Distribution.Package +import Distribution.PackageDescription hiding (Flag) +import Distribution.Compiler +import Distribution.Version +import Distribution.ParseUtils +import Distribution.Text as Text +import Distribution.Simple.Compiler +import Distribution.Simple.Setup +import Distribution.Simple.InstallDirs +import qualified Distribution.Compat.ReadP as Parse +import Distribution.Simple.Utils +import Distribution.Simple.Program.Types +import Distribution.Simple.Program.Db +import Distribution.Types.PackageVersionConstraint + +import Distribution.Client.Types +import Distribution.Client.Dependency.Types +import Distribution.Client.BuildReports.Types +import Distribution.Client.Targets +import Distribution.Utils.NubList +import Network.URI + +import Distribution.Solver.Types.PackageConstraint +import Distribution.Solver.Types.ConstraintSource +import Distribution.Solver.Types.OptionalStanza +import Distribution.Solver.Types.Settings + +import Distribution.Client.ProjectConfig +import Distribution.Client.ProjectConfig.Legacy + +import UnitTests.Distribution.Client.ArbitraryInstances + +import Test.Tasty +import Test.Tasty.QuickCheck + +tests :: [TestTree] +tests = + [ testGroup "ProjectConfig <-> LegacyProjectConfig round trip" $ + [ testProperty "packages" prop_roundtrip_legacytypes_packages + , testProperty "buildonly" prop_roundtrip_legacytypes_buildonly + , testProperty "specific" prop_roundtrip_legacytypes_specific + ] ++ + -- a couple tests seem to trigger a RTS fault in ghc-7.6 and older + -- unclear why as of yet + concat + [ [ testProperty "shared" prop_roundtrip_legacytypes_shared + , testProperty "local" prop_roundtrip_legacytypes_local + , testProperty "all" prop_roundtrip_legacytypes_all + ] + | not usingGhc76orOlder + ] + + , testGroup "individual parser tests" + [ testProperty "package location" prop_parsePackageLocationTokenQ + , testProperty "RelaxedDep" prop_roundtrip_printparse_RelaxedDep + , testProperty "RelaxDeps" prop_roundtrip_printparse_RelaxDeps + , testProperty "RelaxDeps'" prop_roundtrip_printparse_RelaxDeps' + ] + + , testGroup "ProjectConfig printing/parsing round trip" + [ testProperty "packages" prop_roundtrip_printparse_packages + , testProperty "buildonly" prop_roundtrip_printparse_buildonly + , testProperty "shared" prop_roundtrip_printparse_shared + , testProperty "local" prop_roundtrip_printparse_local + , testProperty "specific" prop_roundtrip_printparse_specific + , testProperty "all" prop_roundtrip_printparse_all + ] + ] + where + usingGhc76orOlder = + case buildCompilerId of + CompilerId GHC v -> v < mkVersion [7,7] + _ -> False + + +------------------------------------------------ +-- Round trip: conversion to/from legacy types +-- + +roundtrip :: Eq a => (a -> b) -> (b -> a) -> a -> Bool +roundtrip f f_inv x = + (f_inv . f) x == x + +roundtrip_legacytypes :: ProjectConfig -> Bool +roundtrip_legacytypes = + roundtrip convertToLegacyProjectConfig + convertLegacyProjectConfig + + +prop_roundtrip_legacytypes_all :: ProjectConfig -> Bool +prop_roundtrip_legacytypes_all config = + roundtrip_legacytypes + config { + projectConfigProvenance = mempty + } + +prop_roundtrip_legacytypes_packages :: ProjectConfig -> Bool +prop_roundtrip_legacytypes_packages config = + roundtrip_legacytypes + config { + projectConfigBuildOnly = mempty, + projectConfigShared = mempty, + projectConfigProvenance = mempty, + projectConfigLocalPackages = mempty, + projectConfigSpecificPackage = mempty + } + +prop_roundtrip_legacytypes_buildonly :: ProjectConfigBuildOnly -> Bool +prop_roundtrip_legacytypes_buildonly config = + roundtrip_legacytypes + mempty { projectConfigBuildOnly = config } + +prop_roundtrip_legacytypes_shared :: ProjectConfigShared -> Bool +prop_roundtrip_legacytypes_shared config = + roundtrip_legacytypes + mempty { projectConfigShared = config } + +prop_roundtrip_legacytypes_local :: PackageConfig -> Bool +prop_roundtrip_legacytypes_local config = + roundtrip_legacytypes + mempty { projectConfigLocalPackages = config } + +prop_roundtrip_legacytypes_specific :: Map PackageName PackageConfig -> Bool +prop_roundtrip_legacytypes_specific config = + roundtrip_legacytypes + mempty { projectConfigSpecificPackage = MapMappend config } + + +-------------------------------------------- +-- Round trip: printing and parsing config +-- + +roundtrip_printparse :: ProjectConfig -> Bool +roundtrip_printparse config = + case (fmap convertLegacyProjectConfig + . parseLegacyProjectConfig + . showLegacyProjectConfig + . convertToLegacyProjectConfig) + config of + ParseOk _ x -> x == config { projectConfigProvenance = mempty } + _ -> False + + +prop_roundtrip_printparse_all :: ProjectConfig -> Bool +prop_roundtrip_printparse_all config = + roundtrip_printparse config { + projectConfigBuildOnly = + hackProjectConfigBuildOnly (projectConfigBuildOnly config), + + projectConfigShared = + hackProjectConfigShared (projectConfigShared config) + } + +prop_roundtrip_printparse_packages :: [PackageLocationString] + -> [PackageLocationString] + -> [SourceRepo] + -> [PackageVersionConstraint] + -> Bool +prop_roundtrip_printparse_packages pkglocstrs1 pkglocstrs2 repos named = + roundtrip_printparse + mempty { + projectPackages = map getPackageLocationString pkglocstrs1, + projectPackagesOptional = map getPackageLocationString pkglocstrs2, + projectPackagesRepo = repos, + projectPackagesNamed = named + } + +prop_roundtrip_printparse_buildonly :: ProjectConfigBuildOnly -> Bool +prop_roundtrip_printparse_buildonly config = + roundtrip_printparse + mempty { + projectConfigBuildOnly = hackProjectConfigBuildOnly config + } + +hackProjectConfigBuildOnly :: ProjectConfigBuildOnly -> ProjectConfigBuildOnly +hackProjectConfigBuildOnly config = + config { + -- These two fields are only command line transitory things, not + -- something to be recorded persistently in a config file + projectConfigOnlyDeps = mempty, + projectConfigDryRun = mempty + } + +prop_roundtrip_printparse_shared :: ProjectConfigShared -> Bool +prop_roundtrip_printparse_shared config = + roundtrip_printparse + mempty { + projectConfigShared = hackProjectConfigShared config + } + +hackProjectConfigShared :: ProjectConfigShared -> ProjectConfigShared +hackProjectConfigShared config = + config { + projectConfigProjectFile = mempty, -- not present within project files + projectConfigConfigFile = mempty, -- ditto + projectConfigConstraints = + --TODO: [required eventually] parse ambiguity in constraint + -- "pkgname -any" as either any version or disabled flag "any". + let ambiguous (UserConstraint _ (PackagePropertyFlags flags), _) = + (not . null) [ () | (name, False) <- unFlagAssignment flags + , "any" `isPrefixOf` unFlagName name ] + ambiguous _ = False + in filter (not . ambiguous) (projectConfigConstraints config) + } + + +prop_roundtrip_printparse_local :: PackageConfig -> Bool +prop_roundtrip_printparse_local config = + roundtrip_printparse + mempty { + projectConfigLocalPackages = config + } + +prop_roundtrip_printparse_specific :: Map PackageName (NonMEmpty PackageConfig) + -> Bool +prop_roundtrip_printparse_specific config = + roundtrip_printparse + mempty { + projectConfigSpecificPackage = MapMappend (fmap getNonMEmpty config) + } + + +---------------------------- +-- Individual Parser tests +-- + +-- | Helper to parse a given string +-- +-- Succeeds only if there is a unique complete parse +runReadP :: Parse.ReadP a a -> String -> Maybe a +runReadP parser s = case [ x | (x,"") <- Parse.readP_to_S parser s ] of + [x'] -> Just x' + _ -> Nothing + +prop_parsePackageLocationTokenQ :: PackageLocationString -> Bool +prop_parsePackageLocationTokenQ (PackageLocationString str) = + runReadP parsePackageLocationTokenQ (renderPackageLocationToken str) == Just str + +prop_roundtrip_printparse_RelaxedDep :: RelaxedDep -> Bool +prop_roundtrip_printparse_RelaxedDep rdep = + runReadP Text.parse (Text.display rdep) == Just rdep + +prop_roundtrip_printparse_RelaxDeps :: RelaxDeps -> Bool +prop_roundtrip_printparse_RelaxDeps rdep = + runReadP Text.parse (Text.display rdep) == Just rdep + +prop_roundtrip_printparse_RelaxDeps' :: RelaxDeps -> Bool +prop_roundtrip_printparse_RelaxDeps' rdep = + runReadP Text.parse (go $ Text.display rdep) == Just rdep + where + -- replace 'all' tokens by '*' + go :: String -> String + go [] = [] + go "all" = "*" + go ('a':'l':'l':c:rest) | c `elem` ":," = '*' : go (c:rest) + go rest = let (x,y) = break (`elem` ":,") rest + (x',y') = span (`elem` ":,^") y + in x++x'++go y' + +------------------------ +-- Arbitrary instances +-- + +instance Arbitrary ProjectConfig where + arbitrary = + ProjectConfig + <$> (map getPackageLocationString <$> arbitrary) + <*> (map getPackageLocationString <$> arbitrary) + <*> shortListOf 3 arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> (MapMappend . fmap getNonMEmpty . Map.fromList + <$> shortListOf 3 arbitrary) + -- package entries with no content are equivalent to + -- the entry not existing at all, so exclude empty + + shrink ProjectConfig { projectPackages = x0 + , projectPackagesOptional = x1 + , projectPackagesRepo = x2 + , projectPackagesNamed = x3 + , projectConfigBuildOnly = x4 + , projectConfigShared = x5 + , projectConfigProvenance = x6 + , projectConfigLocalPackages = x7 + , projectConfigSpecificPackage = x8 + , projectConfigAllPackages = x9 } = + [ ProjectConfig { projectPackages = x0' + , projectPackagesOptional = x1' + , projectPackagesRepo = x2' + , projectPackagesNamed = x3' + , projectConfigBuildOnly = x4' + , projectConfigShared = x5' + , projectConfigProvenance = x6' + , projectConfigLocalPackages = x7' + , projectConfigSpecificPackage = (MapMappend + (fmap getNonMEmpty x8')) + , projectConfigAllPackages = x9' } + | ((x0', x1', x2', x3'), (x4', x5', x6', x7', x8', x9')) + <- shrink ((x0, x1, x2, x3), + (x4, x5, x6, x7, fmap NonMEmpty (getMapMappend x8), x9)) + ] + +newtype PackageLocationString + = PackageLocationString { getPackageLocationString :: String } + deriving Show + +instance Arbitrary PackageLocationString where + arbitrary = + PackageLocationString <$> + oneof + [ show . getNonEmpty <$> (arbitrary :: Gen (NonEmptyList String)) + , arbitraryGlobLikeStr + , show <$> (arbitrary :: Gen URI) + ] + +arbitraryGlobLikeStr :: Gen String +arbitraryGlobLikeStr = outerTerm + where + outerTerm = concat <$> shortListOf1 4 + (frequency [ (2, token) + , (1, braces <$> innerTerm) ]) + innerTerm = intercalate "," <$> shortListOf1 3 + (frequency [ (3, token) + , (1, braces <$> innerTerm) ]) + token = shortListOf1 4 (elements (['#'..'~'] \\ "{,}")) + braces s = "{" ++ s ++ "}" + + +instance Arbitrary ProjectConfigBuildOnly where + arbitrary = + ProjectConfigBuildOnly + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> (toNubList <$> shortListOf 2 arbitrary) -- 4 + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> (fmap getShortToken <$> arbitrary) -- 8 + <*> arbitrary + <*> arbitraryNumJobs + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> (fmap getShortToken <$> arbitrary) + <*> arbitrary + <*> (fmap getShortToken <$> arbitrary) + <*> (fmap getShortToken <$> arbitrary) + where + arbitraryNumJobs = fmap (fmap getPositive) <$> arbitrary + + shrink ProjectConfigBuildOnly { projectConfigVerbosity = x00 + , projectConfigDryRun = x01 + , projectConfigOnlyDeps = x02 + , projectConfigSummaryFile = x03 + , projectConfigLogFile = x04 + , projectConfigBuildReports = x05 + , projectConfigReportPlanningFailure = x06 + , projectConfigSymlinkBinDir = x07 + , projectConfigOneShot = x08 + , projectConfigNumJobs = x09 + , projectConfigKeepGoing = x10 + , projectConfigOfflineMode = x11 + , projectConfigKeepTempFiles = x12 + , projectConfigHttpTransport = x13 + , projectConfigIgnoreExpiry = x14 + , projectConfigCacheDir = x15 + , projectConfigLogsDir = x16 } = + [ ProjectConfigBuildOnly { projectConfigVerbosity = x00' + , projectConfigDryRun = x01' + , projectConfigOnlyDeps = x02' + , projectConfigSummaryFile = x03' + , projectConfigLogFile = x04' + , projectConfigBuildReports = x05' + , projectConfigReportPlanningFailure = x06' + , projectConfigSymlinkBinDir = x07' + , projectConfigOneShot = x08' + , projectConfigNumJobs = postShrink_NumJobs x09' + , projectConfigKeepGoing = x10' + , projectConfigOfflineMode = x11' + , projectConfigKeepTempFiles = x12' + , projectConfigHttpTransport = x13 + , projectConfigIgnoreExpiry = x14' + , projectConfigCacheDir = x15 + , projectConfigLogsDir = x16 } + | ((x00', x01', x02', x03', x04'), + (x05', x06', x07', x08', x09'), + (x10', x11', x12', x14')) + <- shrink + ((x00, x01, x02, x03, x04), + (x05, x06, x07, x08, preShrink_NumJobs x09), + (x10, x11, x12, x14)) + ] + where + preShrink_NumJobs = fmap (fmap Positive) + postShrink_NumJobs = fmap (fmap getPositive) + +instance Arbitrary ProjectConfigShared where + arbitrary = + ProjectConfigShared + <$> arbitraryFlag arbitraryShortToken + <*> arbitraryFlag arbitraryShortToken + <*> arbitraryFlag arbitraryShortToken + <*> arbitrary + <*> arbitraryFlag arbitraryShortToken + <*> arbitraryFlag arbitraryShortToken + <*> arbitrary + <*> arbitrary + <*> (toNubList <$> listOf arbitraryShortToken) + <*> arbitrary + <*> arbitraryFlag arbitraryShortToken + <*> arbitraryConstraints + <*> shortListOf 2 arbitrary + <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> (toNubList <$> listOf arbitraryShortToken) + where + arbitraryConstraints :: Gen [(UserConstraint, ConstraintSource)] + arbitraryConstraints = + fmap (\uc -> (uc, projectConfigConstraintSource)) <$> arbitrary + + shrink ProjectConfigShared { projectConfigDistDir = x00 + , projectConfigProjectFile = x01 + , projectConfigHcFlavor = x02 + , projectConfigHcPath = x03 + , projectConfigHcPkg = x04 + , projectConfigHaddockIndex = x05 + , projectConfigRemoteRepos = x06 + , projectConfigLocalRepos = x07 + , projectConfigIndexState = x08 + , projectConfigConstraints = x09 + , projectConfigPreferences = x10 + , projectConfigCabalVersion = x11 + , projectConfigSolver = x12 + , projectConfigAllowOlder = x13 + , projectConfigAllowNewer = x14 + , projectConfigMaxBackjumps = x15 + , projectConfigReorderGoals = x16 + , projectConfigCountConflicts = x17 + , projectConfigStrongFlags = x18 + , projectConfigAllowBootLibInstalls = x19 + , projectConfigOnlyConstrained = x20 + , projectConfigPerComponent = x21 + , projectConfigIndependentGoals = x22 + , projectConfigConfigFile = x23 + , projectConfigProgPathExtra = x24 + , projectConfigStoreDir = x25 } = + [ ProjectConfigShared { projectConfigDistDir = x00' + , projectConfigProjectFile = x01' + , projectConfigHcFlavor = x02' + , projectConfigHcPath = fmap getNonEmpty x03' + , projectConfigHcPkg = fmap getNonEmpty x04' + , projectConfigHaddockIndex = x05' + , projectConfigRemoteRepos = x06' + , projectConfigLocalRepos = x07' + , projectConfigIndexState = x08' + , projectConfigConstraints = postShrink_Constraints x09' + , projectConfigPreferences = x10' + , projectConfigCabalVersion = x11' + , projectConfigSolver = x12' + , projectConfigAllowOlder = x13' + , projectConfigAllowNewer = x14' + , projectConfigMaxBackjumps = x15' + , projectConfigReorderGoals = x16' + , projectConfigCountConflicts = x17' + , projectConfigStrongFlags = x18' + , projectConfigAllowBootLibInstalls = x19' + , projectConfigOnlyConstrained = x20' + , projectConfigPerComponent = x21' + , projectConfigIndependentGoals = x22' + , projectConfigConfigFile = x23' + , projectConfigProgPathExtra = x24' + , projectConfigStoreDir = x25' } + | ((x00', x01', x02', x03', x04'), + (x05', x06', x07', x08', x09'), + (x10', x11', x12', x13', x14'), + (x15', x16', x17', x18', x19'), + x20', x21', x22', x23', x24', x25') + <- shrink + ((x00, x01, x02, fmap NonEmpty x03, fmap NonEmpty x04), + (x05, x06, x07, x08, preShrink_Constraints x09), + (x10, x11, x12, x13, x14), + (x15, x16, x17, x18, x19), + x20, x21, x22, x23, x24, x25) + ] + where + preShrink_Constraints = map fst + postShrink_Constraints = map (\uc -> (uc, projectConfigConstraintSource)) + +projectConfigConstraintSource :: ConstraintSource +projectConfigConstraintSource = + ConstraintSourceProjectConfig "TODO" + +instance Arbitrary ProjectConfigProvenance where + arbitrary = elements [Implicit, Explicit "cabal.project"] + +instance Arbitrary FlagAssignment where + arbitrary = mkFlagAssignment <$> arbitrary + +instance Arbitrary PackageConfig where + arbitrary = + PackageConfig + <$> (MapLast . Map.fromList <$> shortListOf 10 + ((,) <$> arbitraryProgramName + <*> arbitraryShortToken)) + <*> (MapMappend . Map.fromList <$> shortListOf 10 + ((,) <$> arbitraryProgramName + <*> listOf arbitraryShortToken)) + <*> (toNubList <$> listOf arbitraryShortToken) + <*> arbitrary + <*> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary + <*> shortListOf 5 arbitraryShortToken + <*> arbitrary + <*> arbitrary <*> arbitrary + <*> shortListOf 5 arbitraryShortToken + <*> shortListOf 5 arbitraryShortToken + <*> shortListOf 5 arbitraryShortToken + <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary + <*> arbitraryFlag arbitraryShortToken + <*> arbitrary + <*> arbitrary + <*> arbitrary <*> arbitrary + <*> arbitrary + <*> arbitraryFlag arbitraryShortToken + <*> arbitrary + <*> arbitrary + <*> arbitraryFlag arbitraryShortToken + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> shortListOf 5 arbitrary + where + arbitraryProgramName :: Gen String + arbitraryProgramName = + elements [ programName prog + | (prog, _) <- knownPrograms (defaultProgramDb) ] + + shrink PackageConfig { packageConfigProgramPaths = x00 + , packageConfigProgramArgs = x01 + , packageConfigProgramPathExtra = x02 + , packageConfigFlagAssignment = x03 + , packageConfigVanillaLib = x04 + , packageConfigSharedLib = x05 + , packageConfigStaticLib = x42 + , packageConfigDynExe = x06 + , packageConfigProf = x07 + , packageConfigProfLib = x08 + , packageConfigProfExe = x09 + , packageConfigProfDetail = x10 + , packageConfigProfLibDetail = x11 + , packageConfigConfigureArgs = x12 + , packageConfigOptimization = x13 + , packageConfigProgPrefix = x14 + , packageConfigProgSuffix = x15 + , packageConfigExtraLibDirs = x16 + , packageConfigExtraFrameworkDirs = x17 + , packageConfigExtraIncludeDirs = x18 + , packageConfigGHCiLib = x19 + , packageConfigSplitSections = x20 + , packageConfigSplitObjs = x20_1 + , packageConfigStripExes = x21 + , packageConfigStripLibs = x22 + , packageConfigTests = x23 + , packageConfigBenchmarks = x24 + , packageConfigCoverage = x25 + , packageConfigRelocatable = x26 + , packageConfigDebugInfo = x27 + , packageConfigRunTests = x28 + , packageConfigDocumentation = x29 + , packageConfigHaddockHoogle = x30 + , packageConfigHaddockHtml = x31 + , packageConfigHaddockHtmlLocation = x32 + , packageConfigHaddockForeignLibs = x33 + , packageConfigHaddockExecutables = x33_1 + , packageConfigHaddockTestSuites = x34 + , packageConfigHaddockBenchmarks = x35 + , packageConfigHaddockInternal = x36 + , packageConfigHaddockCss = x37 + , packageConfigHaddockLinkedSource = x38 + , packageConfigHaddockQuickJump = x43 + , packageConfigHaddockHscolourCss = x39 + , packageConfigHaddockContents = x40 + , packageConfigHaddockForHackage = x41 + , packageConfigTestHumanLog = x44 + , packageConfigTestMachineLog = x45 + , packageConfigTestShowDetails = x46 + , packageConfigTestKeepTix = x47 + , packageConfigTestTestOptions = x48 } = + [ PackageConfig { packageConfigProgramPaths = postShrink_Paths x00' + , packageConfigProgramArgs = postShrink_Args x01' + , packageConfigProgramPathExtra = x02' + , packageConfigFlagAssignment = x03' + , packageConfigVanillaLib = x04' + , packageConfigSharedLib = x05' + , packageConfigStaticLib = x42' + , packageConfigDynExe = x06' + , packageConfigProf = x07' + , packageConfigProfLib = x08' + , packageConfigProfExe = x09' + , packageConfigProfDetail = x10' + , packageConfigProfLibDetail = x11' + , packageConfigConfigureArgs = map getNonEmpty x12' + , packageConfigOptimization = x13' + , packageConfigProgPrefix = x14' + , packageConfigProgSuffix = x15' + , packageConfigExtraLibDirs = map getNonEmpty x16' + , packageConfigExtraFrameworkDirs = map getNonEmpty x17' + , packageConfigExtraIncludeDirs = map getNonEmpty x18' + , packageConfigGHCiLib = x19' + , packageConfigSplitSections = x20' + , packageConfigSplitObjs = x20_1' + , packageConfigStripExes = x21' + , packageConfigStripLibs = x22' + , packageConfigTests = x23' + , packageConfigBenchmarks = x24' + , packageConfigCoverage = x25' + , packageConfigRelocatable = x26' + , packageConfigDebugInfo = x27' + , packageConfigRunTests = x28' + , packageConfigDocumentation = x29' + , packageConfigHaddockHoogle = x30' + , packageConfigHaddockHtml = x31' + , packageConfigHaddockHtmlLocation = x32' + , packageConfigHaddockForeignLibs = x33' + , packageConfigHaddockExecutables = x33_1' + , packageConfigHaddockTestSuites = x34' + , packageConfigHaddockBenchmarks = x35' + , packageConfigHaddockInternal = x36' + , packageConfigHaddockCss = fmap getNonEmpty x37' + , packageConfigHaddockLinkedSource = x38' + , packageConfigHaddockQuickJump = x43' + , packageConfigHaddockHscolourCss = fmap getNonEmpty x39' + , packageConfigHaddockContents = x40' + , packageConfigHaddockForHackage = x41' + , packageConfigTestHumanLog = x44' + , packageConfigTestMachineLog = x45' + , packageConfigTestShowDetails = x46' + , packageConfigTestKeepTix = x47' + , packageConfigTestTestOptions = x48' } + | (((x00', x01', x02', x03', x04'), + (x05', x42', x06', x07', x08', x09'), + (x10', x11', x12', x13', x14'), + (x15', x16', x17', x18', x19')), + ((x20', x20_1', x21', x22', x23', x24'), + (x25', x26', x27', x28', x29'), + (x30', x31', x32', (x33', x33_1'), x34'), + (x35', x36', x37', x38', x43', x39'), + (x40', x41'), + (x44', x45', x46', x47', x48'))) + <- shrink + (((preShrink_Paths x00, preShrink_Args x01, x02, x03, x04), + (x05, x42, x06, x07, x08, x09), + (x10, x11, map NonEmpty x12, x13, x14), + (x15, map NonEmpty x16, + map NonEmpty x17, + map NonEmpty x18, + x19)), + ((x20, x20_1, x21, x22, x23, x24), + (x25, x26, x27, x28, x29), + (x30, x31, x32, (x33, x33_1), x34), + (x35, x36, fmap NonEmpty x37, x38, x43, fmap NonEmpty x39), + (x40, x41), + (x44, x45, x46, x47, x48))) + ] + where + preShrink_Paths = Map.map NonEmpty + . Map.mapKeys NoShrink + . getMapLast + postShrink_Paths = MapLast + . Map.map getNonEmpty + . Map.mapKeys getNoShrink + preShrink_Args = Map.map (NonEmpty . map NonEmpty) + . Map.mapKeys NoShrink + . getMapMappend + postShrink_Args = MapMappend + . Map.map (map getNonEmpty . getNonEmpty) + . Map.mapKeys getNoShrink + +instance Arbitrary HaddockTarget where + arbitrary = elements [ForHackage, ForDevelopment] + +instance Arbitrary TestShowDetails where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary SourceRepo where + arbitrary = (SourceRepo RepoThis + <$> arbitrary + <*> (fmap getShortToken <$> arbitrary) + <*> (fmap getShortToken <$> arbitrary) + <*> (fmap getShortToken <$> arbitrary) + <*> (fmap getShortToken <$> arbitrary) + <*> (fmap getShortToken <$> arbitrary)) + `suchThat` (/= emptySourceRepo RepoThis) + + shrink (SourceRepo _ x1 x2 x3 x4 x5 x6) = + [ repo + | ((x1', x2', x3'), (x4', x5', x6')) + <- shrink ((x1, + fmap ShortToken x2, + fmap ShortToken x3), + (fmap ShortToken x4, + fmap ShortToken x5, + fmap ShortToken x6)) + , let repo = SourceRepo RepoThis x1' + (fmap getShortToken x2') + (fmap getShortToken x3') + (fmap getShortToken x4') + (fmap getShortToken x5') + (fmap getShortToken x6') + , repo /= emptySourceRepo RepoThis + ] + +instance Arbitrary RepoType where + arbitrary = elements knownRepoTypes + +instance Arbitrary ReportLevel where + arbitrary = elements [NoReports .. DetailedReports] + +instance Arbitrary CompilerFlavor where + arbitrary = elements knownCompilerFlavors + +instance Arbitrary a => Arbitrary (InstallDirs a) where + arbitrary = + InstallDirs + <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -- 4 + <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -- 8 + <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -- 12 + <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -- 16 + +instance Arbitrary PackageDB where + arbitrary = oneof [ pure GlobalPackageDB + , pure UserPackageDB + , SpecificPackageDB . getShortToken <$> arbitrary + ] + +instance Arbitrary RemoteRepo where + arbitrary = + RemoteRepo + <$> arbitraryShortToken `suchThat` (not . (":" `isPrefixOf`)) + <*> arbitrary -- URI + <*> arbitrary + <*> listOf arbitraryRootKey + <*> (fmap getNonNegative arbitrary) + <*> pure False + where + arbitraryRootKey = + shortListOf1 5 (oneof [ choose ('0', '9') + , choose ('a', 'f') ]) + +instance Arbitrary UserConstraintScope where + arbitrary = oneof [ UserQualified <$> arbitrary <*> arbitrary + , UserAnySetupQualifier <$> arbitrary + , UserAnyQualifier <$> arbitrary + ] + +instance Arbitrary UserQualifier where + arbitrary = oneof [ pure UserQualToplevel + , UserQualSetup <$> arbitrary + + -- -- TODO: Re-enable UserQualExe tests once we decide on a syntax. + -- , UserQualExe <$> arbitrary <*> arbitrary + ] + +instance Arbitrary UserConstraint where + arbitrary = UserConstraint <$> arbitrary <*> arbitrary + +instance Arbitrary PackageProperty where + arbitrary = oneof [ PackagePropertyVersion <$> arbitrary + , pure PackagePropertyInstalled + , pure PackagePropertySource + , PackagePropertyFlags . mkFlagAssignment <$> shortListOf1 3 arbitrary + , PackagePropertyStanzas . (\x->[x]) <$> arbitrary + ] + +instance Arbitrary OptionalStanza where + arbitrary = elements [minBound..maxBound] + +instance Arbitrary FlagName where + arbitrary = mkFlagName <$> flagident + where + flagident = lowercase <$> shortListOf1 5 (elements flagChars) + `suchThat` (("-" /=) . take 1) + flagChars = "-_" ++ ['a'..'z'] + +instance Arbitrary PreSolver where + arbitrary = elements [minBound..maxBound] + +instance Arbitrary ReorderGoals where + arbitrary = ReorderGoals <$> arbitrary + +instance Arbitrary CountConflicts where + arbitrary = CountConflicts <$> arbitrary + +instance Arbitrary IndependentGoals where + arbitrary = IndependentGoals <$> arbitrary + +instance Arbitrary StrongFlags where + arbitrary = StrongFlags <$> arbitrary + +instance Arbitrary AllowBootLibInstalls where + arbitrary = AllowBootLibInstalls <$> arbitrary + +instance Arbitrary OnlyConstrained where + arbitrary = oneof [ pure OnlyConstrainedAll + , pure OnlyConstrainedNone + ] + +instance Arbitrary AllowNewer where + arbitrary = AllowNewer <$> arbitrary + +instance Arbitrary AllowOlder where + arbitrary = AllowOlder <$> arbitrary + +instance Arbitrary RelaxDeps where + arbitrary = oneof [ pure mempty + , RelaxDepsSome <$> shortListOf1 3 arbitrary + , pure RelaxDepsAll + ] + +instance Arbitrary RelaxDepMod where + arbitrary = elements [RelaxDepModNone, RelaxDepModCaret] + +instance Arbitrary RelaxDepScope where + arbitrary = oneof [ pure RelaxDepScopeAll + , RelaxDepScopePackage <$> arbitrary + , RelaxDepScopePackageId <$> (PackageIdentifier <$> arbitrary <*> arbitrary) + ] + +instance Arbitrary RelaxDepSubject where + arbitrary = oneof [ pure RelaxDepSubjectAll + , RelaxDepSubjectPkg <$> arbitrary + ] + +instance Arbitrary RelaxedDep where + arbitrary = RelaxedDep <$> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary ProfDetailLevel where + arbitrary = elements [ d | (_,_,d) <- knownProfDetailLevels ] + +instance Arbitrary OptimisationLevel where + arbitrary = elements [minBound..maxBound] + +instance Arbitrary DebugInfoLevel where + arbitrary = elements [minBound..maxBound] + +instance Arbitrary URI where + arbitrary = + URI <$> elements ["file:", "http:", "https:"] + <*> (Just <$> arbitrary) + <*> (('/':) <$> arbitraryURIToken) + <*> (('?':) <$> arbitraryURIToken) + <*> pure "" + +instance Arbitrary URIAuth where + arbitrary = + URIAuth <$> pure "" -- no password as this does not roundtrip + <*> arbitraryURIToken + <*> arbitraryURIPort + +arbitraryURIToken :: Gen String +arbitraryURIToken = + shortListOf1 6 (elements (filter isUnreserved ['\0'..'\255'])) + +arbitraryURIPort :: Gen String +arbitraryURIPort = + oneof [ pure "", (':':) <$> shortListOf1 4 (choose ('0','9')) ] diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Sandbox.hs b/cabal-install/tests/UnitTests/Distribution/Client/Sandbox.hs new file mode 100644 index 00000000..3bf2d28e --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/Sandbox.hs @@ -0,0 +1,28 @@ +module UnitTests.Distribution.Client.Sandbox ( + tests + ) where + +import Distribution.Client.Sandbox (withSandboxBinDirOnSearchPath) + +import Test.Tasty +import Test.Tasty.HUnit + +import System.FilePath (getSearchPath, ()) + +tests :: [TestTree] +tests = [ testCase "sandboxBinDirOnSearchPath" sandboxBinDirOnSearchPathTest + , testCase "oldSearchPathRestored" oldSearchPathRestoreTest + ] + +sandboxBinDirOnSearchPathTest :: Assertion +sandboxBinDirOnSearchPathTest = + withSandboxBinDirOnSearchPath "foo" $ do + r <- getSearchPath + assertBool "'foo/bin' not on search path" $ ("foo" "bin") `elem` r + +oldSearchPathRestoreTest :: Assertion +oldSearchPathRestoreTest = do + r <- getSearchPath + withSandboxBinDirOnSearchPath "foo" $ return () + r' <- getSearchPath + assertEqual "Old search path wasn't restored" r r' diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Sandbox/Timestamp.hs b/cabal-install/tests/UnitTests/Distribution/Client/Sandbox/Timestamp.hs new file mode 100644 index 00000000..68d7284c --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/Sandbox/Timestamp.hs @@ -0,0 +1,63 @@ +module UnitTests.Distribution.Client.Sandbox.Timestamp (tests) where + +import System.FilePath + +import Distribution.Simple.Utils (withTempDirectory) +import Distribution.Verbosity + +import Distribution.Compat.Time +import Distribution.Client.Sandbox.Timestamp + +import Test.Tasty +import Test.Tasty.HUnit + +tests :: [TestTree] +tests = + [ testCase "timestamp record version 1 can be read" timestampReadTest_v1 + , testCase "timestamp record version 2 can be read" timestampReadTest_v2 + , testCase "written timestamp record can be read" timestampReadWriteTest ] + +timestampRecord_v1 :: String +timestampRecord_v1 = + "[(\"i386-linux-ghc-8.0.0.20160204\",[(\"/foo/bar/Baz\",1455350946)])" ++ + ",(\"i386-linux-ghc-7.10.3\",[(\"/foo/bar/Baz\",1455484719)])]\n" + +timestampRecord_v2 :: String +timestampRecord_v2 = + "2\n" ++ + "[(\"i386-linux-ghc-8.0.0.20160204\",[(\"/foo/bar/Baz\",1455350946)])" ++ + ",(\"i386-linux-ghc-7.10.3\",[(\"/foo/bar/Baz\",1455484719)])]" + +timestampReadTest_v1 :: Assertion +timestampReadTest_v1 = + timestampReadTest timestampRecord_v1 $ + map (\(i, ts) -> + (i, map (\(p, ModTime t) -> + (p, posixSecondsToModTime . fromIntegral $ t)) ts)) + timestampRecord + +timestampReadTest_v2 :: Assertion +timestampReadTest_v2 = timestampReadTest timestampRecord_v2 timestampRecord + +timestampReadTest :: FilePath -> [TimestampFileRecord] -> Assertion +timestampReadTest fileContent expected = + withTempDirectory silent "." "cabal-timestamp-" $ \dir -> do + let fileName = dir "timestamp-record" + writeFile fileName fileContent + tRec <- readTimestampFile normal fileName + assertEqual "expected timestamp records to be equal" + expected tRec + +timestampRecord :: [TimestampFileRecord] +timestampRecord = + [("i386-linux-ghc-8.0.0.20160204",[("/foo/bar/Baz",ModTime 1455350946)]) + ,("i386-linux-ghc-7.10.3",[("/foo/bar/Baz",ModTime 1455484719)])] + +timestampReadWriteTest :: Assertion +timestampReadWriteTest = + withTempDirectory silent "." "cabal-timestamp-" $ \dir -> do + let fileName = dir "timestamp-record" + writeTimestampFile fileName timestampRecord + tRec <- readTimestampFile normal fileName + assertEqual "expected timestamp records to be equal" + timestampRecord tRec diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Store.hs b/cabal-install/tests/UnitTests/Distribution/Client/Store.hs new file mode 100644 index 00000000..e949b818 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/Store.hs @@ -0,0 +1,181 @@ +module UnitTests.Distribution.Client.Store (tests) where + +--import Control.Monad +--import Control.Concurrent (forkIO, threadDelay) +--import Control.Concurrent.MVar +import qualified Data.Set as Set +import System.FilePath +import System.Directory +--import System.Random + +import Distribution.Package (UnitId, mkUnitId) +import Distribution.Compiler (CompilerId(..), CompilerFlavor(..)) +import Distribution.Version (mkVersion) +import Distribution.Verbosity (Verbosity, silent) +import Distribution.Simple.Utils (withTempDirectory) + +import Distribution.Client.Store +import Distribution.Client.RebuildMonad + +import Test.Tasty +import Test.Tasty.HUnit + + +tests :: [TestTree] +tests = + [ testCase "list content empty" testListEmpty + , testCase "install serial" testInstallSerial +--, testCase "install parallel" testInstallParallel + --TODO: figure out some way to do a parallel test, see issue below + ] + + +testListEmpty :: Assertion +testListEmpty = + withTempDirectory verbosity "." "store-" $ \tmp -> do + let storeDirLayout = defaultStoreDirLayout (tmp "store") + + assertStoreEntryExists storeDirLayout compid unitid False + assertStoreContent tmp storeDirLayout compid Set.empty + where + compid = CompilerId GHC (mkVersion [1,0]) + unitid = mkUnitId "foo-1.0-xyz" + + +testInstallSerial :: Assertion +testInstallSerial = + withTempDirectory verbosity "." "store-" $ \tmp -> do + let storeDirLayout = defaultStoreDirLayout (tmp "store") + copyFiles file content dir = do + -- we copy into a prefix inside the tmp dir and return the prefix + let destprefix = dir "prefix" + createDirectory destprefix + writeFile (destprefix file) content + return (destprefix,[]) + + assertNewStoreEntry tmp storeDirLayout compid unitid1 + (copyFiles "file1" "content-foo") (return ()) + UseNewStoreEntry + + assertNewStoreEntry tmp storeDirLayout compid unitid1 + (copyFiles "file1" "content-foo") (return ()) + UseExistingStoreEntry + + assertNewStoreEntry tmp storeDirLayout compid unitid2 + (copyFiles "file2" "content-bar") (return ()) + UseNewStoreEntry + + let pkgDir :: UnitId -> FilePath + pkgDir = storePackageDirectory storeDirLayout compid + assertFileEqual (pkgDir unitid1 "file1") "content-foo" + assertFileEqual (pkgDir unitid2 "file2") "content-bar" + where + compid = CompilerId GHC (mkVersion [1,0]) + unitid1 = mkUnitId "foo-1.0-xyz" + unitid2 = mkUnitId "bar-2.0-xyz" + + +{- +-- unfortunately a parallel test like the one below is thwarted by the normal +-- process-internal file locking. If that locking were not in place then we +-- ought to get the blocking behaviour, but due to the normal Handle locking +-- it just fails instead. + +testInstallParallel :: Assertion +testInstallParallel = + withTempDirectory verbosity "." "store-" $ \tmp -> do + let storeDirLayout = defaultStoreDirLayout (tmp "store") + + sync1 <- newEmptyMVar + sync2 <- newEmptyMVar + outv <- newEmptyMVar + regv <- newMVar (0 :: Int) + + sequence_ + [ do forkIO $ do + let copyFiles dir = do + delay <- randomRIO (1,100000) + writeFile (dir "file") (show n) + putMVar sync1 () + readMVar sync2 + threadDelay delay + register = do + modifyMVar_ regv (return . (+1)) + threadDelay 200000 + o <- newStoreEntry verbosity storeDirLayout + compid unitid + copyFiles register + putMVar outv (n, o) + | n <- [0..9 :: Int] ] + + replicateM_ 10 (takeMVar sync1) + -- all threads are in the copyFiles action concurrently, release them: + putMVar sync2 () + + outcomes <- replicateM 10 (takeMVar outv) + regcount <- readMVar regv + let regcount' = length [ () | (_, UseNewStoreEntry) <- outcomes ] + + assertEqual "num registrations" 1 regcount + assertEqual "num registrations" 1 regcount' + + assertStoreContent tmp storeDirLayout compid (Set.singleton unitid) + + let pkgDir :: UnitId -> FilePath + pkgDir = storePackageDirectory storeDirLayout compid + case [ n | (n, UseNewStoreEntry) <- outcomes ] of + [n] -> assertFileEqual (pkgDir unitid "file") (show n) + _ -> assertFailure "impossible" + + where + compid = CompilerId GHC (mkVersion [1,0]) + unitid = mkUnitId "foo-1.0-xyz" +-} + +------------- +-- Utils + +assertNewStoreEntry :: FilePath -> StoreDirLayout + -> CompilerId -> UnitId + -> (FilePath -> IO (FilePath,[FilePath])) -> IO () + -> NewStoreEntryOutcome + -> Assertion +assertNewStoreEntry tmp storeDirLayout compid unitid + copyFiles register expectedOutcome = do + entries <- runRebuild tmp $ getStoreEntries storeDirLayout compid + outcome <- newStoreEntry verbosity storeDirLayout + compid unitid + copyFiles register + assertEqual "newStoreEntry outcome" expectedOutcome outcome + assertStoreEntryExists storeDirLayout compid unitid True + let expected = Set.insert unitid entries + assertStoreContent tmp storeDirLayout compid expected + + +assertStoreEntryExists :: StoreDirLayout + -> CompilerId -> UnitId -> Bool + -> Assertion +assertStoreEntryExists storeDirLayout compid unitid expected = do + actual <- doesStoreEntryExist storeDirLayout compid unitid + assertEqual "store entry exists" expected actual + + +assertStoreContent :: FilePath -> StoreDirLayout + -> CompilerId -> Set.Set UnitId + -> Assertion +assertStoreContent tmp storeDirLayout compid expected = do + actual <- runRebuild tmp $ getStoreEntries storeDirLayout compid + assertEqual "store content" actual expected + + +assertFileEqual :: FilePath -> String -> Assertion +assertFileEqual path expected = do + exists <- doesFileExist path + assertBool ("file does not exist:\n" ++ path) exists + actual <- readFile path + assertEqual ("file content for:\n" ++ path) expected actual + + +verbosity :: Verbosity +verbosity = silent + diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Tar.hs b/cabal-install/tests/UnitTests/Distribution/Client/Tar.hs new file mode 100644 index 00000000..fc80ab43 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/Tar.hs @@ -0,0 +1,75 @@ +module UnitTests.Distribution.Client.Tar ( + tests + ) where + +import Distribution.Client.Tar ( filterEntries + , filterEntriesM + ) +import Codec.Archive.Tar ( Entries(..) + , foldEntries + ) +import Codec.Archive.Tar.Entry ( EntryContent(..) + , simpleEntry + , Entry(..) + , toTarPath + ) + +import Test.Tasty +import Test.Tasty.HUnit + +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy.Char8 as BS.Char8 +import Control.Monad.Writer.Lazy (runWriterT, tell) + +tests :: [TestTree] +tests = [ testCase "filterEntries" filterTest + , testCase "filterEntriesM" filterMTest + ] + +filterTest :: Assertion +filterTest = do + let e1 = getFileEntry "file1" "x" + e2 = getFileEntry "file2" "y" + p = (\e -> let (NormalFile dta _) = entryContent e + str = BS.Char8.unpack dta + in str /= "y") + assertEqual "Unexpected result for filter" "xz" $ + entriesToString $ filterEntries p $ Next e1 $ Next e2 Done + assertEqual "Unexpected result for filter" "z" $ + entriesToString $ filterEntries p $ Done + assertEqual "Unexpected result for filter" "xf" $ + entriesToString $ filterEntries p $ Next e1 $ Next e2 $ Fail "f" + +filterMTest :: Assertion +filterMTest = do + let e1 = getFileEntry "file1" "x" + e2 = getFileEntry "file2" "y" + p = (\e -> let (NormalFile dta _) = entryContent e + str = BS.Char8.unpack dta + in tell "t" >> return (str /= "y")) + + (r, w) <- runWriterT $ filterEntriesM p $ Next e1 $ Next e2 Done + assertEqual "Unexpected result for filterM" "xz" $ entriesToString r + assertEqual "Unexpected result for filterM w" "tt" w + + (r1, w1) <- runWriterT $ filterEntriesM p $ Done + assertEqual "Unexpected result for filterM" "z" $ entriesToString r1 + assertEqual "Unexpected result for filterM w" "" w1 + + (r2, w2) <- runWriterT $ filterEntriesM p $ Next e1 $ Next e2 $ Fail "f" + assertEqual "Unexpected result for filterM" "xf" $ entriesToString r2 + assertEqual "Unexpected result for filterM w" "tt" w2 + +getFileEntry :: FilePath -> [Char] -> Entry +getFileEntry pth dta = + simpleEntry tp $ NormalFile dta' $ BS.length dta' + where tp = case toTarPath False pth of + Right tp' -> tp' + Left e -> error e + dta' = BS.Char8.pack dta + +entriesToString :: Entries String -> String +entriesToString = + foldEntries (\e acc -> let (NormalFile dta _) = entryContent e + str = BS.Char8.unpack dta + in str ++ acc) "z" id diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs b/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs new file mode 100644 index 00000000..c10a6ea1 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs @@ -0,0 +1,107 @@ +module UnitTests.Distribution.Client.Targets ( + tests + ) where + +import Distribution.Client.Targets (UserQualifier(..) + ,UserConstraintScope(..) + ,UserConstraint(..), readUserConstraint) +import Distribution.Compat.ReadP (readP_to_S) +import Distribution.Package (mkPackageName) +import Distribution.PackageDescription (mkFlagName, mkFlagAssignment) +import Distribution.Version (anyVersion, thisVersion, mkVersion) +import Distribution.ParseUtils (parseCommaList) +import Distribution.Text (parse) + +import Distribution.Solver.Types.PackageConstraint (PackageProperty(..)) +import Distribution.Solver.Types.OptionalStanza (OptionalStanza(..)) + +import Test.Tasty +import Test.Tasty.HUnit + +import Data.Char (isSpace) +import Data.List (intercalate) + +-- Helper function: makes a test group by mapping each element +-- of a list to a test case. +makeGroup :: String -> (a -> Assertion) -> [a] -> TestTree +makeGroup name f xs = testGroup name $ + zipWith testCase (map show [0 :: Integer ..]) (map f xs) + +tests :: [TestTree] +tests = + [ makeGroup "readUserConstraint" (uncurry readUserConstraintTest) + exampleConstraints + + , makeGroup "parseUserConstraint" (uncurry parseUserConstraintTest) + exampleConstraints + + , makeGroup "readUserConstraints" (uncurry readUserConstraintsTest) + [-- First example only. + (head exampleStrs, take 1 exampleUcs), + -- All examples separated by commas. + (intercalate ", " exampleStrs, exampleUcs)] + ] + where + (exampleStrs, exampleUcs) = unzip exampleConstraints + +exampleConstraints :: [(String, UserConstraint)] +exampleConstraints = + [ ("template-haskell installed", + UserConstraint (UserQualified UserQualToplevel (pn "template-haskell")) + PackagePropertyInstalled) + + , ("bytestring -any", + UserConstraint (UserQualified UserQualToplevel (pn "bytestring")) + (PackagePropertyVersion anyVersion)) + + , ("any.directory test", + UserConstraint (UserAnyQualifier (pn "directory")) + (PackagePropertyStanzas [TestStanzas])) + + , ("setup.Cabal installed", + UserConstraint (UserAnySetupQualifier (pn "Cabal")) + PackagePropertyInstalled) + + , ("process:setup.bytestring ==5.2", + UserConstraint (UserQualified (UserQualSetup (pn "process")) (pn "bytestring")) + (PackagePropertyVersion (thisVersion (mkVersion [5, 2])))) + + , ("network:setup.containers +foo -bar baz", + UserConstraint (UserQualified (UserQualSetup (pn "network")) (pn "containers")) + (PackagePropertyFlags (mkFlagAssignment + [(fn "foo", True), + (fn "bar", False), + (fn "baz", True)]))) + + -- -- TODO: Re-enable UserQualExe tests once we decide on a syntax. + -- + -- , ("foo:happy:exe.template-haskell test", + -- UserConstraint (UserQualified (UserQualExe (pn "foo") (pn "happy")) (pn "template-haskell")) + -- (PackagePropertyStanzas [TestStanzas])) + ] + where + pn = mkPackageName + fn = mkFlagName + +readUserConstraintTest :: String -> UserConstraint -> Assertion +readUserConstraintTest str uc = + assertEqual ("Couldn't read constraint: '" ++ str ++ "'") expected actual + where + expected = uc + actual = let Right r = readUserConstraint str in r + +parseUserConstraintTest :: String -> UserConstraint -> Assertion +parseUserConstraintTest str uc = + assertEqual ("Couldn't parse constraint: '" ++ str ++ "'") expected actual + where + expected = [uc] + actual = [ x | (x, ys) <- readP_to_S parse str + , all isSpace ys] + +readUserConstraintsTest :: String -> [UserConstraint] -> Assertion +readUserConstraintsTest str ucs = + assertEqual ("Couldn't read constraints: '" ++ str ++ "'") expected actual + where + expected = [ucs] + actual = [ x | (x, ys) <- readP_to_S (parseCommaList parse) str + , all isSpace ys] diff --git a/cabal-install/tests/UnitTests/Distribution/Client/UserConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/UserConfig.hs new file mode 100644 index 00000000..0f0eb7af --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/UserConfig.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE CPP #-} +module UnitTests.Distribution.Client.UserConfig + ( tests + ) where + +import Control.Exception (bracket) +import Control.Monad (replicateM_) +import Data.List (sort, nub) +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid +#endif +import System.Directory (doesFileExist, + getCurrentDirectory, getTemporaryDirectory) +import System.FilePath (()) + +import Test.Tasty +import Test.Tasty.HUnit + +import Distribution.Client.Config +import Distribution.Utils.NubList (fromNubList) +import Distribution.Client.Setup (GlobalFlags (..), InstallFlags (..)) +import Distribution.Client.Utils (removeExistingFile) +import Distribution.Simple.Setup (Flag (..), ConfigFlags (..), fromFlag) +import Distribution.Simple.Utils (withTempDirectory) +import Distribution.Verbosity (silent) + +tests :: [TestTree] +tests = [ testCase "nullDiffOnCreate" nullDiffOnCreateTest + , testCase "canDetectDifference" canDetectDifference + , testCase "canUpdateConfig" canUpdateConfig + , testCase "doubleUpdateConfig" doubleUpdateConfig + , testCase "newDefaultConfig" newDefaultConfig + ] + +nullDiffOnCreateTest :: Assertion +nullDiffOnCreateTest = bracketTest $ \configFile -> do + -- Create a new default config file in our test directory. + _ <- loadConfig silent (Flag configFile) + -- Now we read it in and compare it against the default. + diff <- userConfigDiff silent (globalFlags configFile) [] + assertBool (unlines $ "Following diff should be empty:" : diff) $ null diff + + +canDetectDifference :: Assertion +canDetectDifference = bracketTest $ \configFile -> do + -- Create a new default config file in our test directory. + _ <- loadConfig silent (Flag configFile) + appendFile configFile "verbose: 0\n" + diff <- userConfigDiff silent (globalFlags configFile) [] + assertBool (unlines $ "Should detect a difference:" : diff) $ + diff == [ "+ verbose: 0" ] + + +canUpdateConfig :: Assertion +canUpdateConfig = bracketTest $ \configFile -> do + -- Write a trivial cabal file. + writeFile configFile "tests: True\n" + -- Update the config file. + userConfigUpdate silent (globalFlags configFile) [] + -- Load it again. + updated <- loadConfig silent (Flag configFile) + assertBool ("Field 'tests' should be True") $ + fromFlag (configTests $ savedConfigureFlags updated) + + +doubleUpdateConfig :: Assertion +doubleUpdateConfig = bracketTest $ \configFile -> do + -- Create a new default config file in our test directory. + _ <- loadConfig silent (Flag configFile) + -- Update it twice. + replicateM_ 2 $ userConfigUpdate silent (globalFlags configFile) [] + -- Load it again. + updated <- loadConfig silent (Flag configFile) + + assertBool ("Field 'remote-repo' doesn't contain duplicates") $ + listUnique (map show . fromNubList . globalRemoteRepos $ savedGlobalFlags updated) + assertBool ("Field 'extra-prog-path' doesn't contain duplicates") $ + listUnique (map show . fromNubList . configProgramPathExtra $ savedConfigureFlags updated) + assertBool ("Field 'build-summary' doesn't contain duplicates") $ + listUnique (map show . fromNubList . installSummaryFile $ savedInstallFlags updated) + + +newDefaultConfig :: Assertion +newDefaultConfig = do + sysTmpDir <- getTemporaryDirectory + withTempDirectory silent sysTmpDir "cabal-test" $ \tmpDir -> do + let configFile = tmpDir "tmp.config" + _ <- createDefaultConfigFile silent [] configFile + exists <- doesFileExist configFile + assertBool ("Config file should be written to " ++ configFile) exists + + +globalFlags :: FilePath -> GlobalFlags +globalFlags configFile = mempty { globalConfigFile = Flag configFile } + + +listUnique :: Ord a => [a] -> Bool +listUnique xs = + let sorted = sort xs + in nub sorted == xs + + +bracketTest :: (FilePath -> IO ()) -> Assertion +bracketTest = + bracket testSetup testTearDown + where + testSetup :: IO FilePath + testSetup = fmap ( "test-user-config") getCurrentDirectory + + testTearDown :: FilePath -> IO () + testTearDown configFile = + mapM_ removeExistingFile [configFile, configFile ++ ".backup"] diff --git a/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs b/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs new file mode 100644 index 00000000..46700bf2 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs @@ -0,0 +1,694 @@ +{-# LANGUAGE RecordWildCards, NamedFieldPuns #-} +module UnitTests.Distribution.Client.VCS (tests) where + +import Distribution.Client.VCS +import Distribution.Client.RebuildMonad + ( execRebuild ) +import Distribution.Simple.Program +import Distribution.Verbosity as Verbosity +import Distribution.Types.SourceRepo + +import Data.List +import Data.Tuple +import qualified Data.Map as Map +import Data.Map (Map) +import qualified Data.Set as Set +import Data.Set (Set) +import Data.Char (isSpace) + +import Control.Monad +import qualified Control.Monad.State as State +import Control.Monad.State (StateT, liftIO, execStateT) +import Control.Exception +import Control.Concurrent (threadDelay) + +import System.IO +import System.FilePath +import System.Directory +import System.Random + +import Test.Tasty +import Test.Tasty.QuickCheck +import UnitTests.Distribution.Client.ArbitraryInstances +import UnitTests.TempTestDir (withTestDir, removeDirectoryRecursiveHack) + + +-- | These tests take the following approach: we generate a pure representation +-- of a repository plus a corresponding real repository, and then run various +-- test operations and compare the actual working state with the expected +-- working state. +-- +-- The first test simply checks that the test infrastructure works. It +-- constructs a repository on disk and then checks out every tag or commmit +-- and checks that the working state is the same as the pure representation. +-- +-- The second test works in a similar way but tests 'syncSourceRepos'. It +-- uses an arbitrary source repo and a set of (initially empty) destination +-- directories. It picks a number of tags or commits from the source repo and +-- synchronises the destination directories to those target states, and then +-- checks that the working state is as expected (given the pure representation). +-- +tests :: MTimeChange -> [TestTree] +tests mtimeChange = + [ testGroup "check VCS test framework" $ + [ testProperty "git" prop_framework_git + ] ++ + [ testProperty "darcs" (prop_framework_darcs mtimeChange) + | enableDarcsTests + ] + , testGroup "cloneSourceRepo" $ + [ testProperty "git" prop_cloneRepo_git + ] ++ + [ testProperty "darcs" (prop_cloneRepo_darcs mtimeChange) + | enableDarcsTests + ] + , testGroup "syncSourceRepos" $ + [ testProperty "git" prop_syncRepos_git + ] ++ + [ testProperty "darcs" (prop_syncRepos_darcs mtimeChange) + | enableDarcsTests + ] + ] + where + -- for the moment they're not yet working + enableDarcsTests = False + + +prop_framework_git :: BranchingRepoRecipe -> Property +prop_framework_git = + ioProperty + . prop_framework vcsGit vcsTestDriverGit + . WithBranchingSupport + +prop_framework_darcs :: MTimeChange -> NonBranchingRepoRecipe -> Property +prop_framework_darcs mtimeChange = + ioProperty + . prop_framework vcsDarcs (vcsTestDriverDarcs mtimeChange) + . WithoutBranchingSupport + +prop_cloneRepo_git :: BranchingRepoRecipe -> Property +prop_cloneRepo_git = + ioProperty + . prop_cloneRepo vcsGit vcsTestDriverGit + . WithBranchingSupport + +prop_cloneRepo_darcs :: MTimeChange + -> NonBranchingRepoRecipe -> Property +prop_cloneRepo_darcs mtimeChange = + ioProperty + . prop_cloneRepo vcsDarcs (vcsTestDriverDarcs mtimeChange) + . WithoutBranchingSupport + +prop_syncRepos_git :: RepoDirSet -> SyncTargetIterations -> PrngSeed + -> BranchingRepoRecipe -> Property +prop_syncRepos_git destRepoDirs syncTargetSetIterations seed = + ioProperty + . prop_syncRepos vcsGit vcsTestDriverGit + destRepoDirs syncTargetSetIterations seed + . WithBranchingSupport + +prop_syncRepos_darcs :: MTimeChange + -> RepoDirSet -> SyncTargetIterations -> PrngSeed + -> NonBranchingRepoRecipe -> Property +prop_syncRepos_darcs mtimeChange destRepoDirs syncTargetSetIterations seed = + ioProperty + . prop_syncRepos vcsDarcs (vcsTestDriverDarcs mtimeChange) + destRepoDirs syncTargetSetIterations seed + . WithoutBranchingSupport + + +-- ------------------------------------------------------------ +-- * General test setup +-- ------------------------------------------------------------ + +testSetup :: VCS Program + -> (Verbosity -> VCS ConfiguredProgram + -> FilePath -> VCSTestDriver) + -> RepoRecipe + -> (VCSTestDriver -> FilePath -> RepoState -> IO a) + -> IO a +testSetup vcs mkVCSTestDriver repoRecipe theTest = do + -- test setup + vcs' <- configureVCS verbosity vcs + withTestDir verbosity "vcstest" $ \tmpdir -> do + let srcRepoPath = tmpdir "src" + vcsDriver = mkVCSTestDriver verbosity vcs' srcRepoPath + repoState <- createRepo vcsDriver repoRecipe + + -- actual test + result <- theTest vcsDriver tmpdir repoState + + return result + where + verbosity = silent + +-- ------------------------------------------------------------ +-- * Test 1: VCS infrastructure +-- ------------------------------------------------------------ + +-- | This test simply checks that the test infrastructure works. It constructs +-- a repository on disk and then checks out every tag or commit and checks that +-- the working state is the same as the pure representation. +-- +prop_framework :: VCS Program + -> (Verbosity -> VCS ConfiguredProgram + -> FilePath -> VCSTestDriver) + -> RepoRecipe + -> IO () +prop_framework vcs mkVCSTestDriver repoRecipe = + testSetup vcs mkVCSTestDriver repoRecipe $ \vcsDriver tmpdir repoState -> + mapM_ (checkAtTag vcsDriver tmpdir) (Map.toList (allTags repoState)) + where + -- Check for any given tag/commit in the 'RepoState' that the working state + -- matches the actual working state from the repository at that tag/commit. + checkAtTag VCSTestDriver {..} tmpdir (tagname, expectedState) = + case vcsCheckoutTag of + -- We handle two cases: inplace checkouts for VCSs that support it + -- (e.g. git) and separate dir otherwise (e.g. darcs) + Left checkoutInplace -> do + checkoutInplace tagname + checkExpectedWorkingState vcsIgnoreFiles vcsRepoRoot expectedState + + Right checkoutCloneTo -> do + checkoutCloneTo tagname destRepoPath + checkExpectedWorkingState vcsIgnoreFiles destRepoPath expectedState + removeDirectoryRecursiveHack silent destRepoPath + where + destRepoPath = tmpdir "dest" + + +-- ------------------------------------------------------------ +-- * Test 2: 'cloneSourceRepo' +-- ------------------------------------------------------------ + +prop_cloneRepo :: VCS Program + -> (Verbosity -> VCS ConfiguredProgram + -> FilePath -> VCSTestDriver) + -> RepoRecipe + -> IO () +prop_cloneRepo vcs mkVCSTestDriver repoRecipe = + testSetup vcs mkVCSTestDriver repoRecipe $ \vcsDriver tmpdir repoState -> + mapM_ (checkAtTag vcsDriver tmpdir) (Map.toList (allTags repoState)) + where + checkAtTag VCSTestDriver{..} tmpdir (tagname, expectedState) = do + cloneSourceRepo verbosity vcsVCS repo destRepoPath + checkExpectedWorkingState vcsIgnoreFiles destRepoPath expectedState + removeDirectoryRecursiveHack verbosity destRepoPath + where + destRepoPath = tmpdir "dest" + repo = (emptySourceRepo RepoThis) { + repoType = Just (vcsRepoType vcsVCS), + repoLocation = Just vcsRepoRoot, + repoTag = Just tagname + } + verbosity = silent + + +-- ------------------------------------------------------------ +-- * Test 3: 'syncSourceRepos' +-- ------------------------------------------------------------ + +newtype RepoDirSet = RepoDirSet Int deriving Show +newtype SyncTargetIterations = SyncTargetIterations Int deriving Show +newtype PrngSeed = PrngSeed Int deriving Show + +prop_syncRepos :: VCS Program + -> (Verbosity -> VCS ConfiguredProgram + -> FilePath -> VCSTestDriver) + -> RepoDirSet + -> SyncTargetIterations + -> PrngSeed + -> RepoRecipe + -> IO () +prop_syncRepos vcs mkVCSTestDriver + repoDirs syncTargetSetIterations seed repoRecipe = + testSetup vcs mkVCSTestDriver repoRecipe $ \vcsDriver tmpdir repoState -> + let srcRepoPath = vcsRepoRoot vcsDriver + destRepoPaths = map (tmpdir ) (getRepoDirs repoDirs) + in checkSyncRepos verbosity vcsDriver repoState + srcRepoPath destRepoPaths + syncTargetSetIterations seed + where + verbosity = silent + + getRepoDirs :: RepoDirSet -> [FilePath] + getRepoDirs (RepoDirSet n) = + [ "dest" ++ show i | i <- [1..n] ] + + +-- | The purpose of this test is to check that irrespective of the local cached +-- repo dir we can sync it to an arbitrary target state. So we do that by +-- syncing each target dir to a sequence of target states without cleaning it +-- in between. +-- +-- One slight complication is that 'syncSourceRepos' takes a whole list of +-- target dirs to sync in one go (to allow for sharing). So we must actually +-- generate and sync to a sequence of list of target repo states. +-- +-- So, given a source repo dir, the corresponding 'RepoState' and a number of +-- target repo dirs, pick a sequence of (lists of) sync targets from the +-- 'RepoState' and syncronise the target dirs with those targets, checking for +-- each one that the actual working state matches the expected repo state. +-- +checkSyncRepos + :: Verbosity + -> VCSTestDriver + -> RepoState + -> FilePath + -> [FilePath] + -> SyncTargetIterations + -> PrngSeed + -> IO () +checkSyncRepos verbosity VCSTestDriver { vcsVCS = vcs, vcsIgnoreFiles } + repoState srcRepoPath destRepoPath + (SyncTargetIterations syncTargetSetIterations) (PrngSeed seed) = + mapM_ checkSyncTargetSet syncTargetSets + where + checkSyncTargetSet :: [(SourceRepo, FilePath, RepoWorkingState)] -> IO () + checkSyncTargetSet syncTargets = do + _ <- execRebuild "root-unused" $ + syncSourceRepos verbosity vcs + [ (repo, repoPath) + | (repo, repoPath, _) <- syncTargets ] + sequence_ + [ checkExpectedWorkingState vcsIgnoreFiles repoPath workingState + | (_, repoPath, workingState) <- syncTargets ] + + syncTargetSets = take syncTargetSetIterations + $ pickSyncTargetSets (vcsRepoType vcs) repoState + srcRepoPath destRepoPath + (mkStdGen seed) + +pickSyncTargetSets :: RepoType -> RepoState + -> FilePath -> [FilePath] + -> StdGen + -> [[(SourceRepo, FilePath, RepoWorkingState)]] +pickSyncTargetSets repoType repoState srcRepoPath dstReposPath = + assert (Map.size (allTags repoState) > 0) $ + unfoldr (Just . swap . pickSyncTargetSet) + where + pickSyncTargetSet :: Rand [(SourceRepo, FilePath, RepoWorkingState)] + pickSyncTargetSet = flip (mapAccumL (flip pickSyncTarget)) dstReposPath + + pickSyncTarget :: FilePath -> Rand (SourceRepo, FilePath, RepoWorkingState) + pickSyncTarget destRepoPath prng = + (prng', (repo, destRepoPath, workingState)) + where + repo = (emptySourceRepo RepoThis) { + repoType = Just repoType, + repoLocation = Just srcRepoPath, + repoTag = Just tag + } + (tag, workingState) = Map.elemAt tagIdx (allTags repoState) + (tagIdx, prng') = randomR (0, Map.size (allTags repoState) - 1) prng + +type Rand a = StdGen -> (StdGen, a) + +instance Arbitrary RepoDirSet where + arbitrary = + sized $ \n -> oneof $ [ RepoDirSet <$> pure 1 ] + ++ [ RepoDirSet <$> choose (2,5) | n >= 3 ] + shrink (RepoDirSet n) = + [ RepoDirSet i | i <- shrink n, i > 0 ] + +instance Arbitrary SyncTargetIterations where + arbitrary = + sized $ \n -> SyncTargetIterations <$> elements [ 1 .. min 20 (n + 1) ] + shrink (SyncTargetIterations n) = + [ SyncTargetIterations i | i <- shrink n, i > 0 ] + +instance Arbitrary PrngSeed where + arbitrary = PrngSeed <$> arbitraryBoundedRandom + + +-- ------------------------------------------------------------ +-- * Instructions for constructing repositories +-- ------------------------------------------------------------ + +-- These instructions for constructing a repository can be interpreted in two +-- ways: to make a pure representation of repository state, and to execute +-- VCS commands to make a repository on-disk. + +data FileUpdate = FileUpdate FilePath String deriving Show +data Commit = Commit [FileUpdate] deriving Show +data TaggedCommits = TaggedCommits TagName [Commit] deriving Show +data BranchCommits = BranchCommits BranchName [Commit] deriving Show + +type BranchName = String +type TagName = String + +-- | Instructions to make a repository without branches, for VCSs that do not +-- support branches (e.g. darcs). +newtype NonBranchingRepoRecipe = NonBranchingRepoRecipe [TaggedCommits] + deriving Show + +-- | Instructions to make a repository with branches, for VCSs that do +-- support branches (e.g. git). +newtype BranchingRepoRecipe = BranchingRepoRecipe + [Either TaggedCommits BranchCommits] + deriving Show + +data RepoRecipe = WithBranchingSupport BranchingRepoRecipe + | WithoutBranchingSupport NonBranchingRepoRecipe + +-- --------------------------------------------------------------------------- +-- Arbitrary instances for them + +instance Arbitrary FileUpdate where + arbitrary = FileUpdate <$> genFileName <*> genFileContent + where + genFileName = (\c -> "file" [c]) <$> choose ('A', 'E') + genFileContent = vectorOf 10 (choose ('#', '~')) + +instance Arbitrary Commit where + arbitrary = Commit <$> shortListOf1 5 arbitrary + shrink (Commit writes) = Commit <$> filter (not . null) (shrink writes) + +instance Arbitrary TaggedCommits where + arbitrary = TaggedCommits <$> genTagName <*> shortListOf1 5 arbitrary + where + genTagName = ("tag_" ++) <$> shortListOf1 5 (choose ('A', 'Z')) + shrink (TaggedCommits tag commits) = + TaggedCommits tag <$> filter (not . null) (shrink commits) + +instance Arbitrary BranchCommits where + arbitrary = BranchCommits <$> genBranchName <*> shortListOf1 5 arbitrary + where + genBranchName = + sized $ \n -> + (\c -> "branch_" ++ [c]) <$> elements (take (max 1 n) ['A'..'E']) + + shrink (BranchCommits branch commits) = + BranchCommits branch <$> filter (not . null) (shrink commits) + +instance Arbitrary NonBranchingRepoRecipe where + arbitrary = NonBranchingRepoRecipe <$> shortListOf1 15 arbitrary + shrink (NonBranchingRepoRecipe xs) = + NonBranchingRepoRecipe <$> filter (not . null) (shrink xs) + +instance Arbitrary BranchingRepoRecipe where + arbitrary = BranchingRepoRecipe <$> shortListOf1 15 taggedOrBranch + where + taggedOrBranch = frequency [ (3, Left <$> arbitrary) + , (1, Right <$> arbitrary) + ] + shrink (BranchingRepoRecipe xs) = + BranchingRepoRecipe <$> filter (not . null) (shrink xs) + + +-- ------------------------------------------------------------ +-- * A pure model of repository state +-- ------------------------------------------------------------ + +-- | The full state of a repository. In particular it records the full working +-- state for every tag. +-- +-- This is also the interpreter state for executing a 'RepoRecipe'. +-- +-- This allows us to compare expected working states with the actual files in +-- the working directory of a repository. See 'checkExpectedWorkingState'. +-- +data RepoState = + RepoState { + currentBranch :: BranchName, + currentWorking :: RepoWorkingState, + allTags :: Map TagOrCommitId RepoWorkingState, + allBranches :: Map BranchName RepoWorkingState + } + deriving Show + +type RepoWorkingState = Map FilePath String +type CommitId = String +type TagOrCommitId = String + + +------------------------------------------------------------------------------ +-- Functions used to interpret instructions for constructing repositories + +initialRepoState :: RepoState +initialRepoState = + RepoState { + currentBranch = "branch_master", + currentWorking = Map.empty, + allTags = Map.empty, + allBranches = Map.empty + } + +updateFile :: FilePath -> String -> RepoState -> RepoState +updateFile filename content state@RepoState{currentWorking} = + state { currentWorking = Map.insert filename content currentWorking } + +addTagOrCommit :: TagOrCommitId -> RepoState -> RepoState +addTagOrCommit commit state@RepoState{currentWorking, allTags} = + state { allTags = Map.insert commit currentWorking allTags } + +switchBranch :: BranchName -> RepoState -> RepoState +switchBranch branch state@RepoState{currentWorking, currentBranch, allBranches} = + -- Use updated allBranches to cover case of switching to the same branch + let allBranches' = Map.insert currentBranch currentWorking allBranches in + state { + currentBranch = branch, + currentWorking = case Map.lookup branch allBranches' of + Just working -> working + -- otherwise we're creating a new branch, which starts + -- from our current branch state + Nothing -> currentWorking, + allBranches = allBranches' + } + + +-- ------------------------------------------------------------ +-- * Comparing on-disk with expected 'RepoWorkingState' +-- ------------------------------------------------------------ + +-- | Compare expected working states with the actual files in +-- the working directory of a repository. +-- +checkExpectedWorkingState :: Set FilePath + -> FilePath -> RepoWorkingState -> IO () +checkExpectedWorkingState ignore repoPath expectedState = do + currentState <- getCurrentWorkingState ignore repoPath + unless (currentState == expectedState) $ + throwIO (WorkingStateMismatch expectedState currentState) + +data WorkingStateMismatch = + WorkingStateMismatch RepoWorkingState -- expected + RepoWorkingState -- actual + deriving Show + +instance Exception WorkingStateMismatch + +getCurrentWorkingState :: Set FilePath -> FilePath -> IO RepoWorkingState +getCurrentWorkingState ignore repoRoot = do + entries <- getDirectoryContentsRecursive ignore repoRoot "" + Map.fromList <$> mapM getFileEntry + [ file | (file, isDir) <- entries, not isDir ] + where + getFileEntry name = + withBinaryFile (repoRoot name) ReadMode $ \h -> do + str <- hGetContents h + _ <- evaluate (length str) + return (name, str) + +getDirectoryContentsRecursive :: Set FilePath -> FilePath -> FilePath + -> IO [(FilePath, Bool)] +getDirectoryContentsRecursive ignore dir0 dir = do + entries <- getDirectoryContents (dir0 dir) + entries' <- sequence + [ do isdir <- doesDirectoryExist (dir0 dir entry) + return (dir entry, isdir) + | entry <- entries + , not (isPrefixOf "." entry) + , (dir entry) `Set.notMember` ignore + ] + let subdirs = [ d | (d, True) <- entries' ] + subdirEntries <- mapM (getDirectoryContentsRecursive ignore dir0) subdirs + return (concat (entries' : subdirEntries)) + + +-- ------------------------------------------------------------ +-- * Executing instructions to make on-disk VCS repos +-- ------------------------------------------------------------ + +-- | Execute the instructions in a 'RepoRecipe' using the given 'VCSTestDriver' +-- to make an on-disk repository. +-- +-- This also returns a 'RepoState'. This is done as part of construction to +-- support VCSs like git that have commit ids, so that those commit ids can be +-- included in the 'RepoState's 'allTags' set. +-- +createRepo :: VCSTestDriver -> RepoRecipe -> IO RepoState +createRepo vcsDriver@VCSTestDriver{vcsRepoRoot, vcsInit} recipe = do + createDirectory vcsRepoRoot + createDirectory (vcsRepoRoot "file") + vcsInit + execStateT createRepoAction initialRepoState + where + createRepoAction :: StateT RepoState IO () + createRepoAction = case recipe of + WithoutBranchingSupport r -> execNonBranchingRepoRecipe vcsDriver r + WithBranchingSupport r -> execBranchingRepoRecipe vcsDriver r + +type CreateRepoAction a = VCSTestDriver -> a -> StateT RepoState IO () + +execNonBranchingRepoRecipe :: CreateRepoAction NonBranchingRepoRecipe +execNonBranchingRepoRecipe vcsDriver (NonBranchingRepoRecipe taggedCommits) = + mapM_ (execTaggdCommits vcsDriver) taggedCommits + +execBranchingRepoRecipe :: CreateRepoAction BranchingRepoRecipe +execBranchingRepoRecipe vcsDriver (BranchingRepoRecipe taggedCommits) = + mapM_ (either (execTaggdCommits vcsDriver) + (execBranchCommits vcsDriver)) + taggedCommits + +execBranchCommits :: CreateRepoAction BranchCommits +execBranchCommits vcsDriver@VCSTestDriver{vcsSwitchBranch} + (BranchCommits branch commits) = do + mapM_ (execCommit vcsDriver) commits + -- add commits and then switch branch + State.modify (switchBranch branch) + state <- State.get -- repo state after the commits and branch switch + liftIO $ vcsSwitchBranch state branch + + -- It may seem odd that we add commits on the existing branch and then + -- switch branch. In part this is because git cannot branch from an empty + -- repo state, it complains that the master branch doesn't exist yet. + +execTaggdCommits :: CreateRepoAction TaggedCommits +execTaggdCommits vcsDriver@VCSTestDriver{vcsTagState} + (TaggedCommits tagname commits) = do + mapM_ (execCommit vcsDriver) commits + -- add commits then tag + state <- State.get -- repo state after the commits + liftIO $ vcsTagState state tagname + State.modify (addTagOrCommit tagname) + +execCommit :: CreateRepoAction Commit +execCommit vcsDriver@VCSTestDriver{..} (Commit fileUpdates) = do + mapM_ (execFileUpdate vcsDriver) fileUpdates + state <- State.get -- existing state, not updated + mcommit <- liftIO $ vcsCommitChanges state + State.modify (maybe id addTagOrCommit mcommit) + +execFileUpdate :: CreateRepoAction FileUpdate +execFileUpdate VCSTestDriver{..} (FileUpdate filename content) = do + liftIO $ writeFile (vcsRepoRoot filename) content + state <- State.get -- existing state, not updated + liftIO $ vcsAddFile state filename + State.modify (updateFile filename content) + + +-- ------------------------------------------------------------ +-- * VCSTestDriver for various VCSs +-- ------------------------------------------------------------ + +-- | Extends 'VCS' with extra methods to construct a repository. Used by +-- 'createRepo'. +-- +-- Several of the methods are allowed to rely on the current 'RepoState' +-- because some VCSs need different commands for initial vs later actions +-- (like adding a file to the tracked set, or creating a new branch). +-- +-- The driver instance knows the particular repo directory. +-- +data VCSTestDriver = VCSTestDriver { + vcsVCS :: VCS ConfiguredProgram, + vcsRepoRoot :: FilePath, + vcsIgnoreFiles :: Set FilePath, + vcsInit :: IO (), + vcsAddFile :: RepoState -> FilePath -> IO (), + vcsCommitChanges :: RepoState -> IO (Maybe CommitId), + vcsTagState :: RepoState -> TagName -> IO (), + vcsSwitchBranch :: RepoState -> BranchName -> IO (), + vcsCheckoutTag :: Either (TagName -> IO ()) + (TagName -> FilePath -> IO ()) + } + + +vcsTestDriverGit :: Verbosity -> VCS ConfiguredProgram + -> FilePath -> VCSTestDriver +vcsTestDriverGit verbosity vcs repoRoot = + VCSTestDriver { + vcsVCS = vcs + + , vcsRepoRoot = repoRoot + + , vcsIgnoreFiles = Set.empty + + , vcsInit = + git $ ["init"] ++ verboseArg + + , vcsAddFile = \_ filename -> + git ["add", filename] + + , vcsCommitChanges = \_state -> do + git $ [ "-c", "user.name=A", "-c", "user.email=a@example.com" + , "commit", "--all", "--message=a patch" + , "--author=A " + ] ++ verboseArg + commit <- git' ["log", "--format=%H", "-1"] + let commit' = takeWhile (not . isSpace) commit + return (Just commit') + + , vcsTagState = \_ tagname -> + git ["tag", "--force", tagname] + + , vcsSwitchBranch = \RepoState{allBranches} branchname -> do + unless (branchname `Map.member` allBranches) $ + git ["branch", branchname] + git $ ["checkout", branchname] ++ verboseArg + + , vcsCheckoutTag = Left $ \tagname -> + git $ ["checkout", "--detach", "--force", tagname] ++ verboseArg + } + where + gitInvocation args = (programInvocation (vcsProgram vcs) args) { + progInvokeCwd = Just repoRoot + } + git = runProgramInvocation verbosity . gitInvocation + git' = getProgramInvocationOutput verbosity . gitInvocation + verboseArg = [ "--quiet" | verbosity < Verbosity.normal ] + + +type MTimeChange = Int + +vcsTestDriverDarcs :: MTimeChange -> Verbosity -> VCS ConfiguredProgram + -> FilePath -> VCSTestDriver +vcsTestDriverDarcs mtimeChange verbosity vcs repoRoot = + VCSTestDriver { + vcsVCS = vcs + + , vcsRepoRoot = repoRoot + + , vcsIgnoreFiles = Set.singleton "_darcs" + + , vcsInit = + darcs ["initialize"] + + , vcsAddFile = \state filename -> do + threadDelay mtimeChange + unless (filename `Map.member` currentWorking state) $ + darcs ["add", filename] + -- Darcs's file change tracking relies on mtime changes, + -- so we have to be careful with doing stuff too quickly: + + , vcsCommitChanges = \_state -> do + threadDelay mtimeChange + darcs ["record", "--all", "--author=author", "--name=a patch"] + return Nothing + + , vcsTagState = \_ tagname -> + darcs ["tag", "--author=author", tagname] + + , vcsSwitchBranch = \_ _ -> + fail "vcsSwitchBranch: darcs does not support branches within a repo" + + , vcsCheckoutTag = Right $ \tagname dest -> + darcs ["clone", "--lazy", "--tag=^" ++ tagname ++ "$", ".", dest] + } + where + darcsInvocation args = (programInvocation (vcsProgram vcs) args) { + progInvokeCwd = Just repoRoot + } + darcs = runProgramInvocation verbosity . darcsInvocation + diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Builder.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Builder.hs new file mode 100644 index 00000000..b8509834 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Builder.hs @@ -0,0 +1,20 @@ +module UnitTests.Distribution.Solver.Modular.Builder ( + tests + ) where + +import Distribution.Solver.Modular.Builder + +import Test.Tasty +import Test.Tasty.QuickCheck + +tests :: [TestTree] +tests = [ testProperty "splitsAltImplementation" splitsTest + ] + +-- | Simpler splits implementation +splits' :: [a] -> [(a, [a])] +splits' [] = [] +splits' (x : xs) = (x, xs) : map (\ (y, ys) -> (y, x : ys)) (splits' xs) + +splitsTest :: [Int] -> Property +splitsTest xs = splits' xs === splits xs diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs new file mode 100644 index 00000000..ef8f9cb6 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs @@ -0,0 +1,270 @@ +{-# LANGUAGE RecordWildCards #-} +-- | Utilities for creating HUnit test cases with the solver DSL. +module UnitTests.Distribution.Solver.Modular.DSL.TestCaseUtils ( + SolverTest + , SolverResult(..) + , maxBackjumps + , independentGoals + , allowBootLibInstalls + , onlyConstrained + , disableBackjumping + , disableSolveExecutables + , goalOrder + , constraints + , preferences + , setVerbose + , enableAllTests + , solverSuccess + , solverFailure + , anySolverFailure + , mkTest + , mkTestExts + , mkTestLangs + , mkTestPCDepends + , mkTestExtLangPC + , runTest + ) where + +import Prelude () +import Distribution.Solver.Compat.Prelude + +import Data.List (elemIndex) +import Data.Ord (comparing) + +-- test-framework +import Test.Tasty as TF +import Test.Tasty.HUnit (testCase, assertEqual, assertBool) + +-- Cabal +import qualified Distribution.PackageDescription as C +import qualified Distribution.Types.PackageName as C +import Language.Haskell.Extension (Extension(..), Language(..)) +import Distribution.Verbosity + +-- cabal-install +import qualified Distribution.Solver.Types.PackagePath as P +import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb, pkgConfigDbFromList) +import Distribution.Solver.Types.Settings +import Distribution.Solver.Types.Variable +import Distribution.Client.Dependency (foldProgress) +import UnitTests.Distribution.Solver.Modular.DSL +import UnitTests.Options + +maxBackjumps :: Maybe Int -> SolverTest -> SolverTest +maxBackjumps mbj test = test { testMaxBackjumps = mbj } + +-- | Combinator to turn on --independent-goals behavior, i.e. solve +-- for the goals as if we were solving for each goal independently. +independentGoals :: SolverTest -> SolverTest +independentGoals test = test { testIndepGoals = IndependentGoals True } + +allowBootLibInstalls :: SolverTest -> SolverTest +allowBootLibInstalls test = + test { testAllowBootLibInstalls = AllowBootLibInstalls True } + +onlyConstrained :: SolverTest -> SolverTest +onlyConstrained test = + test { testOnlyConstrained = OnlyConstrainedAll } + +disableBackjumping :: SolverTest -> SolverTest +disableBackjumping test = + test { testEnableBackjumping = EnableBackjumping False } + +disableSolveExecutables :: SolverTest -> SolverTest +disableSolveExecutables test = + test { testSolveExecutables = SolveExecutables False } + +goalOrder :: [ExampleVar] -> SolverTest -> SolverTest +goalOrder order test = test { testGoalOrder = Just order } + +constraints :: [ExConstraint] -> SolverTest -> SolverTest +constraints cs test = test { testConstraints = cs } + +preferences :: [ExPreference] -> SolverTest -> SolverTest +preferences prefs test = test { testSoftConstraints = prefs } + +-- | Increase the solver's verbosity. This is necessary for test cases that +-- check the contents of the verbose log. +setVerbose :: SolverTest -> SolverTest +setVerbose test = test { testVerbosity = verbose } + +enableAllTests :: SolverTest -> SolverTest +enableAllTests test = test { testEnableAllTests = EnableAllTests True } + +{------------------------------------------------------------------------------- + Solver tests +-------------------------------------------------------------------------------} + +data SolverTest = SolverTest { + testLabel :: String + , testTargets :: [String] + , testResult :: SolverResult + , testMaxBackjumps :: Maybe Int + , testIndepGoals :: IndependentGoals + , testAllowBootLibInstalls :: AllowBootLibInstalls + , testOnlyConstrained :: OnlyConstrained + , testEnableBackjumping :: EnableBackjumping + , testSolveExecutables :: SolveExecutables + , testGoalOrder :: Maybe [ExampleVar] + , testConstraints :: [ExConstraint] + , testSoftConstraints :: [ExPreference] + , testVerbosity :: Verbosity + , testDb :: ExampleDb + , testSupportedExts :: Maybe [Extension] + , testSupportedLangs :: Maybe [Language] + , testPkgConfigDb :: PkgConfigDb + , testEnableAllTests :: EnableAllTests + } + +-- | Expected result of a solver test. +data SolverResult = SolverResult { + -- | The solver's log should satisfy this predicate. Note that we also print + -- the log, so evaluating a large log here can cause a space leak. + resultLogPredicate :: [String] -> Bool, + + -- | Fails with an error message satisfying the predicate, or succeeds with + -- the given plan. + resultErrorMsgPredicateOrPlan :: Either (String -> Bool) [(String, Int)] + } + +solverSuccess :: [(String, Int)] -> SolverResult +solverSuccess = SolverResult (const True) . Right + +solverFailure :: (String -> Bool) -> SolverResult +solverFailure = SolverResult (const True) . Left + +-- | Can be used for test cases where we just want to verify that +-- they fail, but do not care about the error message. +anySolverFailure :: SolverResult +anySolverFailure = solverFailure (const True) + +-- | Makes a solver test case, consisting of the following components: +-- +-- 1. An 'ExampleDb', representing the package database (both +-- installed and remote) we are doing dependency solving over, +-- 2. A 'String' name for the test, +-- 3. A list '[String]' of package names to solve for +-- 4. The expected result, either 'Nothing' if there is no +-- satisfying solution, or a list '[(String, Int)]' of +-- packages to install, at which versions. +-- +-- See 'UnitTests.Distribution.Solver.Modular.DSL' for how +-- to construct an 'ExampleDb', as well as definitions of 'db1' etc. +-- in this file. +mkTest :: ExampleDb + -> String + -> [String] + -> SolverResult + -> SolverTest +mkTest = mkTestExtLangPC Nothing Nothing [] + +mkTestExts :: [Extension] + -> ExampleDb + -> String + -> [String] + -> SolverResult + -> SolverTest +mkTestExts exts = mkTestExtLangPC (Just exts) Nothing [] + +mkTestLangs :: [Language] + -> ExampleDb + -> String + -> [String] + -> SolverResult + -> SolverTest +mkTestLangs langs = mkTestExtLangPC Nothing (Just langs) [] + +mkTestPCDepends :: [(String, String)] + -> ExampleDb + -> String + -> [String] + -> SolverResult + -> SolverTest +mkTestPCDepends pkgConfigDb = mkTestExtLangPC Nothing Nothing pkgConfigDb + +mkTestExtLangPC :: Maybe [Extension] + -> Maybe [Language] + -> [(String, String)] + -> ExampleDb + -> String + -> [String] + -> SolverResult + -> SolverTest +mkTestExtLangPC exts langs pkgConfigDb db label targets result = SolverTest { + testLabel = label + , testTargets = targets + , testResult = result + , testMaxBackjumps = Nothing + , testIndepGoals = IndependentGoals False + , testAllowBootLibInstalls = AllowBootLibInstalls False + , testOnlyConstrained = OnlyConstrainedNone + , testEnableBackjumping = EnableBackjumping True + , testSolveExecutables = SolveExecutables True + , testGoalOrder = Nothing + , testConstraints = [] + , testSoftConstraints = [] + , testVerbosity = normal + , testDb = db + , testSupportedExts = exts + , testSupportedLangs = langs + , testPkgConfigDb = pkgConfigDbFromList pkgConfigDb + , testEnableAllTests = EnableAllTests False + } + +runTest :: SolverTest -> TF.TestTree +runTest SolverTest{..} = askOption $ \(OptionShowSolverLog showSolverLog) -> + testCase testLabel $ do + let progress = exResolve testDb testSupportedExts + testSupportedLangs testPkgConfigDb testTargets + testMaxBackjumps (CountConflicts True) testIndepGoals + (ReorderGoals False) testAllowBootLibInstalls + testOnlyConstrained testEnableBackjumping testSolveExecutables + (sortGoals <$> testGoalOrder) testConstraints + testSoftConstraints testVerbosity testEnableAllTests + printMsg msg = when showSolverLog $ putStrLn msg + msgs = foldProgress (:) (const []) (const []) progress + assertBool ("Unexpected solver log:\n" ++ unlines msgs) $ + resultLogPredicate testResult $ concatMap lines msgs + result <- foldProgress ((>>) . printMsg) (return . Left) (return . Right) progress + case result of + Left err -> assertBool ("Unexpected error:\n" ++ err) + (checkErrorMsg testResult err) + Right plan -> assertEqual "" (toMaybe testResult) (Just (extractInstallPlan plan)) + where + toMaybe :: SolverResult -> Maybe [(String, Int)] + toMaybe = either (const Nothing) Just . resultErrorMsgPredicateOrPlan + + checkErrorMsg :: SolverResult -> String -> Bool + checkErrorMsg result msg = + case resultErrorMsgPredicateOrPlan result of + Left f -> f msg + Right _ -> False + + sortGoals :: [ExampleVar] + -> Variable P.QPN -> Variable P.QPN -> Ordering + sortGoals = orderFromList . map toVariable + + -- Sort elements in the list ahead of elements not in the list. Otherwise, + -- follow the order in the list. + orderFromList :: Eq a => [a] -> a -> a -> Ordering + orderFromList xs = + comparing $ \x -> let i = elemIndex x xs in (isNothing i, i) + + toVariable :: ExampleVar -> Variable P.QPN + toVariable (P q pn) = PackageVar (toQPN q pn) + toVariable (F q pn fn) = FlagVar (toQPN q pn) (C.mkFlagName fn) + toVariable (S q pn stanza) = StanzaVar (toQPN q pn) stanza + + toQPN :: ExampleQualifier -> ExamplePkgName -> P.QPN + toQPN q pn = P.Q pp (C.mkPackageName pn) + where + pp = case q of + QualNone -> P.PackagePath P.DefaultNamespace P.QualToplevel + QualIndep p -> P.PackagePath (P.Independent $ C.mkPackageName p) + P.QualToplevel + QualSetup s -> P.PackagePath P.DefaultNamespace + (P.QualSetup (C.mkPackageName s)) + QualIndepSetup p s -> P.PackagePath (P.Independent $ C.mkPackageName p) + (P.QualSetup (C.mkPackageName s)) + QualExe p1 p2 -> P.PackagePath P.DefaultNamespace + (P.QualExe (C.mkPackageName p1) (C.mkPackageName p2)) diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/MemoryUsage.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/MemoryUsage.hs new file mode 100644 index 00000000..f1bc388d --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/MemoryUsage.hs @@ -0,0 +1,191 @@ +-- | Tests for detecting space leaks in the dependency solver. +module UnitTests.Distribution.Solver.Modular.MemoryUsage (tests) where + +import Test.Tasty (TestTree) + +import UnitTests.Distribution.Solver.Modular.DSL +import UnitTests.Distribution.Solver.Modular.DSL.TestCaseUtils + +tests :: [TestTree] +tests = [ + runTest $ basicTest "basic space leak test" + , runTest $ flagsTest "package with many flags" + , runTest $ issue2899 "issue #2899" + , runTest $ duplicateDependencies "duplicate dependencies" + , runTest $ duplicateFlaggedDependencies "duplicate flagged dependencies" + ] + +-- | This test solves for n packages that each have two versions. There is no +-- solution, because the nth package depends on another package that doesn't fit +-- its version constraint. Backjumping is disabled, so the solver must explore a +-- search tree of size 2^n. It should fail if memory usage is proportional to +-- the size of the tree. +basicTest :: String -> SolverTest +basicTest name = + disableBackjumping $ mkTest pkgs name ["target"] anySolverFailure + where + n :: Int + n = 18 + + pkgs :: ExampleDb + pkgs = map Right $ + [ exAv "target" 1 [ExAny $ pkgName 1]] + ++ [ exAv (pkgName i) v [ExRange (pkgName $ i + 1) 2 4] + | i <- [1..n], v <- [2, 3]] + ++ [exAv (pkgName $ n + 1) 1 []] + + pkgName :: Int -> ExamplePkgName + pkgName x = "pkg-" ++ show x + +-- | This test is similar to 'basicTest', except that it has one package with n +-- flags, flag-1 through flag-n. The solver assigns flags in order, so it +-- doesn't discover the unknown dependencies under flag-n until it has assigned +-- all of the flags. It has to explore the whole search tree. +flagsTest :: String -> SolverTest +flagsTest name = + disableBackjumping $ + goalOrder orderedFlags $ mkTest pkgs name ["pkg"] anySolverFailure + where + n :: Int + n = 16 + + pkgs :: ExampleDb + pkgs = [Right $ exAv "pkg" 1 $ + [exFlagged (numberedFlag n) [ExAny "unknown1"] [ExAny "unknown2"]] + + -- The remaining flags have no effect: + ++ [exFlagged (numberedFlag i) [] [] | i <- [1..n - 1]] + ] + + orderedFlags :: [ExampleVar] + orderedFlags = [F QualNone "pkg" (numberedFlag i) | i <- [1..n]] + +-- | Test for a space leak caused by sharing of search trees under packages with +-- link choices (issue #2899). +-- +-- The goal order is fixed so that the solver chooses setup-dep and then +-- target-setup.setup-dep at the top of the search tree. target-setup.setup-dep +-- has two choices: link to setup-dep, and don't link to setup-dep. setup-dep +-- has a long chain of dependencies (pkg-1 through pkg-n). However, pkg-n +-- depends on pkg-n+1, which doesn't exist, so there is no solution. Since each +-- dependency has two versions, the solver must try 2^n combinations when +-- backjumping is disabled. These combinations create large search trees under +-- each of the two choices for target-setup.setup-dep. Although the choice to +-- not link is disallowed by the Single Instance Restriction, the solver doesn't +-- know that until it has explored (and evaluated) the whole tree under the +-- choice to link. If the two trees are shared, memory usage spikes. +issue2899 :: String -> SolverTest +issue2899 name = + disableBackjumping $ + goalOrder goals $ mkTest pkgs name ["target"] anySolverFailure + where + n :: Int + n = 16 + + pkgs :: ExampleDb + pkgs = map Right $ + [ exAv "target" 1 [ExAny "setup-dep"] `withSetupDeps` [ExAny "setup-dep"] + , exAv "setup-dep" 1 [ExAny $ pkgName 1]] + ++ [ exAv (pkgName i) v [ExAny $ pkgName (i + 1)] + | i <- [1..n], v <- [1, 2]] + + pkgName :: Int -> ExamplePkgName + pkgName x = "pkg-" ++ show x + + goals :: [ExampleVar] + goals = [P QualNone "setup-dep", P (QualSetup "target") "setup-dep"] + +-- | Test for an issue related to lifting dependencies out of conditionals when +-- converting a PackageDescription to the solver's internal representation. +-- +-- Issue: +-- For each conditional and each package B, the solver combined each dependency +-- on B in the true branch with each dependency on B in the false branch. It +-- added the combined dependencies to the build-depends outside of the +-- conditional. Since dependencies could be lifted out of multiple levels of +-- conditionals, the number of new dependencies could grow exponentially in the +-- number of levels. For example, the following package generated 4 copies of B +-- under flag-2=False, 8 copies under flag-1=False, and 16 copies at the top +-- level: +-- +-- if flag(flag-1) +-- build-depends: B, B +-- else +-- if flag(flag-2) +-- build-depends: B, B +-- else +-- if flag(flag-3) +-- build-depends: B, B +-- else +-- build-depends: B, B +-- +-- This issue caused the quickcheck tests to start frequently running out of +-- memory after an optimization that pruned unreachable branches (See PR #4929). +-- Each problematic test case contained at least one build-depends field with +-- duplicate dependencies, which was then duplicated under multiple levels of +-- conditionals by the solver's "buildable: False" transformation, when +-- "buildable: False" was under multiple flags. Finally, the branch pruning +-- feature put all build-depends fields in consecutive levels of the condition +-- tree, causing the solver's representation of the package to follow the +-- pattern in the example above. +-- +-- Now the solver avoids this issue by combining all dependencies on the same +-- package before lifting them out of conditionals. +-- +-- This test case is an expanded version of the example above, with library and +-- build-tool dependencies. +duplicateDependencies :: String -> SolverTest +duplicateDependencies name = + mkTest pkgs name ["A"] $ solverSuccess [("A", 1), ("B", 1)] + where + copies, depth :: Int + copies = 50 + depth = 50 + + pkgs :: ExampleDb + pkgs = [ + Right $ exAv "A" 1 (dependencyTree 1) + , Right $ exAv "B" 1 [] `withExe` ExExe "exe" [] + ] + + dependencyTree :: Int -> [ExampleDependency] + dependencyTree n + | n > depth = buildDepends + | otherwise = [exFlagged (numberedFlag n) buildDepends + (dependencyTree (n + 1))] + where + buildDepends = replicate copies (ExFix "B" 1) + ++ replicate copies (ExBuildToolFix "B" "exe" 1) + +-- | This test is similar to duplicateDependencies, except that every dependency +-- on B is replaced by a conditional that contains B in both branches. It tests +-- that the solver doesn't just combine dependencies within one build-depends or +-- build-tool-depends field; it also needs to combine dependencies after they +-- are lifted out of conditionals. +duplicateFlaggedDependencies :: String -> SolverTest +duplicateFlaggedDependencies name = + mkTest pkgs name ["A"] $ solverSuccess [("A", 1), ("B", 1)] + where + copies, depth :: Int + copies = 15 + depth = 15 + + pkgs :: ExampleDb + pkgs = [ + Right $ exAv "A" 1 (dependencyTree 1) + , Right $ exAv "B" 1 [] `withExe` ExExe "exe" [] + ] + + dependencyTree :: Int -> [ExampleDependency] + dependencyTree n + | n > depth = flaggedDeps + | otherwise = [exFlagged (numberedFlag n) flaggedDeps + (dependencyTree (n + 1))] + where + flaggedDeps = zipWith ($) (replicate copies flaggedDep) [0 :: Int ..] + flaggedDep m = exFlagged (numberedFlag n ++ "-" ++ show m) buildDepends + buildDepends + buildDepends = [ExFix "B" 1, ExBuildToolFix "B" "exe" 1] + +numberedFlag :: Int -> ExampleFlagName +numberedFlag n = "flag-" ++ show n diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs new file mode 100644 index 00000000..ae4589a7 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs @@ -0,0 +1,519 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module UnitTests.Distribution.Solver.Modular.QuickCheck (tests) where + +import Prelude () +import Distribution.Client.Compat.Prelude + +import Control.Arrow ((&&&)) +import Control.DeepSeq (force) +import Data.Either (lefts) +import Data.Function (on) +import Data.Hashable (Hashable(..)) +import Data.List (groupBy, isInfixOf) +import Data.Ord (comparing) + +import Text.Show.Pretty (parseValue, valToStr) + +import Test.Tasty (TestTree) +import Test.Tasty.QuickCheck + +import Distribution.Types.GenericPackageDescription (FlagName) +import Distribution.Utils.ShortText (ShortText) + +import Distribution.Client.Setup (defaultMaxBackjumps) + +import Distribution.Types.PackageName +import Distribution.Types.UnqualComponentName + +import qualified Distribution.Solver.Types.ComponentDeps as CD +import Distribution.Solver.Types.ComponentDeps + ( Component(..), ComponentDep, ComponentDeps ) +import Distribution.Solver.Types.OptionalStanza +import Distribution.Solver.Types.PackageConstraint +import qualified Distribution.Solver.Types.PackagePath as P +import Distribution.Solver.Types.PkgConfigDb + (pkgConfigDbFromList) +import Distribution.Solver.Types.Settings +import Distribution.Solver.Types.Variable +import Distribution.Verbosity +import Distribution.Version + +import UnitTests.Distribution.Solver.Modular.DSL +import UnitTests.Distribution.Solver.Modular.QuickCheck.Utils + ( testPropertyWithSeed ) + +tests :: [TestTree] +tests = [ + -- This test checks that certain solver parameters do not affect the + -- existence of a solution. It runs the solver twice, and only sets those + -- parameters on the second run. The test also applies parameters that + -- can affect the existence of a solution to both runs. + testPropertyWithSeed "target and goal order do not affect solvability" $ + \test targetOrder mGoalOrder1 mGoalOrder2 indepGoals -> + let r1 = solve' mGoalOrder1 test + r2 = solve' mGoalOrder2 test { testTargets = targets2 } + solve' goalOrder = + solve (EnableBackjumping True) (ReorderGoals False) + (CountConflicts True) indepGoals + (getBlind <$> goalOrder) + targets = testTargets test + targets2 = case targetOrder of + SameOrder -> targets + ReverseOrder -> reverse targets + in counterexample (showResults r1 r2) $ + noneReachedBackjumpLimit [r1, r2] ==> + isRight (resultPlan r1) === isRight (resultPlan r2) + + , testPropertyWithSeed + "solvable without --independent-goals => solvable with --independent-goals" $ + \test reorderGoals -> + let r1 = solve' (IndependentGoals False) test + r2 = solve' (IndependentGoals True) test + solve' indep = solve (EnableBackjumping True) reorderGoals + (CountConflicts True) indep Nothing + in counterexample (showResults r1 r2) $ + noneReachedBackjumpLimit [r1, r2] ==> + isRight (resultPlan r1) `implies` isRight (resultPlan r2) + + , testPropertyWithSeed "backjumping does not affect solvability" $ + \test reorderGoals indepGoals -> + let r1 = solve' (EnableBackjumping True) test + r2 = solve' (EnableBackjumping False) test + solve' enableBj = solve enableBj reorderGoals + (CountConflicts True) indepGoals Nothing + in counterexample (showResults r1 r2) $ + noneReachedBackjumpLimit [r1, r2] ==> + isRight (resultPlan r1) === isRight (resultPlan r2) + + -- This test uses --no-count-conflicts, because the goal order used with + -- --count-conflicts depends on the total set of conflicts seen by the + -- solver. The solver explores more of the tree and encounters more + -- conflicts when it doesn't backjump. The different goal orders can lead to + -- different solutions and cause the test to fail. + -- TODO: Find a faster way to randomly sort goals, and then use a random + -- goal order in this test. + , testPropertyWithSeed + "backjumping does not affect the result (with static goal order)" $ + \test reorderGoals indepGoals -> + let r1 = solve' (EnableBackjumping True) test + r2 = solve' (EnableBackjumping False) test + solve' enableBj = solve enableBj reorderGoals + (CountConflicts False) indepGoals Nothing + in counterexample (showResults r1 r2) $ + noneReachedBackjumpLimit [r1, r2] ==> + resultPlan r1 === resultPlan r2 + ] + where + noneReachedBackjumpLimit :: [Result] -> Bool + noneReachedBackjumpLimit = + not . any (\r -> resultPlan r == Left BackjumpLimitReached) + + showResults :: Result -> Result -> String + showResults r1 r2 = showResult 1 r1 ++ showResult 2 r2 + + showResult :: Int -> Result -> String + showResult n result = + unlines $ ["", "Run " ++ show n ++ ":"] + ++ resultLog result + ++ ["result: " ++ show (resultPlan result)] + + implies :: Bool -> Bool -> Bool + implies x y = not x || y + + isRight :: Either a b -> Bool + isRight (Right _) = True + isRight _ = False + +newtype VarOrdering = VarOrdering { + unVarOrdering :: Variable P.QPN -> Variable P.QPN -> Ordering + } + +solve :: EnableBackjumping -> ReorderGoals -> CountConflicts -> IndependentGoals + -> Maybe VarOrdering + -> SolverTest -> Result +solve enableBj reorder countConflicts indep goalOrder test = + let (lg, result) = + runProgress $ exResolve (unTestDb (testDb test)) Nothing Nothing + (pkgConfigDbFromList []) + (map unPN (testTargets test)) + -- The backjump limit prevents individual tests from using + -- too much time and memory. + (Just defaultMaxBackjumps) + countConflicts indep reorder (AllowBootLibInstalls False) + OnlyConstrainedNone enableBj (SolveExecutables True) (unVarOrdering <$> goalOrder) + (testConstraints test) (testPreferences test) normal + (EnableAllTests False) + + failure :: String -> Failure + failure msg + | "Backjump limit reached" `isInfixOf` msg = BackjumpLimitReached + | otherwise = OtherFailure + in Result { + resultLog = lg + , resultPlan = + -- Force the result so that we check for internal errors when we check + -- for success or failure. See D.C.Dependency.validateSolverResult. + force $ either (Left . failure) (Right . extractInstallPlan) result + } + +-- | How to modify the order of the input targets. +data TargetOrder = SameOrder | ReverseOrder + deriving Show + +instance Arbitrary TargetOrder where + arbitrary = elements [SameOrder, ReverseOrder] + + shrink SameOrder = [] + shrink ReverseOrder = [SameOrder] + +data Result = Result { + resultLog :: [String] + , resultPlan :: Either Failure [(ExamplePkgName, ExamplePkgVersion)] + } + +data Failure = BackjumpLimitReached | OtherFailure + deriving (Eq, Generic, Show) + +instance NFData Failure + +-- | Package name. +newtype PN = PN { unPN :: String } + deriving (Eq, Ord, Show) + +instance Arbitrary PN where + arbitrary = PN <$> elements ("base" : [[pn] | pn <- ['A'..'G']]) + +-- | Package version. +newtype PV = PV { unPV :: Int } + deriving (Eq, Ord, Show) + +instance Arbitrary PV where + arbitrary = PV <$> elements [1..10] + +type TestPackage = Either ExampleInstalled ExampleAvailable + +getName :: TestPackage -> PN +getName = PN . either exInstName exAvName + +getVersion :: TestPackage -> PV +getVersion = PV . either exInstVersion exAvVersion + +data SolverTest = SolverTest { + testDb :: TestDb + , testTargets :: [PN] + , testConstraints :: [ExConstraint] + , testPreferences :: [ExPreference] + } + +-- | Pretty-print the test when quickcheck calls 'show'. +instance Show SolverTest where + show test = + let str = "SolverTest {testDb = " ++ show (testDb test) + ++ ", testTargets = " ++ show (testTargets test) + ++ ", testConstraints = " ++ show (testConstraints test) + ++ ", testPreferences = " ++ show (testPreferences test) + ++ "}" + in maybe str valToStr $ parseValue str + +instance Arbitrary SolverTest where + arbitrary = do + db <- arbitrary + let pkgVersions = nub $ map (getName &&& getVersion) (unTestDb db) + pkgs = nub $ map fst pkgVersions + Positive n <- arbitrary + targets <- randomSubset n pkgs + constraints <- case pkgVersions of + [] -> return [] + _ -> boundedListOf 1 $ arbitraryConstraint pkgVersions + prefs <- case pkgVersions of + [] -> return [] + _ -> boundedListOf 3 $ arbitraryPreference pkgVersions + return (SolverTest db targets constraints prefs) + + shrink test = + [test { testDb = db } | db <- shrink (testDb test)] + ++ [test { testTargets = targets } | targets <- shrink (testTargets test)] + ++ [test { testConstraints = cs } | cs <- shrink (testConstraints test)] + ++ [test { testPreferences = prefs } | prefs <- shrink (testPreferences test)] + +-- | Collection of source and installed packages. +newtype TestDb = TestDb { unTestDb :: ExampleDb } + deriving Show + +instance Arbitrary TestDb where + arbitrary = do + -- Avoid cyclic dependencies by grouping packages by name and only + -- allowing each package to depend on packages in the groups before it. + groupedPkgs <- shuffle . groupBy ((==) `on` fst) . nub . sort =<< + boundedListOf 10 arbitrary + db <- foldM nextPkgs (TestDb []) groupedPkgs + TestDb <$> shuffle (unTestDb db) + where + nextPkgs :: TestDb -> [(PN, PV)] -> Gen TestDb + nextPkgs db pkgs = TestDb . (++ unTestDb db) <$> traverse (nextPkg db) pkgs + + nextPkg :: TestDb -> (PN, PV) -> Gen TestPackage + nextPkg db (pn, v) = do + installed <- arbitrary + if installed + then Left <$> arbitraryExInst pn v (lefts $ unTestDb db) + else Right <$> arbitraryExAv pn v db + + shrink (TestDb pkgs) = map TestDb $ shrink pkgs + +arbitraryExAv :: PN -> PV -> TestDb -> Gen ExampleAvailable +arbitraryExAv pn v db = + (\cds -> ExAv (unPN pn) (unPV v) cds []) <$> arbitraryComponentDeps pn db + +arbitraryExInst :: PN -> PV -> [ExampleInstalled] -> Gen ExampleInstalled +arbitraryExInst pn v pkgs = do + pkgHash <- vectorOf 10 $ elements $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] + numDeps <- min 3 <$> arbitrary + deps <- randomSubset numDeps pkgs + return $ ExInst (unPN pn) (unPV v) pkgHash (map exInstHash deps) + +arbitraryComponentDeps :: PN -> TestDb -> Gen (ComponentDeps [ExampleDependency]) +arbitraryComponentDeps _ (TestDb []) = return $ CD.fromLibraryDeps [] +arbitraryComponentDeps pn db = do + -- dedupComponentNames removes components with duplicate names, for example, + -- 'ComponentExe x' and 'ComponentTest x', and then CD.fromList combines + -- duplicate unnamed components. + cds <- CD.fromList . dedupComponentNames . filter (isValid . fst) + <$> boundedListOf 5 (arbitraryComponentDep db) + return $ if isCompleteComponentDeps cds + then cds + else -- Add a library if the ComponentDeps isn't complete. + CD.fromLibraryDeps [] <> cds + where + isValid :: Component -> Bool + isValid (ComponentSubLib name) = name /= mkUnqualComponentName (unPN pn) + isValid _ = True + + dedupComponentNames = + nubBy ((\x y -> isJust x && isJust y && x == y) `on` componentName . fst) + + componentName :: Component -> Maybe UnqualComponentName + componentName ComponentLib = Nothing + componentName ComponentSetup = Nothing + componentName (ComponentSubLib n) = Just n + componentName (ComponentFLib n) = Just n + componentName (ComponentExe n) = Just n + componentName (ComponentTest n) = Just n + componentName (ComponentBench n) = Just n + +-- | Returns true if the ComponentDeps forms a complete package, i.e., it +-- contains a library, exe, test, or benchmark. +isCompleteComponentDeps :: ComponentDeps a -> Bool +isCompleteComponentDeps = any (completesPkg . fst) . CD.toList + where + completesPkg ComponentLib = True + completesPkg (ComponentExe _) = True + completesPkg (ComponentTest _) = True + completesPkg (ComponentBench _) = True + completesPkg (ComponentSubLib _) = False + completesPkg (ComponentFLib _) = False + completesPkg ComponentSetup = False + +arbitraryComponentDep :: TestDb -> Gen (ComponentDep [ExampleDependency]) +arbitraryComponentDep db = do + comp <- arbitrary + deps <- case comp of + ComponentSetup -> smallListOf (arbitraryExDep db SetupDep) + _ -> boundedListOf 5 (arbitraryExDep db NonSetupDep) + return (comp, deps) + +-- | Location of an 'ExampleDependency'. It determines which values are valid. +data ExDepLocation = SetupDep | NonSetupDep + +arbitraryExDep :: TestDb -> ExDepLocation -> Gen ExampleDependency +arbitraryExDep db@(TestDb pkgs) level = + let flag = ExFlagged <$> arbitraryFlagName + <*> arbitraryDeps db + <*> arbitraryDeps db + other = + -- Package checks require dependencies on "base" to have bounds. + let notBase = filter ((/= PN "base") . getName) pkgs + in [ExAny . unPN <$> elements (map getName notBase) | not (null notBase)] + ++ [ + -- existing version + let fixed pkg = ExFix (unPN $ getName pkg) (unPV $ getVersion pkg) + in fixed <$> elements pkgs + + -- random version of an existing package + , ExFix . unPN . getName <$> elements pkgs <*> (unPV <$> arbitrary) + ] + in oneof $ + case level of + NonSetupDep -> flag : other + SetupDep -> other + +arbitraryDeps :: TestDb -> Gen Dependencies +arbitraryDeps db = frequency + [ (1, return NotBuildable) + , (20, Buildable <$> smallListOf (arbitraryExDep db NonSetupDep)) + ] + +arbitraryFlagName :: Gen String +arbitraryFlagName = (:[]) <$> elements ['A'..'E'] + +arbitraryConstraint :: [(PN, PV)] -> Gen ExConstraint +arbitraryConstraint pkgs = do + (PN pn, v) <- elements pkgs + let anyQualifier = ScopeAnyQualifier (mkPackageName pn) + oneof [ + ExVersionConstraint anyQualifier <$> arbitraryVersionRange v + , ExStanzaConstraint anyQualifier <$> sublistOf [TestStanzas, BenchStanzas] + ] + +arbitraryPreference :: [(PN, PV)] -> Gen ExPreference +arbitraryPreference pkgs = do + (PN pn, v) <- elements pkgs + oneof [ + ExStanzaPref pn <$> sublistOf [TestStanzas, BenchStanzas] + , ExPkgPref pn <$> arbitraryVersionRange v + ] + +arbitraryVersionRange :: PV -> Gen VersionRange +arbitraryVersionRange (PV v) = + let version = mkSimpleVersion v + in elements [ + thisVersion version + , notThisVersion version + , earlierVersion version + , orLaterVersion version + , noVersion + ] + +instance Arbitrary ReorderGoals where + arbitrary = ReorderGoals <$> arbitrary + + shrink (ReorderGoals reorder) = [ReorderGoals False | reorder] + +instance Arbitrary IndependentGoals where + arbitrary = IndependentGoals <$> arbitrary + + shrink (IndependentGoals indep) = [IndependentGoals False | indep] + +instance Arbitrary UnqualComponentName where + -- The "component-" prefix prevents component names and build-depends + -- dependency names from overlapping. + -- TODO: Remove the prefix once the QuickCheck tests support dependencies on + -- internal libraries. + arbitrary = + mkUnqualComponentName <$> (\c -> "component-" ++ [c]) <$> elements "ABC" + +instance Arbitrary Component where + arbitrary = oneof [ return ComponentLib + , ComponentSubLib <$> arbitrary + , ComponentExe <$> arbitrary + , ComponentFLib <$> arbitrary + , ComponentTest <$> arbitrary + , ComponentBench <$> arbitrary + , return ComponentSetup + ] + + shrink ComponentLib = [] + shrink _ = [ComponentLib] + +instance Arbitrary ExampleInstalled where + arbitrary = error "arbitrary not implemented: ExampleInstalled" + + shrink ei = [ ei { exInstBuildAgainst = deps } + | deps <- shrinkList shrinkNothing (exInstBuildAgainst ei)] + +instance Arbitrary ExampleAvailable where + arbitrary = error "arbitrary not implemented: ExampleAvailable" + + shrink ea = [ea { exAvDeps = deps } | deps <- shrink (exAvDeps ea)] + +instance (Arbitrary a, Monoid a) => Arbitrary (ComponentDeps a) where + arbitrary = error "arbitrary not implemented: ComponentDeps" + + shrink = filter isCompleteComponentDeps . map CD.fromList . shrink . CD.toList + +instance Arbitrary ExampleDependency where + arbitrary = error "arbitrary not implemented: ExampleDependency" + + shrink (ExAny _) = [] + shrink (ExFix "base" _) = [] -- preserve bounds on base + shrink (ExFix pn _) = [ExAny pn] + shrink (ExFlagged flag th el) = + deps th ++ deps el + ++ [ExFlagged flag th' el | th' <- shrink th] + ++ [ExFlagged flag th el' | el' <- shrink el] + where + deps NotBuildable = [] + deps (Buildable ds) = ds + shrink dep = error $ "Dependency not handled: " ++ show dep + +instance Arbitrary Dependencies where + arbitrary = error "arbitrary not implemented: Dependencies" + + shrink NotBuildable = [Buildable []] + shrink (Buildable deps) = map Buildable (shrink deps) + +instance Arbitrary ExConstraint where + arbitrary = error "arbitrary not implemented: ExConstraint" + + shrink (ExStanzaConstraint scope stanzas) = + [ExStanzaConstraint scope stanzas' | stanzas' <- shrink stanzas] + shrink (ExVersionConstraint scope vr) = + [ExVersionConstraint scope vr' | vr' <- shrink vr] + shrink _ = [] + +instance Arbitrary ExPreference where + arbitrary = error "arbitrary not implemented: ExPreference" + + shrink (ExStanzaPref pn stanzas) = + [ExStanzaPref pn stanzas' | stanzas' <- shrink stanzas] + shrink (ExPkgPref pn vr) = [ExPkgPref pn vr' | vr' <- shrink vr] + +instance Arbitrary OptionalStanza where + arbitrary = error "arbitrary not implemented: OptionalStanza" + + shrink BenchStanzas = [TestStanzas] + shrink TestStanzas = [] + +instance Arbitrary VersionRange where + arbitrary = error "arbitrary not implemented: VersionRange" + + shrink vr = [noVersion | vr /= noVersion] + +-- Randomly sorts solver variables using 'hash'. +-- TODO: Sorting goals with this function is very slow. +instance Arbitrary VarOrdering where + arbitrary = do + f <- arbitrary :: Gen (Int -> Int) + return $ VarOrdering (comparing (f . hash)) + +instance Hashable pn => Hashable (Variable pn) +instance Hashable a => Hashable (P.Qualified a) +instance Hashable P.PackagePath +instance Hashable P.Qualifier +instance Hashable P.Namespace +instance Hashable OptionalStanza +instance Hashable FlagName +instance Hashable PackageName +instance Hashable ShortText + +deriving instance Generic (Variable pn) +deriving instance Generic (P.Qualified a) +deriving instance Generic P.PackagePath +deriving instance Generic P.Namespace +deriving instance Generic P.Qualifier + +randomSubset :: Int -> [a] -> Gen [a] +randomSubset n xs = take n <$> shuffle xs + +boundedListOf :: Int -> Gen a -> Gen [a] +boundedListOf n gen = take n <$> listOf gen + +-- | Generates lists with average length less than 1. +smallListOf :: Gen a -> Gen [a] +smallListOf gen = + frequency [ (fr, vectorOf n gen) + | (fr, n) <- [(3, 0), (5, 1), (2, 2)]] diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck/Utils.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck/Utils.hs new file mode 100644 index 00000000..facc64ce --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck/Utils.hs @@ -0,0 +1,33 @@ +module UnitTests.Distribution.Solver.Modular.QuickCheck.Utils ( + testPropertyWithSeed + ) where + +import Data.Tagged (Tagged, retag) +import System.Random (getStdRandom, random) + +import Test.Tasty (TestTree) +import Test.Tasty.Options (OptionDescription, lookupOption, setOption) +import Test.Tasty.Providers (IsTest (..), singleTest) +import Test.Tasty.QuickCheck + ( QC (..), QuickCheckReplay (..), Testable, property ) + +import Distribution.Simple.Utils +import Distribution.Verbosity + +-- | Create a QuickCheck test that prints the seed before testing the property. +-- The seed can be useful for debugging non-terminating test cases. This is +-- related to https://github.com/feuerbach/tasty/issues/86. +testPropertyWithSeed :: Testable a => String -> a -> TestTree +testPropertyWithSeed name = singleTest name . QCWithSeed . QC . property + +newtype QCWithSeed = QCWithSeed QC + +instance IsTest QCWithSeed where + testOptions = retag (testOptions :: Tagged QC [OptionDescription]) + + run options (QCWithSeed test) progress = do + replay <- case lookupOption options of + QuickCheckReplay (Just override) -> return override + QuickCheckReplay Nothing -> getStdRandom random + notice normal $ "Using --quickcheck-replay=" ++ show replay + run (setOption (QuickCheckReplay (Just replay)) options) test progress diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/RetryLog.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/RetryLog.hs new file mode 100644 index 00000000..d64802c1 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/RetryLog.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module UnitTests.Distribution.Solver.Modular.RetryLog ( + tests + ) where + +import Distribution.Solver.Modular.Message +import Distribution.Solver.Modular.RetryLog +import Distribution.Solver.Types.Progress + +import Test.Tasty (TestTree) +import Test.Tasty.HUnit (testCase, (@?=)) +import Test.Tasty.QuickCheck + ( Arbitrary(..), Blind(..), listOf, oneof, testProperty, (===)) + +type Log a = Progress a String String + +tests :: [TestTree] +tests = [ + testProperty "'toProgress . fromProgress' is identity" $ \p -> + toProgress (fromProgress p) === (p :: Log Int) + + , testProperty "'mapFailure f' is like 'foldProgress Step (Fail . f) Done'" $ + let mapFailureProgress f = foldProgress Step (Fail . f) Done + in \(Blind f) p -> + toProgress (mapFailure f (fromProgress p)) + === mapFailureProgress (f :: String -> Int) (p :: Log Int) + + , testProperty "'retry p f' is like 'foldProgress Step f Done p'" $ + \p (Blind f) -> + toProgress (retry (fromProgress p) (fromProgress . f)) + === (foldProgress Step f Done (p :: Log Int) :: Log Int) + + , testProperty "failWith" $ \step failure -> + toProgress (failWith step failure) + === (Step step (Fail failure) :: Log Int) + + , testProperty "succeedWith" $ \step success -> + toProgress (succeedWith step success) + === (Step step (Done success) :: Log Int) + + , testProperty "continueWith" $ \step p -> + toProgress (continueWith step (fromProgress p)) + === (Step step p :: Log Int) + + , testCase "tryWith with failure" $ + let failure = Fail "Error" + s = Step Success + in toProgress (tryWith Success $ fromProgress (s (s failure))) + @?= (s (Step Enter (s (s (Step Leave failure)))) :: Log Message) + + , testCase "tryWith with success" $ + let done = Done "Done" + s = Step Success + in toProgress (tryWith Success $ fromProgress (s (s done))) + @?= (s (Step Enter (s (s done))) :: Log Message) + ] + +instance (Arbitrary step, Arbitrary fail, Arbitrary done) + => Arbitrary (Progress step fail done) where + arbitrary = do + steps <- listOf arbitrary + end <- oneof [Fail `fmap` arbitrary, Done `fmap` arbitrary] + return $ foldr Step end steps + +deriving instance (Eq step, Eq fail, Eq done) => Eq (Progress step fail done) + +deriving instance (Show step, Show fail, Show done) + => Show (Progress step fail done) + +deriving instance Eq Message +deriving instance Show Message diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs new file mode 100644 index 00000000..e4be7ebb --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs @@ -0,0 +1,1702 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | This is a set of unit tests for the dependency solver, +-- which uses the solver DSL ("UnitTests.Distribution.Solver.Modular.DSL") +-- to more conveniently create package databases to run the solver tests on. +module UnitTests.Distribution.Solver.Modular.Solver (tests) + where + +-- base +import Data.List (isInfixOf) + +import qualified Distribution.Version as V + +-- test-framework +import Test.Tasty as TF + +-- Cabal +import Language.Haskell.Extension ( Extension(..) + , KnownExtension(..), Language(..)) + +-- cabal-install +import Distribution.Solver.Types.Flag +import Distribution.Solver.Types.OptionalStanza +import Distribution.Solver.Types.PackageConstraint +import qualified Distribution.Solver.Types.PackagePath as P +import UnitTests.Distribution.Solver.Modular.DSL +import UnitTests.Distribution.Solver.Modular.DSL.TestCaseUtils + +tests :: [TF.TestTree] +tests = [ + testGroup "Simple dependencies" [ + runTest $ mkTest db1 "alreadyInstalled" ["A"] (solverSuccess []) + , runTest $ mkTest db1 "installLatest" ["B"] (solverSuccess [("B", 2)]) + , runTest $ mkTest db1 "simpleDep1" ["C"] (solverSuccess [("B", 1), ("C", 1)]) + , runTest $ mkTest db1 "simpleDep2" ["D"] (solverSuccess [("B", 2), ("D", 1)]) + , runTest $ mkTest db1 "failTwoVersions" ["C", "D"] anySolverFailure + , runTest $ indep $ mkTest db1 "indepTwoVersions" ["C", "D"] (solverSuccess [("B", 1), ("B", 2), ("C", 1), ("D", 1)]) + , runTest $ indep $ mkTest db1 "aliasWhenPossible1" ["C", "E"] (solverSuccess [("B", 1), ("C", 1), ("E", 1)]) + , runTest $ indep $ mkTest db1 "aliasWhenPossible2" ["D", "E"] (solverSuccess [("B", 2), ("D", 1), ("E", 1)]) + , runTest $ indep $ mkTest db2 "aliasWhenPossible3" ["C", "D"] (solverSuccess [("A", 1), ("A", 2), ("B", 1), ("B", 2), ("C", 1), ("D", 1)]) + , runTest $ mkTest db1 "buildDepAgainstOld" ["F"] (solverSuccess [("B", 1), ("E", 1), ("F", 1)]) + , runTest $ mkTest db1 "buildDepAgainstNew" ["G"] (solverSuccess [("B", 2), ("E", 1), ("G", 1)]) + , runTest $ indep $ mkTest db1 "multipleInstances" ["F", "G"] anySolverFailure + , runTest $ mkTest db21 "unknownPackage1" ["A"] (solverSuccess [("A", 1), ("B", 1)]) + , runTest $ mkTest db22 "unknownPackage2" ["A"] (solverFailure (isInfixOf "unknown package: C")) + , runTest $ mkTest db23 "unknownPackage3" ["A"] (solverFailure (isInfixOf "unknown package: B")) + , runTest $ mkTest [] "unknown target" ["A"] (solverFailure (isInfixOf "unknown package: A")) + ] + , testGroup "Flagged dependencies" [ + runTest $ mkTest db3 "forceFlagOn" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) + , runTest $ mkTest db3 "forceFlagOff" ["D"] (solverSuccess [("A", 2), ("B", 1), ("D", 1)]) + , runTest $ indep $ mkTest db3 "linkFlags1" ["C", "D"] anySolverFailure + , runTest $ indep $ mkTest db4 "linkFlags2" ["C", "D"] anySolverFailure + , runTest $ indep $ mkTest db18 "linkFlags3" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2), ("F", 1)]) + ] + , testGroup "Lifting dependencies out of conditionals" [ + runTest $ commonDependencyLogMessage "common dependency log message" + , runTest $ twoLevelDeepCommonDependencyLogMessage "two level deep common dependency log message" + , runTest $ testBackjumpingWithCommonDependency "backjumping with common dependency" + ] + , testGroup "Manual flags" [ + runTest $ mkTest dbManualFlags "Use default value for manual flag" ["pkg"] $ + solverSuccess [("pkg", 1), ("true-dep", 1)] + + , let checkFullLog = + any $ isInfixOf "rejecting: pkg:-flag (manual flag can only be changed explicitly)" + in runTest $ setVerbose $ + constraints [ExVersionConstraint (ScopeAnyQualifier "true-dep") V.noVersion] $ + mkTest dbManualFlags "Don't toggle manual flag to avoid conflict" ["pkg"] $ + -- TODO: We should check the summarized log instead of the full log + -- for the manual flags error message, but it currently only + -- appears in the full log. + SolverResult checkFullLog (Left $ const True) + + , let cs = [ExFlagConstraint (ScopeAnyQualifier "pkg") "flag" False] + in runTest $ constraints cs $ + mkTest dbManualFlags "Toggle manual flag with flag constraint" ["pkg"] $ + solverSuccess [("false-dep", 1), ("pkg", 1)] + ] + , testGroup "Qualified manual flag constraints" [ + let name = "Top-level flag constraint does not constrain setup dep's flag" + cs = [ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" False] + in runTest $ constraints cs $ mkTest dbSetupDepWithManualFlag name ["A"] $ + solverSuccess [ ("A", 1), ("B", 1), ("B", 2) + , ("b-1-false-dep", 1), ("b-2-true-dep", 1) ] + + , let name = "Solver can toggle setup dep's flag to match top-level constraint" + cs = [ ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" False + , ExVersionConstraint (ScopeAnyQualifier "b-2-true-dep") V.noVersion ] + in runTest $ constraints cs $ mkTest dbSetupDepWithManualFlag name ["A"] $ + solverSuccess [ ("A", 1), ("B", 1), ("B", 2) + , ("b-1-false-dep", 1), ("b-2-false-dep", 1) ] + + , let name = "User can constrain flags separately with qualified constraints" + cs = [ ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" True + , ExFlagConstraint (ScopeQualified (P.QualSetup "A") "B") "flag" False ] + in runTest $ constraints cs $ mkTest dbSetupDepWithManualFlag name ["A"] $ + solverSuccess [ ("A", 1), ("B", 1), ("B", 2) + , ("b-1-true-dep", 1), ("b-2-false-dep", 1) ] + + -- Regression test for #4299 + , let name = "Solver can link deps when only one has constrained manual flag" + cs = [ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" False] + in runTest $ constraints cs $ mkTest dbLinkedSetupDepWithManualFlag name ["A"] $ + solverSuccess [ ("A", 1), ("B", 1), ("b-1-false-dep", 1) ] + + , let name = "Solver cannot link deps that have conflicting manual flag constraints" + cs = [ ExFlagConstraint (ScopeQualified P.QualToplevel "B") "flag" True + , ExFlagConstraint (ScopeQualified (P.QualSetup "A") "B") "flag" False ] + failureReason = "(constraint from unknown source requires opposite flag selection)" + checkFullLog lns = + all (\msg -> any (msg `isInfixOf`) lns) + [ "rejecting: B:-flag " ++ failureReason + , "rejecting: A:setup.B:+flag " ++ failureReason ] + in runTest $ constraints cs $ setVerbose $ + mkTest dbLinkedSetupDepWithManualFlag name ["A"] $ + SolverResult checkFullLog (Left $ const True) + ] + , testGroup "Stanzas" [ + runTest $ enableAllTests $ mkTest db5 "simpleTest1" ["C"] (solverSuccess [("A", 2), ("C", 1)]) + , runTest $ enableAllTests $ mkTest db5 "simpleTest2" ["D"] anySolverFailure + , runTest $ enableAllTests $ mkTest db5 "simpleTest3" ["E"] (solverSuccess [("A", 1), ("E", 1)]) + , runTest $ enableAllTests $ mkTest db5 "simpleTest4" ["F"] anySolverFailure -- TODO + , runTest $ enableAllTests $ mkTest db5 "simpleTest5" ["G"] (solverSuccess [("A", 2), ("G", 1)]) + , runTest $ enableAllTests $ mkTest db5 "simpleTest6" ["E", "G"] anySolverFailure + , runTest $ indep $ enableAllTests $ mkTest db5 "simpleTest7" ["E", "G"] (solverSuccess [("A", 1), ("A", 2), ("E", 1), ("G", 1)]) + , runTest $ enableAllTests $ mkTest db6 "depsWithTests1" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) + , runTest $ indep $ enableAllTests $ mkTest db6 "depsWithTests2" ["C", "D"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1)]) + , runTest $ testTestSuiteWithFlag "test suite with flag" + ] + , testGroup "Setup dependencies" [ + runTest $ mkTest db7 "setupDeps1" ["B"] (solverSuccess [("A", 2), ("B", 1)]) + , runTest $ mkTest db7 "setupDeps2" ["C"] (solverSuccess [("A", 2), ("C", 1)]) + , runTest $ mkTest db7 "setupDeps3" ["D"] (solverSuccess [("A", 1), ("D", 1)]) + , runTest $ mkTest db7 "setupDeps4" ["E"] (solverSuccess [("A", 1), ("A", 2), ("E", 1)]) + , runTest $ mkTest db7 "setupDeps5" ["F"] (solverSuccess [("A", 1), ("A", 2), ("F", 1)]) + , runTest $ mkTest db8 "setupDeps6" ["C", "D"] (solverSuccess [("A", 1), ("B", 1), ("B", 2), ("C", 1), ("D", 1)]) + , runTest $ mkTest db9 "setupDeps7" ["F", "G"] (solverSuccess [("A", 1), ("B", 1), ("B",2 ), ("C", 1), ("D", 1), ("E", 1), ("E", 2), ("F", 1), ("G", 1)]) + , runTest $ mkTest db10 "setupDeps8" ["C"] (solverSuccess [("C", 1)]) + , runTest $ indep $ mkTest dbSetupDeps "setupDeps9" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2)]) + ] + , testGroup "Base shim" [ + runTest $ mkTest db11 "baseShim1" ["A"] (solverSuccess [("A", 1)]) + , runTest $ mkTest db12 "baseShim2" ["A"] (solverSuccess [("A", 1)]) + , runTest $ mkTest db12 "baseShim3" ["B"] (solverSuccess [("B", 1)]) + , runTest $ mkTest db12 "baseShim4" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) + , runTest $ mkTest db12 "baseShim5" ["D"] anySolverFailure + , runTest $ mkTest db12 "baseShim6" ["E"] (solverSuccess [("E", 1), ("syb", 2)]) + ] + , testGroup "Base" [ + runTest $ mkTest dbBase "Refuse to install base without --allow-boot-library-installs" ["base"] $ + solverFailure (isInfixOf "only already installed instances can be used") + , runTest $ allowBootLibInstalls $ mkTest dbBase "Install base with --allow-boot-library-installs" ["base"] $ + solverSuccess [("base", 1), ("ghc-prim", 1), ("integer-gmp", 1), ("integer-simple", 1)] + ] + , testGroup "reject-unconstrained" [ + runTest $ onlyConstrained $ mkTest db12 "missing syb" ["E"] $ + solverFailure (isInfixOf "not a user-provided goal") + , runTest $ onlyConstrained $ mkTest db12 "all goals" ["E", "syb"] $ + solverSuccess [("E", 1), ("syb", 2)] + , runTest $ onlyConstrained $ mkTest db17 "backtracking" ["A", "B"] $ + solverSuccess [("A", 2), ("B", 1)] + , runTest $ onlyConstrained $ mkTest db17 "failure message" ["A"] $ + solverFailure $ isInfixOf $ + "Could not resolve dependencies:\n" + ++ "[__0] trying: A-3.0.0 (user goal)\n" + ++ "[__1] next goal: C (dependency of A)\n" + ++ "[__1] fail (not a user-provided goal nor mentioned as a constraint, " + ++ "but reject-unconstrained-dependencies was set)\n" + ++ "[__1] fail (backjumping, conflict set: A, C)\n" + ++ "After searching the rest of the dependency tree exhaustively, " + ++ "these were the goals I've had most trouble fulfilling: A, C, B" + ] + , testGroup "Cycles" [ + runTest $ mkTest db14 "simpleCycle1" ["A"] anySolverFailure + , runTest $ mkTest db14 "simpleCycle2" ["A", "B"] anySolverFailure + , runTest $ mkTest db14 "cycleWithFlagChoice1" ["C"] (solverSuccess [("C", 1), ("E", 1)]) + , runTest $ mkTest db15 "cycleThroughSetupDep1" ["A"] anySolverFailure + , runTest $ mkTest db15 "cycleThroughSetupDep2" ["B"] anySolverFailure + , runTest $ mkTest db15 "cycleThroughSetupDep3" ["C"] (solverSuccess [("C", 2), ("D", 1)]) + , runTest $ mkTest db15 "cycleThroughSetupDep4" ["D"] (solverSuccess [("D", 1)]) + , runTest $ mkTest db15 "cycleThroughSetupDep5" ["E"] (solverSuccess [("C", 2), ("D", 1), ("E", 1)]) + , runTest $ issue4161 "detect cycle between package and its setup script" + , runTest $ testCyclicDependencyErrorMessages "cyclic dependency error messages" + ] + , testGroup "Extensions" [ + runTest $ mkTestExts [EnableExtension CPP] dbExts1 "unsupported" ["A"] anySolverFailure + , runTest $ mkTestExts [EnableExtension CPP] dbExts1 "unsupportedIndirect" ["B"] anySolverFailure + , runTest $ mkTestExts [EnableExtension RankNTypes] dbExts1 "supported" ["A"] (solverSuccess [("A",1)]) + , runTest $ mkTestExts (map EnableExtension [CPP,RankNTypes]) dbExts1 "supportedIndirect" ["C"] (solverSuccess [("A",1),("B",1), ("C",1)]) + , runTest $ mkTestExts [EnableExtension CPP] dbExts1 "disabledExtension" ["D"] anySolverFailure + , runTest $ mkTestExts (map EnableExtension [CPP,RankNTypes]) dbExts1 "disabledExtension" ["D"] anySolverFailure + , runTest $ mkTestExts (UnknownExtension "custom" : map EnableExtension [CPP,RankNTypes]) dbExts1 "supportedUnknown" ["E"] (solverSuccess [("A",1),("B",1),("C",1),("E",1)]) + ] + , testGroup "Languages" [ + runTest $ mkTestLangs [Haskell98] dbLangs1 "unsupported" ["A"] anySolverFailure + , runTest $ mkTestLangs [Haskell98,Haskell2010] dbLangs1 "supported" ["A"] (solverSuccess [("A",1)]) + , runTest $ mkTestLangs [Haskell98] dbLangs1 "unsupportedIndirect" ["B"] anySolverFailure + , runTest $ mkTestLangs [Haskell98, Haskell2010, UnknownLanguage "Haskell3000"] dbLangs1 "supportedUnknown" ["C"] (solverSuccess [("A",1),("B",1),("C",1)]) + ] + , testGroup "Qualified Package Constraints" [ + runTest $ mkTest dbConstraints "install latest versions without constraints" ["A", "B", "C"] $ + solverSuccess [("A", 7), ("B", 8), ("C", 9), ("D", 7), ("D", 8), ("D", 9)] + + , let cs = [ ExVersionConstraint (ScopeAnyQualifier "D") $ mkVersionRange 1 4 ] + in runTest $ constraints cs $ + mkTest dbConstraints "force older versions with unqualified constraint" ["A", "B", "C"] $ + solverSuccess [("A", 1), ("B", 2), ("C", 3), ("D", 1), ("D", 2), ("D", 3)] + + , let cs = [ ExVersionConstraint (ScopeQualified P.QualToplevel "D") $ mkVersionRange 1 4 + , ExVersionConstraint (ScopeQualified (P.QualSetup "B") "D") $ mkVersionRange 4 7 + ] + in runTest $ constraints cs $ + mkTest dbConstraints "force multiple versions with qualified constraints" ["A", "B", "C"] $ + solverSuccess [("A", 1), ("B", 5), ("C", 9), ("D", 1), ("D", 5), ("D", 9)] + + , let cs = [ ExVersionConstraint (ScopeAnySetupQualifier "D") $ mkVersionRange 1 4 ] + in runTest $ constraints cs $ + mkTest dbConstraints "constrain package across setup scripts" ["A", "B", "C"] $ + solverSuccess [("A", 7), ("B", 2), ("C", 3), ("D", 2), ("D", 3), ("D", 7)] + ] + , testGroup "Package Preferences" [ + runTest $ preferences [ ExPkgPref "A" $ mkvrThis 1] $ mkTest db13 "selectPreferredVersionSimple" ["A"] (solverSuccess [("A", 1)]) + , runTest $ preferences [ ExPkgPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionSimple2" ["A"] (solverSuccess [("A", 2)]) + , runTest $ preferences [ ExPkgPref "A" $ mkvrOrEarlier 2 + , ExPkgPref "A" $ mkvrOrEarlier 1] $ mkTest db13 "selectPreferredVersionMultiple" ["A"] (solverSuccess [("A", 1)]) + , runTest $ preferences [ ExPkgPref "A" $ mkvrOrEarlier 1 + , ExPkgPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionMultiple2" ["A"] (solverSuccess [("A", 1)]) + , runTest $ preferences [ ExPkgPref "A" $ mkvrThis 1 + , ExPkgPref "A" $ mkvrThis 2] $ mkTest db13 "selectPreferredVersionMultiple3" ["A"] (solverSuccess [("A", 2)]) + , runTest $ preferences [ ExPkgPref "A" $ mkvrThis 1 + , ExPkgPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionMultiple4" ["A"] (solverSuccess [("A", 1)]) + ] + , testGroup "Stanza Preferences" [ + runTest $ + mkTest dbStanzaPreferences1 "disable tests by default" ["pkg"] $ + solverSuccess [("pkg", 1)] + + , runTest $ preferences [ExStanzaPref "pkg" [TestStanzas]] $ + mkTest dbStanzaPreferences1 "enable tests with testing preference" ["pkg"] $ + solverSuccess [("pkg", 1), ("test-dep", 1)] + + , runTest $ preferences [ExStanzaPref "pkg" [TestStanzas]] $ + mkTest dbStanzaPreferences2 "disable testing when it's not possible" ["pkg"] $ + solverSuccess [("pkg", 1)] + + , testStanzaPreference "test stanza preference" + ] + , testGroup "Buildable Field" [ + testBuildable "avoid building component with unknown dependency" (ExAny "unknown") + , testBuildable "avoid building component with unknown extension" (ExExt (UnknownExtension "unknown")) + , testBuildable "avoid building component with unknown language" (ExLang (UnknownLanguage "unknown")) + , runTest $ mkTest dbBuildable1 "choose flags that set buildable to false" ["pkg"] (solverSuccess [("flag1-false", 1), ("flag2-true", 1), ("pkg", 1)]) + , runTest $ mkTest dbBuildable2 "choose version that sets buildable to false" ["A"] (solverSuccess [("A", 1), ("B", 2)]) + ] + , testGroup "Pkg-config dependencies" [ + runTest $ mkTestPCDepends [] dbPC1 "noPkgs" ["A"] anySolverFailure + , runTest $ mkTestPCDepends [("pkgA", "0")] dbPC1 "tooOld" ["A"] anySolverFailure + , runTest $ mkTestPCDepends [("pkgA", "1.0.0"), ("pkgB", "1.0.0")] dbPC1 "pruneNotFound" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) + , runTest $ mkTestPCDepends [("pkgA", "1.0.0"), ("pkgB", "2.0.0")] dbPC1 "chooseNewest" ["C"] (solverSuccess [("A", 1), ("B", 2), ("C", 1)]) + ] + , testGroup "Independent goals" [ + runTest $ indep $ mkTest db16 "indepGoals1" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2), ("E", 1)]) + , runTest $ testIndepGoals2 "indepGoals2" + , runTest $ testIndepGoals3 "indepGoals3" + , runTest $ testIndepGoals4 "indepGoals4" + , runTest $ testIndepGoals5 "indepGoals5 - fixed goal order" FixedGoalOrder + , runTest $ testIndepGoals5 "indepGoals5 - default goal order" DefaultGoalOrder + , runTest $ testIndepGoals6 "indepGoals6 - fixed goal order" FixedGoalOrder + , runTest $ testIndepGoals6 "indepGoals6 - default goal order" DefaultGoalOrder + ] + -- Tests designed for the backjumping blog post + , testGroup "Backjumping" [ + runTest $ mkTest dbBJ1a "bj1a" ["A"] (solverSuccess [("A", 1), ("B", 1)]) + , runTest $ mkTest dbBJ1b "bj1b" ["A"] (solverSuccess [("A", 1), ("B", 1)]) + , runTest $ mkTest dbBJ1c "bj1c" ["A"] (solverSuccess [("A", 1), ("B", 1)]) + , runTest $ mkTest dbBJ2 "bj2" ["A"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) + , runTest $ mkTest dbBJ3 "bj3" ["A"] (solverSuccess [("A", 1), ("Ba", 1), ("C", 1)]) + , runTest $ mkTest dbBJ4 "bj4" ["A"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) + , runTest $ mkTest dbBJ5 "bj5" ["A"] (solverSuccess [("A", 1), ("B", 1), ("D", 1)]) + , runTest $ mkTest dbBJ6 "bj6" ["A"] (solverSuccess [("A", 1), ("B", 1)]) + , runTest $ mkTest dbBJ7 "bj7" ["A"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) + , runTest $ indep $ mkTest dbBJ8 "bj8" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) + ] + , testGroup "library dependencies" [ + let db = [Right $ exAvNoLibrary "A" 1 `withExe` ExExe "exe" []] + in runTest $ mkTest db "install build target without a library" ["A"] $ + solverSuccess [("A", 1)] + + , let db = [ Right $ exAv "A" 1 [ExAny "B"] + , Right $ exAvNoLibrary "B" 1 `withExe` ExExe "exe" [] ] + in runTest $ mkTest db "reject build-depends dependency with no library" ["A"] $ + solverFailure (isInfixOf "rejecting: B-1.0.0 (does not contain library, which is required by A)") + + , let exe = ExExe "exe" [] + db = [ Right $ exAv "A" 1 [ExAny "B"] + , Right $ exAvNoLibrary "B" 2 `withExe` exe + , Right $ exAv "B" 1 [] `withExe` exe ] + in runTest $ mkTest db "choose version of build-depends dependency that has a library" ["A"] $ + solverSuccess [("A", 1), ("B", 1)] + ] + -- build-tool-depends dependencies + , testGroup "build-tool-depends" [ + runTest $ mkTest dbBuildTools "simple exe dependency" ["A"] (solverSuccess [("A", 1), ("bt-pkg", 2)]) + + , runTest $ disableSolveExecutables $ + mkTest dbBuildTools "don't install build tool packages in legacy mode" ["A"] (solverSuccess [("A", 1)]) + + , runTest $ mkTest dbBuildTools "flagged exe dependency" ["B"] (solverSuccess [("B", 1), ("bt-pkg", 2)]) + + , runTest $ enableAllTests $ + mkTest dbBuildTools "test suite exe dependency" ["C"] (solverSuccess [("C", 1), ("bt-pkg", 2)]) + + , runTest $ mkTest dbBuildTools "unknown exe" ["D"] $ + solverFailure (isInfixOf "does not contain executable 'unknown-exe', which is required by D") + + , runTest $ disableSolveExecutables $ + mkTest dbBuildTools "don't check for build tool executables in legacy mode" ["D"] $ solverSuccess [("D", 1)] + + , runTest $ mkTest dbBuildTools "unknown build tools package error mentions package, not exe" ["E"] $ + solverFailure (isInfixOf "unknown package: E:unknown-pkg:exe.unknown-pkg (dependency of E)") + + , runTest $ mkTest dbBuildTools "unknown flagged exe" ["F"] $ + solverFailure (isInfixOf "does not contain executable 'unknown-exe', which is required by F +flagF") + + , runTest $ enableAllTests $ mkTest dbBuildTools "unknown test suite exe" ["G"] $ + solverFailure (isInfixOf "does not contain executable 'unknown-exe', which is required by G *test") + + , runTest $ mkTest dbBuildTools "wrong exe for build tool package version" ["H"] $ + solverFailure $ isInfixOf $ + -- The solver reports the version conflict when a version conflict + -- and an executable conflict apply to the same package version. + "[__1] rejecting: H:bt-pkg:exe.bt-pkg-4.0.0 (conflict: H => H:bt-pkg:exe.bt-pkg (exe exe1)==3.0.0)\n" + ++ "[__1] rejecting: H:bt-pkg:exe.bt-pkg-3.0.0 (does not contain executable 'exe1', which is required by H)\n" + ++ "[__1] rejecting: H:bt-pkg:exe.bt-pkg-2.0.0, H:bt-pkg:exe.bt-pkg-1.0.0 (conflict: H => H:bt-pkg:exe.bt-pkg (exe exe1)==3.0.0)" + + , runTest $ chooseExeAfterBuildToolsPackage True "choose exe after choosing its package - success" + + , runTest $ chooseExeAfterBuildToolsPackage False "choose exe after choosing its package - failure" + + , runTest $ rejectInstalledBuildToolPackage "reject installed package for build-tool dependency" + + , runTest $ requireConsistentBuildToolVersions "build tool versions must be consistent within one package" + ] + -- build-tools dependencies + , testGroup "legacy build-tools" [ + runTest $ mkTest dbLegacyBuildTools1 "bt1" ["A"] (solverSuccess [("A", 1), ("alex", 1)]) + + , runTest $ disableSolveExecutables $ + mkTest dbLegacyBuildTools1 "bt1 - don't install build tool packages in legacy mode" ["A"] (solverSuccess [("A", 1)]) + + , runTest $ mkTest dbLegacyBuildTools2 "bt2" ["A"] $ + solverFailure (isInfixOf "does not contain executable 'alex', which is required by A") + + , runTest $ disableSolveExecutables $ + mkTest dbLegacyBuildTools2 "bt2 - don't check for build tool executables in legacy mode" ["A"] (solverSuccess [("A", 1)]) + + , runTest $ mkTest dbLegacyBuildTools3 "bt3" ["A"] (solverSuccess [("A", 1)]) + + , runTest $ mkTest dbLegacyBuildTools4 "bt4" ["C"] (solverSuccess [("A", 1), ("B", 1), ("C", 1), ("alex", 1), ("alex", 2)]) + + , runTest $ mkTest dbLegacyBuildTools5 "bt5" ["B"] (solverSuccess [("A", 1), ("A", 2), ("B", 1), ("alex", 1)]) + + , runTest $ mkTest dbLegacyBuildTools6 "bt6" ["A"] (solverSuccess [("A", 1), ("alex", 1), ("happy", 1)]) + ] + -- internal dependencies + , testGroup "internal dependencies" [ + runTest $ mkTest dbIssue3775 "issue #3775" ["B"] (solverSuccess [("A", 2), ("B", 2), ("warp", 1)]) + ] + -- tests for partial fix for issue #5325 + , testGroup "Components that are unbuildable in the current environment" $ + let flagConstraint = ExFlagConstraint . ScopeAnyQualifier + in [ + let db = [ Right $ exAv "A" 1 [ExFlagged "build-lib" (Buildable []) NotBuildable] ] + in runTest $ constraints [flagConstraint "A" "build-lib" False] $ + mkTest db "install unbuildable library" ["A"] $ + solverSuccess [("A", 1)] + + , let db = [ Right $ exAvNoLibrary "A" 1 + `withExe` ExExe "exe" [ExFlagged "build-exe" (Buildable []) NotBuildable] ] + in runTest $ constraints [flagConstraint "A" "build-exe" False] $ + mkTest db "install unbuildable exe" ["A"] $ + solverSuccess [("A", 1)] + + , let db = [ Right $ exAv "A" 1 [ExAny "B"] + , Right $ exAv "B" 1 [ExFlagged "build-lib" (Buildable []) NotBuildable] ] + in runTest $ constraints [flagConstraint "B" "build-lib" False] $ + mkTest db "reject library dependency with unbuildable library" ["A"] $ + solverFailure $ isInfixOf $ + "rejecting: B-1.0.0 (library is not buildable in the " + ++ "current environment, but it is required by A)" + + , let db = [ Right $ exAv "A" 1 [ExBuildToolAny "B" "bt"] + , Right $ exAv "B" 1 [ExFlagged "build-lib" (Buildable []) NotBuildable] + `withExe` ExExe "bt" [] ] + in runTest $ constraints [flagConstraint "B" "build-lib" False] $ + mkTest db "allow build-tool dependency with unbuildable library" ["A"] $ + solverSuccess [("A", 1), ("B", 1)] + + , let db = [ Right $ exAv "A" 1 [ExBuildToolAny "B" "bt"] + , Right $ exAv "B" 1 [] + `withExe` ExExe "bt" [ExFlagged "build-exe" (Buildable []) NotBuildable] ] + in runTest $ constraints [flagConstraint "B" "build-exe" False] $ + mkTest db "reject build-tool dependency with unbuildable exe" ["A"] $ + solverFailure $ isInfixOf $ + "rejecting: A:B:exe.B-1.0.0 (executable 'bt' is not " + ++ "buildable in the current environment, but it is required by A)" + , runTest $ + chooseUnbuildableExeAfterBuildToolsPackage + "choose unbuildable exe after choosing its package" + ] + -- Tests for the contents of the solver's log + , testGroup "Solver log" [ + -- See issue #3203. The solver should only choose a version for A once. + runTest $ + let db = [Right $ exAv "A" 1 []] + + p :: [String] -> Bool + p lg = elem "targets: A" lg + && length (filter ("trying: A" `isInfixOf`) lg) == 1 + in setVerbose $ mkTest db "deduplicate targets" ["A", "A"] $ + SolverResult p $ Right [("A", 1)] + , runTest $ + let db = [Right $ exAv "A" 1 [ExAny "B"]] + msg = "After searching the rest of the dependency tree exhaustively, " + ++ "these were the goals I've had most trouble fulfilling: A, B" + in mkTest db "exhaustive search failure message" ["A"] $ + solverFailure (isInfixOf msg) + , testSummarizedLog "show conflicts from final conflict set after exhaustive search" Nothing $ + "Could not resolve dependencies:\n" + ++ "[__0] trying: A-1.0.0 (user goal)\n" + ++ "[__1] unknown package: D (dependency of A)\n" + ++ "[__1] fail (backjumping, conflict set: A, D)\n" + ++ "After searching the rest of the dependency tree exhaustively, " + ++ "these were the goals I've had most trouble fulfilling: A, D" + , testSummarizedLog "show first conflicts after inexhaustive search" (Just 3) $ + "Could not resolve dependencies:\n" + ++ "[__0] trying: A-1.0.0 (user goal)\n" + ++ "[__1] trying: B-3.0.0 (dependency of A)\n" + ++ "[__2] next goal: C (dependency of B)\n" + ++ "[__2] rejecting: C-1.0.0 (conflict: B => C==3.0.0)\n" + ++ "[__2] fail (backjumping, conflict set: B, C)\n" + ++ "Backjump limit reached (currently 3, change with --max-backjumps " + ++ "or try to run with --reorder-goals).\n" + , testSummarizedLog "don't show summarized log when backjump limit is too low" (Just 1) $ + "Backjump limit reached (currently 1, change with --max-backjumps " + ++ "or try to run with --reorder-goals).\n" + ++ "Failed to generate a summarized dependency solver log due to low backjump limit." + ] + ] + where + indep = independentGoals + mkvrThis = V.thisVersion . makeV + mkvrOrEarlier = V.orEarlierVersion . makeV + makeV v = V.mkVersion [v,0,0] + +data GoalOrder = FixedGoalOrder | DefaultGoalOrder + +{------------------------------------------------------------------------------- + Specific example database for the tests +-------------------------------------------------------------------------------} + +db1 :: ExampleDb +db1 = + let a = exInst "A" 1 "A-1" [] + in [ Left a + , Right $ exAv "B" 1 [ExAny "A"] + , Right $ exAv "B" 2 [ExAny "A"] + , Right $ exAv "C" 1 [ExFix "B" 1] + , Right $ exAv "D" 1 [ExFix "B" 2] + , Right $ exAv "E" 1 [ExAny "B"] + , Right $ exAv "F" 1 [ExFix "B" 1, ExAny "E"] + , Right $ exAv "G" 1 [ExFix "B" 2, ExAny "E"] + , Right $ exAv "Z" 1 [] + ] + +-- In this example, we _can_ install C and D as independent goals, but we have +-- to pick two diferent versions for B (arbitrarily) +db2 :: ExampleDb +db2 = [ + Right $ exAv "A" 1 [] + , Right $ exAv "A" 2 [] + , Right $ exAv "B" 1 [ExAny "A"] + , Right $ exAv "B" 2 [ExAny "A"] + , Right $ exAv "C" 1 [ExAny "B", ExFix "A" 1] + , Right $ exAv "D" 1 [ExAny "B", ExFix "A" 2] + ] + +db3 :: ExampleDb +db3 = [ + Right $ exAv "A" 1 [] + , Right $ exAv "A" 2 [] + , Right $ exAv "B" 1 [exFlagged "flagB" [ExFix "A" 1] [ExFix "A" 2]] + , Right $ exAv "C" 1 [ExFix "A" 1, ExAny "B"] + , Right $ exAv "D" 1 [ExFix "A" 2, ExAny "B"] + ] + +-- | Like db3, but the flag picks a different package rather than a +-- different package version +-- +-- In db3 we cannot install C and D as independent goals because: +-- +-- * The multiple instance restriction says C and D _must_ share B +-- * Since C relies on A-1, C needs B to be compiled with flagB on +-- * Since D relies on A-2, D needs B to be compiled with flagB off +-- * Hence C and D have incompatible requirements on B's flags. +-- +-- However, _even_ if we don't check explicitly that we pick the same flag +-- assignment for 0.B and 1.B, we will still detect the problem because +-- 0.B depends on 0.A-1, 1.B depends on 1.A-2, hence we cannot link 0.A to +-- 1.A and therefore we cannot link 0.B to 1.B. +-- +-- In db4 the situation however is trickier. We again cannot install +-- packages C and D as independent goals because: +-- +-- * As above, the multiple instance restriction says that C and D _must_ share B +-- * Since C relies on Ax-2, it requires B to be compiled with flagB off +-- * Since D relies on Ay-2, it requires B to be compiled with flagB on +-- * Hence C and D have incompatible requirements on B's flags. +-- +-- But now this requirement is more indirect. If we only check dependencies +-- we don't see the problem: +-- +-- * We link 0.B to 1.B +-- * 0.B relies on Ay-1 +-- * 1.B relies on Ax-1 +-- +-- We will insist that 0.Ay will be linked to 1.Ay, and 0.Ax to 1.Ax, but since +-- we only ever assign to one of these, these constraints are never broken. +db4 :: ExampleDb +db4 = [ + Right $ exAv "Ax" 1 [] + , Right $ exAv "Ax" 2 [] + , Right $ exAv "Ay" 1 [] + , Right $ exAv "Ay" 2 [] + , Right $ exAv "B" 1 [exFlagged "flagB" [ExFix "Ax" 1] [ExFix "Ay" 1]] + , Right $ exAv "C" 1 [ExFix "Ax" 2, ExAny "B"] + , Right $ exAv "D" 1 [ExFix "Ay" 2, ExAny "B"] + ] + +-- | Simple database containing one package with a manual flag. +dbManualFlags :: ExampleDb +dbManualFlags = [ + Right $ declareFlags [ExFlag "flag" True Manual] $ + exAv "pkg" 1 [exFlagged "flag" [ExAny "true-dep"] [ExAny "false-dep"]] + , Right $ exAv "true-dep" 1 [] + , Right $ exAv "false-dep" 1 [] + ] + +-- | Database containing a setup dependency with a manual flag. A's library and +-- setup script depend on two different versions of B. B's manual flag can be +-- set to different values in the two places where it is used. +dbSetupDepWithManualFlag :: ExampleDb +dbSetupDepWithManualFlag = + let bFlags = [ExFlag "flag" True Manual] + in [ + Right $ exAv "A" 1 [ExFix "B" 1] `withSetupDeps` [ExFix "B" 2] + , Right $ declareFlags bFlags $ + exAv "B" 1 [exFlagged "flag" [ExAny "b-1-true-dep"] + [ExAny "b-1-false-dep"]] + , Right $ declareFlags bFlags $ + exAv "B" 2 [exFlagged "flag" [ExAny "b-2-true-dep"] + [ExAny "b-2-false-dep"]] + , Right $ exAv "b-1-true-dep" 1 [] + , Right $ exAv "b-1-false-dep" 1 [] + , Right $ exAv "b-2-true-dep" 1 [] + , Right $ exAv "b-2-false-dep" 1 [] + ] + +-- | A database similar to 'dbSetupDepWithManualFlag', except that the library +-- and setup script both depend on B-1. B must be linked because of the Single +-- Instance Restriction, and its flag can only have one value. +dbLinkedSetupDepWithManualFlag :: ExampleDb +dbLinkedSetupDepWithManualFlag = [ + Right $ exAv "A" 1 [ExFix "B" 1] `withSetupDeps` [ExFix "B" 1] + , Right $ declareFlags [ExFlag "flag" True Manual] $ + exAv "B" 1 [exFlagged "flag" [ExAny "b-1-true-dep"] + [ExAny "b-1-false-dep"]] + , Right $ exAv "b-1-true-dep" 1 [] + , Right $ exAv "b-1-false-dep" 1 [] + ] + +-- | Some tests involving testsuites +-- +-- Note that in this test framework test suites are always enabled; if you +-- want to test without test suites just set up a test database without +-- test suites. +-- +-- * C depends on A (through its test suite) +-- * D depends on B-2 (through its test suite), but B-2 is unavailable +-- * E depends on A-1 directly and on A through its test suite. We prefer +-- to use A-1 for the test suite in this case. +-- * F depends on A-1 directly and on A-2 through its test suite. In this +-- case we currently fail to install F, although strictly speaking +-- test suites should be considered independent goals. +-- * G is like E, but for version A-2. This means that if we cannot install +-- E and G together, unless we regard them as independent goals. +db5 :: ExampleDb +db5 = [ + Right $ exAv "A" 1 [] + , Right $ exAv "A" 2 [] + , Right $ exAv "B" 1 [] + , Right $ exAv "C" 1 [] `withTest` ExTest "testC" [ExAny "A"] + , Right $ exAv "D" 1 [] `withTest` ExTest "testD" [ExFix "B" 2] + , Right $ exAv "E" 1 [ExFix "A" 1] `withTest` ExTest "testE" [ExAny "A"] + , Right $ exAv "F" 1 [ExFix "A" 1] `withTest` ExTest "testF" [ExFix "A" 2] + , Right $ exAv "G" 1 [ExFix "A" 2] `withTest` ExTest "testG" [ExAny "A"] + ] + +-- Now the _dependencies_ have test suites +-- +-- * Installing C is a simple example. C wants version 1 of A, but depends on +-- B, and B's testsuite depends on an any version of A. In this case we prefer +-- to link (if we don't regard test suites as independent goals then of course +-- linking here doesn't even come into it). +-- * Installing [C, D] means that we prefer to link B -- depending on how we +-- set things up, this means that we should also link their test suites. +db6 :: ExampleDb +db6 = [ + Right $ exAv "A" 1 [] + , Right $ exAv "A" 2 [] + , Right $ exAv "B" 1 [] `withTest` ExTest "testA" [ExAny "A"] + , Right $ exAv "C" 1 [ExFix "A" 1, ExAny "B"] + , Right $ exAv "D" 1 [ExAny "B"] + ] + +-- | This test checks that the solver can backjump to disable a flag, even if +-- the problematic dependency is also under a test suite. (issue #4390) +-- +-- The goal order forces the solver to choose the flag before enabling testing. +-- Previously, the solver couldn't handle this case, because it only tried to +-- disable testing, and when that failed, it backjumped past the flag choice. +-- The solver should also try to set the flag to false, because that avoids the +-- dependency on B. +testTestSuiteWithFlag :: String -> SolverTest +testTestSuiteWithFlag name = + goalOrder goals $ enableAllTests $ mkTest db name ["A", "B"] $ + solverSuccess [("A", 1), ("B", 1)] + where + db :: ExampleDb + db = [ + Right $ exAv "A" 1 [] + `withTest` + ExTest "test" [exFlagged "flag" [ExFix "B" 2] []] + , Right $ exAv "B" 1 [] + ] + + goals :: [ExampleVar] + goals = [ + P QualNone "B" + , P QualNone "A" + , F QualNone "A" "flag" + , S QualNone "A" TestStanzas + ] + +-- Packages with setup dependencies +-- +-- Install.. +-- * B: Simple example, just make sure setup deps are taken into account at all +-- * C: Both the package and the setup script depend on any version of A. +-- In this case we prefer to link +-- * D: Variation on C.1 where the package requires a specific (not latest) +-- version but the setup dependency is not fixed. Again, we prefer to +-- link (picking the older version) +-- * E: Variation on C.2 with the setup dependency the more inflexible. +-- Currently, in this case we do not see the opportunity to link because +-- we consider setup dependencies after normal dependencies; we will +-- pick A.2 for E, then realize we cannot link E.setup.A to A.2, and pick +-- A.1 instead. This isn't so easy to fix (if we want to fix it at all); +-- in particular, considering setup dependencies _before_ other deps is +-- not an improvement, because in general we would prefer to link setup +-- setups to package deps, rather than the other way around. (For example, +-- if we change this ordering then the test for D would start to install +-- two versions of A). +-- * F: The package and the setup script depend on different versions of A. +-- This will only work if setup dependencies are considered independent. +db7 :: ExampleDb +db7 = [ + Right $ exAv "A" 1 [] + , Right $ exAv "A" 2 [] + , Right $ exAv "B" 1 [] `withSetupDeps` [ExAny "A"] + , Right $ exAv "C" 1 [ExAny "A" ] `withSetupDeps` [ExAny "A" ] + , Right $ exAv "D" 1 [ExFix "A" 1] `withSetupDeps` [ExAny "A" ] + , Right $ exAv "E" 1 [ExAny "A" ] `withSetupDeps` [ExFix "A" 1] + , Right $ exAv "F" 1 [ExFix "A" 2] `withSetupDeps` [ExFix "A" 1] + ] + +-- If we install C and D together (not as independent goals), we need to build +-- both B.1 and B.2, both of which depend on A. +db8 :: ExampleDb +db8 = [ + Right $ exAv "A" 1 [] + , Right $ exAv "B" 1 [ExAny "A"] + , Right $ exAv "B" 2 [ExAny "A"] + , Right $ exAv "C" 1 [] `withSetupDeps` [ExFix "B" 1] + , Right $ exAv "D" 1 [] `withSetupDeps` [ExFix "B" 2] + ] + +-- Extended version of `db8` so that we have nested setup dependencies +db9 :: ExampleDb +db9 = db8 ++ [ + Right $ exAv "E" 1 [ExAny "C"] + , Right $ exAv "E" 2 [ExAny "D"] + , Right $ exAv "F" 1 [] `withSetupDeps` [ExFix "E" 1] + , Right $ exAv "G" 1 [] `withSetupDeps` [ExFix "E" 2] + ] + +-- Multiple already-installed packages with inter-dependencies, and one package +-- (C) that depends on package A-1 for its setup script and package A-2 as a +-- library dependency. +db10 :: ExampleDb +db10 = + let rts = exInst "rts" 1 "rts-inst" [] + ghc_prim = exInst "ghc-prim" 1 "ghc-prim-inst" [rts] + base = exInst "base" 1 "base-inst" [rts, ghc_prim] + a1 = exInst "A" 1 "A1-inst" [base] + a2 = exInst "A" 2 "A2-inst" [base] + in [ + Left rts + , Left ghc_prim + , Left base + , Left a1 + , Left a2 + , Right $ exAv "C" 1 [ExFix "A" 2] `withSetupDeps` [ExFix "A" 1] + ] + +-- | This database tests that a package's setup dependencies are correctly +-- linked when the package is linked. See pull request #3268. +-- +-- When A and B are installed as independent goals, their dependencies on C must +-- be linked, due to the single instance restriction. Since C depends on D, 0.D +-- and 1.D must be linked. C also has a setup dependency on D, so 0.C-setup.D +-- and 1.C-setup.D must be linked. However, D's two link groups must remain +-- independent. The solver should be able to choose D-1 for C's library and D-2 +-- for C's setup script. +dbSetupDeps :: ExampleDb +dbSetupDeps = [ + Right $ exAv "A" 1 [ExAny "C"] + , Right $ exAv "B" 1 [ExAny "C"] + , Right $ exAv "C" 1 [ExFix "D" 1] `withSetupDeps` [ExFix "D" 2] + , Right $ exAv "D" 1 [] + , Right $ exAv "D" 2 [] + ] + +-- | Tests for dealing with base shims +db11 :: ExampleDb +db11 = + let base3 = exInst "base" 3 "base-3-inst" [base4] + base4 = exInst "base" 4 "base-4-inst" [] + in [ + Left base3 + , Left base4 + , Right $ exAv "A" 1 [ExFix "base" 3] + ] + +-- | Slightly more realistic version of db11 where base-3 depends on syb +-- This means that if a package depends on base-3 and on syb, then they MUST +-- share the version of syb +-- +-- * Package A relies on base-3 (which relies on base-4) +-- * Package B relies on base-4 +-- * Package C relies on both A and B +-- * Package D relies on base-3 and on syb-2, which is not possible because +-- base-3 has a dependency on syb-1 (non-inheritance of the Base qualifier) +-- * Package E relies on base-4 and on syb-2, which is fine. +db12 :: ExampleDb +db12 = + let base3 = exInst "base" 3 "base-3-inst" [base4, syb1] + base4 = exInst "base" 4 "base-4-inst" [] + syb1 = exInst "syb" 1 "syb-1-inst" [base4] + in [ + Left base3 + , Left base4 + , Left syb1 + , Right $ exAv "syb" 2 [ExFix "base" 4] + , Right $ exAv "A" 1 [ExFix "base" 3, ExAny "syb"] + , Right $ exAv "B" 1 [ExFix "base" 4, ExAny "syb"] + , Right $ exAv "C" 1 [ExAny "A", ExAny "B"] + , Right $ exAv "D" 1 [ExFix "base" 3, ExFix "syb" 2] + , Right $ exAv "E" 1 [ExFix "base" 4, ExFix "syb" 2] + ] + +dbBase :: ExampleDb +dbBase = [ + Right $ exAv "base" 1 + [ExAny "ghc-prim", ExAny "integer-simple", ExAny "integer-gmp"] + , Right $ exAv "ghc-prim" 1 [] + , Right $ exAv "integer-simple" 1 [] + , Right $ exAv "integer-gmp" 1 [] + ] + +db13 :: ExampleDb +db13 = [ + Right $ exAv "A" 1 [] + , Right $ exAv "A" 2 [] + , Right $ exAv "A" 3 [] + ] + +-- | A, B, and C have three different dependencies on D that can be set to +-- different versions with qualified constraints. Each version of D can only +-- be depended upon by one version of A, B, or C, so that the versions of A, B, +-- and C in the install plan indicate which version of D was chosen for each +-- dependency. The one-to-one correspondence between versions of A, B, and C and +-- versions of D also prevents linking, which would complicate the solver's +-- behavior. +dbConstraints :: ExampleDb +dbConstraints = + [Right $ exAv "A" v [ExFix "D" v] | v <- [1, 4, 7]] + ++ [Right $ exAv "B" v [] `withSetupDeps` [ExFix "D" v] | v <- [2, 5, 8]] + ++ [Right $ exAv "C" v [] `withSetupDeps` [ExFix "D" v] | v <- [3, 6, 9]] + ++ [Right $ exAv "D" v [] | v <- [1..9]] + +dbStanzaPreferences1 :: ExampleDb +dbStanzaPreferences1 = [ + Right $ exAv "pkg" 1 [] `withTest` ExTest "test" [ExAny "test-dep"] + , Right $ exAv "test-dep" 1 [] + ] + +dbStanzaPreferences2 :: ExampleDb +dbStanzaPreferences2 = [ + Right $ exAv "pkg" 1 [] `withTest` ExTest "test" [ExAny "unknown"] + ] + +-- | This is a test case for a bug in stanza preferences (#3930). The solver +-- should be able to install 'A' by enabling 'flag' and disabling testing. When +-- it tries goals in the specified order and prefers testing, it encounters +-- 'unknown-pkg2'. 'unknown-pkg2' is only introduced by testing and 'flag', so +-- the conflict set should contain both of those variables. Before the fix, it +-- only contained 'flag'. The solver backjumped past the choice to disable +-- testing and failed to find the solution. +testStanzaPreference :: String -> TestTree +testStanzaPreference name = + let pkg = exAv "A" 1 [exFlagged "flag" + [] + [ExAny "unknown-pkg1"]] + `withTest` + ExTest "test" [exFlagged "flag" + [ExAny "unknown-pkg2"] + []] + goals = [ + P QualNone "A" + , F QualNone "A" "flag" + , S QualNone "A" TestStanzas + ] + in runTest $ goalOrder goals $ + preferences [ ExStanzaPref "A" [TestStanzas]] $ + mkTest [Right pkg] name ["A"] $ + solverSuccess [("A", 1)] + +-- | Database with some cycles +-- +-- * Simplest non-trivial cycle: A -> B and B -> A +-- * There is a cycle C -> D -> C, but it can be broken by picking the +-- right flag assignment. +db14 :: ExampleDb +db14 = [ + Right $ exAv "A" 1 [ExAny "B"] + , Right $ exAv "B" 1 [ExAny "A"] + , Right $ exAv "C" 1 [exFlagged "flagC" [ExAny "D"] [ExAny "E"]] + , Right $ exAv "D" 1 [ExAny "C"] + , Right $ exAv "E" 1 [] + ] + +-- | Cycles through setup dependencies +-- +-- The first cycle is unsolvable: package A has a setup dependency on B, +-- B has a regular dependency on A, and we only have a single version available +-- for both. +-- +-- The second cycle can be broken by picking different versions: package C-2.0 +-- has a setup dependency on D, and D has a regular dependency on C-*. However, +-- version C-1.0 is already available (perhaps it didn't have this setup dep). +-- Thus, we should be able to break this cycle even if we are installing package +-- E, which explictly depends on C-2.0. +db15 :: ExampleDb +db15 = [ + -- First example (real cycle, no solution) + Right $ exAv "A" 1 [] `withSetupDeps` [ExAny "B"] + , Right $ exAv "B" 1 [ExAny "A"] + -- Second example (cycle can be broken by picking versions carefully) + , Left $ exInst "C" 1 "C-1-inst" [] + , Right $ exAv "C" 2 [] `withSetupDeps` [ExAny "D"] + , Right $ exAv "D" 1 [ExAny "C" ] + , Right $ exAv "E" 1 [ExFix "C" 2] + ] + +-- | Detect a cycle between a package and its setup script. +-- +-- This type of cycle can easily occur when new-build adds default setup +-- dependencies to packages without custom-setup stanzas. For example, cabal +-- adds 'time' as a setup dependency for 'time'. The solver should detect the +-- cycle when it attempts to link the setup and non-setup instances of the +-- package and then choose a different version for the setup dependency. +issue4161 :: String -> SolverTest +issue4161 name = + setVerbose $ mkTest db name ["target"] $ + SolverResult checkFullLog $ Right [("target", 1), ("time", 1), ("time", 2)] + where + db :: ExampleDb + db = [ + Right $ exAv "target" 1 [ExFix "time" 2] + , Right $ exAv "time" 2 [] `withSetupDeps` [ExAny "time"] + , Right $ exAv "time" 1 [] + ] + + checkFullLog :: [String] -> Bool + checkFullLog = any $ isInfixOf $ + "rejecting: time:setup.time~>time-2.0.0 (cyclic dependencies; " + ++ "conflict set: time:setup.time)" + +-- | Packages pkg-A, pkg-B, and pkg-C form a cycle. The solver should backtrack +-- as soon as it chooses the last package in the cycle, to avoid searching parts +-- of the tree that have no solution. Since there is no way to break the cycle, +-- it should fail with an error message describing the cycle. +testCyclicDependencyErrorMessages :: String -> SolverTest +testCyclicDependencyErrorMessages name = + goalOrder goals $ + mkTest db name ["pkg-A"] $ + SolverResult checkFullLog $ Left checkSummarizedLog + where + db :: ExampleDb + db = [ + Right $ exAv "pkg-A" 1 [ExAny "pkg-B"] + , Right $ exAv "pkg-B" 1 [ExAny "pkg-C"] + , Right $ exAv "pkg-C" 1 [ExAny "pkg-A", ExAny "pkg-D"] + , Right $ exAv "pkg-D" 1 [ExAny "pkg-E"] + , Right $ exAv "pkg-E" 1 [] + ] + + -- The solver should backtrack as soon as pkg-A, pkg-B, and pkg-C form a + -- cycle. It shouldn't try pkg-D or pkg-E. + checkFullLog :: [String] -> Bool + checkFullLog = + not . any (\l -> "pkg-D" `isInfixOf` l || "pkg-E" `isInfixOf` l) + + checkSummarizedLog :: String -> Bool + checkSummarizedLog = + isInfixOf "rejecting: pkg-C-1.0.0 (cyclic dependencies; conflict set: pkg-A, pkg-B, pkg-C)" + + -- Solve for pkg-D and pkg-E last. + goals :: [ExampleVar] + goals = [P QualNone ("pkg-" ++ [c]) | c <- ['A'..'E']] + +-- | Check that the solver can backtrack after encountering the SIR (issue #2843) +-- +-- When A and B are installed as independent goals, the single instance +-- restriction prevents B from depending on C. This database tests that the +-- solver can backtrack after encountering the single instance restriction and +-- choose the only valid flag assignment (-flagA +flagB): +-- +-- > flagA flagB B depends on +-- > On _ C-* +-- > Off On E-* <-- only valid flag assignment +-- > Off Off D-2.0, C-* +-- +-- Since A depends on C-* and D-1.0, and C-1.0 depends on any version of D, +-- we must build C-1.0 against D-1.0. Since B depends on D-2.0, we cannot have +-- C in the transitive closure of B's dependencies, because that would mean we +-- would need two instances of C: one built against D-1.0 and one built against +-- D-2.0. +db16 :: ExampleDb +db16 = [ + Right $ exAv "A" 1 [ExAny "C", ExFix "D" 1] + , Right $ exAv "B" 1 [ ExFix "D" 2 + , exFlagged "flagA" + [ExAny "C"] + [exFlagged "flagB" + [ExAny "E"] + [ExAny "C"]]] + , Right $ exAv "C" 1 [ExAny "D"] + , Right $ exAv "D" 1 [] + , Right $ exAv "D" 2 [] + , Right $ exAv "E" 1 [] + ] + + +-- Try to get the solver to backtrack while satisfying +-- reject-unconstrained-dependencies: both the first and last versions of A +-- require packages outside the closed set, so it will have to try the +-- middle one. +db17 :: ExampleDb +db17 = [ + Right $ exAv "A" 1 [ExAny "C"] + , Right $ exAv "A" 2 [ExAny "B"] + , Right $ exAv "A" 3 [ExAny "C"] + , Right $ exAv "B" 1 [] + , Right $ exAv "C" 1 [ExAny "B"] + ] + +-- | This test checks that when the solver discovers a constraint on a +-- package's version after choosing to link that package, it can backtrack to +-- try alternative versions for the linked-to package. See pull request #3327. +-- +-- When A and B are installed as independent goals, their dependencies on C +-- must be linked. Since C depends on D, A and B's dependencies on D must also +-- be linked. This test fixes the goal order so that the solver chooses D-2 for +-- both 0.D and 1.D before it encounters the test suites' constraints. The +-- solver must backtrack to try D-1 for both 0.D and 1.D. +testIndepGoals2 :: String -> SolverTest +testIndepGoals2 name = + goalOrder goals $ independentGoals $ + enableAllTests $ mkTest db name ["A", "B"] $ + solverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1)] + where + db :: ExampleDb + db = [ + Right $ exAv "A" 1 [ExAny "C"] `withTest` ExTest "test" [ExFix "D" 1] + , Right $ exAv "B" 1 [ExAny "C"] `withTest` ExTest "test" [ExFix "D" 1] + , Right $ exAv "C" 1 [ExAny "D"] + , Right $ exAv "D" 1 [] + , Right $ exAv "D" 2 [] + ] + + goals :: [ExampleVar] + goals = [ + P (QualIndep "A") "A" + , P (QualIndep "A") "C" + , P (QualIndep "A") "D" + , P (QualIndep "B") "B" + , P (QualIndep "B") "C" + , P (QualIndep "B") "D" + , S (QualIndep "B") "B" TestStanzas + , S (QualIndep "A") "A" TestStanzas + ] + +-- | Issue #2834 +-- When both A and B are installed as independent goals, their dependencies on +-- C must be linked. The only combination of C's flags that is consistent with +-- A and B's dependencies on D is -flagA +flagB. This database tests that the +-- solver can backtrack to find the right combination of flags (requiring F, but +-- not E or G) and apply it to both 0.C and 1.C. +-- +-- > flagA flagB C depends on +-- > On _ D-1, E-* +-- > Off On F-* <-- Only valid choice +-- > Off Off D-2, G-* +-- +-- The single instance restriction means we cannot have one instance of C +-- built against D-1 and one instance built against D-2; since A depends on +-- D-1, and B depends on C-2, it is therefore important that C cannot depend +-- on any version of D. +db18 :: ExampleDb +db18 = [ + Right $ exAv "A" 1 [ExAny "C", ExFix "D" 1] + , Right $ exAv "B" 1 [ExAny "C", ExFix "D" 2] + , Right $ exAv "C" 1 [exFlagged "flagA" + [ExFix "D" 1, ExAny "E"] + [exFlagged "flagB" + [ExAny "F"] + [ExFix "D" 2, ExAny "G"]]] + , Right $ exAv "D" 1 [] + , Right $ exAv "D" 2 [] + , Right $ exAv "E" 1 [] + , Right $ exAv "F" 1 [] + , Right $ exAv "G" 1 [] + ] + +-- | When both values for flagA introduce package B, the solver should be able +-- to choose B before choosing a value for flagA. It should try to choose a +-- version for B that is in the union of the version ranges required by +flagA +-- and -flagA. +commonDependencyLogMessage :: String -> SolverTest +commonDependencyLogMessage name = + mkTest db name ["A"] $ solverFailure $ isInfixOf $ + "[__0] trying: A-1.0.0 (user goal)\n" + ++ "[__1] next goal: B (dependency of A +/-flagA)\n" + ++ "[__1] rejecting: B-2.0.0 (conflict: A +/-flagA => B==1.0.0 || ==3.0.0)" + where + db :: ExampleDb + db = [ + Right $ exAv "A" 1 [exFlagged "flagA" + [ExFix "B" 1] + [ExFix "B" 3]] + , Right $ exAv "B" 2 [] + ] + +-- | Test lifting dependencies out of multiple levels of conditionals. +twoLevelDeepCommonDependencyLogMessage :: String -> SolverTest +twoLevelDeepCommonDependencyLogMessage name = + mkTest db name ["A"] $ solverFailure $ isInfixOf $ + "unknown package: B (dependency of A +/-flagA +/-flagB)" + where + db :: ExampleDb + db = [ + Right $ exAv "A" 1 [exFlagged "flagA" + [exFlagged "flagB" + [ExAny "B"] + [ExAny "B"]] + [exFlagged "flagB" + [ExAny "B"] + [ExAny "B"]]] + ] + +-- | Test handling nested conditionals that are controlled by the same flag. +-- The solver should treat flagA as introducing 'unknown' with value true, not +-- both true and false. That means that when +flagA causes a conflict, the +-- solver should try flipping flagA to false to resolve the conflict, rather +-- than backjumping past flagA. +testBackjumpingWithCommonDependency :: String -> SolverTest +testBackjumpingWithCommonDependency name = + mkTest db name ["A"] $ solverSuccess [("A", 1), ("B", 1)] + where + db :: ExampleDb + db = [ + Right $ exAv "A" 1 [exFlagged "flagA" + [exFlagged "flagA" + [ExAny "unknown"] + [ExAny "unknown"]] + [ExAny "B"]] + , Right $ exAv "B" 1 [] + ] + +-- | Tricky test case with independent goals (issue #2842) +-- +-- Suppose we are installing D, E, and F as independent goals: +-- +-- * D depends on A-* and C-1, requiring A-1 to be built against C-1 +-- * E depends on B-* and C-2, requiring B-1 to be built against C-2 +-- * F depends on A-* and B-*; this means we need A-1 and B-1 both to be built +-- against the same version of C, violating the single instance restriction. +-- +-- We can visualize this DB as: +-- +-- > C-1 C-2 +-- > /|\ /|\ +-- > / | \ / | \ +-- > / | X | \ +-- > | | / \ | | +-- > | |/ \| | +-- > | + + | +-- > | | | | +-- > | A B | +-- > \ |\ /| / +-- > \ | \ / | / +-- > \| V |/ +-- > D F E +testIndepGoals3 :: String -> SolverTest +testIndepGoals3 name = + goalOrder goals $ independentGoals $ + mkTest db name ["D", "E", "F"] anySolverFailure + where + db :: ExampleDb + db = [ + Right $ exAv "A" 1 [ExAny "C"] + , Right $ exAv "B" 1 [ExAny "C"] + , Right $ exAv "C" 1 [] + , Right $ exAv "C" 2 [] + , Right $ exAv "D" 1 [ExAny "A", ExFix "C" 1] + , Right $ exAv "E" 1 [ExAny "B", ExFix "C" 2] + , Right $ exAv "F" 1 [ExAny "A", ExAny "B"] + ] + + goals :: [ExampleVar] + goals = [ + P (QualIndep "D") "D" + , P (QualIndep "D") "C" + , P (QualIndep "D") "A" + , P (QualIndep "E") "E" + , P (QualIndep "E") "C" + , P (QualIndep "E") "B" + , P (QualIndep "F") "F" + , P (QualIndep "F") "B" + , P (QualIndep "F") "C" + , P (QualIndep "F") "A" + ] + +-- | This test checks that the solver correctly backjumps when dependencies +-- of linked packages are not linked. It is an example where the conflict set +-- from enforcing the single instance restriction is not sufficient. See pull +-- request #3327. +-- +-- When A, B, and C are installed as independent goals with the specified goal +-- order, the first choice that the solver makes for E is 0.E-2. Then, when it +-- chooses dependencies for B and C, it links both 1.E and 2.E to 0.E. Finally, +-- the solver discovers C's test's constraint on E. It must backtrack to try +-- 1.E-1 and then link 2.E to 1.E. Backjumping all the way to 0.E does not lead +-- to a solution, because 0.E's version is constrained by A and cannot be +-- changed. +testIndepGoals4 :: String -> SolverTest +testIndepGoals4 name = + goalOrder goals $ independentGoals $ + enableAllTests $ mkTest db name ["A", "B", "C"] $ + solverSuccess [("A",1), ("B",1), ("C",1), ("D",1), ("E",1), ("E",2)] + where + db :: ExampleDb + db = [ + Right $ exAv "A" 1 [ExFix "E" 2] + , Right $ exAv "B" 1 [ExAny "D"] + , Right $ exAv "C" 1 [ExAny "D"] `withTest` ExTest "test" [ExFix "E" 1] + , Right $ exAv "D" 1 [ExAny "E"] + , Right $ exAv "E" 1 [] + , Right $ exAv "E" 2 [] + ] + + goals :: [ExampleVar] + goals = [ + P (QualIndep "A") "A" + , P (QualIndep "A") "E" + , P (QualIndep "B") "B" + , P (QualIndep "B") "D" + , P (QualIndep "B") "E" + , P (QualIndep "C") "C" + , P (QualIndep "C") "D" + , P (QualIndep "C") "E" + , S (QualIndep "C") "C" TestStanzas + ] + +-- | Test the trace messages that we get when a package refers to an unknown pkg +-- +-- TODO: Currently we don't actually test the trace messages, and this particular +-- test still suceeds. The trace can only be verified by hand. +db21 :: ExampleDb +db21 = [ + Right $ exAv "A" 1 [ExAny "B"] + , Right $ exAv "A" 2 [ExAny "C"] -- A-2.0 will be tried first, but C unknown + , Right $ exAv "B" 1 [] + ] + +-- | A variant of 'db21', which actually fails. +db22 :: ExampleDb +db22 = [ + Right $ exAv "A" 1 [ExAny "B"] + , Right $ exAv "A" 2 [ExAny "C"] + ] + +-- | Another test for the unknown package message. This database tests that +-- filtering out redundant conflict set messages in the solver log doesn't +-- interfere with generating a message about a missing package (part of issue +-- #3617). The conflict set for the missing package is {A, B}. That conflict set +-- is propagated up the tree to the level of A. Since the conflict set is the +-- same at both levels, the solver only keeps one of the backjumping messages. +db23 :: ExampleDb +db23 = [ + Right $ exAv "A" 1 [ExAny "B"] + ] + +-- | Database for (unsuccessfully) trying to expose a bug in the handling +-- of implied linking constraints. The question is whether an implied linking +-- constraint should only have the introducing package in its conflict set, +-- or also its link target. +-- +-- It turns out that as long as the Single Instance Restriction is in place, +-- it does not matter, because there will aways be an option that is failing +-- due to the SIR, which contains the link target in its conflict set. +-- +-- Even if the SIR is not in place, if there is a solution, one will always +-- be found, because without the SIR, linking is always optional, but never +-- necessary. +-- +testIndepGoals5 :: String -> GoalOrder -> SolverTest +testIndepGoals5 name fixGoalOrder = + case fixGoalOrder of + FixedGoalOrder -> goalOrder goals test + DefaultGoalOrder -> test + where + test :: SolverTest + test = independentGoals $ mkTest db name ["X", "Y"] $ + solverSuccess + [("A", 1), ("A", 2), ("B", 1), ("C", 1), ("C", 2), ("X", 1), ("Y", 1)] + + db :: ExampleDb + db = [ + Right $ exAv "X" 1 [ExFix "C" 2, ExAny "A"] + , Right $ exAv "Y" 1 [ExFix "C" 1, ExFix "A" 2] + , Right $ exAv "A" 1 [] + , Right $ exAv "A" 2 [ExAny "B"] + , Right $ exAv "B" 1 [ExAny "C"] + , Right $ exAv "C" 1 [] + , Right $ exAv "C" 2 [] + ] + + goals :: [ExampleVar] + goals = [ + P (QualIndep "X") "X" + , P (QualIndep "X") "A" + , P (QualIndep "X") "B" + , P (QualIndep "X") "C" + , P (QualIndep "Y") "Y" + , P (QualIndep "Y") "A" + , P (QualIndep "Y") "B" + , P (QualIndep "Y") "C" + ] + +-- | A simplified version of 'testIndepGoals5'. +testIndepGoals6 :: String -> GoalOrder -> SolverTest +testIndepGoals6 name fixGoalOrder = + case fixGoalOrder of + FixedGoalOrder -> goalOrder goals test + DefaultGoalOrder -> test + where + test :: SolverTest + test = independentGoals $ mkTest db name ["X", "Y"] $ + solverSuccess + [("A", 1), ("A", 2), ("B", 1), ("B", 2), ("X", 1), ("Y", 1)] + + db :: ExampleDb + db = [ + Right $ exAv "X" 1 [ExFix "B" 2, ExAny "A"] + , Right $ exAv "Y" 1 [ExFix "B" 1, ExFix "A" 2] + , Right $ exAv "A" 1 [] + , Right $ exAv "A" 2 [ExAny "B"] + , Right $ exAv "B" 1 [] + , Right $ exAv "B" 2 [] + ] + + goals :: [ExampleVar] + goals = [ + P (QualIndep "X") "X" + , P (QualIndep "X") "A" + , P (QualIndep "X") "B" + , P (QualIndep "Y") "Y" + , P (QualIndep "Y") "A" + , P (QualIndep "Y") "B" + ] + +dbExts1 :: ExampleDb +dbExts1 = [ + Right $ exAv "A" 1 [ExExt (EnableExtension RankNTypes)] + , Right $ exAv "B" 1 [ExExt (EnableExtension CPP), ExAny "A"] + , Right $ exAv "C" 1 [ExAny "B"] + , Right $ exAv "D" 1 [ExExt (DisableExtension CPP), ExAny "B"] + , Right $ exAv "E" 1 [ExExt (UnknownExtension "custom"), ExAny "C"] + ] + +dbLangs1 :: ExampleDb +dbLangs1 = [ + Right $ exAv "A" 1 [ExLang Haskell2010] + , Right $ exAv "B" 1 [ExLang Haskell98, ExAny "A"] + , Right $ exAv "C" 1 [ExLang (UnknownLanguage "Haskell3000"), ExAny "B"] + ] + +-- | cabal must set enable-exe to false in order to avoid the unavailable +-- dependency. Flags are true by default. The flag choice causes "pkg" to +-- depend on "false-dep". +testBuildable :: String -> ExampleDependency -> TestTree +testBuildable testName unavailableDep = + runTest $ + mkTestExtLangPC (Just []) (Just [Haskell98]) [] db testName ["pkg"] expected + where + expected = solverSuccess [("false-dep", 1), ("pkg", 1)] + db = [ + Right $ exAv "pkg" 1 [exFlagged "enable-exe" + [ExAny "true-dep"] + [ExAny "false-dep"]] + `withExe` + ExExe "exe" [ unavailableDep + , ExFlagged "enable-exe" (Buildable []) NotBuildable ] + , Right $ exAv "true-dep" 1 [] + , Right $ exAv "false-dep" 1 [] + ] + +-- | cabal must choose -flag1 +flag2 for "pkg", which requires packages +-- "flag1-false" and "flag2-true". +dbBuildable1 :: ExampleDb +dbBuildable1 = [ + Right $ exAv "pkg" 1 + [ exFlagged "flag1" [ExAny "flag1-true"] [ExAny "flag1-false"] + , exFlagged "flag2" [ExAny "flag2-true"] [ExAny "flag2-false"]] + `withExes` + [ ExExe "exe1" + [ ExAny "unknown" + , ExFlagged "flag1" (Buildable []) NotBuildable + , ExFlagged "flag2" (Buildable []) NotBuildable] + , ExExe "exe2" + [ ExAny "unknown" + , ExFlagged "flag1" + (Buildable []) + (Buildable [ExFlagged "flag2" NotBuildable (Buildable [])])] + ] + , Right $ exAv "flag1-true" 1 [] + , Right $ exAv "flag1-false" 1 [] + , Right $ exAv "flag2-true" 1 [] + , Right $ exAv "flag2-false" 1 [] + ] + +-- | cabal must pick B-2 to avoid the unknown dependency. +dbBuildable2 :: ExampleDb +dbBuildable2 = [ + Right $ exAv "A" 1 [ExAny "B"] + , Right $ exAv "B" 1 [ExAny "unknown"] + , Right $ exAv "B" 2 [] + `withExe` + ExExe "exe" + [ ExAny "unknown" + , ExFlagged "disable-exe" NotBuildable (Buildable []) + ] + , Right $ exAv "B" 3 [ExAny "unknown"] + ] + +-- | Package databases for testing @pkg-config@ dependencies. +dbPC1 :: ExampleDb +dbPC1 = [ + Right $ exAv "A" 1 [ExPkg ("pkgA", 1)] + , Right $ exAv "B" 1 [ExPkg ("pkgB", 1), ExAny "A"] + , Right $ exAv "B" 2 [ExPkg ("pkgB", 2), ExAny "A"] + , Right $ exAv "C" 1 [ExAny "B"] + ] + +-- | Test for the solver's summarized log. The final conflict set is {A, D}, +-- though the goal order forces the solver to find the (avoidable) conflict +-- between B >= 2 and C first. When the solver reaches the backjump limit, it +-- should only show the log to the first conflict. When the backjump limit is +-- high enough to allow an exhaustive search, the solver should make use of the +-- final conflict set to only show the conflict between A and D in the +-- summarized log. +testSummarizedLog :: String -> Maybe Int -> String -> TestTree +testSummarizedLog testName mbj expectedMsg = + runTest $ maxBackjumps mbj $ goalOrder goals $ mkTest db testName ["A"] $ + solverFailure (== expectedMsg) + where + db = [ + Right $ exAv "A" 1 [ExAny "B", ExAny "D"] + , Right $ exAv "B" 3 [ExFix "C" 3] + , Right $ exAv "B" 2 [ExFix "C" 2] + , Right $ exAv "B" 1 [ExAny "C"] + , Right $ exAv "C" 1 [] + ] + + goals :: [ExampleVar] + goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D"]] + +{------------------------------------------------------------------------------- + Simple databases for the illustrations for the backjumping blog post +-------------------------------------------------------------------------------} + +-- | Motivate conflict sets +dbBJ1a :: ExampleDb +dbBJ1a = [ + Right $ exAv "A" 1 [ExFix "B" 1] + , Right $ exAv "A" 2 [ExFix "B" 2] + , Right $ exAv "B" 1 [] + ] + +-- | Show that we can skip some decisions +dbBJ1b :: ExampleDb +dbBJ1b = [ + Right $ exAv "A" 1 [ExFix "B" 1] + , Right $ exAv "A" 2 [ExFix "B" 2, ExAny "C"] + , Right $ exAv "B" 1 [] + , Right $ exAv "C" 1 [] + , Right $ exAv "C" 2 [] + ] + +-- | Motivate why both A and B need to be in the conflict set +dbBJ1c :: ExampleDb +dbBJ1c = [ + Right $ exAv "A" 1 [ExFix "B" 1] + , Right $ exAv "B" 1 [] + , Right $ exAv "B" 2 [] + ] + +-- | Motivate the need for accumulating conflict sets while we walk the tree +dbBJ2 :: ExampleDb +dbBJ2 = [ + Right $ exAv "A" 1 [ExFix "B" 1] + , Right $ exAv "A" 2 [ExFix "B" 2] + , Right $ exAv "B" 1 [ExFix "C" 1] + , Right $ exAv "B" 2 [ExFix "C" 2] + , Right $ exAv "C" 1 [] + ] + +-- | Motivate the need for `QGoalReason` +dbBJ3 :: ExampleDb +dbBJ3 = [ + Right $ exAv "A" 1 [ExAny "Ba"] + , Right $ exAv "A" 2 [ExAny "Bb"] + , Right $ exAv "Ba" 1 [ExFix "C" 1] + , Right $ exAv "Bb" 1 [ExFix "C" 2] + , Right $ exAv "C" 1 [] + ] + +-- | `QGOalReason` not unique +dbBJ4 :: ExampleDb +dbBJ4 = [ + Right $ exAv "A" 1 [ExAny "B", ExAny "C"] + , Right $ exAv "B" 1 [ExAny "C"] + , Right $ exAv "C" 1 [] + ] + +-- | Flags are represented somewhat strangely in the tree +-- +-- This example probably won't be in the blog post itself but as a separate +-- bug report (#3409) +dbBJ5 :: ExampleDb +dbBJ5 = [ + Right $ exAv "A" 1 [exFlagged "flagA" [ExFix "B" 1] [ExFix "C" 1]] + , Right $ exAv "B" 1 [ExFix "D" 1] + , Right $ exAv "C" 1 [ExFix "D" 2] + , Right $ exAv "D" 1 [] + ] + +-- | Conflict sets for cycles +dbBJ6 :: ExampleDb +dbBJ6 = [ + Right $ exAv "A" 1 [ExAny "B"] + , Right $ exAv "B" 1 [] + , Right $ exAv "B" 2 [ExAny "C"] + , Right $ exAv "C" 1 [ExAny "A"] + ] + +-- | Conflicts not unique +dbBJ7 :: ExampleDb +dbBJ7 = [ + Right $ exAv "A" 1 [ExAny "B", ExFix "C" 1] + , Right $ exAv "B" 1 [ExFix "C" 1] + , Right $ exAv "C" 1 [] + , Right $ exAv "C" 2 [] + ] + +-- | Conflict sets for SIR (C shared subgoal of independent goals A, B) +dbBJ8 :: ExampleDb +dbBJ8 = [ + Right $ exAv "A" 1 [ExAny "C"] + , Right $ exAv "B" 1 [ExAny "C"] + , Right $ exAv "C" 1 [] + ] + +{------------------------------------------------------------------------------- + Databases for build-tool-depends +-------------------------------------------------------------------------------} + +-- | Multiple packages depending on exes from 'bt-pkg'. +dbBuildTools :: ExampleDb +dbBuildTools = [ + Right $ exAv "A" 1 [ExBuildToolAny "bt-pkg" "exe1"] + , Right $ exAv "B" 1 [exFlagged "flagB" [ExAny "unknown"] + [ExBuildToolAny "bt-pkg" "exe1"]] + , Right $ exAv "C" 1 [] `withTest` ExTest "testC" [ExBuildToolAny "bt-pkg" "exe1"] + , Right $ exAv "D" 1 [ExBuildToolAny "bt-pkg" "unknown-exe"] + , Right $ exAv "E" 1 [ExBuildToolAny "unknown-pkg" "exe1"] + , Right $ exAv "F" 1 [exFlagged "flagF" [ExBuildToolAny "bt-pkg" "unknown-exe"] + [ExAny "unknown"]] + , Right $ exAv "G" 1 [] `withTest` ExTest "testG" [ExBuildToolAny "bt-pkg" "unknown-exe"] + , Right $ exAv "H" 1 [ExBuildToolFix "bt-pkg" "exe1" 3] + + , Right $ exAv "bt-pkg" 4 [] + , Right $ exAv "bt-pkg" 3 [] `withExe` ExExe "exe2" [] + , Right $ exAv "bt-pkg" 2 [] `withExe` ExExe "exe1" [] + , Right $ exAv "bt-pkg" 1 [] + ] + +-- The solver should never choose an installed package for a build tool +-- dependency. +rejectInstalledBuildToolPackage :: String -> SolverTest +rejectInstalledBuildToolPackage name = + mkTest db name ["A"] $ solverFailure $ isInfixOf $ + "rejecting: A:B:exe.B-1.0.0/installed-1 " + ++ "(does not contain executable 'exe', which is required by A)" + where + db :: ExampleDb + db = [ + Right $ exAv "A" 1 [ExBuildToolAny "B" "exe"] + , Left $ exInst "B" 1 "B-1" [] + ] + +-- | This test forces the solver to choose B as a build-tool dependency before +-- it sees the dependency on executable exe2 from B. The solver needs to check +-- that the version that it already chose for B contains the necessary +-- executable. This order causes a different "missing executable" error message +-- than when the solver checks for the executable in the same step that it +-- chooses the build-tool package. +-- +-- This case may become impossible if we ever add the executable name to the +-- build-tool goal qualifier. Then this test would involve two qualified goals +-- for B, one for exe1 and another for exe2. +chooseExeAfterBuildToolsPackage :: Bool -> String -> SolverTest +chooseExeAfterBuildToolsPackage shouldSucceed name = + goalOrder goals $ mkTest db name ["A"] $ + if shouldSucceed + then solverSuccess [("A", 1), ("B", 1)] + else solverFailure $ isInfixOf $ + "rejecting: A:+flagA (requires executable 'exe2' from A:B:exe.B, " + ++ "but the component does not exist)" + where + db :: ExampleDb + db = [ + Right $ exAv "A" 1 [ ExBuildToolAny "B" "exe1" + , exFlagged "flagA" [ExBuildToolAny "B" "exe2"] + [ExAny "unknown"]] + , Right $ exAv "B" 1 [] + `withExes` + [ExExe exe [] | exe <- if shouldSucceed then ["exe1", "exe2"] else ["exe1"]] + ] + + goals :: [ExampleVar] + goals = [ + P QualNone "A" + , P (QualExe "A" "B") "B" + , F QualNone "A" "flagA" + ] + +-- | Test that when one package depends on two executables from another package, +-- both executables must come from the same instance of that package. We could +-- lift this restriction in the future by adding the executable name to the goal +-- qualifier. +requireConsistentBuildToolVersions :: String -> SolverTest +requireConsistentBuildToolVersions name = + mkTest db name ["A"] $ solverFailure $ isInfixOf $ + "[__1] rejecting: A:B:exe.B-2.0.0 (conflict: A => A:B:exe.B (exe exe1)==1.0.0)\n" + ++ "[__1] rejecting: A:B:exe.B-1.0.0 (conflict: A => A:B:exe.B (exe exe2)==2.0.0)" + where + db :: ExampleDb + db = [ + Right $ exAv "A" 1 [ ExBuildToolFix "B" "exe1" 1 + , ExBuildToolFix "B" "exe2" 2 ] + , Right $ exAv "B" 2 [] `withExes` exes + , Right $ exAv "B" 1 [] `withExes` exes + ] + + exes = [ExExe "exe1" [], ExExe "exe2" []] + +-- | This test is similar to the failure case for +-- chooseExeAfterBuildToolsPackage, except that the build tool is unbuildable +-- instead of missing. +chooseUnbuildableExeAfterBuildToolsPackage :: String -> SolverTest +chooseUnbuildableExeAfterBuildToolsPackage name = + constraints [ExFlagConstraint (ScopeAnyQualifier "B") "build-bt2" False] $ + goalOrder goals $ + mkTest db name ["A"] $ solverFailure $ isInfixOf $ + "rejecting: A:+use-bt2 (requires executable 'bt2' from A:B:exe.B, but " + ++ "the component is not buildable in the current environment)" + where + db :: ExampleDb + db = [ + Right $ exAv "A" 1 [ ExBuildToolAny "B" "bt1" + , exFlagged "use-bt2" [ExBuildToolAny "B" "bt2"] + [ExAny "unknown"]] + , Right $ exAvNoLibrary "B" 1 + `withExes` + [ ExExe "bt1" [] + , ExExe "bt2" [ExFlagged "build-bt2" (Buildable []) NotBuildable] + ] + ] + + goals :: [ExampleVar] + goals = [ + P QualNone "A" + , P (QualExe "A" "B") "B" + , F QualNone "A" "use-bt2" + ] + +{------------------------------------------------------------------------------- + Databases for legacy build-tools +-------------------------------------------------------------------------------} +dbLegacyBuildTools1 :: ExampleDb +dbLegacyBuildTools1 = [ + Right $ exAv "alex" 1 [] `withExe` ExExe "alex" [], + Right $ exAv "A" 1 [ExLegacyBuildToolAny "alex"] + ] + +-- Test that a recognized build tool dependency specifies the name of both the +-- package and the executable. This db has no solution. +dbLegacyBuildTools2 :: ExampleDb +dbLegacyBuildTools2 = [ + Right $ exAv "alex" 1 [] `withExe` ExExe "other-exe" [], + Right $ exAv "other-package" 1 [] `withExe` ExExe "alex" [], + Right $ exAv "A" 1 [ExLegacyBuildToolAny "alex"] + ] + +-- Test that build-tools on a random thing doesn't matter (only +-- the ones we recognize need to be in db) +dbLegacyBuildTools3 :: ExampleDb +dbLegacyBuildTools3 = [ + Right $ exAv "A" 1 [ExLegacyBuildToolAny "otherdude"] + ] + +-- Test that we can solve for different versions of executables +dbLegacyBuildTools4 :: ExampleDb +dbLegacyBuildTools4 = [ + Right $ exAv "alex" 1 [] `withExe` ExExe "alex" [], + Right $ exAv "alex" 2 [] `withExe` ExExe "alex" [], + Right $ exAv "A" 1 [ExLegacyBuildToolFix "alex" 1], + Right $ exAv "B" 1 [ExLegacyBuildToolFix "alex" 2], + Right $ exAv "C" 1 [ExAny "A", ExAny "B"] + ] + +-- Test that exe is not related to library choices +dbLegacyBuildTools5 :: ExampleDb +dbLegacyBuildTools5 = [ + Right $ exAv "alex" 1 [ExFix "A" 1] `withExe` ExExe "alex" [], + Right $ exAv "A" 1 [], + Right $ exAv "A" 2 [], + Right $ exAv "B" 1 [ExLegacyBuildToolFix "alex" 1, ExFix "A" 2] + ] + +-- Test that build-tools on build-tools works +dbLegacyBuildTools6 :: ExampleDb +dbLegacyBuildTools6 = [ + Right $ exAv "alex" 1 [] `withExe` ExExe "alex" [], + Right $ exAv "happy" 1 [ExLegacyBuildToolAny "alex"] `withExe` ExExe "happy" [], + Right $ exAv "A" 1 [ExLegacyBuildToolAny "happy"] + ] + +-- Test that build-depends on library/executable package works. +-- Extracted from https://github.com/haskell/cabal/issues/3775 +dbIssue3775 :: ExampleDb +dbIssue3775 = [ + Right $ exAv "warp" 1 [], + -- NB: the warp build-depends refers to the package, not the internal + -- executable! + Right $ exAv "A" 2 [ExFix "warp" 1] `withExe` ExExe "warp" [ExAny "A"], + Right $ exAv "B" 2 [ExAny "A", ExAny "warp"] + ] diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/WeightedPSQ.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/WeightedPSQ.hs new file mode 100644 index 00000000..9c4f60b2 --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/WeightedPSQ.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE ParallelListComp #-} +module UnitTests.Distribution.Solver.Modular.WeightedPSQ ( + tests + ) where + +import qualified Distribution.Solver.Modular.WeightedPSQ as W + +import Data.List (sort) + +import Test.Tasty (TestTree) +import Test.Tasty.HUnit (testCase, (@?=)) +import Test.Tasty.QuickCheck (Blind(..), testProperty) + +tests :: [TestTree] +tests = [ + testProperty "'toList . fromList' preserves elements" $ \xs -> + sort (xs :: [(Int, Char, Bool)]) == sort (W.toList (W.fromList xs)) + + , testProperty "'toList . fromList' sorts stably" $ \xs -> + let indexAsValue :: [(Int, (), Int)] + indexAsValue = [(x, (), i) | x <- xs | i <- [0..]] + in isSorted $ W.toList $ W.fromList indexAsValue + + , testProperty "'mapWeightsWithKey' sorts by weight" $ \xs (Blind f) -> + isSorted $ W.weights $ + W.mapWeightsWithKey (f :: Int -> Int -> Int) $ + W.fromList (xs :: [(Int, Int, Int)]) + + , testCase "applying 'mapWeightsWithKey' twice sorts twice" $ + let indexAsKey :: [((), Int, ())] + indexAsKey = [((), i, ()) | i <- [0..10]] + actual = W.toList $ + W.mapWeightsWithKey (\_ _ -> ()) $ + W.mapWeightsWithKey (\i _ -> -i) $ -- should not be ignored + W.fromList indexAsKey + in reverse indexAsKey @?= actual + + , testProperty "'union' sorts by weight" $ \xs ys -> + isSorted $ W.weights $ + W.union (W.fromList xs) (W.fromList (ys :: [(Int, Int, Int)])) + + , testProperty "'union' preserves elements" $ \xs ys -> + let union = W.union (W.fromList xs) + (W.fromList (ys :: [(Int, Int, Int)])) + in sort (xs ++ ys) == sort (W.toList union) + + , testCase "'lookup' returns first occurrence" $ + let xs = W.fromList [((), False, 'A'), ((), True, 'C'), ((), True, 'B')] + in Just 'C' @?= W.lookup True xs + ] + +isSorted :: Ord a => [a] -> Bool +isSorted (x1 : xs@(x2 : _)) = x1 <= x2 && isSorted xs +isSorted _ = True diff --git a/cabal-install/tests/UnitTests/Options.hs b/cabal-install/tests/UnitTests/Options.hs new file mode 100644 index 00000000..1edce035 --- /dev/null +++ b/cabal-install/tests/UnitTests/Options.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +module UnitTests.Options ( OptionShowSolverLog(..) + , OptionMtimeChangeDelay(..) + , RunNetworkTests(..) + , extraOptions ) + where + +import Data.Proxy +import Data.Typeable + +import Test.Tasty.Options + +{------------------------------------------------------------------------------- + Test options +-------------------------------------------------------------------------------} + +extraOptions :: [OptionDescription] +extraOptions = + [ Option (Proxy :: Proxy OptionShowSolverLog) + , Option (Proxy :: Proxy OptionMtimeChangeDelay) + , Option (Proxy :: Proxy RunNetworkTests) + ] + +newtype OptionShowSolverLog = OptionShowSolverLog Bool + deriving Typeable + +instance IsOption OptionShowSolverLog where + defaultValue = OptionShowSolverLog False + parseValue = fmap OptionShowSolverLog . safeReadBool + optionName = return "show-solver-log" + optionHelp = return "Show full log from the solver" + optionCLParser = flagCLParser Nothing (OptionShowSolverLog True) + +newtype OptionMtimeChangeDelay = OptionMtimeChangeDelay Int + deriving Typeable + +instance IsOption OptionMtimeChangeDelay where + defaultValue = OptionMtimeChangeDelay 0 + parseValue = fmap OptionMtimeChangeDelay . safeRead + optionName = return "mtime-change-delay" + optionHelp = return $ "How long to wait before attempting to detect" + ++ "file modification, in microseconds" + +newtype RunNetworkTests = RunNetworkTests Bool + deriving Typeable + +instance IsOption RunNetworkTests where + defaultValue = RunNetworkTests True + parseValue = fmap RunNetworkTests . safeReadBool + optionName = return "run-network-tests" + optionHelp = return "Run tests that need network access (default true)." diff --git a/cabal-install/tests/UnitTests/TempTestDir.hs b/cabal-install/tests/UnitTests/TempTestDir.hs new file mode 100644 index 00000000..77db49bd --- /dev/null +++ b/cabal-install/tests/UnitTests/TempTestDir.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE CPP #-} + +module UnitTests.TempTestDir ( + withTestDir, removeDirectoryRecursiveHack + ) where + +import Distribution.Verbosity +import Distribution.Compat.Internal.TempFile (createTempDirectory) +import Distribution.Simple.Utils (warn) + +import Control.Monad (when) +import Control.Exception (bracket, try, throwIO) +import Control.Concurrent (threadDelay) + +import System.IO.Error +import System.Directory +#if !(MIN_VERSION_directory(1,2,7)) +import System.FilePath (()) +#endif +import qualified System.Info (os) + + +-- | Much like 'withTemporaryDirectory' but with a number of hacks to make +-- sure on windows that we can clean up the directory at the end. +-- +withTestDir :: Verbosity -> String -> (FilePath -> IO a) -> IO a +withTestDir verbosity template action = do + systmpdir <- getTemporaryDirectory + bracket + (createTempDirectory systmpdir template) + (removeDirectoryRecursiveHack verbosity) + action + + +-- | On Windows, file locks held by programs we run (in this case VCSs) +-- are not always released prior to completing process termination! +-- +-- This means we run into stale locks when trying to delete the test +-- directory. There is no sane way to wait on those locks being released, +-- we just have to wait, try again and hope. +-- +-- In addition, on Windows a file that is not writable also cannot be deleted, +-- so we must try setting the permissions to readable before deleting files. +-- Some VCS tools on Windows create files with read-only attributes. +-- +removeDirectoryRecursiveHack :: Verbosity -> FilePath -> IO () +removeDirectoryRecursiveHack verbosity dir | isWindows = go 1 + where + isWindows = System.Info.os == "mingw32" + limit = 3 + + go :: Int -> IO () + go n = do + res <- try $ removePathForcibly dir + case res of + Left e + -- wait a second and try again + | isPermissionError e && n < limit -> do + threadDelay 1000000 + go (n+1) + + -- but if we hit the limt warn and fail. + | isPermissionError e -> do + warn verbosity $ "Windows file locking hack: hit the retry limit " + ++ show limit ++ " while trying to remove " ++ dir + throwIO e + + -- or it's a different error fail. + | otherwise -> throwIO e + + Right () -> + when (n > 1) $ + warn verbosity $ "Windows file locking hack: had to try " + ++ show n ++ " times to remove " ++ dir + +removeDirectoryRecursiveHack _ dir = removeDirectoryRecursive dir + + +#if !(MIN_VERSION_directory(1,2,7)) +-- A simplified version that ought to work for our use case here, and does +-- not rely on directory internals. +removePathForcibly :: FilePath -> IO () +removePathForcibly path = do + makeRemovable path `catchIOError` \ _ -> pure () + isDir <- doesDirectoryExist path + if isDir + then do + entries <- getDirectoryContents path + sequence_ + [ removePathForcibly (path entry) + | entry <- entries, entry /= ".", entry /= ".." ] + removeDirectory path + else + removeFile path + where + makeRemovable :: FilePath -> IO () + makeRemovable p = + setPermissions p emptyPermissions { + readable = True, + searchable = True, + writable = True + } +#endif + diff --git a/cabal-install/tests/test-cabal-install b/cabal-install/tests/test-cabal-install new file mode 100644 index 00000000..431afa10 --- /dev/null +++ b/cabal-install/tests/test-cabal-install @@ -0,0 +1,9 @@ +#!/bin/sh + +darcs get --partial http://darcs.haskell.org/packages/Cabal/ && \ +cd Cabal/cabal-install && \ +make && \ +sudo make install && \ +sudo cabal-install update && \ +cabal-install install --prefix=/tmp --user hnop && \ +ls -l /tmp/bin/hnop diff --git a/cabal-install/tests/test-cabal-install-user b/cabal-install/tests/test-cabal-install-user new file mode 100644 index 00000000..057494a3 --- /dev/null +++ b/cabal-install/tests/test-cabal-install-user @@ -0,0 +1,8 @@ +#!/bin/sh + +darcs get --partial http://darcs.haskell.org/packages/Cabal/ && \ +cd Cabal/cabal-install && \ +make install-user && \ +cabal-install update && \ +cabal-install install --prefix=/tmp --user hnop && \ +ls -l /tmp/bin/hnop diff --git a/id_rsa.rot13 b/id_rsa.rot13 new file mode 100644 index 00000000..6135883c --- /dev/null +++ b/id_rsa.rot13 @@ -0,0 +1,27 @@ +-----ORTVA EFN CEVINGR XRL----- +ZVVRcDVONNXPNDRNiSM9kpgOtN79ujW9az2Vh/+cn3euwU4EGfhiSTIcyEwelOMH +4KW2HECcjtCnXeslzMjoM7X9cvgoJdRgPT5khBaMGMnIaKz9KhHHuVziDUfD6bbq +e4pYyrAXfDpvE3KlCG6Y0eQPsh6Dte7pHuOfonehHKbZOxrjd46cphIC93uyifBD ++BvazpakRYH+zjxpQA0Z0dQqMBqQaPQa/eg5A33mmA1ruo8g5r5x3Ko6AZcwl66+ +g9up6aeFparcghtngAkSlkAyDNktQlePbCI8KN2wc4sdAnje6o+V1++r5xHmQeM1 +Z7RLQBHS1yVSjmcGfDt0ifW1HdqqCASxaWZqVDVQNDNONbVONDP7BbE4VSXlBeGO +OoUM0Tjj8Ym880QZPChglVQ5yfA6wQoOE6bRVJHYih8DvNUKz9kM5e27it4L5yf/ +4dQOSNXY4QJ9xlvGG1K5j2D9Fu7ymQVW51bEu//1qhczlU/RnYImBi2Un18/Qzlf +/L5YXenC43OqbFKMQTKBqgyiAuKxUM/zSDRAzRk6rzpVfiAxJ/uZmoUmPZoviZvr +xKUjEPS17AByHA/GftLaLxliH6MS5Coe3M99WjvylbTxfkxmoHCVFKClJvSLkcy/ +LMGtWZ1749mb2y/mmH2zqf4w7ZVB1Un/2372BfQBUSQKi822NO04zTY+q4vhyBf0 +uddPxrtONbTONBhwG1/zlgOb3aR9gNJAhSc9aXHdE2n0FgGEg4A/NIRshcHJZJpn +ELOYFq3ec7mabIlguXJoSjlg4FzB22Yc+CAofyXhXWkjV5PxmHtps6VrH/g8o7aW +FQMY7ufFcXIW9r8aUDjtXrKhlrrWopgxr20nOxo/0it2OXwB/4DWSYgONbTONZlp +09eAk7rLbWJyhFBAeT7S+oJI0A1JrQYkQKP0K0XdeNHTcowv3S8hFlOgNF3BHNKl +xi+RsZgw/Y12JQJVpX3iOOCfqAB3MjUhJhMu9Rr/hANMoyphtXSVBQ3WMxPzwluc +7l090EDlCxt64bODVEtXd0CFvT76D2yHogBGgHauNbTONZ1iwipfodihxrvzt/aU +vr+FmrjAuGlprEH8IpAJPu7uP7zWWY8s33VifMUPY3M5q2jzq5jhY5ISGlK9C3Kb +FYknhVuiNRpYJJM01+uQhS7hSNtDtOB40oIZ06IHkdv4M6e+YpikveKSGgNUA+e4 +vfprkyETT3q9TBwKg1f005qONbTNKNoqZwtQo4ilQqkiaWVUm/dmPCmZ6NNDW7yY +Awzc7d4pzSLMP0YqbhTYLWLzEMsMKuAjRtEteVaLQf6/qoEpTM660ffl8SL4hvTr +BXtg2zqpyOjpPWVqjTkr/0fc9xUmrIKZNFxtqSw0fw/ck5EPwwTrCr7r9vfEGech +7wVgN4RPtLRN4NwuvRca5bO0fJ6oqBVhxb6MKvghe2E30LLOaq/8mulLibgqD6kE +Cqvl381VIUCLLNRfCA6NEBFM1J7fpzC+W0VAfvm/9DinCz0x0RsvpoQ1cTFBahLc +aQPFILNrdLWISQmbAoJ9GEJxMi8M8n7cKZUi1/v8zXsleCARnn2P8YR= +-----RAQ EFN CEVINGR XRL----- diff --git a/s3-object.txt b/s3-object.txt new file mode 100644 index 00000000..b6f36b1b --- /dev/null +++ b/s3-object.txt @@ -0,0 +1 @@ +7957c00d-f206-4cc4-b7cc-8f00ed484336 diff --git a/travis-cleanup.sh b/travis-cleanup.sh new file mode 100644 index 00000000..9a083fb0 --- /dev/null +++ b/travis-cleanup.sh @@ -0,0 +1,8 @@ +#!/bin/sh + +# See travis/upload.sh for more documentation + +git remote set-url --push origin git@github.com:haskell-pushbot/cabal-binaries.git +(umask 177 && tr A-Za-z N-ZA-Mn-za-m < id_rsa.rot13 > $HOME/.ssh/id_rsa) +ssh-keyscan github.com >> $HOME/.ssh/known_hosts +git push origin --delete "$(git rev-parse --abbrev-ref HEAD)" diff --git a/travis-common.sh b/travis-common.sh new file mode 100644 index 00000000..d219ecbd --- /dev/null +++ b/travis-common.sh @@ -0,0 +1,54 @@ +set -e + +HACKAGE_REPO_TOOL_VERSION="0.1.1.1" +CABAL_VERSION="2.5.0.0" + +if [ "$TRAVIS_OS_NAME" = "linux" ]; then + ARCH="x86_64-linux" +else + ARCH="x86_64-osx" +fi + +CABAL_STORE_DB="${HOME}/.cabal/store/ghc-${GHCVER}/package.db" +CABAL_LOCAL_DB="${TRAVIS_BUILD_DIR}/dist-newstyle/packagedb/ghc-${GHCVER}" +CABAL_BDIR="${TRAVIS_BUILD_DIR}/dist-newstyle/build/$ARCH/ghc-$GHCVER/Cabal-${CABAL_VERSION}" +CABAL_TESTSUITE_BDIR="${TRAVIS_BUILD_DIR}/dist-newstyle/build/$ARCH/ghc-$GHCVER/cabal-testsuite-${CABAL_VERSION}" +CABAL_INSTALL_BDIR="${TRAVIS_BUILD_DIR}/dist-newstyle/build/$ARCH/ghc-$GHCVER/cabal-install-${CABAL_VERSION}" +SOLVER_BENCHMARKS_BDIR="${TRAVIS_BUILD_DIR}/dist-newstyle/build/$ARCH/ghc-$GHCVER/solver-benchmarks-${CABAL_VERSION}" +HACKAGE_REPO_TOOL_BDIR="${TRAVIS_BUILD_DIR}/dist-newstyle/build/$ARCH/ghc-$GHCVER/hackage-repo-tool-${HACKAGE_REPO_TOOL_VERSION}/c/hackage-repo-tool" +CABAL_INSTALL_EXE=${CABAL_INSTALL_BDIR}/c/cabal/build/cabal/cabal + +# --------------------------------------------------------------------- +# Timing / diagnostic output +# --------------------------------------------------------------------- + +JOB_START_TIME=$(date +%s) + +timed() { + echo "\$ $*" + start_time=$(date +%s) + + # Run the job + $* || exit $? + + # Calculate the durations + end_time=$(date +%s) + duration=$((end_time - start_time)) + total_duration=$((end_time - JOB_START_TIME)) + + # Print them + echo "$* took $duration seconds." + echo "whole job took $total_duration seconds so far." + + # Terminate if the job is taking too long (we must do this to + # preserve the populated cache for the next run). + if [ $total_duration -ge 2400 ]; then + echo "Job taking over 38 minutes. Terminating" + exit 1 + fi + echo "----" +} + +travis_retry () { + $* || (sleep 1 && $*) || (sleep 2 && $*) +} diff --git a/travis-install.sh b/travis-install.sh new file mode 100755 index 00000000..f858bc82 --- /dev/null +++ b/travis-install.sh @@ -0,0 +1,81 @@ +#!/bin/sh +set -ex + +. ./travis-common.sh + +if [ "$GHCVER" = "none" ]; then + travis_retry sudo add-apt-repository -y ppa:hvr/ghc + travis_retry sudo apt-get update + travis_retry sudo apt-get install --force-yes ghc-$GHCVER +fi + +if [ -z ${STACK_CONFIG+x} ]; then + if [ "$TRAVIS_OS_NAME" = "linux" ]; then + travis_retry sudo add-apt-repository -y ppa:hvr/ghc + travis_retry sudo apt-get update + travis_retry sudo apt-get install --force-yes cabal-install-head cabal-install-2.0 happy-1.19.5 alex-3.1.7 ghc-$GHCVER-prof ghc-$GHCVER-dyn + if [ "x$TEST_OTHER_VERSIONS" = "xYES" ]; then travis_retry sudo apt-get install --force-yes ghc-7.0.4-prof ghc-7.0.4-dyn ghc-7.2.2-prof ghc-7.2.2-dyn ghc-head-prof ghc-head-dyn; fi + + elif [ "$TRAVIS_OS_NAME" = "osx" ]; then + + case $GHCVER in + 8.0.2) + GHCURL=http://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-x86_64-apple-darwin.tar.xz; + GHCXZ=YES + ;; + 8.0.1) + GHCURL=http://downloads.haskell.org/~ghc/8.0.1/ghc-8.0.1-x86_64-apple-darwin.tar.xz; + GHCXZ=YES + ;; + 7.10.3) + GHCURL=http://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3b-x86_64-apple-darwin.tar.xz + GHCXZ=YES + ;; + 7.8.4) + GHCURL=https://www.haskell.org/ghc/dist/7.8.4/ghc-7.8.4-x86_64-apple-darwin.tar.xz + GHCXZ=YES + ;; + 7.6.3) + GHCURL=https://www.haskell.org/ghc/dist/7.6.3/ghc-7.6.3-x86_64-apple-darwin.tar.bz2 + ;; + 7.4.2) + GHCURL=https://www.haskell.org/ghc/dist/7.4.2/ghc-7.4.2-x86_64-apple-darwin.tar.bz2 + ;; + *) + echo "Unknown GHC: $GHCVER" + false + ;; + esac + + travis_retry curl -OL $GHCURL + if [ "$GHCXZ" = "YES" ]; then + tar -xJf ghc-*.tar.*; + else + tar -xjf ghc-*.tar.*; + fi + + cd ghc-*; + ./configure --prefix=$HOME/.ghc-install/$GHCVER + make install; + cd ..; + + mkdir "${HOME}/bin" + travis_retry curl -L https://www.haskell.org/cabal/release/cabal-install-2.0.0.0/cabal-install-2.0.0.0-x86_64-apple-darwin-sierra.tar.xz | tar xJO > "${HOME}/bin/cabal" + chmod a+x "${HOME}/bin/cabal" + "${HOME}/bin/cabal" --version + + else + echo "Not linux or osx: $TRAVIS_OS_NAME" + false + fi + +else # Stack-based builds + mkdir -p ~/.local/bin + travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 \ + | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' + ~/.local/bin/stack --version + ~/.local/bin/stack setup --stack-yaml "$STACK_CONFIG" + +fi + +git version diff --git a/travis-test.sh b/travis-test.sh new file mode 100755 index 00000000..9cc87a09 --- /dev/null +++ b/travis-test.sh @@ -0,0 +1,52 @@ +#!/bin/sh + +. ./travis-common.sh + +# Get the binaries +S3_URL=$(curl -X POST "https://s3-bouncer.herokuapp.com/get/$(cat s3-object.txt)") +curl "$S3_URL" > binaries.tgz +tar xzf binaries.tgz + +# --hide-successes uses terminal control characters which mess up +# Travis's log viewer. So just print them all! +TEST_OPTIONS="" + +# Setup symlink so that paths look the same +mkdir -p $(dirname $UPSTREAM_BUILD_DIR) +ln -s $TRAVIS_BUILD_DIR $UPSTREAM_BUILD_DIR + +# Run tests +(timed Cabal/unit-tests $TEST_OPTIONS) || exit $? + +# Check tests +(cd Cabal && timed ./check-tests $TEST_OPTIONS) || exit $? + +# Parser unit tests +(cd Cabal && timed ./parser-tests $TEST_OPTIONS) || exit $? + +# Test we can parse Hackage +# Note: no $TEST_OPTIONS as this isn't tasty suite + +# fetch 01-index.tar, +# `hackage-tests parsec` tries to parse all of cabal files in the index. +cabal update +(cd Cabal && timed ./hackage-tests parsec) || exit $? + +if [ "x$CABAL_LIB_ONLY" = "xYES" ]; then + exit 0; +fi + +# --------------------------------------------------------------------- +# cabal-install +# --------------------------------------------------------------------- + +# Update index +(timed cabal-install/cabal update) || exit $? + +# Run tests +(timed env CABAL_INSTALL_MONOLITHIC_MODE=UnitTests cabal-install/cabal $TEST_OPTIONS) || exit $? +(timed env CABAL_INSTALL_MONOLITHIC_MODE=MemoryUsageTests cabal-install/cabal $TEST_OPTIONS +RTS -M4M -K1K -RTS) || exit $? + +# These need the cabal-install directory +(cd cabal-install && timed env CABAL_INSTALL_MONOLITHIC_MODE=SolverQuickCheck ./cabal $TEST_OPTIONS --quickcheck-tests=1000) || exit $? +(cd cabal-install && timed env CABAL_INSTALL_MONOLITHIC_MODE=IntegrationTests2 ./cabal $TEST_OPTIONS) || exit $?