summaryrefslogtreecommitdiff
path: root/libraries/ghc-compact
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2019-07-26 10:41:44 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-05-13 02:02:33 -0400
commitcf4f1e2f78840d25b132de55bce1e02256334ace (patch)
tree19b0b6e268c574763eb09e0798c9cceb5c0dfdb2 /libraries/ghc-compact
parentb352d63cbbfbee69358c198edd876fe7ef9d63ef (diff)
downloadhaskell-cf4f1e2f78840d25b132de55bce1e02256334ace.tar.gz
rts/CNF: Fix fixup comparison function
Previously we would implicitly convert the difference between two words to an int, resulting in an integer overflow on 64-bit machines. Fixes #16992
Diffstat (limited to 'libraries/ghc-compact')
-rw-r--r--libraries/ghc-compact/tests/T16992.hs22
-rw-r--r--libraries/ghc-compact/tests/T16992.stdout1
-rw-r--r--libraries/ghc-compact/tests/all.T5
3 files changed, 28 insertions, 0 deletions
diff --git a/libraries/ghc-compact/tests/T16992.hs b/libraries/ghc-compact/tests/T16992.hs
new file mode 100644
index 0000000000..6505aa7b00
--- /dev/null
+++ b/libraries/ghc-compact/tests/T16992.hs
@@ -0,0 +1,22 @@
+import Data.Bifunctor
+import Foreign.Ptr
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Unsafe as BS
+import qualified GHC.Compact as Compact
+import qualified GHC.Compact.Serialized as CompactSerialize
+
+-- | Minimal test case for reproducing compactFixupPointers# bug for large compact regions.
+-- See Issue #16992.
+main :: IO ()
+main = do
+ let
+ large = 1024 * 1024 * 128
+ largeString = replicate large 'A'
+
+ region <- Compact.compact largeString
+
+ Just deserialized <- CompactSerialize.withSerializedCompact region $ \s -> do
+ blks <- mapM (BS.unsafePackCStringLen . bimap castPtr fromIntegral) (CompactSerialize.serializedCompactBlockList s)
+ CompactSerialize.importCompactByteStrings s blks
+
+ print (Compact.getCompact deserialized == largeString)
diff --git a/libraries/ghc-compact/tests/T16992.stdout b/libraries/ghc-compact/tests/T16992.stdout
new file mode 100644
index 0000000000..0ca95142bb
--- /dev/null
+++ b/libraries/ghc-compact/tests/T16992.stdout
@@ -0,0 +1 @@
+True
diff --git a/libraries/ghc-compact/tests/all.T b/libraries/ghc-compact/tests/all.T
index 24f5d6d2b4..45e8d5f378 100644
--- a/libraries/ghc-compact/tests/all.T
+++ b/libraries/ghc-compact/tests/all.T
@@ -22,3 +22,8 @@ test('compact_share', omit_ways(['ghci', 'profasm', 'profthreaded']),
test('compact_bench', [ ignore_stdout, extra_run_opts('100') ],
compile_and_run, [''])
test('T17044', normal, compile_and_run, [''])
+# N.B. Sanity check times out due to large list.
+test('T16992', [when(wordsize(32), skip), # Resource limit exceeded on 32-bit
+ high_memory_usage,
+ run_timeout_multiplier(5),
+ omit_ways(['sanity'])], compile_and_run, [''])