diff options
-rw-r--r-- | testsuite/tests/ghc-api/T19156.hs | 33 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/T19156.stdout | 1 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/all.T | 3 |
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']) |