1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Control.Exception
import Control.Concurrent (killThread)
import Control.Concurrent.MVar
import Control.Monad
import Prelude hiding (catch)
import Network (withSocketsDo)
import Test.Framework (defaultMain, testGroup)
import System.Environment
import Snap.Http.Server.Config
import qualified Data.Concurrent.HashMap.Tests
import qualified Snap.Internal.Http.Parser.Tests
import qualified Snap.Internal.Http.Server.Tests
import qualified Snap.Internal.Http.Server.TimeoutManager.Tests
import qualified Test.Blackbox
ports :: Int -> [Int]
ports sp = [sp..]
#ifdef OPENSSL
sslports :: Int -> [Maybe Int]
sslports sp = map Just [(sp + 100)..]
#else
sslports :: Int -> [Maybe Int]
sslports _ = repeat Nothing
#endif
#ifdef LIBEV
backends :: Int -> [(Int,Maybe Int,ConfigBackend)]
backends sp = zip3 (ports sp)
(sslports sp)
[ConfigSimpleBackend, ConfigLibEvBackend]
#else
backends :: Int -> [(Int,Maybe Int,ConfigBackend)]
backends sp = zip3 (ports sp)
(sslports sp)
[ConfigSimpleBackend]
#endif
getStartPort :: IO Int
getStartPort = (liftM read (getEnv "STARTPORT") >>= evaluate)
`catch` \(_::SomeException) -> return 8111
main :: IO ()
main = withSocketsDo $ do
sp <- getStartPort
let bends = backends sp
tinfos <- forM bends $ \(port,sslport,b) ->
Test.Blackbox.startTestServer port sslport b
defaultMain (tests ++ concatMap blackbox bends) `finally` do
mapM_ killThread $ map fst tinfos
mapM_ takeMVar $ map snd tinfos
where tests =
[ testGroup "Data.Concurrent.HashMap.Tests"
Data.Concurrent.HashMap.Tests.tests
, testGroup "Snap.Internal.Http.Parser.Tests"
Snap.Internal.Http.Parser.Tests.tests
, testGroup "Snap.Internal.Http.Server.Tests"
Snap.Internal.Http.Server.Tests.tests
, testGroup "Snap.Internal.Http.Server.TimeoutManager.Tests"
Snap.Internal.Http.Server.TimeoutManager.Tests.tests
]
blackbox (port, sslport, b) =
[ testGroup ("Test.Blackbox " ++ backendName)
$ Test.Blackbox.tests port backendName
, testGroup ("Test.Blackbox SSL " ++ backendName)
$ Test.Blackbox.ssltests backendName sslport
]
where
backendName = show b
|
