diff options
author | Ben Gamari <ben@smart-cactus.org> | 2019-07-26 10:41:44 -0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-05-13 02:02:33 -0400 |
commit | cf4f1e2f78840d25b132de55bce1e02256334ace (patch) | |
tree | 19b0b6e268c574763eb09e0798c9cceb5c0dfdb2 /libraries/ghc-compact | |
parent | b352d63cbbfbee69358c198edd876fe7ef9d63ef (diff) | |
download | haskell-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.hs | 22 | ||||
-rw-r--r-- | libraries/ghc-compact/tests/T16992.stdout | 1 | ||||
-rw-r--r-- | libraries/ghc-compact/tests/all.T | 5 |
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, ['']) |