Skip to content

Commit 7395bea

Browse files
committed
Use Tasty for RTS thread count test
This removes test/Makefile since all tests have been moved to be run by Tasty! Yay! The thread count is a pretty good example for how the shell is pretty useful for this kind of tests. DSLs aren't that bad after all...
1 parent 87619af commit 7395bea

File tree

3 files changed

+21
-20
lines changed

3 files changed

+21
-20
lines changed

Makefile

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -349,7 +349,6 @@ rts: $(ARCHIVES)
349349
test:
350350
cd compiler && stack test
351351
$(MAKE) -C backend test
352-
$(MAKE) -C test
353352

354353
test-builtins:
355354
cd compiler && stack test --ta '-p "Builtins"'

compiler/test.hs

Lines changed: 21 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,6 @@ import Data.List.Split
44
import Data.Maybe
55
import Data.Ord
66
import Data.Time.Clock.POSIX
7-
87
import System.Directory
98
import System.Directory.Recursive
109
import System.Exit
@@ -142,6 +141,27 @@ rtsTests =
142141
assertEqual "RTS wthreads error retCode" (ExitFailure 1) returnCode
143142
assertEqual "RTS wthreads error cmdErr" "ERROR: --rts-wthreads requires an argument.\n" cmdErr
144143

144+
, testCase "thread count" $ do
145+
-- check the number of threads, which should be 10, consisting of 7
146+
-- worker threads (as specified on command line), IO+new IO & main
147+
testBuild "" ExitSuccess False "../test/rts/wthreads1.act"
148+
(pin, pout, perr, ph) <- runInteractiveProcess "../test/rts/wthreads1" ["--rts-wthreads=7"] Nothing Nothing
149+
mpid <- getPid ph
150+
case mpid of
151+
Just pid -> do
152+
#if defined(darwin_HOST_OS)
153+
let cmd = "ps -M " ++ show pid ++ " | tail -n +2 | wc -l"
154+
#else
155+
let cmd = "ps -o thcount " ++ show pid
156+
#endif
157+
(returnCode, cmdOut, cmdErr) <- readCreateProcessWithExitCode (shell $ cmd) ""
158+
let tCount = read (last $ lines cmdOut)::Int
159+
assertEqual "RTS thread count" 10 tCount
160+
Nothing -> do
161+
assertFailure "whtreads1 program should be running"
162+
terminateProcess ph
163+
waitForProcess ph
164+
return ()
145165
]
146166

147167
rtsDDBTests =

test/Makefile

Lines changed: 0 additions & 18 deletions
This file was deleted.

0 commit comments

Comments
 (0)