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 edca479ff52b933a2c1a0c9e3dd7e4bf583d2177 (commit)
via 5131d6f4f7453e122de3e708df4af4e5bd7cad9d (commit)
from 91d88ecbec9cad82933849889e9b7f4d05a2c425 (commit)
Summary of changes:
src/Snap/Internal/Debug.hs | 8 +-
src/Snap/Internal/Iteratee/Debug.hs | 6 +-
src/Snap/Internal/Types.hs | 1 -
src/Snap/Iteratee.hs | 3 +-
src/Snap/Util/GZip.hs | 46 +++----
test/runTestsAndCoverage.sh | 1 +
test/snap-core-testsuite.cabal | 1 +
test/suite/Snap/Internal/Http/Types/Tests.hs | 2 +-
test/suite/Snap/Iteratee/Tests.hs | 8 +-
test/suite/Snap/Types/Tests.hs | 8 +-
test/suite/Snap/Util/GZip/Tests.hs | 195 ++++++++++++++++++++------
11 files changed, 192 insertions(+), 87 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 edca479ff52b933a2c1a0c9e3dd7e4bf583d2177
Author: Gregory Collins <[email protected]>
Date: Thu Oct 7 01:08:40 2010 +0200
Bugfixes and improved test coverage for Snap.Util.GZip
Bugs fixed:
- gzip thread was probably insufficiently lazy; either way the new
testsuite
explicitly tests for this now
- if the enumerator threw an error, the gzip handler would hang; fixed.
diff --git a/src/Snap/Util/GZip.hs b/src/Snap/Util/GZip.hs
index fa65db0..afb3948 100644
--- a/src/Snap/Util/GZip.hs
+++ b/src/Snap/Util/GZip.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module Snap.Util.GZip
( withCompression
@@ -80,18 +80,14 @@ withCompression' mimeTable action = do
-- If a content-encoding is already set, do nothing. This prevents
-- "withCompression $ withCompression m" from ruining your day.
- if isJust $ getHeader "Content-Encoding" resp
- then return ()
- else do
- let mbCt = getHeader "Content-Type" resp
+ when (not $ isJust $ getHeader "Content-Encoding" resp) $ do
+ let mbCt = getHeader "Content-Type" resp
- debug $ "withCompression', content-type is " ++ show mbCt
+ debug $ "withCompression', content-type is " ++ show mbCt
- case mbCt of
- (Just ct) -> if Set.member ct mimeTable
- then chkAcceptEncoding
- else return ()
- _ -> return ()
+ case mbCt of
+ (Just ct) -> when (Set.member ct mimeTable) chkAcceptEncoding
+ _ -> return $! ()
getResponse >>= finishWith
@@ -110,7 +106,7 @@ withCompression' mimeTable action = do
chooseType types
- chooseType [] = return ()
+ chooseType [] = return $! ()
chooseType ("gzip":_) = gzipCompression "gzip"
chooseType ("compress":_) = compressCompression "compress"
chooseType ("x-gzip":_) = gzipCompression "x-gzip"
@@ -197,9 +193,7 @@ compressEnumerator compFunc enum iteratee = do
ch <- readChan writeEnd
iter' <- liftM liftI $ runIter iter ch
- if (streamFinished ch)
- then return iter'
- else consumeSomeOutput writeEnd iter'
+ consumeSomeOutput writeEnd iter'
--------------------------------------------------------------------------
@@ -222,10 +216,9 @@ compressEnumerator compFunc enum iteratee = do
killThread tid
return x
- f _ _ tid i ch@(EOF (Just _)) = do
- x <- runIter i ch
+ f _ _ tid _ (EOF (Just e)) = do
killThread tid
- return x
+ return $ Cont undefined (Just e)
f readEnd writeEnd tid i (Chunk s') = do
let s = unWrap s'
@@ -240,18 +233,19 @@ compressEnumerator compFunc enum iteratee = do
-> IO ()
threadProc readEnd writeEnd = do
stream <- getChanContents readEnd
- let bs = L.fromChunks $ streamToChunks stream
+ let bs = L.fromChunks $ streamToChunks stream
let output = L.toChunks $ compFunc bs
- let runIt = do
- --Prelude specified to work with iteratee-0.3.6
- Prelude.mapM_ (writeChan writeEnd . toChunk) output
- writeChan writeEnd $ EOF Nothing
- runIt `catch` \(e::SomeException) ->
+ runIt output `catch` \(e::SomeException) ->
writeChan writeEnd $ EOF (Just $ Err $ show e)
+ where
+ runIt (x:xs) = do
+ writeChan writeEnd (toChunk x) >> runIt xs
+ runIt [] = do
+ writeChan writeEnd $ EOF Nothing
--------------------------------------------------------------------------
streamToChunks [] = []
streamToChunks (Nothing:_) = []
diff --git a/test/snap-core-testsuite.cabal b/test/snap-core-testsuite.cabal
index 593cfd7..34e3c90 100644
--- a/test/snap-core-testsuite.cabal
+++ b/test/snap-core-testsuite.cabal
@@ -40,6 +40,7 @@ Executable testsuite
old-locale,
old-time,
parallel >= 2.2 && <2.3,
+ pureMD5 == 2.1.*,
regex-posix >= 0.94.4 && <0.95,
test-framework >= 0.3.1 && <0.4,
test-framework-hunit >= 0.2.5 && < 0.3,
diff --git a/test/suite/Snap/Util/GZip/Tests.hs
b/test/suite/Snap/Util/GZip/Tests.hs
index 568986a..736fae9 100644
--- a/test/suite/Snap/Util/GZip/Tests.hs
+++ b/test/suite/Snap/Util/GZip/Tests.hs
@@ -10,14 +10,18 @@ import qualified Codec.Compression.GZip as GZip
import qualified Codec.Compression.Zlib as Zlib
import Control.Exception hiding (assert)
import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Digest.Pure.MD5
import Data.IORef
import Data.Iteratee
import qualified Data.Map as Map
+import Data.Serialize
import Test.Framework
import Test.Framework.Providers.QuickCheck2
import Test.QuickCheck
import qualified Test.QuickCheck.Monadic as QC
import Test.QuickCheck.Monadic hiding (run)
+import Test.Framework.Providers.HUnit
+import qualified Test.HUnit as H
import Snap.Types
import Snap.Internal.Http.Types
@@ -33,9 +37,13 @@ tests = [ testIdentity1
, testIdentity3
, testIdentity4
, testIdentity5
+ , testNoHeaders
+ , testNoAcceptEncoding
, testNopWhenContentEncodingSet
, testCompositionDoesn'tExplode
- , testBadHeaders ]
+ , testGzipLotsaChunks
+ , testBadHeaders
+ , testIterateeException ]
------------------------------------------------------------------------------
@@ -64,6 +72,14 @@ xCompressHdrs = setHeader "Accept-Encoding" "x-compress"
emptyHdrs
------------------------------------------------------------------------------
+mkNoHeaders :: IO Request
+mkNoHeaders = do
+ enum <- newIORef $ SomeEnumerator return
+
+ return $ Request "foo" 80 "foo" 999 "foo" 1000 "foo" False emptyHdrs
+ enum Nothing GET (1,1) [] "" "/" "/" "/" "" Map.empty
+
+
mkGzipRq :: IO Request
mkGzipRq = do
enum <- newIORef $ SomeEnumerator return
@@ -106,29 +122,40 @@ mkBadRq = do
enum Nothing GET (1,1) [] "" "/" "/" "/" "" Map.empty
------------------------------------------------------------------------------
-goGZip, goCompress, goXGZip, goXCompress, goBad :: Snap a -> IO
(Request,Response)
-goGZip m = do
- gzipRq <- mkGzipRq
- run $ runSnap m (const $ return ()) gzipRq
+seqSnap :: Snap a -> Snap a
+seqSnap m = do
+ !x <- m
+ return $! x `seq` x
+
-goCompress m = do
- compressRq <- mkCompressRq
- run $ runSnap m (const $ return ()) compressRq
+------------------------------------------------------------------------------
+goGeneric :: IO Request -> Snap a -> IO (Request, Response)
+goGeneric mkRq m = do
+ rq <- mkRq
+ run $! runSnap (seqSnap m) (const $ return ()) rq
-goXGZip m = do
- gzipRq <- mkXGzipRq
- run $ runSnap m (const $ return ()) gzipRq
+goGZip, goCompress, goXGZip :: Snap a -> IO (Request,Response)
+goNoHeaders, goXCompress, goBad :: Snap a -> IO (Request,Response)
-goXCompress m = do
- compressRq <- mkXCompressRq
- run $ runSnap m (const $ return ()) compressRq
+goGZip = goGeneric mkGzipRq
+goCompress = goGeneric mkCompressRq
+goXGZip = goGeneric mkXGzipRq
+goXCompress = goGeneric mkXCompressRq
+goBad = goGeneric mkBadRq
+goNoHeaders = goGeneric mkNoHeaders
+------------------------------------------------------------------------------
+noContentType :: L.ByteString -> Snap ()
+noContentType s = modifyResponse $ setResponseBody (enumLBS s)
-goBad m = do
- badRq <- mkBadRq
- run $ runSnap m (const $ return ()) badRq
------------------------------------------------------------------------------
+textPlainErr :: L.ByteString -> Snap ()
+textPlainErr s = modifyResponse $
+ setResponseBody (enumLBS s >. enumErr "blah") .
+ setContentType "text/plain"
+
+
textPlain :: L.ByteString -> Snap ()
textPlain s = modifyResponse $
setResponseBody (enumLBS s) .
@@ -143,13 +170,56 @@ binary s = modifyResponse $
------------------------------------------------------------------------------
+testNoHeaders :: Test
+testNoHeaders = testProperty "gzip/noheaders" $
+ monadicIO $
+ forAllM arbitrary prop
+ where
+ prop :: L.ByteString -> PropertyM IO ()
+ prop s = do
+ -- if there's no content-type, withCompression should be a no-op
+ (!_,!rsp) <- liftQ $ goNoHeaders (seqSnap $ withCompression
+ $ noContentType s)
+ assert $ getHeader "Content-Encoding" rsp == Nothing
+ assert $ getHeader "Vary" rsp == Nothing
+ let body = rspBodyToEnum $ rspBody rsp
+
+ c <- liftQ $
+ body stream2stream >>= run >>= return . fromWrap
+
+ assert $ s == c
+
+
+------------------------------------------------------------------------------
+testNoAcceptEncoding :: Test
+testNoAcceptEncoding = testProperty "gzip/noAcceptEncoding" $
+ monadicIO $
+ forAllM arbitrary prop
+ where
+ prop :: L.ByteString -> PropertyM IO ()
+ prop s = do
+ -- if there's no content-type, withCompression should be a no-op
+ (!_,!rsp) <- liftQ $ goNoHeaders (seqSnap $ withCompression
+ $ textPlain s)
+ assert $ getHeader "Content-Encoding" rsp == Nothing
+ assert $ getHeader "Vary" rsp == Nothing
+ let body = rspBodyToEnum $ rspBody rsp
+
+ c <- liftQ $
+ body stream2stream >>= run >>= return . fromWrap
+
+ assert $ s == c
+
+
+------------------------------------------------------------------------------
testIdentity1 :: Test
-testIdentity1 = testProperty "identity1" $ monadicIO $ forAllM arbitrary prop
+testIdentity1 = testProperty "gzip/identity1" $ monadicIO $ forAllM arbitrary
prop
where
prop :: L.ByteString -> PropertyM IO ()
prop s = do
- (_,rsp) <- liftQ $ goGZip (withCompression $ textPlain s)
+ (!_,!rsp) <- liftQ $ goGZip (seqSnap $ withCompression $ textPlain s)
assert $ getHeader "Content-Encoding" rsp == Just "gzip"
+ assert $ getHeader "Vary" rsp == Just "Accept-Encoding"
let body = rspBodyToEnum $ rspBody rsp
c <- liftQ $
@@ -161,29 +231,30 @@ testIdentity1 = testProperty "identity1" $ monadicIO $
forAllM arbitrary prop
------------------------------------------------------------------------------
testIdentity2 :: Test
-testIdentity2 = testProperty "identity2" $ monadicIO $ forAllM arbitrary prop
+testIdentity2 = testProperty "gzip/identity2" $ monadicIO $ forAllM arbitrary
prop
where
prop :: L.ByteString -> PropertyM IO ()
prop s = do
- (_,rsp2) <- liftQ $ goCompress (withCompression $ textPlain s)
+ (!_,!rsp) <- liftQ $ goCompress (seqSnap $ withCompression $ textPlain
s)
- assert $ getHeader "Content-Encoding" rsp2 == Just "compress"
- let body2 = rspBodyToEnum $ rspBody rsp2
+ assert $ getHeader "Content-Encoding" rsp == Just "compress"
+ assert $ getHeader "Vary" rsp == Just "Accept-Encoding"
+ let body = rspBodyToEnum $ rspBody rsp
- c2 <- liftQ $
- body2 stream2stream >>= run >>= return . fromWrap
+ c <- liftQ $
+ body stream2stream >>= run >>= return . fromWrap
- let s2 = Zlib.decompress c2
- assert $ s == s2
+ let s' = Zlib.decompress c
+ assert $ s == s'
------------------------------------------------------------------------------
testIdentity3 :: Test
-testIdentity3 = testProperty "identity3" $ monadicIO $ forAllM arbitrary prop
+testIdentity3 = testProperty "gzip/identity3" $ monadicIO $ forAllM arbitrary
prop
where
prop :: L.ByteString -> PropertyM IO ()
prop s = do
- (_,rsp3) <- liftQ $ goGZip (withCompression $ binary s)
+ (!_,!rsp3) <- liftQ $ goGZip (seqSnap $ withCompression $ binary s)
let body3 = rspBodyToEnum $ rspBody rsp3
s3 <- liftQ $
@@ -194,11 +265,11 @@ testIdentity3 = testProperty "identity3" $ monadicIO $
forAllM arbitrary prop
------------------------------------------------------------------------------
testIdentity4 :: Test
-testIdentity4 = testProperty "identity4" $ monadicIO $ forAllM arbitrary prop
+testIdentity4 = testProperty "gzip/identity4" $ monadicIO $ forAllM arbitrary
prop
where
prop :: L.ByteString -> PropertyM IO ()
prop s = do
- (_,rsp) <- liftQ $ goXGZip (withCompression $ textPlain s)
+ (!_,!rsp) <- liftQ $ goXGZip (seqSnap $ withCompression $ textPlain s)
assert $ getHeader "Content-Encoding" rsp == Just "x-gzip"
let body = rspBodyToEnum $ rspBody rsp
@@ -211,11 +282,11 @@ testIdentity4 = testProperty "identity4" $ monadicIO $
forAllM arbitrary prop
------------------------------------------------------------------------------
testIdentity5 :: Test
-testIdentity5 = testProperty "identity5" $ monadicIO $ forAllM arbitrary prop
+testIdentity5 = testProperty "gzip/identity5" $ monadicIO $ forAllM arbitrary
prop
where
prop :: L.ByteString -> PropertyM IO ()
prop s = do
- (_,rsp2) <- liftQ $ goXCompress (withCompression $ textPlain s)
+ (!_,!rsp2) <- liftQ $ goXCompress (seqSnap $ withCompression $
textPlain s)
assert $ getHeader "Content-Encoding" rsp2 == Just "x-compress"
let body2 = rspBodyToEnum $ rspBody rsp2
@@ -229,11 +300,11 @@ testIdentity5 = testProperty "identity5" $ monadicIO $
forAllM arbitrary prop
------------------------------------------------------------------------------
testBadHeaders :: Test
-testBadHeaders = testProperty "bad headers" $ monadicIO $ forAllM arbitrary
prop
+testBadHeaders = testProperty "gzip/bad headers" $ monadicIO $ forAllM
arbitrary prop
where
prop :: L.ByteString -> PropertyM IO ()
prop s = expectException $ do
- (_,rsp) <- goBad (withCompression $ textPlain s)
+ (!_,!rsp) <- goBad (seqSnap $ withCompression $ textPlain s)
let body = rspBodyToEnum $ rspBody rsp
body stream2stream >>= run >>= return . fromWrap
@@ -241,16 +312,17 @@ testBadHeaders = testProperty "bad headers" $ monadicIO $
forAllM arbitrary prop
------------------------------------------------------------------------------
testNopWhenContentEncodingSet :: Test
-testNopWhenContentEncodingSet = testProperty "testNopWhenContentEncodingSet" $
- monadicIO $
- forAllM arbitrary prop
+testNopWhenContentEncodingSet =
+ testProperty "gzip/testNopWhenContentEncodingSet" $
+ monadicIO $
+ forAllM arbitrary prop
where
prop :: L.ByteString -> PropertyM IO ()
prop s = do
- (_,rsp) <- liftQ $ goGZip $ f s
+ (!_,!rsp) <- liftQ $ goGZip $ f s
assert $ getHeader "Content-Encoding" rsp == Just "identity"
- f s = withCompression $ do
+ f !s = seqSnap $ withCompression $ do
modifyResponse $ setHeader "Content-Encoding" "identity"
textPlain s
@@ -258,15 +330,16 @@ testNopWhenContentEncodingSet = testProperty
"testNopWhenContentEncodingSet" $
------------------------------------------------------------------------------
testCompositionDoesn'tExplode :: Test
testCompositionDoesn'tExplode =
- testProperty "testCompositionDoesn'tExplode" $
+ testProperty "gzip/testCompositionDoesn'tExplode" $
monadicIO $
forAllM arbitrary prop
where
prop :: L.ByteString -> PropertyM IO ()
prop s = do
- (_,rsp) <- liftQ $ goGZip (withCompression $
- withCompression $
- withCompression $ textPlain s)
+ (!_,!rsp) <- liftQ $ goGZip (seqSnap $
+ withCompression $
+ withCompression $
+ withCompression $ textPlain s)
assert $ getHeader "Content-Encoding" rsp == Just "gzip"
@@ -277,3 +350,37 @@ testCompositionDoesn'tExplode =
let s1 = GZip.decompress c
assert $ s == s1
+
+
+------------------------------------------------------------------------------
+testGzipLotsaChunks :: Test
+testGzipLotsaChunks = testCase "gzip/lotsOfChunks" prop
+ where
+ prop = do
+ let s = L.take 120000 $ L.fromChunks $ frobnicate "dshflkahdflkdhsaflk"
+ (!_,!rsp) <- goGZip (seqSnap $ withCompression $ textPlain s)
+ let body = rspBodyToEnum $ rspBody rsp
+
+ c <- body stream2stream >>= run >>= return . fromWrap
+
+ let s1 = GZip.decompress c
+ H.assertBool "streams equal" $ s == s1
+
+
+ -- in order to get incompressible text (so that we can test whether the
+ -- gzip thread is streaming properly!) we'll iteratively md5 the source
+ -- string
+ frobnicate s = let s' = encode $ md5 $ L.fromChunks [s]
+ in (s:frobnicate s')
+
+
+------------------------------------------------------------------------------
+testIterateeException :: Test
+testIterateeException = testProperty "gzip/iterateeException" $
+ monadicIO $ forAllM arbitrary prop
+ where
+ prop :: L.ByteString -> PropertyM IO ()
+ prop s = expectException $ do
+ (!_,!rsp) <- goGZip (seqSnap $ withCompression $ textPlainErr s)
+ let body = rspBodyToEnum $ rspBody rsp
+ body stream2stream >>= run >>= return . fromWrap
commit 5131d6f4f7453e122de3e708df4af4e5bd7cad9d
Author: Gregory Collins <[email protected]>
Date: Thu Oct 7 01:08:23 2010 +0200
Code cleanup
diff --git a/src/Snap/Internal/Debug.hs b/src/Snap/Internal/Debug.hs
index 54845ac..4fe940e 100644
--- a/src/Snap/Internal/Debug.hs
+++ b/src/Snap/Internal/Debug.hs
@@ -39,9 +39,9 @@ debug = let !x = unsafePerformIO $! do
!e <- try $ getEnv "DEBUG"
!f <- either (\(_::SomeException) -> return debugIgnore)
- (\x -> if x == "1" || x == "on"
+ (\y -> if y == "1" || y == "on"
then return debugOn
- else if x == "testsuite"
+ else if y == "testsuite"
then return debugSeq
else return debugIgnore)
(fmap (map toLower) e)
@@ -54,9 +54,9 @@ debugErrno = let !x = unsafePerformIO $ do
e <- try $ getEnv "DEBUG"
!f <- either (\(_::SomeException) -> return debugErrnoIgnore)
- (\x -> if x == "1" || x == "on"
+ (\y -> if y == "1" || y == "on"
then return debugErrnoOn
- else if x == "testsuite"
+ else if y == "testsuite"
then return debugErrnoSeq
else return debugErrnoIgnore)
(fmap (map toLower) e)
diff --git a/src/Snap/Internal/Iteratee/Debug.hs
b/src/Snap/Internal/Iteratee/Debug.hs
index c2c6981..155ddfb 100644
--- a/src/Snap/Internal/Iteratee/Debug.hs
+++ b/src/Snap/Internal/Iteratee/Debug.hs
@@ -18,7 +18,9 @@ import Data.Iteratee.WrappedByteString
import Data.Word (Word8)
import System.IO
------------------------------------------------------------------------------
+#ifndef NODEBUG
import Snap.Internal.Debug
+#endif
import Snap.Iteratee
------------------------------------------------------------------------------
@@ -43,7 +45,7 @@ debugIteratee = IterateeG f
return $ Cont debugIteratee Nothing
-#if defined(DEBUG)
+#ifndef NODEBUG
iterateeDebugWrapper :: String -> Iteratee IO a -> Iteratee IO a
iterateeDebugWrapper name iter = IterateeG f
@@ -52,7 +54,7 @@ iterateeDebugWrapper name iter = IterateeG f
debug $ name ++ ": got EOF: " ++ show c
runIter iter c
- f c@(EOF (Just e)) = do
+ f c@(EOF (Just _)) = do
debug $ name ++ ": got EOF **error**: " ++ show c
runIter iter c
diff --git a/src/Snap/Internal/Types.hs b/src/Snap/Internal/Types.hs
index 89dc694..1a7ef53 100644
--- a/src/Snap/Internal/Types.hs
+++ b/src/Snap/Internal/Types.hs
@@ -28,7 +28,6 @@ import Data.Typeable
------------------------------------------------------------------------------
import Snap.Iteratee hiding (Enumerator)
import Snap.Internal.Http.Types
-import Snap.Internal.Debug
import Snap.Internal.Iteratee.Debug
diff --git a/src/Snap/Iteratee.hs b/src/Snap/Iteratee.hs
index 2b87aab..27a5ef7 100644
--- a/src/Snap/Iteratee.hs
+++ b/src/Snap/Iteratee.hs
@@ -5,6 +5,7 @@
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Snap Framework type aliases and utilities for iteratees. Note that as a
-- convenience, this module also exports everything from @Data.Iteratee@ in the
@@ -51,7 +52,7 @@ module Snap.Iteratee
------------------------------------------------------------------------------
import Control.Monad
import Control.Monad.CatchIO
-import Control.Exception (Exception, SomeException)
+import Control.Exception (SomeException)
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Unsafe as S
diff --git a/test/runTestsAndCoverage.sh b/test/runTestsAndCoverage.sh
index 0a1ce73..2200318 100755
--- a/test/runTestsAndCoverage.sh
+++ b/test/runTestsAndCoverage.sh
@@ -33,6 +33,7 @@ mkdir -p $DIR
EXCLUDES='Main
Data.CIByteString
Snap.Internal.Debug
+Snap.Internal.Iteratee.Debug
Snap.Iteratee.Tests
Snap.Internal.Http.Parser.Tests
Snap.Internal.Http.Server.Tests
diff --git a/test/suite/Snap/Internal/Http/Types/Tests.hs
b/test/suite/Snap/Internal/Http/Types/Tests.hs
index 8178bd0..bb292c7 100644
--- a/test/suite/Snap/Internal/Http/Types/Tests.hs
+++ b/test/suite/Snap/Internal/Http/Types/Tests.hs
@@ -40,7 +40,7 @@ testFormatLogTime :: Test
testFormatLogTime = testCase "formatLogTime" $ do
b <- formatLogTime 3804938
- let re = ("^[0-9]{1,2}/[A-Za-z]{3}/[0-9]{4}:[0-9]{2}:[0-9]{2}:[0-9]{2}
-[0-9]{4}$"
+ let re = ("^[0-9]{1,2}/[A-Za-z]{3}/[0-9]{4}:[0-9]{2}:[0-9]{2}:[0-9]{2}
(-|\\+)[0-9]{4}$"
:: ByteString)
assertBool "formatLogTime" $ b =~ re
diff --git a/test/suite/Snap/Iteratee/Tests.hs
b/test/suite/Snap/Iteratee/Tests.hs
index a75be5b..80a8395 100644
--- a/test/suite/Snap/Iteratee/Tests.hs
+++ b/test/suite/Snap/Iteratee/Tests.hs
@@ -1,6 +1,7 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
module Snap.Iteratee.Tests
( tests ) where
@@ -24,7 +25,6 @@ import qualified Test.QuickCheck.Monadic as QC
import Test.QuickCheck.Monadic hiding (run)
import Test.Framework.Providers.HUnit
import qualified Test.HUnit as H
-import System.IO.Unsafe
import Snap.Iteratee
import Snap.Test.Common ()
diff --git a/test/suite/Snap/Types/Tests.hs b/test/suite/Snap/Types/Tests.hs
index 3b9d8fa..cf736e2 100644
--- a/test/suite/Snap/Types/Tests.hs
+++ b/test/suite/Snap/Types/Tests.hs
@@ -411,8 +411,8 @@ testRedirect = testCase "redirect" $ do
assertEqual "status description" "Found" $ rspStatusReason rsp
- (_,rsp) <- go (redirect' "/bar/foo" 307)
+ (_,rsp2) <- go (redirect' "/bar/foo" 307)
- assertEqual "redirect path" (Just "/bar/foo") $ getHeader "Location" rsp
- assertEqual "redirect status" 307 $ rspStatus rsp
- assertEqual "status description" "Temporary Redirect" $ rspStatusReason rsp
+ assertEqual "redirect path" (Just "/bar/foo") $ getHeader "Location" rsp2
+ assertEqual "redirect status" 307 $ rspStatus rsp2
+ assertEqual "status description" "Temporary Redirect" $ rspStatusReason
rsp2
-----------------------------------------------------------------------
hooks/post-receive
--
snap-core
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
