From c00c81a507d31b6d51e89f00d1e4c83f71c7d382 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Fri, 26 Jul 2019 10:41:44 -0400 Subject: 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 --- libraries/ghc-compact/tests/T16992.hs | 22 ++++++++++++++++++++++ libraries/ghc-compact/tests/T16992.stdout | 1 + libraries/ghc-compact/tests/all.T | 5 +++++ rts/sm/CNF.c | 5 +++-- 4 files changed, 31 insertions(+), 2 deletions(-) create mode 100644 libraries/ghc-compact/tests/T16992.hs create mode 100644 libraries/ghc-compact/tests/T16992.stdout 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, ['']) diff --git a/rts/sm/CNF.c b/rts/sm/CNF.c index 43a090fd42..2c701c2c29 100644 --- a/rts/sm/CNF.c +++ b/rts/sm/CNF.c @@ -1020,8 +1020,9 @@ cmp_fixup_table_item (const void *e1, const void *e2) { const StgWord *w1 = e1; const StgWord *w2 = e2; - - return *w1 - *w2; + if (*w1 > *w2) return +1; + else if (*w1 < *w2) return -1; + else return 0; } static StgWord * -- cgit v1.2.1