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-server".
The branch, master has been updated
via 97b23dd112787dbb20e0287b36659a668e7fd9b0 (commit)
from 344aca6b7e18dc4f32acae324029ea22f3ddf8e9 (commit)
Summary of changes:
test/suite/Snap/Internal/Http/Server/Tests.hs | 17 +++++++++--------
1 files changed, 9 insertions(+), 8 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 97b23dd112787dbb20e0287b36659a668e7fd9b0
Author: Gregory Collins <[email protected]>
Date: Sat Dec 11 17:23:10 2010 +0100
Prevent exceptions from leaking out httpServe in whitebox test
diff --git a/test/suite/Snap/Internal/Http/Server/Tests.hs
b/test/suite/Snap/Internal/Http/Server/Tests.hs
index a795f7d..9a7a651 100644
--- a/test/suite/Snap/Internal/Http/Server/Tests.hs
+++ b/test/suite/Snap/Internal/Http/Server/Tests.hs
@@ -8,7 +8,8 @@ module Snap.Internal.Http.Server.Tests
( tests ) where
import Control.Concurrent
-import Control.Exception ( try
+import Control.Exception ( catch
+ , try
, throwIO
, bracket
, finally
@@ -32,7 +33,7 @@ import Data.Typeable
import Data.Word
import qualified Network.HTTP as HTTP
import qualified Network.Socket.ByteString as N
-import Prelude hiding (take)
+import Prelude hiding (catch, take)
import qualified Prelude
import System.Timeout
import Test.Framework
@@ -469,9 +470,6 @@ testHttpResponse4 = testCase "server/HttpResponse4" $ do
emptyResponse { rspHttpVersion = (1,0) }
--- httpServe "127.0.0.1" 8080 "localhost" pongServer
-
-
echoServer :: (ByteString -> IO ())
-> Request
@@ -731,9 +729,7 @@ sendFileFoo = sendFile "data/fileServe/foo.html"
testSendFile :: Test
testSendFile = testCase "server/sendFile" $ do
- bracket (forkIO $ httpServe [HttpPort "*" port] Nothing "localhost"
- Nothing Nothing
- $ runSnap sendFileFoo)
+ bracket (forkIO serve)
(killThread)
(\tid -> do
m <- timeout (120 * seconds) $ go tid
@@ -742,6 +738,11 @@ testSendFile = testCase "server/sendFile" $ do
m)
where
+ serve = (httpServe [HttpPort "*" port] Nothing "localhost"
+ Nothing Nothing
+ $ runSnap sendFileFoo)
+ `catch` \(_::SomeException) -> return ()
+
go tid = do
waitabit
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
