hasufell
/
ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Bring test suite up to date

This commit is contained in:
Daniel Gröber 2015-03-05 16:50:06 +01:00
parent f0ea445a9b
commit 01dde80385
65 changed files with 641 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
.travis.yml
View File

@ -5,12 +5,13 @@ ghc:
- 7.8
install:
- sudo apt-get install zlib1g-dev
- cabal update
# - ( $CABAL122 && cabal install cabal-install --constraint "Cabal >= 1.22" && ghc-pkg unregister Cabal ) || true
- echo $PATH
- which cabal
- cabal install happy --constraint 'transformers <= 0.3.0.0'
- cabal install Cabal --constraint "Cabal == $(cabal --version | grep 'Cabal library' | awk '{ print $3 }' | awk -vFS=. '{ print $1 "." $2 }' | tail -n1).*"
- cabal install cabal-install --constraint "Cabal == $(cabal --version | grep 'Cabal library' | awk '{ print $3 }' | awk -vFS=. '{ print $1 "." $2 }' | tail -n1).*"
# - cabal install Cabal --constraint "Cabal == $(cabal --version | grep 'Cabal library' | awk '{ print $3 }' | tail -n1)"
- happy --version
- cabal install -j --only-dependencies --enable-tests
@ -25,6 +26,8 @@ script:
- if [ -n "$(ghc --version | awk '{ print $8 }' | sed -n '/^7.8/p')" ]; then export WERROR="--ghc-option=-Werror"; fi
- cabal configure --enable-tests $WERROR
- cabal build
- export ghc_mod_libexecdir=$PWD/dist/build/cabal-helper-wrapper
- export ghc_mod_datadir=$PWD
- cabal test
matrix:

4
CabalHelper/Common.hs
View File

@ -18,7 +18,7 @@
module CabalHelper.Common where
import Control.Applicative
import Control.Exception
import Control.Exception as E
import Control.Monad
import Data.List
import Data.Maybe
@ -40,7 +40,7 @@ panic msg = throw $ Panic msg
handlePanic :: IO a -> IO a
handlePanic action =
action `catch` \(Panic msg) -> errMsg msg >> exitFailure
action `E.catch` \(Panic msg) -> errMsg msg >> exitFailure
errMsg :: String -> IO ()
errMsg str = do

2
CabalHelper/Main.hs
View File

@ -114,7 +114,7 @@ main = do
errMsg $ "distdir '"++distdir++"' does not exist"
exitFailure
v <- maybe silent (const deafening) <$> lookupEnv "GHC_MOD_DEBUG"
v <- maybe silent (const deafening) . lookup "GHC_MOD_DEBUG" <$> getEnvironment
lbi <- unsafeInterleaveIO $ getPersistBuildConfig distdir
let pd = localPkgDescr lbi

25
CabalHelper/Wrapper.hs
View File

@ -19,6 +19,7 @@ module Main where
import Control.Applicative
import Control.Arrow
import Control.Exception as E
import Control.Monad
import Control.Monad.Trans.Maybe
import Data.Char
@ -133,7 +134,8 @@ compileHelper cabalVer = do
else do
-- otherwise compile the requested cabal version into an isolated
-- package-db
db <- installCabal cabalVer
db <- installCabal cabalVer `E.catch`
\(SomeException _) -> errorInstallCabal cabalVer
compileWithPkg chdir (Just db)
Just _ ->
compileWithPkg chdir Nothing
@ -149,12 +151,27 @@ compileHelper cabalVer = do
-- errorNoCabal :: Version -> a
-- errorNoCabal cabalVer = panic $ printf "\
-- \No appropriate Cabal package found, wanted version %s.\n\
-- \- Check output of: $ ghc-pkg list Cabal\n\
-- \- Maybe try: $ cabal install Cabal --constraint 'Cabal == %s'" sver sver
-- \No appropriate Cabal package found, wanted version %s.\n"
-- where
-- sver = showVersion cabalVer
errorInstallCabal :: Version -> a
errorInstallCabal cabalVer = panic $ printf "\
\Installing Cabal version %s failed.\n\
\n\
\You have two choices now:\n\
\- Either you install this version of Cabal in your globa/luser package-db\n\
\ somehow\n\
\n\
\- Or you can see if you can update your cabal-install to use a different\n\
\ version of the Cabal library that we can build with:\n\
\ $ cabal install cabal-install --constraint 'Cabal > %s'\n\
\n\
\To check the version cabal-install is currently using try:\n\
\ $ cabal --version\n" sver sver
where
sver = showVersion cabalVer
errorNoMain :: FilePath -> a
errorNoMain datadir = panic $ printf "\
\Could not find $datadir/CabalHelper/Main.hs!\n\

4
Language/Haskell/GhcMod/CabalHelper.hs
View File

