diff options
author | Ben Gamari <bgamari.foss@gmail.com> | 2017-06-16 15:18:48 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2017-06-16 15:18:49 -0400 |
commit | 9849403147b584ff160daeb4f13bf36adb2bab2e (patch) | |
tree | 71575819587edb945ad99e96637ed753e2b11324 | |
parent | 430137c45420153dafbd448b4d509f893fe675f4 (diff) | |
download | haskell-9849403147b584ff160daeb4f13bf36adb2bab2e.tar.gz |
base: Validate input in setNumCapabilities
Test Plan: validate
Reviewers: austin, hvr, erikd, simonmar
Subscribers: rwbarton, thomie
GHC Trac Issues: #13832
Differential Revision: https://phabricator.haskell.org/D3652
-rw-r--r-- | libraries/base/GHC/Conc/Sync.hs | 4 | ||||
-rw-r--r-- | testsuite/tests/rts/T13832.hs | 4 | ||||
-rw-r--r-- | testsuite/tests/rts/T13832.stderr | 1 | ||||
-rw-r--r-- | testsuite/tests/rts/all.T | 2 |
4 files changed, 9 insertions, 2 deletions
diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs index 78a0334617..44d34d8262 100644 --- a/libraries/base/GHC/Conc/Sync.hs +++ b/libraries/base/GHC/Conc/Sync.hs @@ -379,7 +379,9 @@ to avoid contention with other processes in the machine. @since 4.5.0.0 -} setNumCapabilities :: Int -> IO () -setNumCapabilities i = c_setNumCapabilities (fromIntegral i) +setNumCapabilities i + | i <= 0 = fail $ "setNumCapabilities: Capability count ("++show i++") must be positive" + | otherwise = c_setNumCapabilities (fromIntegral i) foreign import ccall safe "setNumCapabilities" c_setNumCapabilities :: CUInt -> IO () diff --git a/testsuite/tests/rts/T13832.hs b/testsuite/tests/rts/T13832.hs new file mode 100644 index 0000000000..47d9ed2b7f --- /dev/null +++ b/testsuite/tests/rts/T13832.hs @@ -0,0 +1,4 @@ +import GHC.Conc + +main :: IO () +main = setNumCapabilities 0 diff --git a/testsuite/tests/rts/T13832.stderr b/testsuite/tests/rts/T13832.stderr new file mode 100644 index 0000000000..7a552caa9a --- /dev/null +++ b/testsuite/tests/rts/T13832.stderr @@ -0,0 +1 @@ +T13832: user error (setNumCapabilities: Capability count (0) must be positive) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index fc7363f6bd..f32a35be3e 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -372,4 +372,4 @@ test('T12497', [ unless(opsys('mingw32'), skip) run_command, ['$MAKE -s --no-print-directory T12497']) test('T12903', [when(opsys('mingw32'), skip)], compile_and_run, ['']) - +test('T13832', exit_code(1), compile_and_run, ['-threaded']) |