Skip to content

Commit

Permalink
Use Tasty for RTS thread count test
Browse files Browse the repository at this point in the history
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...
  • Loading branch information
plajjan committed Aug 2, 2022
1 parent 87619af commit 3a8f66c
Show file tree
Hide file tree
Showing 3 changed files with 20 additions and 20 deletions.
1 change: 0 additions & 1 deletion Makefile
Original file line number Diff line number Diff line change
Expand Up @@ -349,7 +349,6 @@ rts: $(ARCHIVES)
test:
cd compiler && stack test
$(MAKE) -C backend test
$(MAKE) -C test

test-builtins:
cd compiler && stack test --ta '-p "Builtins"'
Expand Down
21 changes: 20 additions & 1 deletion compiler/test.hs
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
{-# LANGUAGE CPP #-}
import Control.Concurrent
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Ord
import Data.Time.Clock.POSIX

import System.Directory
import System.Directory.Recursive
import System.Exit
Expand Down Expand Up @@ -142,6 +142,25 @@ rtsTests =
assertEqual "RTS wthreads error retCode" (ExitFailure 1) returnCode
assertEqual "RTS wthreads error cmdErr" "ERROR: --rts-wthreads requires an argument.\n" cmdErr

, testCase "thread count" $ do
-- check the number of threads, which should be 10, consisting of 7
-- worker threads (as specified on command line), IO+new IO & main
testBuild "" ExitSuccess False "../test/rts/wthreads1.act"
(pin, pout, perr, ph) <- runInteractiveProcess "../test/rts/wthreads1" ["--rts-wthreads=7"] Nothing Nothing
-- wait for program to start up
threadDelay 100000
mpid <- getPid ph
case mpid of
Just pid -> do
let cmd = "ps -o thcount " ++ show pid
(returnCode, cmdOut, cmdErr) <- readCreateProcessWithExitCode (shell $ cmd) ""
let tCount = read (last $ lines cmdOut)::Int
assertEqual "RTS thread count" 10 tCount
Nothing -> do
assertFailure "whtreads1 program should be running"
terminateProcess ph
waitForProcess ph
return ()
]

rtsDDBTests =
Expand Down
18 changes: 0 additions & 18 deletions test/Makefile

This file was deleted.

0 comments on commit 3a8f66c

Please sign in to comment.