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-core".
The branch, master has been updated
via fcb2afceea72310bd1fed352fcc523d0bccc1d9d (commit)
from 76b2b0d1cb61d0e3aee6ee12739632d1d87952e1 (commit)
Summary of changes:
test/snap-core-testsuite.cabal | 1 -
test/suite/Snap/Iteratee/Tests.hs | 14 ++--
test/suite/Snap/Types/Tests.hs | 125 ++++++++++++++++++++++++++++++-
test/suite/Snap/Util/FileServe/Tests.hs | 8 ++-
4 files changed, 135 insertions(+), 13 deletions(-)
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 fcb2afceea72310bd1fed352fcc523d0bccc1d9d
Author: Gregory Collins <[email protected]>
Date: Mon Aug 2 00:39:08 2010 -0400
Improve snap-core test coverage
diff --git a/test/snap-core-testsuite.cabal b/test/snap-core-testsuite.cabal
index 911d036..45a83a4 100644
--- a/test/snap-core-testsuite.cabal
+++ b/test/snap-core-testsuite.cabal
@@ -26,7 +26,6 @@ Executable testsuite
if flag(testsuite)
cpp-options: -DDEBUG_TEST
- build-depends: deepseq >= 1.1 && <1.2
if flag(portable) || os(windows)
cpp-options: -DPORTABLE
diff --git a/test/suite/Snap/Iteratee/Tests.hs
b/test/suite/Snap/Iteratee/Tests.hs
index 0e1752d..60bc39e 100644
--- a/test/suite/Snap/Iteratee/Tests.hs
+++ b/test/suite/Snap/Iteratee/Tests.hs
@@ -338,7 +338,8 @@ testTakeNoMoreThan2 = testProperty "takeNoMore: exact
stream" $
assert $ e == s
where
- doIter = enumLBS s (joinI (takeNoMoreThan n stream2stream))
+ doIter = enumLBS (L.concat ["", s])
+ (joinI (takeNoMoreThan n stream2stream))
n = fromIntegral $ L.length s
@@ -354,7 +355,7 @@ testTakeNoMoreThan3 = testProperty "takeNoMoreLong" $
if (L.null s || m == 0)
then liftQ $ do
- !v <- doIter >>= run
+ !_ <- doIter >>= run
return ()
else expectException $ doIter >>= run >>= return . fromWrap
@@ -394,13 +395,14 @@ testCountBytes2 = testProperty "count bytes" $
prop :: L.ByteString -> PropertyM IO ()
prop s = do
pre $ L.length s > 4
- n1 <- f iter
+ (n1,s') <- f iter
assert $ n1 == 4
+ assert $ fromWrap s' == L.drop 4 s
where
f i = liftQ $ enumLBS s i >>= run
iter = do
- (!_,m) <- countBytes $ drop 4
- stream2stream
- return m
+ (!_,m) <- countBytes $ drop' 4
+ x <- stream2stream
+ return (m,x)
diff --git a/test/suite/Snap/Types/Tests.hs b/test/suite/Snap/Types/Tests.hs
index 8e3dbdd..47edd36 100644
--- a/test/suite/Snap/Types/Tests.hs
+++ b/test/suite/Snap/Types/Tests.hs
@@ -11,11 +11,14 @@ import Control.Exception (SomeException)
import Control.Monad
import Control.Monad.CatchIO
import Control.Monad.Trans (liftIO)
+import Control.Parallel.Strategies
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import Data.IORef
import Data.Iteratee
+import Data.Text ()
+import Data.Text.Lazy ()
import qualified Data.Map as Map
import Prelude hiding (catch)
import Test.Framework
@@ -41,7 +44,20 @@ tests = [ testFail
, testWrites
, testParam
, testURLEncode1
- , testURLEncode2 ]
+ , testURLEncode2
+ , testDir2
+ , testIpHeaderFilter
+ , testMZero404
+ , testEvalSnap
+ , testLocalRequest ]
+
+
+expectException :: IO () -> IO ()
+expectException m = do
+ r <- (try m :: IO (Either SomeException ()))
+ let b = either (\e -> show e `using` rdeepseq `seq` True)
+ (const False) r
+ assertBool "expected exception" b
expect404 :: IO (Request,Response) -> IO ()
@@ -49,6 +65,7 @@ expect404 m = do
(_,r) <- m
assertBool "expected 404" (rspStatus r == 404)
+
expectNo404 :: IO (Request,Response) -> IO ()
expectNo404 m = do
(_,r) <- m
@@ -60,7 +77,7 @@ mkRequest :: ByteString -> IO Request
mkRequest uri = do
enum <- newIORef $ SomeEnumerator return
- return $ Request "foo" 80 "foo" 999 "foo" 1000 "foo" False Map.empty
+ return $ Request "foo" 80 "127.0.0.1" 999 "foo" 1000 "foo" False Map.empty
enum Nothing GET (1,1) [] "" uri "/"
(S.concat ["/",uri]) "" Map.empty
@@ -80,10 +97,16 @@ mkZomgRq :: IO Request
mkZomgRq = do
enum <- newIORef $ SomeEnumerator return
- return $ Request "foo" 80 "foo" 999 "foo" 1000 "foo" False Map.empty
+ return $ Request "foo" 80 "127.0.0.1" 999 "foo" 1000 "foo" False Map.empty
enum Nothing GET (1,1) [] "" "/" "/" "/" "" Map.empty
+mkIpHeaderRq :: IO Request
+mkIpHeaderRq = do
+ rq <- mkZomgRq
+ return $ setHeader "X-Forwarded-For" "1.2.3.4" rq
+
+
mkRqWithBody :: IO Request
mkRqWithBody = do
enum <- newIORef $ SomeEnumerator (enumBS "zazzle")
@@ -113,7 +136,13 @@ testCatchIO = testCase "catchIO" $ do
go :: Snap a -> IO (Request,Response)
go m = do
zomgRq <- mkZomgRq
- run $ runSnap m (const $ return ()) zomgRq
+ run $ runSnap m (\x -> return $! (show x `using` rdeepseq) `seq` ()) zomgRq
+
+
+goIP :: Snap a -> IO (Request,Response)
+goIP m = do
+ rq <- mkIpHeaderRq
+ run $ runSnap m (const $ return ()) rq
goPath :: ByteString -> Snap a -> IO (Request,Response)
@@ -222,8 +251,27 @@ testTrivials = testCase "trivial functions" $ do
q <- getRequest
liftIO $ assertEqual "localrq" False $ rqIsSecure q
return ()
+
+ logError "foo"
+ writeText "zzz"
+ writeLazyText "zzz"
+
+ let req' = updateContextPath 0 req
+ let cp1 = rqContextPath req
+ let cp2 = rqContextPath req'
+
+ liftIO $ assertEqual "updateContextPath 0" cp1 cp2
+
+ withRequest $ return . (`seq` ())
+ withResponse $ return . (`seq` ())
+
+
return ()
+ b <- getBody rsp
+ let !_ = show b `using` rdeepseq
+
+
let !_ = show NoHandlerException `seq` ()
assertEqual "rq secure" True $ rqIsSecure rq
@@ -287,3 +335,72 @@ testURLEncode2 :: Test
testURLEncode2 = testProperty "url encoding 2" prop
where
prop s = (urlDecode $ urlEncode s) == Just s
+
+
+testDir2 :: Test
+testDir2 = testCase "dir2" $ do
+ (_,resp) <- goPath "foo/bar" f
+ b <- getBody resp
+ assertEqual "context path" "/foo/bar/" b
+
+ where
+ f = dir "foo" $ dir "bar" $ do
+ p <- liftM rqContextPath getRequest
+ addToOutput $ enumBS p
+
+
+testIpHeaderFilter :: Test
+testIpHeaderFilter = testCase "ipHeaderFilter" $ do
+ (_,r) <- goIP f
+ b <- getBody r
+ assertEqual "ipHeaderFilter" "1.2.3.4" b
+
+
+ (_,r2) <- go f
+ b2 <- getBody r2
+ assertEqual "ipHeaderFilter" "127.0.0.1" b2
+
+ where
+ f = do
+ ipHeaderFilter
+ ip <- liftM rqRemoteAddr getRequest
+ writeBS ip
+
+
+testMZero404 :: Test
+testMZero404 = testCase "mzero 404" $ do
+ (_,r) <- go mzero
+ let l = rspContentLength r
+ b <- getBody r
+ assertEqual "mzero 404" "404" b
+ assertEqual "mzero 404 length" (Just 3) l
+
+
+testEvalSnap :: Test
+testEvalSnap = testCase "evalSnap exception" $ do
+ rq <- mkZomgRq
+ expectException (run $ evalSnap f
+ (const $ return ())
+ rq >> return ())
+ where
+ f = do
+ logError "zzz"
+ v <- withResponse (return . rspHttpVersion)
+ liftIO $ assertEqual "evalSnap rsp version" (1,1) v
+ finishWith emptyResponse
+
+
+testLocalRequest :: Test
+testLocalRequest = testCase "localRequest" $ do
+ rq1 <- mkZomgRq
+ rq2 <- mkRequest "zzz/zz/z"
+
+ let h = localRequest (const rq2) mzero
+
+ (rq',_) <- go (h <|> return ())
+
+ let u1 = rqURI rq1
+ let u2 = rqURI rq'
+
+ assertEqual "localRequest backtrack" u1 u2
+
diff --git a/test/suite/Snap/Util/FileServe/Tests.hs
b/test/suite/Snap/Util/FileServe/Tests.hs
index 1274a9a..a0bbaa4 100644
--- a/test/suite/Snap/Util/FileServe/Tests.hs
+++ b/test/suite/Snap/Util/FileServe/Tests.hs
@@ -57,10 +57,14 @@ mkRequest uri = do
(B.concat ["/",uri]) "" Map.empty
fs :: Snap ()
-fs = fileServe "data/fileServe"
+fs = do
+ x <- fileServe "data/fileServe"
+ return $! x `seq` ()
fsSingle :: Snap ()
-fsSingle = fileServeSingle "data/fileServe/foo.html"
+fsSingle = do
+ x <- fileServeSingle "data/fileServe/foo.html"
+ return $! x `seq` ()
testFs :: Test
-----------------------------------------------------------------------
hooks/post-receive
--
snap-core
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
