diff options
Diffstat (limited to 'testsuite')
| -rw-r--r-- | testsuite/.gitignore | 1 | ||||
| -rw-r--r-- | testsuite/tests/rts/T10728.hs | 40 | ||||
| -rw-r--r-- | testsuite/tests/rts/T10728.stdout | 1 | ||||
| -rw-r--r-- | testsuite/tests/rts/all.T | 13 |
4 files changed, 50 insertions, 5 deletions
diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 2886400681..e8cb351fcc 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1389,6 +1389,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/rts/T8242 /tests/rts/T9045 /tests/rts/T9078 +/tests/rts/T10728 /tests/rts/atomicinc /tests/rts/bug1010 /tests/rts/derefnull diff --git a/testsuite/tests/rts/T10728.hs b/testsuite/tests/rts/T10728.hs new file mode 100644 index 0000000000..056124d0ca --- /dev/null +++ b/testsuite/tests/rts/T10728.hs @@ -0,0 +1,40 @@ +-- T10728 test case for ``-maxN<n>`` + +module Main where + +import GHC.Conc (getNumProcessors, getNumCapabilities) +import GHC.Environment +import Data.Char + +main :: IO () +main = do + -- We're parsing args passed in to make sure things are proper between the + -- cli and the program. + n <- getN + + c <- getNumCapabilities + p <- getNumProcessors + + putStr $ check n c p + +----- + +check :: Int -> Int -> Int -> String +check n c p + | n /= 0 && c /= 0 && p /= 0 -- These should never be 0 + -- Capabilities are equal to n, are they also within processor count? + && (n == c && c <= p) + -- Capabilities are equal to processor count, are they also within n? + || (c == p && c <= n) + = "maxN Successful" +check _n _c _p = "maxN Error" + +-- Parsing ``-maxN<n>`` from Args to be sure of it. +getN :: IO Int +getN = getFullArgs >>= return . go + where + go :: [String] -> Int + go as = case reads ( + dropWhile (not . isDigit) . (!! 1) $ as ) :: [(Int, String)] of + [x] -> fst x + _ -> 0 diff --git a/testsuite/tests/rts/T10728.stdout b/testsuite/tests/rts/T10728.stdout new file mode 100644 index 0000000000..715329ea3c --- /dev/null +++ b/testsuite/tests/rts/T10728.stdout @@ -0,0 +1 @@ +maxN Successful diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 9892050b34..c88bd62267 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -1,9 +1,9 @@ test('testblockalloc', - [c_src, only_ways(['normal','threaded1']), extra_run_opts('+RTS -I0')], + [c_src, only_ways(['normal','threaded1']), extra_run_opts('+RTS -I0')], compile_and_run, ['']) test('testmblockalloc', - [c_src, only_ways(['normal','threaded1']), extra_run_opts('+RTS -I0')], + [c_src, only_ways(['normal','threaded1']), extra_run_opts('+RTS -I0')], compile_and_run, ['']) # -I0 is important: the idle GC will run the memory leak detector, # which will crash because the mblocks we allocate are not in a state @@ -53,7 +53,7 @@ test('divbyzero', when(opsys('mingw32'), omit_ways(prof_ways))], compile_and_run, ['']) -test('outofmem', when(opsys('darwin'), skip), +test('outofmem', when(opsys('darwin'), skip), run_command, ['$MAKE -s --no-print-directory outofmem']) test('outofmem2', extra_run_opts('+RTS -M5m -RTS'), run_command, ['$MAKE -s --no-print-directory outofmem2']) @@ -111,8 +111,8 @@ test('T2615', # omit dyn and profiling ways, because we don't build dyn_l or p_l # variants of the RTS by default -test('traceEvent', [ omit_ways(['dyn'] + prof_ways), - extra_run_opts('+RTS -ls -RTS') ], +test('traceEvent', [ omit_ways(['dyn'] + prof_ways), + extra_run_opts('+RTS -ls -RTS') ], compile_and_run, ['-eventlog']) test('T4059', @@ -333,3 +333,6 @@ test('T10590', [ignore_output, when(opsys('mingw32'),skip)], compile_and_run, [' # 20000 was easily enough to trigger the bug with 7.10 test('T10904', [ omit_ways(['ghci']), extra_run_opts('20000') ], compile_and_run, ['T10904lib.c']) + +test('T10728', [extra_run_opts('+RTS -maxN3 -RTS'), req_smp], + compile_and_run, ['-threaded']) |