blob: 75321ec7e593c2e844726572bf7b373c13131d21 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
{-# LANGUAGE RecordWildCards #-}
module Main where
import Control.Exception
import Control.Monad
import Data.Functor
import Data.List
import Data.Maybe
import System.Exit
import System.Environment
import System.Process
import System.Directory
import Text.Printf
import Test.Hspec
import Config
import Spec
type Command = String
type Descr = (ClientName, ClientOpts -> FilePath -> Command)
torrents :: [FilePath]
torrents =
[ "dapper-dvd-amd64-iso.torrent"
, "pkg.torrent"
, "testfile.torrent"
]
clients :: [Descr]
clients =
[ ("rtorrent"
, \ ClientOpts {..} tfile -> printf
"rtorrent -p %i-%i -O dht=on -O dht_port=%i -O session=rtorrent-sessiondir %s"
(fromEnum peerPort) (fromEnum peerPort) (fromEnum nodePort) tfile
)
]
sessionName :: String -- screen session name
sessionName = "bittorrent-testsuite"
setupEnv :: EnvOpts -> IO (Maybe ())
setupEnv EnvOpts {..}
| Just client <- testClient
, Just mkCmd <- lookup client clients = do
let runner = printf "screen -dm -S %s %s" sessionName
(mkCmd remoteOpts "testfile.torrent")
dir <- getCurrentDirectory
_ <- createProcess (shell runner) { cwd = Just (dir ++ "/res") }
return (Just ())
| Just client <- testClient = do
printf "Bad client `%s`, use one of %s" client (show (fst <$> clients))
return Nothing
| isNothing testClient = do
printf "Running without remote client"
return (Just ())
terminateEnv :: IO ()
terminateEnv = do
printf "closing screen session: %s" sessionName
_ <- system (printf "screen -S %s -X quit" sessionName)
return ()
runTestSuite :: [String] -> IO ExitCode
runTestSuite args = do
printf "running hspec test suite with args: %s\n" (show args)
catch (withArgs args (hspec spec) >> return ExitSuccess) return
main :: IO ()
main = do
(envOpts, suiteArgs) <- getOpts
running <- setupEnv envOpts
code <- runTestSuite suiteArgs
when (isJust running) $ do
terminateEnv
exitWith code
|