@ -29,7 +29,7 @@ import Data.Monoid
import Data.List
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Monad.Types
import Language.Haskell.GhcMod.Error
import Language.Haskell.GhcMod.Error as E
import Language.Haskell.GhcMod.Utils
import Language.Haskell.GhcMod.World
import Language.Haskell.GhcMod.PathsAndFiles
@ -93,7 +93,7 @@ cabalHelper = withCabal $ do
res <- liftIO $ cached cradleRootDir (cabalHelperCache cmds) $ do
out <- readProcess exe (distdir:cmds) ""
evaluate (read out) `catch`
evaluate (read out) `E.catch`
\(SomeException _) -> error "cabalHelper: read failed"
let [ Just (GmCabalHelperEntrypoints eps),

8
Language/Haskell/GhcMod/Doc.hs
View File

@ -11,10 +11,10 @@ showPage dflag style = showDocWith dflag PageMode . withStyle dflag style
showOneLine :: DynFlags -> PprStyle -> SDoc -> String
showOneLine dflag style = showDocWith dflag OneLineMode . withStyle dflag style
showForUser :: DynFlags -> PrintUnqualified -> SDoc -> String
showForUser dflags unqual sdoc =
showDocWith dflags PageMode $
runSDoc sdoc $ initSDocContext dflags $ mkUserStyle unqual AllTheWay
-- showForUser :: DynFlags -> PrintUnqualified -> SDoc -> String
-- showForUser dflags unqual sdoc =
-- showDocWith dflags PageMode $
-- runSDoc sdoc $ initSDocContext dflags $ mkUserStyle unqual AllTheWay
getStyle :: GhcMonad m => m PprStyle
getStyle = do

4
Language/Haskell/GhcMod/Find.hs
View File

@ -38,8 +38,8 @@ import System.IO
#endif
#if MIN_VERSION_containers(0,5,0)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Map (Map)
import qualified Data.Map as M
#else
import Data.Map (Map)
import qualified Data.Map as M

32
Language/Haskell/GhcMod/Gap.hs
View File

@ -39,6 +39,7 @@ module Language.Haskell.GhcMod.Gap (
, listVisibleModuleNames
, listVisibleModules
, Language.Haskell.GhcMod.Gap.isSynTyCon
, parseModuleHeader
) where
import Control.Applicative hiding (empty)
@ -96,6 +97,13 @@ import PackageConfig (PackageConfig, packageConfigId)
import qualified Data.IntSet as I (IntSet, empty)
#endif
import Bag
import Lexer as L
import Parser
import SrcLoc
----------------------------------------------------------------
----------------------------------------------------------------
--
@ -487,3 +495,27 @@ isSynTyCon = GHC.isTypeSynonymTyCon
#else
isSynTyCon = GHC.isSynTyCon
#endif
parseModuleHeader
:: String -- ^ Haskell module source text (full Unicode is supported)
-> DynFlags
-> FilePath -- ^ the filename (for source locations)
-> Either ErrorMessages (WarningMessages, Located (HsModule RdrName))
parseModuleHeader str dflags filename =
let
loc = mkRealSrcLoc (mkFastString filename) 1 1
buf = stringToStringBuffer str
in
case L.unP Parser.parseHeader (mkPState dflags buf loc) of
PFailed sp err ->
#if __GLASGOW_HASKELL__ >= 706
Left (unitBag (mkPlainErrMsg dflags sp err))
#else
Left (unitBag (mkPlainErrMsg sp err))
#endif
POk pst rdr_module ->
let (warns,_) = getMessages pst in
Right (warns, rdr_module)

32
Language/Haskell/GhcMod/HomeModuleGraph.hs
View File

@ -30,19 +30,13 @@ module Language.Haskell.GhcMod.HomeModuleGraph (
, moduleGraphToDot
) where
import Bag
import DriverPipeline hiding (unP)
import DriverPipeline
import ErrUtils
import Exception
import FastString
import Finder
import GHC
import HscTypes
import Lexer
import MonadUtils hiding (foldrM)
import Parser
import SrcLoc
import StringBuffer
import Control.Arrow ((&&&))
import Control.Monad
@ -51,8 +45,8 @@ import Control.Monad.State.Strict (execStateT)
import Control.Monad.State.Class
import Data.Maybe
import Data.Monoid
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import System.FilePath
@ -61,6 +55,7 @@ import Language.Haskell.GhcMod.Logging
import Language.Haskell.GhcMod.Logger
import Language.Haskell.GhcMod.Monad.Types
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Gap (parseModuleHeader)
-- | Turn module graph into a graphviz dot file
--
@ -249,22 +244,3 @@ fileModuleName env fn = handle (\(_ :: SomeException) -> return $ Right Nothing)
Right (_, lmdl) -> do
let HsModule {..} = unLoc lmdl
return $ Right $ unLoc <$> hsmodName
parseModuleHeader
:: String -- ^ Haskell module source text (full Unicode is supported)
-> DynFlags
-> FilePath -- ^ the filename (for source locations)
-> Either ErrorMessages (WarningMessages, Located (HsModule RdrName))
parseModuleHeader str dflags filename =
let
loc = mkRealSrcLoc (mkFastString filename) 1 1
buf = stringToStringBuffer str
in
case unP Parser.parseHeader (mkPState dflags buf loc) of
PFailed sp err ->
Left (unitBag (mkPlainErrMsg dflags sp err))
POk pst rdr_module ->
let (warns,_) = getMessages pst in
Right (warns, rdr_module)

2
Language/Haskell/GhcMod/Monad/Types.hs
View File

@ -17,7 +17,7 @@
{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, RankNTypes #-}
{-# LANGUAGE TypeFamilies, UndecidableInstances, BangPatterns #-}
{-# LANGUAGE StandaloneDeriving, InstanceSigs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Language.Haskell.GhcMod.Monad.Types (

12
Language/Haskell/GhcMod/Target.hs
View File

@ -36,13 +36,14 @@ import Language.Haskell.GhcMod.GhcPkg
import Language.Haskell.GhcMod.Error
import Language.Haskell.GhcMod.Logging
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Utils
import Data.Maybe
import Data.Either
import Data.Foldable (foldrM)
import Data.IORef
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
@ -51,8 +52,7 @@ import System.FilePath
withLightHscEnv :: forall m a. IOish m
=> [GHCOption] -> (HscEnv -> m a) -> m a
withLightHscEnv opts action = gbracket initEnv teardownEnv (action)
withLightHscEnv opts action = gbracket initEnv teardownEnv action
where
teardownEnv :: HscEnv -> m ()
teardownEnv env = liftIO $ do
@ -241,7 +241,7 @@ resolveEntrypoints env srcDirs ms =
resolve :: Either FilePath ModuleName -> IO (Maybe ModulePath)
resolve (Right mn) = findModulePath env mn
resolve (Left fn') = do
mfn <- findFile srcDirs fn'
mfn <- findFile' srcDirs fn'
case mfn of
Nothing -> return Nothing
Just fn'' -> do
@ -253,6 +253,8 @@ resolveEntrypoints env srcDirs ms =
case mmn of
Nothing -> mkMainModulePath fn
Just mn -> ModulePath mn fn
findFile' dirs file =
mconcat <$> mapM (mightExist . (</>file)) dirs
resolveGmComponents :: (IOish m, GmState m, GmLog m, GmEnv m)
=> Maybe [Either FilePath ModuleName]

2
Language/Haskell/GhcMod/Utils.hs
View File

@ -128,7 +128,7 @@ libexecNotExitsError exe dir = printf
tryFindGhcModTreeLibexecDir :: IO (Maybe FilePath)
tryFindGhcModTreeLibexecDir = do
exe <- getExecutablePath
exe <- getExecutablePath'
dir <- case takeFileName exe of
"ghc" -> do -- we're probably in ghci; try CWD
getCurrentDirectory

14
NotCPP/Declarations.hs
View File

@ -22,7 +22,7 @@ module NotCPP.Declarations where
import Control.Arrow
import Control.Applicative
import Data.Maybe
import Language.Haskell.TH.Syntax hiding (lookupName)
import Language.Haskell.TH.Syntax
import NotCPP.LookupValueName
@ -39,10 +39,10 @@ recUpdE' :: Q Exp -> Name -> Exp -> Q Exp
recUpdE' ex name assign = do
RecUpdE <$> ex <*> pure [(name, assign)]
lookupName :: (NameSpace, String) -> Q (Maybe Name)
lookupName (VarName, n) = lookupValueName n
lookupName (DataName, n) = lookupValueName n
lookupName (TcClsName, n) = lookupTypeName n
lookupName' :: (NameSpace, String) -> Q (Maybe Name)
lookupName' (VarName, n) = lookupValueName n
lookupName' (DataName, n) = lookupValueName n
lookupName' (TcClsName, n) = lookupTypeName n
-- Does this even make sense?
ifelseD :: Q [Dec] -> Q [Dec] -> Q [Dec]
@ -90,14 +90,16 @@ ifD decls' = do
_ -> return [])
definedNames :: [(NameSpace, Name)] -> Q [Name]
definedNames ns = catMaybes <$> (lookupName . second nameBase) `mapM` ns
definedNames ns = catMaybes <$> (lookupName' . second nameBase) `mapM` ns
boundNames :: Dec -> [(NameSpace, Name)]
boundNames decl =
case decl of
SigD n _ -> [(VarName, n)]
FunD n _cls -> [(VarName, n)]
#if __GLASGOW_HASKELL__ >= 706
InfixD _ n -> [(VarName, n)]
#endif
ValD p _ _ -> map ((,) VarName) $ patNames p
TySynD n _ _ -> [(TcClsName, n)]

8
ghc-mod.cabal
View File

@ -37,6 +37,7 @@ Extra-Source-Files: ChangeLog
test/data/cabal-flags/cabal-flags.cabal
test/data/cabal-project/*.cabal
test/data/cabal-project/*.hs
test/data/cabal-project/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/Cabal-1.18.1.3-2b161c6bf77657aa17e1681d83cb051b.conf
test/data/cabal-project/cabal.sandbox.config.in
test/data/cabal-project/subdir1/subdir2/dummy
test/data/case-split/*.hs
@ -44,6 +45,8 @@ Extra-Source-Files: ChangeLog
test/data/check-packageid/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c.conf
test/data/check-test-subdir/*.cabal
test/data/check-test-subdir/src/Check/Test/*.hs
test/data/check-test-subdir/test/*.hs
test/data/check-test-subdir/test/Bar/*.hs
test/data/duplicate-pkgver/cabal.sandbox.config.in
test/data/duplicate-pkgver/duplicate-pkgver.cabal
test/data/duplicate-pkgver/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-1.0-7c59d13f32294d1ef6dc6233c24df961.conf
@ -195,9 +198,10 @@ Executable cabal-helper-wrapper
, bytestring
, binary
, containers
, Cabal >= 1.16
, Cabal >= 1.14
, directory
, filepath
, old-time
, process
, transformers
, template-haskell
@ -210,6 +214,8 @@ Test-Suite doctest
Ghc-Options: -Wall
Default-Extensions: ConstraintKinds, FlexibleContexts
Main-Is: doctests.hs
if impl(ghc == 7.4.*)
Buildable: False
Build-Depends: base
, doctest >= 0.9.3

70
test/CabalHelperSpec.hs Normal file
View File

@ -0,0 +1,70 @@
module CabalHelperSpec where
import Control.Arrow
import Control.Applicative
import Language.Haskell.GhcMod.CabalHelper
import Language.Haskell.GhcMod.PathsAndFiles
import Language.Haskell.GhcMod.Error
import Test.Hspec
import System.Directory
import System.FilePath
import System.Process (readProcess)
import Dir
import TestUtils
import Data.List
import Config (cProjectVersionInt)
ghcVersion :: Int
ghcVersion = read cProjectVersionInt
gmeProcessException :: GhcModError -> Bool
gmeProcessException GMEProcess {} = True
gmeProcessException _ = False
pkgOptions :: [String] -> [String]
pkgOptions [] = []
pkgOptions (_:[]) = []
pkgOptions (x:y:xs) | x == "-package-id" = [name y] ++ pkgOptions xs
| otherwise = pkgOptions (y:xs)
where
stripDash s = maybe s id $ (flip drop s . (+1) <$> findIndex (=='-') s)
name s = reverse $ stripDash $ stripDash $ reverse s
idirOpts :: [(c, [String])] -> [(c, [String])]
idirOpts = map (second $ map (drop 2) . filter ("-i"`isPrefixOf`))
spec :: Spec
spec = do
describe "getGhcOptions" $ do
it "throws an exception if the cabal file is broken" $ do
let tdir = "test/data/broken-caba"
runD' tdir getGhcOptions `shouldThrow` anyIOException
it "handles sandboxes correctly" $ do
let tdir = "test/data/cabal-project"
cwd <- getCurrentDirectory
opts <- runD' tdir getGhcOptions
if ghcVersion < 706
then forM_ opts (\(_, o) -> o `shouldContain` ["-no-user-package-conf","-package-conf", cwd </> "test/data/cabal-project/.cabal-sandbox/"++ghcSandboxPkgDbDir])
else forM_ opts (\(_, o) -> o `shouldContain` ["-no-user-package-db","-package-db",cwd </> "test/data/cabal-project/.cabal-sandbox/"++ghcSandboxPkgDbDir])
it "extracts build dependencies" $ do
let tdir = "test/data/cabal-project"
opts <- runD' tdir getGhcOptions
let ghcOpts = snd $ head opts
pkgs = pkgOptions ghcOpts
pkgs `shouldBe` ["Cabal","base","template-haskell"]
it "uses non default flags" $ do
let tdir = "test/data/cabal-flags"
_ <- withDirectory_ tdir $
readProcess "cabal" ["configure", "-ftest-flag"] ""
opts <- runD' tdir getGhcOptions
let ghcOpts = snd $ head opts
pkgs = pkgOptions ghcOpts
pkgs `shouldBe` ["Cabal","base"]

6
test/CheckSpec.hs
View File

@ -1,9 +1,10 @@
{-# LANGUAGE CPP #-}
module CheckSpec where
import Data.List (isInfixOf, isPrefixOf) --isSuffixOf,
import Language.Haskell.GhcMod
--import System.FilePath
import Data.List
import System.Process
import Test.Hspec
import TestUtils
@ -20,6 +21,7 @@ spec = do
it "works even if a module imports another module from a different directory" $ do
withDirectory_ "test/data/check-test-subdir" $ do
_ <- system "cabal configure --enable-tests"
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`)

180
test/HomeModuleGraphSpec.hs Normal file
View File

@ -0,0 +1,180 @@
-- ghc-mod: Making Haskell development *more* fun
-- Copyright (C) 2015 Daniel Gröber <dxld ÄT darkboxed DOT org>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
{-# LANGUAGE OverloadedStrings #-}
module HomeModuleGraphSpec where
import Language.Haskell.GhcMod.HomeModuleGraph
import Language.Haskell.GhcMod.Target
import TestUtils
import GHC
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Maybe
import Test.Hspec
runAGhc :: [GHCOption] -> (HscEnv -> LightGhc a) -> IO a
runAGhc opts action = withLightHscEnv opts $ \env -> do
runLightGhc env $ getSession >>= action
hmGraph :: FilePath -> [String] -> String -> IO GmModuleGraph
hmGraph dir opts mn = runAGhc opts $ \env -> liftIO $ do
runD' dir $ do
smp <- liftIO $ findModulePathSet env [mkModuleName mn]
homeModuleGraph env smp
uhmGraph :: FilePath -> [String] -> String -> String -> GmModuleGraph -> IO GmModuleGraph
uhmGraph dir opts mn umn g = runAGhc opts $ \env -> liftIO $ do
runD' dir $ do
smp <- liftIO $ findModulePathSet env [mkModuleName mn]
usmp <- liftIO $ findModulePathSet env [mkModuleName umn]
updateHomeModuleGraph env g smp usmp
mapMap :: (Ord k, Ord k')
=> (k -> k') -> (a -> a') -> Map.Map k a -> Map.Map k' a'
mapMap fk fa = Map.mapKeys fk . Map.map fa
mapMpFn :: (FilePath -> FilePath) -> ModulePath -> ModulePath
mapMpFn f (ModulePath mn fn) = ModulePath mn (f fn)
mp :: ModuleName -> ModulePath
mp mn = ModulePath mn $ moduleNameString mn ++ ".hs"
spec :: Spec
spec = do
describe "reachable" $ do
let
smp =
Set.fromList
[ mp "A"
, mp "B"
, mp "C"
, mp "D"
, mp "E"
, mp "F"
, mp "G"
, mp "H"
, mp "I"
]
fileMap = mkFileMap smp
moduleMap = mkModuleMap smp
completeGraph =
Map.map (Set.map lookupMM) . Map.mapKeys lookupMM
lookupMM = fromJust . flip Map.lookup moduleMap
graph = completeGraph $
Map.fromList
[ ("A", Set.fromList ["B"])
, ("B", Set.fromList ["C", "D"])
, ("C", Set.fromList ["F"])
, ("D", Set.fromList ["E"])
, ("E", Set.fromList [])
, ("F", Set.fromList [])
, ("G", Set.fromList [])
, ("H", Set.fromList [])
, ("I", Set.fromList [])
]
really_reachable =
Set.fromList
[ mp "A"
, mp "B"
, mp "C"
, mp "D"
, mp "E"
, mp "F"
]
g = GmModuleGraph {
gmgFileMap = fileMap,
gmgModuleMap = moduleMap,
gmgGraph = graph
}
it "reachable Set.empty g == Set.empty" $ do
reachable Set.empty g `shouldBe` Set.empty
it "lists only reachable nodes" $ do
reachable (Set.fromList [mp "A"]) g `shouldBe` really_reachable
describe "homeModuleGraph" $ do
it "cycles don't break it" $ do
let tdir = "test/data/home-module-graph/cycle"
g <- hmGraph tdir [] "A"
gmgGraph g `shouldBe`
Map.fromList
[ (mp "A", Set.fromList [mp "B"])
, (mp "B", Set.fromList [mp "A"])
]
it "follows imports" $ do
let tdir = "test/data/home-module-graph/indirect"
g <- hmGraph tdir [] "A"
gmgGraph g `shouldBe`
Map.fromList
[ (mp "A", Set.fromList [mp "A1", mp "A2", mp "A3"])
, (mp "A1", Set.fromList [mp "B"])
, (mp "A2", Set.fromList [mp "C"])
, (mp "A3", Set.fromList [mp "B"])
, (mp "B", Set.fromList [])
, (mp "C", Set.fromList [])
]
it "returns partial results on parse errors" $ do
let tdir = "test/data/home-module-graph/errors"
g <- hmGraph tdir [] "A"
gmgGraph g `shouldBe`
Map.fromList
[ (mp "A", Set.fromList [mp "A1", mp "A2", mp "A3"])
, (mp "A1", Set.fromList []) -- parse error here
, (mp "A2", Set.fromList [])
, (mp "A3", Set.fromList [mp "B"])
, (mp "B", Set.fromList [])
]
it "returns partial results on CPP errors" $ do
let tdir = "test/data/home-module-graph/cpp"
g <- hmGraph tdir [] "A"
gmgGraph g `shouldBe`
Map.fromList
[ (mp "A", Set.fromList [mp "A1", mp "A2", mp "A3"])
, (mp "A1", Set.fromList []) -- CPP error here
, (mp "A2", Set.fromList [])
, (mp "A3", Set.fromList [mp "B"])
, (mp "B", Set.fromList [])
]
describe "updateHomeModuleGraph" $ do
it "removes unreachable nodes" $ do
let tdir = "test/data/home-module-graph/indirect"
let tdir' = "test/data/home-module-graph/indirect-update"
ig <- hmGraph tdir [] "A"
g <- uhmGraph tdir' [] "A" "A2" ig
gmgGraph g `shouldBe`
Map.fromList
[ (mp "A", Set.fromList [mp "A1", mp "A2", mp "A3"])
, (mp "A1", Set.fromList [mp "B"])
, (mp "A2", Set.fromList [])
, (mp "A3", Set.fromList [mp "B"])
, (mp "B", Set.fromList [])
-- C was removed
]

35
test/TargetSpec.hs Normal file
View File

@ -0,0 +1,35 @@
{-# LANGUAGE OverloadedStrings #-}
module TargetSpec where
import Language.Haskell.GhcMod.Target
import Language.Haskell.GhcMod.Gap
import Test.Hspec
import TestUtils
import GHC
import Data.List
import Data.Maybe
spec :: Spec
spec = do
describe "runLightGhc" $ do
it "works at all" $ do
withLightHscEnv [] $ \env ->
runLightGhc env (return ()) `shouldReturn` ()
it "has modules in scope" $ do
withLightHscEnv [] $ \env ->
runLightGhc env $ do
dflags <- getSessionDynFlags
let i = intersect (listVisibleModuleNames dflags)
["Control.Applicative", "Control.Arrow"
,"Control.Exception", "GHC.Exts", "GHC.Float"]
liftIO $ i `shouldSatisfy` not . null
it "can get module info" $ do
withLightHscEnv [] $ \env ->
runLightGhc env $ do
mdl <- findModule "Data.List" Nothing
mmi <- getModuleInfo mdl
liftIO $ isJust mmi `shouldBe` True

6
test/data/annotations/With.hs Normal file
View File

@ -0,0 +1,6 @@
module Main where
{-# ANN module ["this", "can", "be", "anything"] #-}
main :: IO ()
main = putStrLn "Hello world!"

4
test/data/cabal-project/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/Cabal-1.18.1.3-2b161c6bf77657aa17e1681d83cb051b.conf Normal file
View File

@ -0,0 +1,4 @@
name: Cabal
version: 1.18.1.3
id: Cabal-1.18.1.3-2b161c6bf77657aa17e1681d83cb051b
exposed: True

0
test/data/cabal-project/.cabal-sandbox/packages/00-index.cache Normal file
View File

BIN
test/data/cabal-project/.cabal-sandbox/packages/00-index.tar Normal file
View File

Binary file not shown.

5
test/data/cabal-project/Baz.hs Normal file
View File

@ -0,0 +1,5 @@
{-# LANGUAGE QuasiQuotes #-}
module Baz (baz) where
import Foo (fooQ)
baz = [fooQ| foo bar baz |]

9
test/data/cabal-project/Foo.hs Normal file
View File

@ -0,0 +1,9 @@
module Foo (foo, fooQ) where
import Language.Haskell.TH
import Language.Haskell.TH.Quote (QuasiQuoter(..))
foo :: ExpQ
foo = stringE "foo"
fooQ :: QuasiQuoter
fooQ = QuasiQuoter (litE . stringL) undefined undefined undefined

8
test/data/cabal-project/Info.hs Normal file
View File

@ -0,0 +1,8 @@
{-# LANGUAGE TemplateHaskell #-} -- for HscInterpreted
module Info () where
fib :: Int -> Int
fib 0 = 0
fib 1 = 1
fib n = fib (n - 1) + fib (n - 2)

3
test/data/cabal-project/Main.hs Normal file
View File

@ -0,0 +1,3 @@
import Bar (bar)
main = putStrLn bar

25
test/data/cabal-project/cabal.sandbox.config.in Normal file
View File

@ -0,0 +1,25 @@
-- This is a Cabal package environment file.
-- THIS FILE IS AUTO-GENERATED. DO NOT EDIT DIRECTLY.
-- Please create a 'cabal.config' file in the same directory
-- if you want to change the default settings for this sandbox.
local-repo: @CWD@/test/data/cabal-project/.cabal-sandbox/packages
logs-dir: @CWD@/test/data/cabal-project/.cabal-sandbox/logs
world-file: @CWD@/test/data/cabal-project/.cabal-sandbox/world
user-install: False
package-db: @CWD@/test/data/cabal-project/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d
build-summary: @CWD@/test/data/cabal-project/.cabal-sandbox/logs/build.log
install-dirs
prefix: @CWD@/test/data/cabal-project/.cabal-sandbox
bindir: $prefix/bin
libdir: $prefix/lib
libsubdir: $arch-$os-$compiler/$pkgid
libexecdir: $prefix/libexec
datadir: $prefix/share
datasubdir: $arch-$os-$compiler/$pkgid
docdir: $datadir/doc/$arch-$os-$compiler/$pkgid
htmldir: $docdir/html
haddockdir: $htmldir
sysconfdir: $prefix/etc

67
test/data/cabal-project/cabalapi.cabal Normal file
View File

@ -0,0 +1,67 @@
Name: ghc-mod
Version: 1.11.3
Author: Kazu Yamamoto <kazu@iij.ad.jp>
Maintainer: Kazu Yamamoto <kazu@iij.ad.jp>
License: BSD3
License-File: LICENSE
Homepage: http://www.mew.org/~kazu/proj/ghc-mod/
Synopsis: Happy Haskell programming on Emacs/Vim
Description: This packages includes Elisp files
and a Haskell command, "ghc-mod".
"ghc*.el" enable completion of
Haskell symbols on Emacs.
Flymake is also integrated.
"ghc-mod" is a backend of "ghc*.el".
It lists up all installed modules
or extracts names of functions, classes,
and data declarations.
To use "ghc-mod" on Vim,
see <https://github.com/eagletmt/ghcmod-vim> or
<https://github.com/scrooloose/syntastic>
Category: Development
Cabal-Version: >= 1.6
Build-Type: Simple
Data-Dir: elisp
Data-Files: Makefile ghc.el ghc-func.el ghc-doc.el ghc-comp.el
ghc-flymake.el ghc-command.el ghc-info.el
ghc-ins-mod.el ghc-indent.el
Executable ghc-mod
Main-Is: GHCMod.hs
Other-Modules: Browse
CabalApi
Cabal
CabalDev
Check
ErrMsg
Flag
GHCApi
GHCChoice
Gap
Info
Lang
Lint
List
Paths_ghc_mod
Types
GHC-Options: -Wall
Build-Depends: base >= 4.0 && < 5
, Cabal >= 1.10
, template-haskell
Test-Suite spec
Main-Is: Spec.hs
Hs-Source-Dirs: test, .
Type: exitcode-stdio-1.0
Other-Modules: Expectation
BrowseSpec
CabalApiSpec
FlagSpec
LangSpec
LintSpec
ListSpec
Build-Depends: base >= 4.0 && < 5
, Cabal >= 1.10
Source-Repository head
Type: git
Location: git://github.com/kazu-yamamoto/ghc-mod.git

1
test/data/cabal-project/subdir1/subdir2/dummy Normal file
View File

@ -0,0 +1 @@
dummy

10
test/data/foreign-export/ForeignExport.hs Normal file
View File

@ -0,0 +1,10 @@
{-# LANGUAGE ForeignFunctionInterface #-}
module ForeignExport where
import Foreign.C.Types
foreign export ccall foo :: CUInt
foo :: CUInt
foo = 123

11
test/data/ghc-mod-check/lib/Data/Foo.hs Normal file
View File

@ -0,0 +1,11 @@
module Data.Foo where
foo :: Int
foo = undefined
fibonacci :: Int -> Integer
fibonacci n = fib 1 0 1
where
fib m x y
| n == m = y
| otherwise = fib (m+1) y (x + y)

5
test/data/hlint/hlint.hs Normal file
View File

@ -0,0 +1,5 @@
module Hlist where
main :: IO ()
main = do
putStrLn "Hello, world!"

4
test/data/home-module-graph/cpp/A.hs Normal file
View File

@ -0,0 +1,4 @@
module A where
import A1
import A2
import A3

4
test/data/home-module-graph/cpp/A1.hs Normal file
View File

@ -0,0 +1,4 @@
{-# LANGUAGE CPP #-}
module A1 where
#elif
import B

1
test/data/home-module-graph/cpp/A2.hs Normal file
View File

@ -0,0 +1 @@
module A2 where

2
test/data/home-module-graph/cpp/A3.hs Normal file
View File

@ -0,0 +1,2 @@
module A3 where
import B

1
test/data/home-module-graph/cpp/B.hs Normal file
View File

@ -0,0 +1 @@
module B where

2
test/data/home-module-graph/cycle/A.hs Normal file
View File

@ -0,0 +1,2 @@
module A where
import B

2
test/data/home-module-graph/cycle/B.hs Normal file
View File

@ -0,0 +1,2 @@
module B where
import A

4
test/data/home-module-graph/errors/A.hs Normal file
View File

@ -0,0 +1,4 @@
module A where
import A1
import A2
import A3

4
test/data/home-module-graph/errors/A1.hs Normal file
View File

@ -0,0 +1,4 @@
module A1 where
psogduapzsü9
import B
lxäö,vLMCks

1
test/data/home-module-graph/errors/A2.hs Normal file
View File

@ -0,0 +1 @@
module A2 where

2
test/data/home-module-graph/errors/A3.hs Normal file
View File

@ -0,0 +1,2 @@
module A3 where
import B

1
test/data/home-module-graph/errors/B.hs Normal file
View File

@ -0,0 +1 @@
module B where

4
test/data/home-module-graph/indirect-update/A.hs Normal file
View File

@ -0,0 +1,4 @@
module A where
import A1
import A2
import A3

2
test/data/home-module-graph/indirect-update/A1.hs Normal file
View File

@ -0,0 +1,2 @@
module A1 where
import B

1
test/data/home-module-graph/indirect-update/A2.hs Normal file
View File

@ -0,0 +1 @@
module A2 where

2
test/data/home-module-graph/indirect-update/A3.hs Normal file
View File

@ -0,0 +1,2 @@
module A3 where
import B

1
test/data/home-module-graph/indirect-update/B.hs Normal file
View File

@ -0,0 +1 @@
module B where

1
test/data/home-module-graph/indirect-update/C.hs Normal file
View File

@ -0,0 +1 @@
module C where

4
test/data/home-module-graph/indirect/A.hs Normal file
View File

@ -0,0 +1,4 @@
module A where
import A1
import A2
import A3

2
test/data/home-module-graph/indirect/A1.hs Normal file
View File

@ -0,0 +1,2 @@
module A1 where
import B

2
test/data/home-module-graph/indirect/A2.hs Normal file
View File

@ -0,0 +1,2 @@
module A2 where
import C

2
test/data/home-module-graph/indirect/A3.hs Normal file
View File

@ -0,0 +1,2 @@
module A3 where
import B

1
test/data/home-module-graph/indirect/B.hs Normal file
View File

@ -0,0 +1 @@
module B where

1
test/data/home-module-graph/indirect/C.hs Normal file
View File

@ -0,0 +1 @@
module C where

5
test/data/import-cycle/Mutual1.hs Normal file
View File

@ -0,0 +1,5 @@
{-# LANGUAGE TemplateHaskell #-} -- for HscInterpreted
module Mutual1 where
import Mutual2

3
test/data/import-cycle/Mutual2.hs Normal file
View File

@ -0,0 +1,3 @@
module Mutual2 where
import Mutual1

8
test/data/non-exported/Fib.hs Normal file
View File

@ -0,0 +1,8 @@
{-# LANGUAGE TemplateHaskell #-} -- for HscInterpreted
module Fib () where
fib :: Int -> Int
fib 0 = 0
fib 1 = 1
fib n = fib (n - 1) + fib (n - 2)

6
test/data/quasi-quotes/FooQ.hs Normal file
View File

@ -0,0 +1,6 @@
module FooQ (fooQ) where
import Language.Haskell.TH
import Language.Haskell.TH.Quote (QuasiQuoter(..))
fooQ :: QuasiQuoter
fooQ = QuasiQuoter (litE . stringL) undefined undefined undefined

6
test/data/quasi-quotes/QuasiQuotes.hs Normal file
View File

@ -0,0 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
module QuasiQuotes where
import FooQ
bar = [fooQ| foo bar baz |]

5
test/data/template-haskell/Bar.hs Normal file
View File

@ -0,0 +1,5 @@
{-# LANGUAGE TemplateHaskell #-}
module Bar (bar) where
import Foo (foo)
bar = $foo ++ "bar"

9
test/data/template-haskell/Foo.hs Normal file
View File

@ -0,0 +1,9 @@
module Foo (foo, fooQ) where
import Language.Haskell.TH
import Language.Haskell.TH.Quote (QuasiQuoter(..))
foo :: ExpQ
foo = stringE "foo"
fooQ :: QuasiQuoter
fooQ = QuasiQuoter (litE . stringL) undefined undefined undefined

3
test/data/template-haskell/ImportsTH.hs Normal file
View File

@ -0,0 +1,3 @@
import Bar (bar)
main = putStrLn bar

8
test/doctests.hs
View File

@ -1,11 +1,13 @@
{-# LANGUAGE CPP #-}
module Main where
import Test.DocTest
main :: IO ()
main = doctest [
"-package"
, "ghc"
main = doctest
[ "-package", "ghc"
, "-package", "transformers-" ++ VERSION_transformers
, "-package", "directory-" ++ VERSION_directory
, "-XConstraintKinds", "-XFlexibleContexts", "-XScopedTypeVariables", "-XRecordWildCards", "-XNamedFieldPuns"
, "-idist/build/autogen/"
, "-optP-include"