[commit: ghc] ghc-7.8: rts: remove stable-names from hashtable upon free (7304d18)

[git at git.haskell.org]

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

On branch  : ghc-7.8
Link       : http://ghc.haskell.org/trac/ghc/changeset/7304d1814a55fdcde6923feb18d33ae3a17c0d30/ghc

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

commit 7304d1814a55fdcde6923feb18d33ae3a17c0d30
Author: Edward Z. Yang <ezyang at cs.stanford.edu>
Date:   Sun May 18 21:32:10 2014 -0500

    rts: remove stable-names from hashtable upon free
    
    This fixes #9078.
    
    Signed-off-by: Austin Seipp <austin at well-typed.com>
    (cherry picked from commit b75d126e779e8690c675be84e8972dc023e04b9b)


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

7304d1814a55fdcde6923feb18d33ae3a17c0d30
 rts/Stable.c                     |  1 +
 testsuite/tests/rts/T9078.hs     | 10 ++++++++++
 testsuite/tests/rts/T9078.stderr |  2 ++
 testsuite/tests/rts/all.T        |  3 +++
 4 files changed, 16 insertions(+)

diff --git a/rts/Stable.c b/rts/Stable.c
index ec74b0d..431b7c6 100644
--- a/rts/Stable.c
+++ b/rts/Stable.c
@@ -246,6 +246,7 @@ STATIC_INLINE void
 freeSnEntry(snEntry *sn)
 {
   ASSERT(sn->sn_obj == NULL);
+  removeHashTable(addrToStableHash, (W_)sn->old, NULL);
   sn->addr = (P_)stable_name_free;
   stable_name_free = sn;
 }
diff --git a/testsuite/tests/rts/T9078.hs b/testsuite/tests/rts/T9078.hs
new file mode 100644
index 0000000..d0389f1
--- /dev/null
+++ b/testsuite/tests/rts/T9078.hs
@@ -0,0 +1,10 @@
+module Main where
+
+import Control.Monad
+import System.Mem.StableName
+
+main :: IO ()
+main = replicateM_ 500000 (makeStableName foo)
+
+foo :: Int
+foo = 1
diff --git a/testsuite/tests/rts/T9078.stderr b/testsuite/tests/rts/T9078.stderr
new file mode 100644
index 0000000..901a1ca
--- /dev/null
+++ b/testsuite/tests/rts/T9078.stderr
@@ -0,0 +1,2 @@
+cap 0: initialised
+cap 0: shutting down
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index 102a671..8b4fdfa 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -212,3 +212,6 @@ test('T8124', [ only_ways(threaded_ways), omit_ways(['ghci']),
 # The ghci way gets confused by the RTS options
 test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], compile_and_run, [''])
 
+# I couldn't reproduce 9078 with the -threaded runtime, but could easily
+# with the non-threaded one.
+test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-DS" -debug'])