This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap".
The branch, master has been updated
via ead5e964a9fddda6a33e6154ba4390c0cce36026 (commit)
from a478c11273a44f709c3a4f8d888caaab131c9489 (commit)
Summary of changes:
test/runTests.sh | 21 +++++++++++++++
test/snap-testsuite.cabal | 24 +++++++++++++++++
test/suite/Snap/TestCommon.hs | 57 +++++++++++++++++++++++++++++++++++++++++
test/suite/TestSuite.hs | 52 +++++++++++++++++++++++++++++++++++++
4 files changed, 154 insertions(+), 0 deletions(-)
create mode 100755 test/runTests.sh
create mode 100644 test/snap-testsuite.cabal
create mode 100644 test/suite/Snap/TestCommon.hs
create mode 100644 test/suite/TestSuite.hs
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit ead5e964a9fddda6a33e6154ba4390c0cce36026
Author: Gregory Collins <[email protected]>
Date: Sat Jan 8 17:52:21 2011 +0100
Add a testsuite to the snap project
diff --git a/test/runTests.sh b/test/runTests.sh
new file mode 100755
index 0000000..0088a98
--- /dev/null
+++ b/test/runTests.sh
@@ -0,0 +1,21 @@
+#!/bin/sh
+
+set -e
+
+if [ -z "$DEBUG" ]; then
+ export DEBUG=testsuite
+fi
+
+SUITE=./dist/build/testsuite/testsuite
+
+if [ ! -f $SUITE ]; then
+ cat <<EOF
+Testsuite executable not found, please run:
+ cabal configure -ftest
+then
+ cabal build
+EOF
+ exit;
+fi
+
+./dist/build/testsuite/testsuite -j1 $*
diff --git a/test/snap-testsuite.cabal b/test/snap-testsuite.cabal
new file mode 100644
index 0000000..972c870
--- /dev/null
+++ b/test/snap-testsuite.cabal
@@ -0,0 +1,24 @@
+name: snap-testsuite
+version: 0.0.1
+build-type: Simple
+cabal-version: >= 1.6
+
+Executable testsuite
+ hs-source-dirs: suite
+ main-is: TestSuite.hs
+
+ build-depends:
+ QuickCheck >= 2.3.0.2,
+ base >= 4 && < 5,
+ bytestring == 0.9.*,
+ directory,
+ filepath,
+ HUnit >= 1.2 && < 2,
+ http-enumerator >= 0.2.1.5 && <0.3,
+ process == 1.*,
+ test-framework >= 0.3.1 && <0.4,
+ test-framework-hunit >= 0.2.5 && < 0.3,
+ test-framework-quickcheck2 >= 0.2.6 && < 0.3
+
+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -threaded
+ -fno-warn-unused-do-bind
diff --git a/test/suite/Snap/TestCommon.hs b/test/suite/Snap/TestCommon.hs
new file mode 100644
index 0000000..810e551
--- /dev/null
+++ b/test/suite/Snap/TestCommon.hs
@@ -0,0 +1,57 @@
+module Snap.TestCommon where
+
+import Control.Concurrent
+import Control.Exception
+import Control.Monad (when)
+import System.Cmd
+import System.Directory
+import System.Exit
+import System.FilePath
+import System.Process
+
+testGeneratedProject :: String -- ^ project name and directory
+ -> String -- ^ arguments to @snap init@
+ -> String -- ^ arguments to @cabal install@
+ -> Int -- ^ port to run http server on
+ -> IO () -- ^ action to run when the server goes up
+ -> IO ()
+testGeneratedProject projName snapInitArgs cabalInstallArgs httpPort
+ testAction = bracket initialize cleanup (const testAction)
+ where
+ initialize = do
+ cwd <- getCurrentDirectory
+ let projectPath = cwd </> projName
+ flip onException (setCurrentDirectory cwd >>
+ removeDirectoryRecursive projectPath) $ do
+ makeWorkDirectory projectPath
+ setCurrentDirectory projectPath
+ systemOrDie $ "snap init " ++ snapInitArgs
+ systemOrDie $ "cabal install " ++ cabalInstallArgs
+ let cmd = ("." </> "dist" </> "build" </> projName </> projName)
+ ++ " -p " ++ show httpPort
+ putStrLn $ "Running \"" ++ cmd ++ "\""
+ pHandle <- runCommand cmd
+ waitABit
+ return (cwd, projectPath, pHandle)
+
+ cleanup (cwd, projectPath, pHandle) = do
+ setCurrentDirectory cwd
+ terminateProcess pHandle
+ waitForProcess pHandle
+ removeDirectoryRecursive projectPath
+
+ waitABit = threadDelay $ 2*10^(6::Int)
+
+systemOrDie :: String -> IO ()
+systemOrDie s = do
+ putStrLn $ "Running \"" ++ s ++ "\""
+ system s >>= check
+ where
+ check ExitSuccess = return ()
+ check _ = throwIO $ ErrorCall $ "command failed: '" ++ s ++ "'"
+
+
+makeWorkDirectory :: FilePath -> IO ()
+makeWorkDirectory p = do
+ doesDirectoryExist p >>= flip when (removeDirectoryRecursive p)
+ createDirectory p
diff --git a/test/suite/TestSuite.hs b/test/suite/TestSuite.hs
new file mode 100644
index 0000000..eba3c9b
--- /dev/null
+++ b/test/suite/TestSuite.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Control.Monad
+import qualified Data.ByteString.Lazy.Char8 as L
+import qualified Data.ByteString.Char8 as S
+import qualified Network.HTTP.Enumerator as HTTP
+import Test.Framework (defaultMain, Test)
+import Test.Framework.Providers.HUnit
+import Test.HUnit hiding (Test, path)
+
+import Snap.TestCommon
+
+main :: IO ()
+main = defaultMain tests
+ where tests = [ testBarebones
+ , testDefault
+ ]
+
+
+testBarebones :: Test
+testBarebones = testCase "snap/barebones" go
+ where
+ go = testGeneratedProject "barebonesTest"
+ "-b"
+ ""
+ port
+ testIt
+ port = 9990
+ testIt = do
+ body <- HTTP.simpleHttp "http://127.0.0.1:9990";
+ assertEqual "server not up" "hello world" body
+
+
+testDefault :: Test
+testDefault = testCase "snap/default" go
+ where
+ go = testGeneratedProject "defaultTest"
+ ""
+ ""
+ port
+ testIt
+ port = 9991
+ testIt = do
+ body <- liftM (S.concat . L.toChunks) $
+ HTTP.simpleHttp "http://127.0.0.1:9991";
+ assertBool "response contains phrase 'it works!'"
+ $ "It works!" `S.isInfixOf` body
+
+
+-- TODO: test hint code here
-----------------------------------------------------------------------
hooks/post-receive
--
snap
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
