Skip to content

Commit a863a1a

Browse files
snoybergsnoyberg
committed
Initial integration test suite #339 
1 parent 0af6995 commit a863a1a

File tree

6 files changed

+230
-0
lines changed

6 files changed

+230
-0
lines changed

‎test/integration/LICENSE‎

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
Copyright (c) 2015, stack
2+
All rights reserved.
3+
4+
Redistribution and use in source and binary forms, with or without
5+
modification, are permitted provided that the following conditions are met:
6+
* Redistributions of source code must retain the above copyright
7+
notice, this list of conditions and the following disclaimer.
8+
* Redistributions in binary form must reproduce the above copyright
9+
notice, this list of conditions and the following disclaimer in the
10+
documentation and/or other materials provided with the distribution.
11+
* Neither the name of stackage-common nor the
12+
names of its contributors may be used to endorse or promote products
13+
derived from this software without specific prior written permission.
14+
15+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
16+
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
17+
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
18+
DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY
19+
DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
20+
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
21+
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
22+
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
23+
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
24+
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

‎test/integration/Spec.hs‎

Lines changed: 125 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,125 @@
1+
{-# LANGUAGE DeriveDataTypeable #-}
2+
3+
import Control.Applicative
4+
import Control.Arrow
5+
import Control.Concurrent.Async
6+
import Control.Exception
7+
import Control.Monad
8+
import Control.Monad.IO.Class
9+
import Control.Monad.Trans.Resource
10+
import qualified Data.ByteString.Lazy as L
11+
import Data.Char
12+
import Data.Conduit
13+
import Data.Conduit.Binary (sinkLbs)
14+
import Data.Conduit.Filesystem (sourceDirectoryDeep)
15+
import qualified Data.Conduit.List as CL
16+
import Data.Conduit.Process
17+
import Data.List (isSuffixOf, stripPrefix)
18+
import qualified Data.Map as Map
19+
import Data.Text.Encoding.Error (lenientDecode)
20+
import qualified Data.Text.Lazy as TL
21+
import qualified Data.Text.Lazy.Encoding as TL
22+
import Data.Typeable
23+
import System.Directory
24+
import System.Environment
25+
import System.Exit
26+
import System.FilePath
27+
import System.IO.Temp
28+
import System.PosixCompat.Files
29+
import Test.Hspec
30+
31+
main :: IO ()
32+
main = do
33+
currDir <- getCurrentDirectory
34+
35+
let findExe name = do
36+
mexe <- findExecutable name
37+
case mexe of
38+
Nothing -> error $ name ++ " not found on PATH"
39+
Just exe -> return exe
40+
runghc <- findExe "runghc"
41+
stack <- findExe "stack"
42+
43+
tests <- getDirectoryContents "tests" >>= filterM hasTest
44+
45+
envOrig <- getEnvironment
46+
47+
withSystemTempDirectory ("stack-integration-home") $ \newHome -> do
48+
let env' = Map.toList
49+
$ Map.insert "STACK_EXE" stack
50+
$ Map.insert "HOME" newHome
51+
$ Map.insert "APPDATA" newHome
52+
$ Map.delete "GHC_PACKAGE_PATH"
53+
$ Map.fromList
54+
$ map (first (map toUpper)) envOrig
55+
56+
origStackRoot <- getAppUserDataDirectory "stack"
57+
58+
hspec $ mapM_ (test runghc env' currDir origStackRoot newHome) tests
59+
60+
hasTest :: FilePath -> IO Bool
61+
hasTest dir = doesFileExist $ "tests" </> dir </> "Main.hs"
62+
63+
test :: FilePath -- ^ runghc
64+
-> [(String, String)] -- ^ env
65+
-> FilePath -- ^ currdir
66+
-> FilePath -- ^ origStackRoot
67+
-> FilePath -- ^ newHome
68+
-> String
69+
-> Spec
70+
test runghc env' currDir origStackRoot newHome name = it name $ withDir $ \dir -> do
71+
copyStackRoot origStackRoot (newHome </> takeFileName origStackRoot)
72+
let testDir = currDir </> "tests" </> name
73+
mainFile = testDir </> "Main.hs"
74+
libDir = currDir </> "lib"
75+
cp = (proc runghc
76+
[ "-clear-package-db"
77+
, "-global-package-db"
78+
, "-i" ++ libDir
79+
, mainFile
80+
])
81+
{ cwd = Just dir
82+
, env = Just env'
83+
}
84+
(ClosedStream, outSrc, errSrc, sph) <- streamingProcess cp
85+
(out, err, ec) <- runConcurrently $ (,,)
86+
<$> Concurrently (outSrc $$ sinkLbs)
87+
<*> Concurrently (errSrc $$ sinkLbs)
88+
<*> Concurrently (waitForStreamingProcess sph)
89+
when (ec /= ExitSuccess) $ throwIO $ TestFailure out err ec
90+
where
91+
withDir = withSystemTempDirectory ("stack-integration-" ++ name)
92+
93+
data TestFailure = TestFailure L.ByteString L.ByteString ExitCode
94+
deriving Typeable
95+
instance Show TestFailure where
96+
show (TestFailure out err ec) = concat
97+
[ "Exited with " ++ show ec
98+
, "\n\nstdout:\n"
99+
, toStr out
100+
, "\n\nstderr:\n"
101+
, toStr err
102+
]
103+
where
104+
toStr = TL.unpack . TL.decodeUtf8With lenientDecode
105+
instance Exception TestFailure
106+
107+
copyStackRoot :: FilePath -> FilePath -> IO ()
108+
copyStackRoot src dst =
109+
runResourceT $ sourceDirectoryDeep False src $$ CL.mapM_ go
110+
where
111+
go srcfp = when toCopy $ liftIO $ do
112+
Just suffix <- return $ stripPrefix src srcfp
113+
let dstfp = dst ++ "/" ++ suffix
114+
createDirectoryIfMissing True $ takeDirectory dstfp
115+
createSymbolicLink srcfp dstfp
116+
where
117+
toCopy = any (`isSuffixOf` srcfp)
118+
-- FIXME command line parameters to control how many of these get
119+
-- copied, trade-off of runtime/bandwidth vs isolation of tests
120+
[ ".tar"
121+
, ".xz"
122+
, ".gz"
123+
, ".7z.exe"
124+
, "00-index.cache"
125+
]

‎test/integration/lib/StackTest.hs‎

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
module StackTest where
2+
3+
import Control.Exception
4+
import System.Environment
5+
import System.FilePath
6+
import System.Directory
7+
import System.IO
8+
import System.Process
9+
import System.Exit
10+
import System.Environment
11+
12+
stack' :: [String] -> IO ExitCode
13+
stack' args = do
14+
stack <- getEnv "STACK_EXE"
15+
putStrLn $ "Running stack with args " ++ show args
16+
(Nothing, Nothing, Nothing, ph) <- createProcess (proc stack args)
17+
waitForProcess ph
18+
19+
stack :: [String] -> IO ()
20+
stack args = do
21+
ec <- stack' args
22+
if ec == ExitSuccess
23+
then return ()
24+
else error $ "Exited with exit code: " ++ show ec
25+
26+
stackErr :: [String] -> IO ()
27+
stackErr args = do
28+
ec <- stack' args
29+
if ec == ExitSuccess
30+
then error "stack was supposed to fail, but didn't"
31+
else return ()

‎test/integration/stack-integration-tests.cabal‎

Lines changed: 36 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
1+
name: stack-integration-tests
2+
version: 0.0.0
3+
synopsis: Integration tests
4+
description: Integration tests
5+
license: BSD3
6+
license-file: LICENSE
7+
author: Chris Done
8+
maintainer: [email protected]
9+
category: Development
10+
build-type: Simple
11+
cabal-version: >=1.10
12+
homepage: https://github.com/commercialhaskell/stack
13+
14+
executable stack-integration-tests
15+
main-is: Spec.hs
16+
17+
build-depends: base >= 4.7 && < 10
18+
, temporary
19+
, hspec
20+
, process
21+
, filepath
22+
, directory
23+
, text
24+
, unix-compat
25+
, containers
26+
, conduit
27+
, conduit-extra
28+
, resourcet
29+
, async
30+
, transformers
31+
, bytestring
32+
default-language: Haskell2010
33+
34+
source-repository head
35+
type: git
36+
location: https://github.com/commercialhaskell/stack

‎test/integration/stack.yaml‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
packages:
2+
- '.'
3+
resolver: lts-2.9

‎test/integration/tests/sanity/Main.hs‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
import StackTest
2+
3+
main :: IO ()
4+
main = do
5+
stack ["--version"]
6+
stack ["--help"]
7+
stack ["unpack", "acme-missiles-0.2"]
8+
stack ["unpack", "acme-missiles"]
9+
stackErr ["command-does-not-exist"]
10+
stackErr ["unpack", "invalid-package-name-"]
11+
stackErr ["build"]

0 commit comments

Comments
 (0)