Pre-add test case for #19156

3 files changed, 37 insertions, 0 deletions

diff --git a/testsuite/tests/ghc-api/T19156.hs b/testsuite/tests/ghc-api/T19156.hs
new file mode 100644
index 0000000000..999c1af242
--- /dev/null
+++ b/testsuite/tests/ghc-api/T19156.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+import GHC.Exts.Heap
+import GHC.Types.SrcLoc
+
+rsl :: RealSrcLoc
+rsl = mkRealSrcLoc "Foo" 1 1
+
+main = do
+  let !s1 = RealSrcLoc rsl (Just (BufPos 999222))
+      !s2 = RealSrcLoc rsl (Just (BufPos 999333))
+      !s3 = RealSrcLoc rsl (Just (BufPos 999444))
+
+      !res = combineSrcSpans (combineSrcSpans (srcLocSpan s1) (srcLocSpan s2)) (srcLocSpan s3)
+  cs <- unbox res
+
+  -- The output must be an empty list because we don't want to retain
+  -- intermediate locations in the heap.
+  print (filter (hasDataArg 999333) cs)
+
+hasDataArg x (ConstrClosure _ _ dataArgs _ _ _) = any (== x) dataArgs
+hasDataArg x _ = False
+
+unbox :: a -> IO [GenClosure Box]
+unbox a = loop (asBox a)
+  where
+    loop :: Box -> IO [GenClosure Box]
+    loop (Box b) = do
+      c <- getClosureData b
+      p <- concat <$> traverse loop (allClosures c)
+      return (c : p)
diff --git a/testsuite/tests/ghc-api/T19156.stdout b/testsuite/tests/ghc-api/T19156.stdout
new file mode 100644
index 0000000000..fe51488c70
--- /dev/null
+++ b/testsuite/tests/ghc-api/T19156.stdout
@@ -0,0 +1 @@
+[]
diff --git a/testsuite/tests/ghc-api/all.T b/testsuite/tests/ghc-api/all.T
index 4135ca7a13..00e158516e 100644
--- a/testsuite/tests/ghc-api/all.T
+++ b/testsuite/tests/ghc-api/all.T
@@ -24,3 +24,6 @@ test('T18522-dbg-ppr',
   extra_run_opts('"' + config.libdir + '"'),
   compile_and_run,
   ['-package ghc'])
+test('T19156', [extra_run_opts('"' + config.libdir + '"'), expect_broken(19156)],
+              compile_and_run,
+              ['-package ghc'])