module name change.

This commit is contained in:
Kazu Yamamoto 2013-09-03 11:49:35 +09:00
parent 1b862ca107
commit 955223a2a8
6 changed files with 10 additions and 6 deletions

View File

@ -90,7 +90,7 @@ Test-Suite spec
Main-Is: Spec.hs Main-Is: Spec.hs
Hs-Source-Dirs: test, . Hs-Source-Dirs: test, .
Type: exitcode-stdio-1.0 Type: exitcode-stdio-1.0
Other-Modules: Expectation Other-Modules: Dir
BrowseSpec BrowseSpec
CabalApiSpec CabalApiSpec
CheckSpec CheckSpec

View File

@ -1,11 +1,12 @@
module CheckSpec where module CheckSpec where
import Data.List (isSuffixOf, isInfixOf, isPrefixOf) import Data.List (isSuffixOf, isInfixOf, isPrefixOf)
import Expectation
import Language.Haskell.GhcMod import Language.Haskell.GhcMod
import System.FilePath import System.FilePath
import Test.Hspec import Test.Hspec
import Dir
spec :: Spec spec :: Spec
spec = do spec = do
describe "checkSyntax" $ do describe "checkSyntax" $ do

View File

@ -2,12 +2,13 @@ module CradleSpec where
import Control.Applicative import Control.Applicative
import Data.List (isPrefixOf) import Data.List (isPrefixOf)
import Expectation
import Language.Haskell.GhcMod import Language.Haskell.GhcMod
import System.Directory (canonicalizePath) import System.Directory (canonicalizePath)
import System.FilePath (addTrailingPathSeparator, (</>)) import System.FilePath (addTrailingPathSeparator, (</>))
import Test.Hspec import Test.Hspec
import Dir
spec :: Spec spec :: Spec
spec = do spec = do
describe "findCradle" $ do describe "findCradle" $ do

View File

@ -1,9 +1,10 @@
module DebugSpec where module DebugSpec where
import Expectation
import Language.Haskell.GhcMod import Language.Haskell.GhcMod
import Test.Hspec import Test.Hspec
import Dir
checkFast :: String -> String -> IO () checkFast :: String -> String -> IO ()
checkFast file ans = withDirectory_ "test/data" $ do checkFast file ans = withDirectory_ "test/data" $ do
(strVer,_) <- getGHCVersion (strVer,_) <- getGHCVersion

View File

@ -1,4 +1,4 @@
module Expectation where module Dir where
import System.Directory import System.Directory
import Control.Exception as E import Control.Exception as E

View File

@ -1,12 +1,13 @@
module InfoSpec where module InfoSpec where
import Data.List (isPrefixOf) import Data.List (isPrefixOf)
import Expectation
import Language.Haskell.GhcMod import Language.Haskell.GhcMod
import System.Exit import System.Exit
import System.Process import System.Process
import Test.Hspec import Test.Hspec
import Dir
spec :: Spec spec :: Spec
spec = do spec = do
describe "typeExpr" $ do describe "typeExpr" $ do