Bring test suite up to date

This commit is contained in:
Daniel Gröber 2015-02-07 16:41:15 +01:00
parent 417cacbf81
commit 36ed081d54
7 changed files with 99 additions and 38 deletions

View File

@ -28,5 +28,5 @@ spec = do
describe "`browse' in a project directory" $ do
it "lists symbols defined in a a local module (e.g. `Baz.baz)" $ do
withDirectory_ "test/data" $ do
syms <- runID $ lines <$> browse "Baz"
syms <- runD $ lines <$> browse "Baz"
syms `shouldContain` ["baz"]

View File

@ -40,20 +40,45 @@ spec = do
ghcOptions = ghcOptions res
, includeDirs = map (toRelativeDir dir) (includeDirs res)
}
let [fGlobalPkg, fNoUserPkg, fPkg, sb, _] = ghcOptions res'
sb `shouldSatisfy`
isPkgConfDAt (cwd </> "test/data/.cabal-sandbox")
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"]
includeDirs res' `shouldBe` ["test/data","test/data/dist/build","test/data/dist/build/autogen","test/data/subdir1/subdir2","test/data/test"]
then do
fGlobalPkg `shouldBe` "-global-package-conf"
fNoUserPkg `shouldBe` "-no-user-package-conf"
fPkg `shouldBe` "-package-conf"
else do
fGlobalPkg `shouldBe` "-global-package-db"
fNoUserPkg `shouldBe` "-no-user-package-db"
fPkg `shouldBe` "-package-db"
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"]
describe "cabalSourceDirs" $ do
it "extracts all hs-source-dirs" $ do
crdl <- findCradle' "test/data/check-test-subdir"
dirs <- cabalSourceDirs . cabalAllBuildInfo <$> runD (parseCabalFile crdl "test/data/check-test-subdir/check-test-subdir.cabal")
let cabalFile = "test/data/check-test-subdir/check-test-subdir.cabal"
dirs <- cabalSourceDirs . cabalAllBuildInfo
<$> runD (parseCabalFile crdl cabalFile)
dirs `shouldBe` ["src", "test"]
it "extracts all hs-source-dirs including \".\"" $ do
crdl <- findCradle' "test/data/"
dirs <- cabalSourceDirs . cabalAllBuildInfo <$> runD (parseCabalFile crdl "test/data/cabalapi.cabal")
dirs <- cabalSourceDirs . cabalAllBuildInfo
<$> runD (parseCabalFile crdl "test/data/cabalapi.cabal")
dirs `shouldBe` [".", "test"]
describe "cabalAllBuildInfo" $ do

View File

@ -14,38 +14,38 @@ spec = do
describe "checkSyntax" $ do
it "works even if an executable depends on the library defined in the same cabal file" $ do
withDirectory_ "test/data/ghc-mod-check" $ do
res <- runID $ checkSyntax ["main.hs"]
res <- runD $ checkSyntax ["main.hs"]
res `shouldBe` "main.hs:5:1:Warning: Top-level binding with no type signature: main :: IO ()\n"
it "works even if a module imports another module from a different directory" $ do
withDirectory_ "test/data/check-test-subdir" $ do
res <- runID $ checkSyntax ["test/Bar/Baz.hs"]
res <- runD $ checkSyntax ["test/Bar/Baz.hs"]
res `shouldSatisfy` (("test" </> "Foo.hs:3:1:Warning: Top-level binding with no type signature: foo :: [Char]\n") `isSuffixOf`)
it "detects cyclic imports" $ do
withDirectory_ "test/data" $ do
res <- runID $ checkSyntax ["Mutual1.hs"]
res <- runD $ checkSyntax ["Mutual1.hs"]
res `shouldSatisfy` ("Module imports form a cycle" `isInfixOf`)
it "works with modules using QuasiQuotes" $ do
withDirectory_ "test/data" $ do
res <- runID $ checkSyntax ["Baz.hs"]
res <- runD $ checkSyntax ["Baz.hs"]
res `shouldSatisfy` ("Baz.hs:5:1:Warning:" `isPrefixOf`)
#if __GLASGOW_HASKELL__ >= 708
it "works with modules using PatternSynonyms" $ do
withDirectory_ "test/data/pattern-synonyms" $ do
res <- runID $ checkSyntax ["B.hs"]
res <- runD $ checkSyntax ["B.hs"]
res `shouldSatisfy` ("B.hs:6:9:Warning:" `isPrefixOf`)
#endif
it "works with foreign exports" $ do
withDirectory_ "test/data" $ do
res <- runID $ checkSyntax ["ForeignExport.hs"]
res <- runD $ checkSyntax ["ForeignExport.hs"]
res `shouldBe` ""
context "when no errors are found" $ do
it "doesn't output an empty line" $ do
withDirectory_ "test/data/ghc-mod-check/Data" $ do
res <- runID $ checkSyntax ["Foo.hs"]
res <- runD $ checkSyntax ["Foo.hs"]
res `shouldBe` ""

