gameServer/stresstest2.hs
author unc0rr
Sun, 19 Apr 2009 11:40:41 +0000
changeset 2004 f7944d5adc5f
parent 1804 4e78ad846fb6
child 2352 7eaf82cf0890
permissions -rw-r--r--
Some work to try prevent stack memory leak
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
testing = Control.Exception.handle (\e -> putStrLn $ show e) $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
	delay <- randomRIO (100::Int, 300)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
	threadDelay delay
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
	sock <- connectTo "127.0.0.1" (PortNumber 46631)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
	hClose sock
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
forks i = do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
	delay <- randomRIO (50::Int, 190)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
	if i `mod` 10 == 0 then putStr (show i) else putStr "."
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
	hFlush stdout
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
	threadDelay delay
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
	forkIO testing
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    29
	forks (i + 1)
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)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    33
	installHandler sigPIPE Ignore Nothing;
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
	forks 1