[commit: ghc] master: A panic in CmmBuildInfoTables.bundle shouldn't be a panic (#9329) (2989ffd)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/2989ffdcb88ab24e8a4e8b3d0454497a0db2652c/ghc

>---------------------------------------------------------------

commit 2989ffdcb88ab24e8a4e8b3d0454497a0db2652c
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Thu Jul 31 11:47:16 2014 +0100

    A panic in CmmBuildInfoTables.bundle shouldn't be a panic (#9329)
    
    Summary:
    This code needs more comments, but I believe this is safe.  By
    definition I can't have broken anything that was working by turning a
    panic into a non-panic anyway.
    
    Test Plan: validate
    
    Reviewers: hvr, simonpj, austin
    
    Subscribers: simonmar, relrod, ezyang, carter
    
    Differential Revision: https://phabricator.haskell.org/D105
    
    GHC Trac Issues: #9329


>---------------------------------------------------------------

2989ffdcb88ab24e8a4e8b3d0454497a0db2652c
 compiler/cmm/CmmBuildInfoTables.hs               | 12 ++++++++----
 testsuite/tests/codeGen/should_compile/T9329.cmm |  5 +++++
 testsuite/tests/codeGen/should_compile/all.T     |  1 +
 3 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index e10716a..6521a84 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -286,7 +286,7 @@ bundle :: Map CLabel CAFSet
        -> (CAFEnv, CmmDecl)
        -> (CAFSet, Maybe CLabel)
        -> (BlockEnv CAFSet, CmmDecl)
-bundle flatmap (env, decl@(CmmProc infos lbl _ g)) (closure_cafs, mb_lbl)
+bundle flatmap (env, decl@(CmmProc infos _lbl _ g)) (closure_cafs, mb_lbl)
   = ( mapMapWithKey get_cafs (info_tbls infos), decl )
  where
   entry = g_entry g
@@ -297,9 +297,13 @@ bundle flatmap (env, decl@(CmmProc infos lbl _ g)) (closure_cafs, mb_lbl)
 
   get_cafs l _
     | l == entry = entry_cafs
-    | otherwise  = if not (mapMember l env)
-                      then pprPanic "bundle" (ppr l <+> ppr lbl <+> ppr (info_tbls infos) $$ ppr env $$ ppr decl)
-                      else flatten flatmap $ expectJust "bundle" $ mapLookup l env
+    | Just info <- mapLookup l env = flatten flatmap info
+    | otherwise  = Set.empty
+    -- the label might not be in the env if the code corresponding to
+    -- this info table was optimised away (perhaps because it was
+    -- unreachable).  In this case it doesn't matter what SRT we
+    -- infer, since the info table will not appear in the generated
+    -- code.  See #9329.
 
 bundle _flatmap (_, decl) _
   = ( mapEmpty, decl )
diff --git a/testsuite/tests/codeGen/should_compile/T9329.cmm b/testsuite/tests/codeGen/should_compile/T9329.cmm
new file mode 100644
index 0000000..da20069
--- /dev/null
+++ b/testsuite/tests/codeGen/should_compile/T9329.cmm
@@ -0,0 +1,5 @@
+foo ()
+{
+  STK_CHK_GEN_N (8); /* panics */
+  return (0);
+}
diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T
index a3020fe..a6b6894 100644
--- a/testsuite/tests/codeGen/should_compile/all.T
+++ b/testsuite/tests/codeGen/should_compile/all.T
@@ -24,3 +24,4 @@ test('T7574', [cmm_src, omit_ways(['llvm', 'optllvm'])], compile, [''])
 test('T8205', normal, compile, ['-O0'])
 test('T9155', normal, compile, ['-O2'])
 test('T9303', normal, compile, ['-O2'])
+test('T9329', [cmm_src], compile, [''])