summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2022-08-06 00:06:03 -0400
committerBen Gamari <ben@smart-cactus.org>2022-08-06 10:47:04 -0400
commit2363cf077587b38950ee9908632777e0a4fc99b0 (patch)
tree52cc1e9c9e9e10ed26203882a7fdc881d949aef8
parenta54827e0b48af33fa9cfde6ad131c6751c2fe321 (diff)
downloadhaskell-wip/T21962.tar.gz
rts: Don't clear cards of zero-length arrayswip/T21962
Fix #21962, where attempting to clear the card table of a zero-length array resulted in an integer underflow.
-rw-r--r--rts/PrimOps.cmm4
-rw-r--r--testsuite/tests/array/should_run/T21962.hs12
-rw-r--r--testsuite/tests/array/should_run/all.T1
3 files changed, 16 insertions, 1 deletions
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 26568f961d..8932bd6042 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -409,7 +409,9 @@ stg_newArrayArrayzh ( W_ n /* words */ )
StgMutArrPtrs_size(arr) = size;
// Initialize card table to all-clean.
- setCardsValue(arr, 0, n, 0);
+ if (n != 0) {
+ setCardsValue(arr, 0, n, 0);
+ }
// Initialise all elements of the array with a pointer to the new array
p = arr + SIZEOF_StgMutArrPtrs;
diff --git a/testsuite/tests/array/should_run/T21962.hs b/testsuite/tests/array/should_run/T21962.hs
new file mode 100644
index 0000000000..ab96760289
--- /dev/null
+++ b/testsuite/tests/array/should_run/T21962.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE MagicHash #-}
+
+module Main where
+
+import GHC.IO
+import GHC.Exts
+
+main :: IO ()
+main = do
+ IO $ \s0 -> case newArray# 0# () s0 of (# s1, arr #) -> (# s1, () #)
+ IO $ \s0 -> case newArrayArray# 0# s0 of (# s1, arr #) -> (# s1, () #)
diff --git a/testsuite/tests/array/should_run/all.T b/testsuite/tests/array/should_run/all.T
index 6b5500700e..3c4e7cb755 100644
--- a/testsuite/tests/array/should_run/all.T
+++ b/testsuite/tests/array/should_run/all.T
@@ -24,3 +24,4 @@ test('arr017', when(fast(), skip), compile_and_run, [''])
test('arr018', when(fast(), skip), compile_and_run, [''])
test('arr019', normal, compile_and_run, [''])
test('arr020', normal, compile_and_run, [''])
+test('T21962', normal, compile_and_run, [''])