View File

@ -9,6 +9,7 @@ import System.FilePath ((</>), pathSeparator)
import Test.Hspec
import Dir
import TestUtils
spec :: Spec
spec = do
@ -26,24 +27,37 @@ spec = do
cwd <- getCurrentDirectory
withDirectory "test/data/subdir1/subdir2" $ \dir -> do
res <- relativeCradle dir <$> findCradle
cradleCurrentDir res `shouldBe` "test" </> "data" </> "subdir1" </> "subdir2"
cradleCurrentDir res `shouldBe`
"test" </> "data" </> "subdir1" </> "subdir2"
cradleRootDir res `shouldBe` "test" </> "data"
cradleCabalFile res `shouldBe` Just ("test" </> "data" </> "cabalapi.cabal")
cradlePkgDbStack res `shouldBe` [GlobalDb, PackageDb (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")]
cradleCabalFile res `shouldBe`
Just ("test" </> "data" </> "cabalapi.cabal")
let [GlobalDb, sb] = cradlePkgDbStack res
sb `shouldSatisfy` isPkgDbAt (cwd </> "test/data/.cabal-sandbox")
it "works even if a sandbox config file is broken" $ do
withDirectory "test/data/broken-sandbox" $ \dir -> do
res <- relativeCradle dir <$> findCradle
cradleCurrentDir res `shouldBe` "test" </> "data" </> "broken-sandbox"
cradleRootDir res `shouldBe` "test" </> "data" </> "broken-sandbox"
cradleCabalFile res `shouldBe` Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
cradleCurrentDir res `shouldBe`
"test" </> "data" </> "broken-sandbox"
cradleRootDir res `shouldBe`
"test" </> "data" </> "broken-sandbox"
cradleCabalFile res `shouldBe`
Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
cradlePkgDbStack res `shouldBe` [GlobalDb, UserDb]
relativeCradle :: FilePath -> Cradle -> Cradle
relativeCradle dir cradle = cradle {
cradleCurrentDir = toRelativeDir dir $ cradleCurrentDir cradle
, cradleRootDir = toRelativeDir dir $ cradleRootDir cradle
, cradleCabalFile = toRelativeDir dir <$> cradleCabalFile cradle
relativeCradle dir crdl = crdl {
cradleCurrentDir = toRelativeDir dir $ cradleCurrentDir crdl
, cradleRootDir = toRelativeDir dir $ cradleRootDir crdl
, cradleCabalFile = toRelativeDir dir <$> cradleCabalFile crdl
}
-- Work around GHC 7.2.2 where `canonicalizePath "/"` returns "/.".

View File

@ -24,7 +24,7 @@ main = do
genGhcPkgCache dir = system $ "ghc-pkg recache --force -f" ++ dir
genSandboxCfg `mapM_` sandboxes
genGhcPkgCache `mapM_` pkgDirs
void $ system "find test -name setup-config -name ghc-mod.cache -exec rm {} \\;"
void $ system "find test \\( -name setup-config -o -name ghc-mod.cache \\) -exec rm {} \\;"
void $ system "cabal --version"
putStrLn $ "ghc-mod was built with Cabal version " ++ VERSION_Cabal
void $ system "ghc --version"

View File

@ -3,14 +3,13 @@ module PathsAndFilesSpec where
import Language.Haskell.GhcMod.PathsAndFiles
#if __GLASGOW_HASKELL__ <= 706
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.GhcPkg
#endif
import System.Directory
import System.Environment
import System.FilePath ((</>))
import System.FilePath
import Test.Hspec
import TestUtils
spec :: Spec
spec = do
@ -18,25 +17,29 @@ spec = do
-- ghc < 7.8
#if __GLASGOW_HASKELL__ <= 706
it "does include a sandbox with ghc < 7.8" $ do
cwd <- getCurrentDirectory
getPackageDbStack "test/data/" `shouldReturn` [GlobalDb, PackageDb $ cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"]
cwd <- getCurrentDirectory
[GlobalDb, sbPkgDb] <- getPackageDbStack "test/data/"
sbPkgDb `shouldSatisfy` isPkgDbAt (cwd </> "test/data/.cabal-sandbox")
#endif
it "can parse a config file and extract the sandbox package-db" $ do
cwd <- getCurrentDirectory
pkgDb <- getSandboxDb "test/data/"
pkgDb `shouldBe` Just (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")
Just db <- getSandboxDb "test/data/"
db `shouldSatisfy` isPkgDbAt (cwd </> "test/data/.cabal-sandbox")
it "returns Nothing if the sandbox config file is broken" $ do
getSandboxDb "test/data/broken-sandbox" `shouldReturn` Nothing
describe "getCabalFiles" $ do
it "doesn't think $HOME/.cabal is a cabal file" $ do
(getCabalFiles =<< getEnv "HOME") `shouldReturn` []
describe "findCabalFile" $ do
it "works" $ do
findCabalFile "test/data" `shouldReturn` Just "test/data/cabalapi.cabal"
it "finds cabal files in parent directories" $ do
findCabalFile "test/data/subdir1/subdir2" `shouldReturn` Just "test/data/cabalapi.cabal"
describe "findCabalSandboxDir" $ do
it "works" $ do
findCabalSandboxDir "test/data" `shouldReturn` Just "test/data"
it "finds sandboxes in parent directories" $ do
findCabalSandboxDir "test/data/subdir1/subdir2" `shouldReturn` Just "test/data"

View File

@ -3,10 +3,12 @@ module TestUtils (
, runD
, runD'
, runI
, runID
-- , runID
, runIsolatedGhcMod
, isolateCradle
, shouldReturnError
, isPkgDbAt
, isPkgConfDAt
, module Language.Haskell.GhcMod.Monad
, module Language.Haskell.GhcMod.Types
) where
@ -14,6 +16,8 @@ module TestUtils (
import Language.Haskell.GhcMod.Monad
import Language.Haskell.GhcMod.Types
import Data.List.Split
import System.FilePath
import Test.Hspec
isolateCradle :: IOish m => GhcModT m a -> GhcModT m a
@ -34,8 +38,8 @@ runIsolatedGhcMod opt action = do
extract $ runGhcModT opt $ isolateCradle action
-- | Run GhcMod in isolated cradle with default options
runID :: GhcModT IO a -> IO a
runID = runIsolatedGhcMod defaultOptions
--runID :: GhcModT IO a -> IO a
--runID = runIsolatedGhcMod defaultOptions
-- | Run GhcMod in isolated cradle
runI :: Options -> GhcModT IO a -> IO a
@ -61,3 +65,18 @@ shouldReturnError action = do
where
isLeft (Left _) = True
isLeft _ = False
isPkgConfD :: FilePath -> Bool
isPkgConfD d = let
(_dir, pkgconfd) = splitFileName d
in case splitOn "-" pkgconfd of
[_arch, _platform, _compiler, _compver, "packages.conf.d"] -> True
_ -> False
isPkgConfDAt :: FilePath -> FilePath -> Bool
isPkgConfDAt d d' | d == takeDirectory d' && isPkgConfD d' = True
isPkgConfDAt _ _ = False
isPkgDbAt :: FilePath -> GhcPkgDb -> Bool
isPkgDbAt d (PackageDb dir) = isPkgConfDAt d dir
isPkgDbAt _ _ = False