gameServer/stresstest2.hs
author nemo
Fri, 12 Nov 2010 17:53:35 -0500
branch0.9.14
changeset 4251 4b7d3507d175
parent 4242 5e3c5fe2cb14
child 4295 1f5604cd99be
permissions -rw-r--r--
pull bugfix into 0.9.14 avoid major performance hit when using flamethrower
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
{-# LANGUAGE CPP #-}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
module Main where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
import IO
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import System.IO
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import Control.Concurrent
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import Network
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3947
diff changeset
     9
import Control.Exception
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import Control.Monad
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import System.Random
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
import System.Posix
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3947
diff changeset
    17
testing = Control.Exception.handle print $ do
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3947
diff changeset
    18
    delay <- randomRIO (100::Int, 300)
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3947
diff changeset
    19
    threadDelay delay
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    20
    sock <- connectTo "127.0.0.1" (PortNumber 46631)
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3947
diff changeset
    21
    hClose sock
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3947
diff changeset
    23
forks i = do
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3947
diff changeset
    24
    delay <- randomRIO (50::Int, 190)
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3947
diff changeset
    25
    if i `mod` 10 == 0 then putStr (show i) else putStr "."
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3947
diff changeset
    26
    hFlush stdout
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3947
diff changeset
    27
    threadDelay delay
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3947
diff changeset
    28
    forkIO testing
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3947
diff changeset
    29
    forks (i + 1)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
main = withSocketsDo $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
#if !defined(mingw32_HOST_OS)
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    33
    installHandler sigPIPE Ignore Nothing;
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
#endif
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3947
diff changeset
    35
    forks 1