Merge pull request #263 from DanielG/dev-fix-262

Revert "Fix tests for Cabal <= 1.16"
This commit is contained in:
Kazu Yamamoto 2014-05-19 09:45:19 +09:00
commit 57392a238c
4 changed files with 10 additions and 29 deletions

View File

@ -1,4 +1,4 @@
{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables, TupleSections #-} {-# LANGUAGE BangPatterns, ScopedTypeVariables, TupleSections #-}
module Language.Haskell.GhcMod.GhcPkg ( module Language.Haskell.GhcMod.GhcPkg (
ghcPkgDbOpt ghcPkgDbOpt
, ghcPkgDbStackOpts , ghcPkgDbStackOpts
@ -10,15 +10,10 @@ module Language.Haskell.GhcMod.GhcPkg (
, getPackageDbStack , getPackageDbStack
) where ) where
#ifndef MIN_VERSION_Cabal
#define MIN_VERSION_Cabal(x,y,z) 1
#endif
import Config (cProjectVersionInt) import Config (cProjectVersionInt)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
#if MIN_VERSION_Cabal(1,18,0) import Control.Exception (SomeException(..))
import qualified Control.Exception as E import qualified Control.Exception as E
#endif
import Data.Char (isSpace) import Data.Char (isSpace)
import Data.List (isPrefixOf, intercalate) import Data.List (isPrefixOf, intercalate)
import Data.List.Split (splitOn) import Data.List.Split (splitOn)
@ -55,14 +50,9 @@ getPackageDbStack :: FilePath -- ^ Project Directory (where the
-- cabal.sandbox.config file would be if it -- cabal.sandbox.config file would be if it
-- exists) -- exists)
-> IO [GhcPkgDb] -> IO [GhcPkgDb]
#if MIN_VERSION_Cabal(1,18,0)
getPackageDbStack cdir = getPackageDbStack cdir =
(getSandboxDb cdir >>= \db -> return [GlobalDb, PackageDb db]) (getSandboxDb cdir >>= \db -> return [GlobalDb, PackageDb db])
`E.catch` \(_ :: E.SomeException) -> return [GlobalDb, UserDb] `E.catch` \(_ :: SomeException) -> return [GlobalDb, UserDb]
#else
getPackageDbStack _ =
return [GlobalDb, UserDb]
#endif
fromInstalledPackageId' :: InstalledPackageId -> Maybe Package fromInstalledPackageId' :: InstalledPackageId -> Maybe Package
fromInstalledPackageId' pid = let fromInstalledPackageId' pid = let

View File

@ -1,4 +1,4 @@
{-# LANGUAGE CPP, ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
module CabalApiSpec where module CabalApiSpec where
@ -36,15 +36,9 @@ spec = do
ghcOptions = ghcOptions res ghcOptions = ghcOptions res
, includeDirs = map (toRelativeDir dir) (includeDirs res) , includeDirs = map (toRelativeDir dir) (includeDirs res)
} }
#if MIN_VERSION_Cabal(1,18,0)
if ghcVersion < 706 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"] 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 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"] 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"] (pkgName `map` depPackages res') `shouldContain` ["Cabal"]

View File

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
module CradleSpec where module CradleSpec where
import Control.Applicative import Control.Applicative
@ -32,11 +31,7 @@ spec = do
cradleCurrentDir = "test" </> "data" </> "subdir1" </> "subdir2" cradleCurrentDir = "test" </> "data" </> "subdir1" </> "subdir2"
, cradleRootDir = "test" </> "data" , cradleRootDir = "test" </> "data"
, cradleCabalFile = Just ("test" </> "data" </> "cabalapi.cabal") , 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")] , 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 it "works even if a sandbox config file is broken" $ do
withDirectory "test/data/broken-sandbox" $ \dir -> do withDirectory "test/data/broken-sandbox" $ \dir -> do

View File

@ -10,12 +10,14 @@ import Test.Hspec
spec :: Spec spec :: Spec
spec = do spec = do
describe "getPackageDbStack" $ do describe "getSandboxDb" $ do
#if !MIN_VERSION_Cabal(1,18,0) -- ghc < 7.8
it "does not include a sandbox with Cabal < 1.18" $ do #if !MIN_VERSION_ghc(7,8,0)
it "does include a sandbox with ghc < 7.8" $ do
cwd <- getCurrentDirectory 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 #endif
it "parses a config file and extracts sandbox package db" $ do it "parses a config file and extracts sandbox package db" $ do
cwd <- getCurrentDirectory cwd <- getCurrentDirectory
pkgDb <- getSandboxDb "test/data/" pkgDb <- getSandboxDb "test/data/"