[commit: ghc] ghc-8.2: base: Validate input in setNumCapabilities (a4e7820)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.2
Link       : http://ghc.haskell.org/trac/ghc/changeset/a4e782087ae0df211f8d48c11ded0b1dd81f40a4/ghc

>---------------------------------------------------------------

commit a4e782087ae0df211f8d48c11ded0b1dd81f40a4
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Fri Jun 16 15:18:48 2017 -0400

    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
    
    (cherry picked from commit 9849403147b584ff160daeb4f13bf36adb2bab2e)


>---------------------------------------------------------------

a4e782087ae0df211f8d48c11ded0b1dd81f40a4
 libraries/base/GHC/Conc/Sync.hs   | 4 +++-
 testsuite/tests/rts/T13832.hs     | 4 ++++
 testsuite/tests/rts/T13832.stderr | 1 +
 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 78a0334..44d34d8 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 0000000..47d9ed2
--- /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 0000000..7a552ca
--- /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 fc7363f..f32a35b 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'])