Fix tests

This commit is contained in:
Daniel Gröber 2015-08-31 08:01:20 +02:00
parent 0b65487e50
commit 4aa75818d8
10 changed files with 29 additions and 16 deletions

View File

@ -47,9 +47,9 @@ lineSep oopts = interpret lsep
-- | -- |
-- --
-- >>> toLisp defaultOptions "fo\"o" "" -- >>> toLisp (outputOpts defaultOptions) "fo\"o" ""
-- "\"fo\\\"o\"" -- "\"fo\\\"o\""
-- >>> toPlain defaultOptions "foo" "" -- >>> toPlain (outputOpts defaultOptions) "foo" ""
-- "foo" -- "foo"
instance ToString String where instance ToString String where
toLisp oopts = quote oopts toLisp oopts = quote oopts
@ -57,9 +57,9 @@ instance ToString String where
-- | -- |
-- --
-- >>> toLisp defaultOptions ["foo", "bar", "ba\"z"] "" -- >>> toLisp (outputOpts defaultOptions) ["foo", "bar", "ba\"z"] ""
-- "(\"foo\" \"bar\" \"ba\\\"z\")" -- "(\"foo\" \"bar\" \"ba\\\"z\")"
-- >>> toPlain defaultOptions ["foo", "bar", "baz"] "" -- >>> toPlain (outputOpts defaultOptions) ["foo", "bar", "baz"] ""
-- "foo\nbar\nbaz" -- "foo\nbar\nbaz"
instance ToString [String] where instance ToString [String] where
toLisp oopts = toSexp1 oopts toLisp oopts = toSexp1 oopts
@ -72,9 +72,9 @@ instance ToString [ModuleString] where
-- | -- |
-- --
-- >>> let inp = [((1,2,3,4),"foo"),((5,6,7,8),"bar")] :: [((Int,Int,Int,Int),String)] -- >>> let inp = [((1,2,3,4),"foo"),((5,6,7,8),"bar")] :: [((Int,Int,Int,Int),String)]
-- >>> toLisp defaultOptions inp "" -- >>> toLisp (outputOpts defaultOptions) inp ""
-- "((1 2 3 4 \"foo\") (5 6 7 8 \"bar\"))" -- "((1 2 3 4 \"foo\") (5 6 7 8 \"bar\"))"
-- >>> toPlain defaultOptions inp "" -- >>> toPlain (outputOpts defaultOptions) inp ""
-- "1 2 3 4 \"foo\"\n5 6 7 8 \"bar\"" -- "1 2 3 4 \"foo\"\n5 6 7 8 \"bar\""
instance ToString [((Int,Int,Int,Int),String)] where instance ToString [((Int,Int,Int,Int),String)] where
toLisp oopts = toSexp2 . map toS toLisp oopts = toSexp2 . map toS

View File

