summaryrefslogtreecommitdiff
path: root/libraries/ghc-compact/tests/T16992.hs
diff options
context:
space:
mode:
Diffstat (limited to 'libraries/ghc-compact/tests/T16992.hs')
-rw-r--r--libraries/ghc-compact/tests/T16992.hs22
1 files changed, 22 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)