Merge pull request #263 from DanielG/dev-fix-262
Revert "Fix tests for Cabal <= 1.16"
This commit is contained in:
commit
57392a238c
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables, TupleSections #-}
|
||||
{-# LANGUAGE BangPatterns, ScopedTypeVariables, TupleSections #-}
|
||||
module Language.Haskell.GhcMod.GhcPkg (
|
||||
ghcPkgDbOpt
|
||||
, ghcPkgDbStackOpts
|
||||
@ -10,15 +10,10 @@ module Language.Haskell.GhcMod.GhcPkg (
|
||||
, getPackageDbStack
|
||||
) where
|
||||
|
||||
#ifndef MIN_VERSION_Cabal
|
||||
#define MIN_VERSION_Cabal(x,y,z) 1
|
||||
#endif
|
||||
|
||||
import Config (cProjectVersionInt)
|
||||
import Control.Applicative ((<$>))
|
||||
#if MIN_VERSION_Cabal(1,18,0)
|
||||
import Control.Exception (SomeException(..))
|
||||
import qualified Control.Exception as E
|
||||
#endif
|
||||
import Data.Char (isSpace)
|
||||
import Data.List (isPrefixOf, intercalate)
|
||||
import Data.List.Split (splitOn)
|
||||
@ -55,14 +50,9 @@ getPackageDbStack :: FilePath -- ^ Project Directory (where the
|
||||
-- cabal.sandbox.config file would be if it
|
||||
-- exists)
|
||||
-> IO [GhcPkgDb]
|
||||
#if MIN_VERSION_Cabal(1,18,0)
|
||||
getPackageDbStack cdir =
|
||||
(getSandboxDb cdir >>= \db -> return [GlobalDb, PackageDb db])
|
||||
`E.catch` \(_ :: E.SomeException) -> return [GlobalDb, UserDb]
|
||||
#else
|
||||
getPackageDbStack _ =
|
||||
return [GlobalDb, UserDb]
|
||||
#endif
|
||||
`E.catch` \(_ :: SomeException) -> return [GlobalDb, UserDb]
|
||||
|
||||
fromInstalledPackageId' :: InstalledPackageId -> Maybe Package
|
||||
fromInstalledPackageId' pid = let
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE CPP, ScopedTypeVariables #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module CabalApiSpec where
|
||||
|
||||
@ -36,15 +36,9 @@ spec = do
|
||||
ghcOptions = ghcOptions res
|
||||
, includeDirs = map (toRelativeDir dir) (includeDirs res)
|
||||
}
|
||||
#if MIN_VERSION_Cabal(1,18,0)
|
||||
if ghcVersion < 706
|
||||
then ghcOptions res' `shouldContain` ["-global-package-conf", "-no-user-package-conf","-package-conf",cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d","-XHaskell98"]
|
||||
else ghcOptions res' `shouldContain` ["-global-package-db", "-no-user-package-db","-package-db",cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d","-XHaskell98"]
|
||||
#else
|
||||
if ghcVersion < 706
|
||||
then ghcOptions res' `shouldContain` ["-global-package-conf", "-user-package-conf","-XHaskell98"]
|
||||
else ghcOptions res' `shouldContain` ["-global-package-db", "-user-package-db","-XHaskell98"]
|
||||
#endif
|
||||
includeDirs res' `shouldBe` ["test/data","test/data/dist/build","test/data/dist/build/autogen","test/data/subdir1/subdir2","test/data/test"]
|
||||
(pkgName `map` depPackages res') `shouldContain` ["Cabal"]
|
||||
|
||||
|
@ -1,4 +1,3 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
module CradleSpec where
|
||||
|
||||
import Control.Applicative
|
||||
@ -32,11 +31,7 @@ spec = do
|
||||
cradleCurrentDir = "test" </> "data" </> "subdir1" </> "subdir2"
|
||||
, cradleRootDir = "test" </> "data"
|
||||
, cradleCabalFile = Just ("test" </> "data" </> "cabalapi.cabal")
|
||||
#if MIN_VERSION_Cabal(1,18,0)
|
||||
, cradlePkgDbStack = [GlobalDb, PackageDb (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")]
|
||||
#else
|
||||
, cradlePkgDbStack = [GlobalDb, UserDb]
|
||||
#endif
|
||||
}
|
||||
it "works even if a sandbox config file is broken" $ do
|
||||
withDirectory "test/data/broken-sandbox" $ \dir -> do
|
||||
|
@ -10,12 +10,14 @@ import Test.Hspec
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "getPackageDbStack" $ do
|
||||
#if !MIN_VERSION_Cabal(1,18,0)
|
||||
it "does not include a sandbox with Cabal < 1.18" $ do
|
||||
describe "getSandboxDb" $ do
|
||||
-- ghc < 7.8
|
||||
#if !MIN_VERSION_ghc(7,8,0)
|
||||
it "does include a sandbox with ghc < 7.8" $ do
|
||||
cwd <- getCurrentDirectory
|
||||
getPackageDbStack cwd `shouldReturn` [GlobalDb, UserDb]
|
||||
getPackageDbStack "test/data/" `shouldReturn` [GlobalDb, PackageDb $ cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"]
|
||||
#endif
|
||||
|
||||
it "parses a config file and extracts sandbox package db" $ do
|
||||
cwd <- getCurrentDirectory
|
||||
pkgDb <- getSandboxDb "test/data/"
|
||||
|
Loading…
Reference in New Issue
Block a user