@ -21,6 +21,7 @@ module Language.Haskell.GhcMod.PathsAndFiles (
import Config (cProjectVersion) import Config (cProjectVersion)
import Control.Applicative import Control.Applicative
import Control.Exception as E
import Control.Monad import Control.Monad
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import Data.List import Data.List
@ -106,7 +107,7 @@ findExecutablesInDirectories' path binary =
readStack :: OutputOpts -> [String] -> MaybeT IO String readStack :: OutputOpts -> [String] -> MaybeT IO String
readStack oopts args = do readStack oopts args = do
stack <- MaybeT $ findExecutable "stack" stack <- MaybeT $ findExecutable "stack"
liftIO $ flip catch (\(e :: IOError) -> throw $ GMEStackBootrap $ show e) $ do liftIO $ flip E.catch (\(e :: IOError) -> throw $ GMEStackBootrap $ show e) $ do
evaluate =<< gmUnsafeReadProcess oopts stack args "" evaluate =<< gmUnsafeReadProcess oopts stack args ""
-- | Get path to sandbox config file -- | Get path to sandbox config file

View File

@ -3,6 +3,7 @@ module BrowseSpec where
import Control.Applicative import Control.Applicative
import Language.Haskell.GhcMod import Language.Haskell.GhcMod
import Test.Hspec import Test.Hspec
import Prelude
import TestUtils import TestUtils
import Dir import Dir

View File

@ -10,6 +10,7 @@ import Test.Hspec
import System.Directory import System.Directory
import System.FilePath import System.FilePath
import System.Process (readProcess, system) import System.Process (readProcess, system)
import Prelude
import Dir import Dir
import TestUtils import TestUtils

View File

@ -7,6 +7,7 @@ import Language.Haskell.GhcMod.Types
import System.Directory (canonicalizePath) import System.Directory (canonicalizePath)
import System.FilePath (pathSeparator) import System.FilePath (pathSeparator)
import Test.Hspec import Test.Hspec
import Prelude
import Dir import Dir
@ -35,14 +36,14 @@ spec = do
it "returns the current directory" $ do it "returns the current directory" $ do
withDirectory_ "/" $ do withDirectory_ "/" $ do
curDir <- stripLastDot <$> canonicalizePath "/" curDir <- stripLastDot <$> canonicalizePath "/"
res <- clean_ findCradle res <- clean_ $ findCradle (outputOpts defaultOptions)
cradleCurrentDir res `shouldBe` curDir cradleCurrentDir res `shouldBe` curDir
cradleRootDir res `shouldBe` curDir cradleRootDir res `shouldBe` curDir
cradleCabalFile res `shouldBe` Nothing cradleCabalFile res `shouldBe` Nothing
it "finds a cabal file and a sandbox" $ do it "finds a cabal file and a sandbox" $ do
withDirectory "test/data/cabal-project/subdir1/subdir2" $ \dir -> do withDirectory "test/data/cabal-project/subdir1/subdir2" $ \dir -> do
res <- relativeCradle dir <$> clean_ findCradle res <- relativeCradle dir <$> clean_ (findCradle (outputOpts defaultOptions))
cradleCurrentDir res `shouldBe` cradleCurrentDir res `shouldBe`
"test/data/cabal-project/subdir1/subdir2" "test/data/cabal-project/subdir1/subdir2"
@ -54,7 +55,7 @@ spec = do
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
res <- relativeCradle dir <$> clean_ findCradle res <- relativeCradle dir <$> clean_ (findCradle (outputOpts defaultOptions))
cradleCurrentDir res `shouldBe` cradleCurrentDir res `shouldBe`
"test" </> "data" </> "broken-sandbox" "test" </> "data" </> "broken-sandbox"

View File

@ -114,7 +114,7 @@ spec = do
it "should work even if file doesn't exist" $ do it "should work even if file doesn't exist" $ do
withDirectory_ "test/data/file-mapping" $ do withDirectory_ "test/data/file-mapping" $ do
let fm = [("Nonexistent.hs", "main = putStrLn \"Hello World!\"\n")] let fm = [("Nonexistent.hs", "main = putStrLn \"Hello World!\"\n")]
res <- run defaultOptions{logLevel=GmDebug} $ do res <- run defaultOptions $ do
mapM_ (uncurry loadMappedFileSource) fm mapM_ (uncurry loadMappedFileSource) fm
checkSyntax ["Nonexistent.hs"] checkSyntax ["Nonexistent.hs"]
res `shouldBe` "Nonexistent.hs:1:1:Warning: Top-level binding with no type signature: main :: IO ()\n" res `shouldBe` "Nonexistent.hs:1:1:Warning: Top-level binding with no type signature: main :: IO ()\n"
@ -224,7 +224,7 @@ spec = do
writeFile (tmpdir </> "Bar_Redir.hs") srcBar writeFile (tmpdir </> "Bar_Redir.hs") srcBar
let fm = [("Foo.hs", tmpdir </> "Foo_Redir.hs") let fm = [("Foo.hs", tmpdir </> "Foo_Redir.hs")
,("Bar.hs", tmpdir </> "Bar_Redir.hs")] ,("Bar.hs", tmpdir </> "Bar_Redir.hs")]
res <- run defaultOptions{logLevel = GmDebug} $ do res <- run defaultOptions $ do
mapM_ (uncurry loadMappedFile) fm mapM_ (uncurry loadMappedFile) fm
types "Bar.hs" 5 1 types "Bar.hs" 5 1
res `shouldBe` unlines ["5 1 5 20 \"[Char]\""] res `shouldBe` unlines ["5 1 5 20 \"[Char]\""]
@ -234,7 +234,7 @@ spec = do
withDirectory_ "test/data/file-mapping" $ do withDirectory_ "test/data/file-mapping" $ do
let fm = [("Foo.hs", srcFoo) let fm = [("Foo.hs", srcFoo)
,("Bar.hs", srcBar)] ,("Bar.hs", srcBar)]
res <- run defaultOptions{logLevel = GmDebug} $ do res <- run defaultOptions $ do
mapM_ (uncurry loadMappedFileSource) fm mapM_ (uncurry loadMappedFileSource) fm
types "Bar.hs" 5 1 types "Bar.hs" 5 1
res `shouldBe` unlines ["5 1 5 20 \"[Char]\""] res `shouldBe` unlines ["5 1 5 20 \"[Char]\""]

View File

@ -4,6 +4,7 @@ import Control.Applicative
import Language.Haskell.GhcMod import Language.Haskell.GhcMod
import Test.Hspec import Test.Hspec
import TestUtils import TestUtils
import Prelude
spec :: Spec spec :: Spec
spec = do spec = do

View File

@ -4,6 +4,7 @@ import Control.Applicative
import Language.Haskell.GhcMod import Language.Haskell.GhcMod
import Test.Hspec import Test.Hspec
import TestUtils import TestUtils
import Prelude
spec :: Spec spec :: Spec
spec = do spec = do

View File

@ -4,6 +4,7 @@ import Control.Applicative
import Language.Haskell.GhcMod import Language.Haskell.GhcMod
import Test.Hspec import Test.Hspec
import TestUtils import TestUtils
import Prelude
spec :: Spec spec :: Spec
spec = do spec = do

View File

@ -18,14 +18,17 @@ import Language.Haskell.GhcMod.Cradle
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import Control.Arrow import Control.Arrow
import Control.Category
import Control.Applicative import Control.Applicative
import Control.Monad.Error (ErrorT, runErrorT) import Control.Monad.Error (ErrorT, runErrorT)
import Control.Monad.Trans.Journal import Control.Monad.Trans.Journal
import Data.List.Split import Data.List.Split
import Data.Label
import Data.String import Data.String
import System.FilePath import System.FilePath
import System.Directory import System.Directory
import Test.Hspec import Test.Hspec
import Prelude hiding ((.))
import Exception import Exception
@ -56,7 +59,7 @@ runGhcModTSpec' :: IOish m
runGhcModTSpec' dir opt action = liftIO (canonicalizePath dir) >>= \dir' -> runGhcModTSpec' dir opt action = liftIO (canonicalizePath dir) >>= \dir' ->
withGhcModEnvSpec dir' opt $ \env -> do withGhcModEnvSpec dir' opt $ \env -> do
first (fst <$>) <$> runGhcModT'' env defaultGhcModState first (fst <$>) <$> runGhcModT'' env defaultGhcModState
(gmSetLogLevel (logLevel opt) >> action) (gmSetLogLevel (logLevel $ outputOpts opt) >> action)
-- | Run GhcMod -- | Run GhcMod
run :: Options -> GhcModT IO a -> IO a run :: Options -> GhcModT IO a -> IO a
@ -65,11 +68,14 @@ run opt a = extract $ runGhcModTSpec opt a
-- | Run GhcMod with default options -- | Run GhcMod with default options
runD :: GhcModT IO a -> IO a runD :: GhcModT IO a -> IO a
runD = runD =
extract . runGhcModTSpec defaultOptions { logLevel = testLogLevel } extract . runGhcModTSpec (setLogLevel testLogLevel defaultOptions)
runD' :: FilePath -> GhcModT IO a -> IO a runD' :: FilePath -> GhcModT IO a -> IO a
runD' dir = runD' dir =
extract . runGhcModTSpec' dir defaultOptions { logLevel = testLogLevel } extract . runGhcModTSpec' dir (setLogLevel testLogLevel defaultOptions)
setLogLevel :: GmLogLevel -> Options -> Options
setLogLevel = set (lLogLevel . lOutputOpts)
runE :: ErrorT e IO a -> IO (Either e a) runE :: ErrorT e IO a -> IO (Either e a)
runE = runErrorT runE = runErrorT