Add regression test for #17574

This test currently fails in the nonmoving way

3 files changed, 44 insertions, 0 deletions

diff --git a/testsuite/tests/rts/T17574.hs b/testsuite/tests/rts/T17574.hs
new file mode 100644
index 0000000000..2af8d156b1
--- /dev/null
+++ b/testsuite/tests/rts/T17574.hs
@@ -0,0 +1,40 @@
+-- | Check that large objects are properly accounted for by GHC.Stats
+module Main (main) where
+
+import Control.Monad
+import Control.Exception
+import Control.Concurrent
+import System.Mem
+import System.Exit
+import GHC.Stats
+import GHC.Compact
+import Data.List (replicate)
+
+import qualified Data.ByteString.Char8 as BS
+
+doGC :: IO ()
+doGC = do
+  performMajorGC
+  threadDelay 1000 -- small delay to allow GC to run when using concurrent gc
+
+main :: IO ()
+main = do
+  let size = 4096*2
+  largeString <- evaluate $ BS.replicate size 'A'
+  compactString <- compact $ replicate size 'A'
+  doGC
+  doGC -- run GC twice to make sure the objects end up in the oldest gen
+  stats <- getRTSStats
+  let large_obj_bytes = gcdetails_large_objects_bytes $ gc stats
+  let compact_obj_bytes = gcdetails_compact_bytes $ gc stats
+  -- assert that large_obj_bytes is at least as big as size
+  -- this indicates that `largeString` is being accounted for by the stats department
+  when (large_obj_bytes < fromIntegral size) $ do
+    putStrLn $ "large_obj_bytes is: " <> show large_obj_bytes <> " but expected at least: " <> show size
+    exitFailure
+  when (compact_obj_bytes < fromIntegral size) $ do
+    putStrLn $ "compact_obj_bytes is: " <> show large_obj_bytes <> " but expected at least: " <> show size
+    exitFailure
+  -- keep them alive
+  print $ BS.length largeString
+  print $ length $ getCompact compactString
diff --git a/testsuite/tests/rts/T17574.stdout b/testsuite/tests/rts/T17574.stdout
new file mode 100644
index 0000000000..82950d41bb
--- /dev/null
+++ b/testsuite/tests/rts/T17574.stdout
@@ -0,0 +1,2 @@
+8192
+8192
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index 407c653655..ba18e32d35 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -573,3 +573,5 @@ test('decodeMyStack_emptyListForMissingFlag',
 test('T22795a', [only_ways(['normal']), js_skip], compile_and_run, ['-threaded'])
 test('T22795b', [only_ways(['normal']), js_skip], compile_and_run, ['-single-threaded'])
 test('T22795c', [only_ways(['normal']), js_skip], compile_and_run, ['-threaded -single-threaded'])
+
+test('T17574', [js_skip], compile_and_run, ['-with-rtsopts -T'])