gameServer/stresstest2.hs
author unc0rr
Wed, 29 Feb 2012 23:44:49 +0400
changeset 6753 e95b1f62d0de
parent 4932 f11d80bac7ed
child 10460 8dcea9087d75
permissions -rw-r--r--
Don't remove client's teams from teams list on "ROUNDFINISHED 0", just send team removal message to others. This should fix problems with ghost teams in frontend. Not tested at all, successfully built on first attempt, which is considered as a bad sign :D Server still thinks game proceeds, so restart isn't possible.
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 System.IO
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import Control.Concurrent
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import Network
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
     8
import Control.OldException
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import Control.Monad
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import System.Random
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
import System.Posix
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    16
session1 nick room = ["NICK", nick, "", "PROTO", "32", ""]
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    17
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    18
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    19
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    20
testing = Control.OldException.handle print $ do
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    21
    putStrLn "Start"
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    22
    sock <- connectTo "127.0.0.1" (PortNumber 46631)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    24
    num1 <- randomRIO (70000::Int, 70100)
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    25
    num2 <- randomRIO (0::Int, 2)
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    26
    num3 <- randomRIO (0::Int, 5)
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    27
    let nick1 = 'n' : show num1
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    28
    let room1 = 'r' : show num2
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    29
    mapM_ (\x -> hPutStrLn sock x >> hFlush sock >> randomRIO (300::Int, 590) >>= threadDelay) $ session1 nick1 room1
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    30
    mapM_ (\x -> hPutStrLn sock x >> hFlush sock) $ concatMap (\x -> ["CHAT_MSG", show x, ""]) [1..]
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    31
    hClose sock
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    32
    putStrLn "Finish"
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    33
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    34
forks = testing
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
main = withSocketsDo $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    37
#if !defined(mingw32_HOST_OS)
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2352
diff changeset
    38
    installHandler sigPIPE Ignore Nothing;
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    39
#endif
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    40
    forks