gameServer/stresstest3.hs
author Simon McVittie <smcv@debian.org>
Mon, 12 Sep 2022 10:40:53 -0400
branch1.0.0
changeset 15859 7b1d6dfa3173
parent 11046 47a8c19ecb60
permissions -rw-r--r--
Remove FindSDL2 find-module, use sdl2-config.cmake instead This requires SDL >= 2.0.4. Since <https://bugzilla.libsdl.org/show_bug.cgi?id=2464> was fixed in SDL 2.0.4, SDL behaves as a CMake "config-file package", even if it was not itself built using CMake: it installs a sdl2-config.cmake file to ${libdir}/cmake/SDL2, which tells CMake where to find SDL's headers and library, analogous to a pkg-config .pc file. As a result, we no longer need to copy/paste a "find-module package" to be able to find a system copy of SDL >= 2.0.4 with find_package(SDL2). Find-module packages are now discouraged by the CMake developers, in favour of having upstream projects behave as config-file packages. This results in a small API change: FindSDL2 used to set SDL2_INCLUDE_DIR and SDL2_LIBRARY, but the standard behaviour for config-file packages is to set <name>_INCLUDE_DIRS and <name>_LIBRARIES. Use the CONFIG keyword to make sure we search in config-file package mode, and will not find a FindSDL2.cmake in some other directory that implements the old interface. In addition to deleting redundant code, this avoids some assumptions in FindSDL2 about the layout of a SDL installation. The current libsdl2-dev package in Debian breaks those assumptions; this is considered a bug and will hopefully be fixed soon, but it illustrates how fragile these assumptions can be. We can be more robust against different installation layouts by relying on SDL's own CMake integration. When linking to a copy of CMake in a non-standard location, users can now set the SDL2_DIR or CMAKE_PREFIX_PATH environment variable to point to it; previously, these users would have used the SDL2DIR environment variable. This continues to be unnecessary if using matching system-wide installations of CMake and SDL2, for example both from Debian.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10460
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
     1
{-
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
     2
 * Hedgewars, a free turn based strategy game
11046
47a8c19ecb60 more copyright fixes
sheepluva
parents: 10460
diff changeset
     3
 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
10460
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
     4
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
     8
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
    12
 * GNU General Public License for more details.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
    13
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
    14
 * You should have received a copy of the GNU General Public License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
    15
 * along with this program; if not, write to the Free Software
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
    16
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
    17
 \-}
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 7751
diff changeset
    18
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    19
{-# LANGUAGE CPP #-}
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    20
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    21
module Main where
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    22
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    23
import System.IO
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
    24
import System.IO.Error
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    25
import Control.Concurrent
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    26
import Network
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    27
import Control.OldException
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    28
import Control.Monad
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    29
import System.Random
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    30
import Control.Monad.State
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    31
import Data.List
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    32
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    33
#if !defined(mingw32_HOST_OS)
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    34
import System.Posix
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    35
#endif
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    36
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    37
type SState = Handle
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    38
io = liftIO
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    39
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    40
readPacket :: StateT SState IO [String]
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    41
readPacket = do
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    42
    h <- get
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
    43
    io $ hGetPacket h []
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    44
    where
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    45
    hGetPacket h buf = do
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    46
        l <- hGetLine h
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
    47
        if not $ null l then hGetPacket h (buf ++ [l]) else return buf
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    48
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    49
waitPacket :: String -> StateT SState IO Bool
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    50
waitPacket s = do
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    51
    p <- readPacket
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    52
    return $ head p == s
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    53
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    54
sendPacket :: [String] -> StateT SState IO ()
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    55
sendPacket s = do
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    56
    h <- get
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    57
    io $ do
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    58
        mapM_ (hPutStrLn h) s
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    59
        hPutStrLn h ""
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    60
        hFlush h
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    61
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    62
emulateSession :: StateT SState IO ()
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    63
emulateSession = do
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    64
    n <- io $ randomRIO (100000::Int, 100100)
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    65
    waitPacket "CONNECTED"
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
    66
    sendPacket ["NICK", "test" ++ show n]
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    67
    waitPacket "NICK"
7751
8c7f5c43ea5e Switch to vector library for arrays
unc0rr
parents: 5058
diff changeset
    68
    sendPacket ["PROTO", "41"]
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    69
    waitPacket "PROTO"
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    70
    b <- waitPacket "LOBBY:JOINED"
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    71
    --io $ print b
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    72
    sendPacket ["QUIT", "BYE"]
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    73
    return ()
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    74
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    75
testing = Control.OldException.handle print $ do
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    76
    putStr "+"
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    77
    sock <- connectTo "127.0.0.1" (PortNumber 46631)
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    78
    evalStateT emulateSession sock
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    79
    --hClose sock
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    80
    putStr "-"
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    81
    hFlush stdout
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    82
5058
4229507909d6 Some improvements in test programs
unc0rr
parents: 4932
diff changeset
    83
forks = forever $ do
4229507909d6 Some improvements in test programs
unc0rr
parents: 4932
diff changeset
    84
    delay <- randomRIO (0::Int, 80000)
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    85
    threadDelay delay
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    86
    forkIO testing
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    87
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    88
main = withSocketsDo $ do
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    89
#if !defined(mingw32_HOST_OS)
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    90
    installHandler sigPIPE Ignore Nothing;
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    91
#endif
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    92
    forks