gameServer/stresstest2.hs
author koda
Thu, 15 Jul 2010 01:18:51 +0200
changeset 3642 fb39fecca350
parent 2948 3f21a9dc93d0
child 3947 709fdb89f76c
permissions -rw-r--r--
support for static map added to iFrontend
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import Control.Exception
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
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 1804
diff changeset
    17
testing = Control.Exception.handle print $ do
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    18
    delay <- randomRIO (100::Int, 300)
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    19
    threadDelay delay
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    20
    sock <- connectTo "127.0.0.1" (PortNumber 46631)
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    21
    hClose sock
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
forks i = do
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    24
    delay <- randomRIO (50::Int, 190)
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    25
    if i `mod` 10 == 0 then putStr (show i) else putStr "."
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    26
    hFlush stdout
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    27
    threadDelay delay
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    28
    forkIO testing
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
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
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    35
    forks 1