testsuite: Add test for #23160wip/T23160

2 files changed, 40 insertions, 0 deletions

diff --git a/testsuite/tests/rts/T23160.hs b/testsuite/tests/rts/T23160.hs
new file mode 100644
index 0000000000..e3707b8516
--- /dev/null
+++ b/testsuite/tests/rts/T23160.hs
@@ -0,0 +1,39 @@
+import Control.Exception
+import Control.Monad
+import System.Mem.Weak
+import System.Mem
+import System.IO.Unsafe
+import Control.Concurrent
+import Data.IORef
+
+
+data Dog = Dog { age :: !Int, dogTag :: DogTag}
+data DogTag = DogTag {name :: String, weakPtr :: !(Weak Dog)}
+
+mkDogTag :: Dog -> DogTag
+mkDogTag d = unsafePerformIO $ do
+  threadDelay 10
+  wk <- mkWeakPtr d $ Nothing
+  pure $ DogTag "k9" wk
+
+mkDog :: Int -> IO Dog
+mkDog age =
+  let
+    ret =
+      Dog
+        { age = age
+        , dogTag = mkDogTag ret
+        }
+  in do
+  performMajorGC
+  evaluate $ dogTag ret
+  pure $! ret
+
+main = do
+  dogs <- newIORef []
+  forM [1..2000] $ \n -> forkIO $ do
+    dog <- mkDog n
+    -- print $ age dog
+    modifyIORef' dogs (dog:)
+  threadDelay 100000
+
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index 407c653655..d701f5f247 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -573,3 +573,4 @@ 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('T23160', normal, compile_and_run, [])