[commit: ghc] master: Fix segmentation fault when .prof file not writeable (6d2bdfd)

git at git.haskell.org git at git.haskell.org
Tue Jan 26 17:24:06 UTC 2016


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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/6d2bdfd8d40b926d7a11d003213220022a63d9f5/ghc

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

commit 6d2bdfd8d40b926d7a11d003213220022a63d9f5
Author: Thomas Miedema <thomasmiedema at gmail.com>
Date:   Tue Jan 26 01:11:49 2016 +0100

    Fix segmentation fault when .prof file not writeable
    
    There are two ways to do retainer profiling. Quoting from the user's guide:
      1. `+RTS -hr` "Breaks down the graph by retainer set"
      2. `+RTS -hr<cc> -h<x>`, where `-h<x>` is one of normal heap profiling
         break-down options (e.g. `-hc`), and `-hr<cc> means "Restrict the
         profile to closures with retainer sets containing cost-centre
         stacks with one of the specified cost centres at the top."
    
    Retainer profiling writes to a .hp file, like the other heap profiling
    options, but also to a .prof file. Therefore, when the .prof file is not
    writeable for whatever reason, retainer profiling should be turned off
    completely.
    
    This worked ok when running the program with `+RTS -hr` (option 1), but a
    segfault would occur when using `+RTS -hr<cc> -h<x>`, with `x!=r` (option 2).
    
    This commit fixes that.
    
    Reviewed by: bgamari
    
    Differential Revision: https://phabricator.haskell.org/D1849
    
    GHC Trac Issues: #11489


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

6d2bdfd8d40b926d7a11d003213220022a63d9f5
 rts/ProfHeap.c                                              |  2 +-
 rts/ProfHeap.h                                              |  5 +++++
 rts/Profiling.c                                             | 13 +++++--------
 testsuite/tests/profiling/should_run/Makefile               | 10 ++++++++++
 .../{driver/T10219.hspp => profiling/should_run/T11489.hs}  |  0
 testsuite/tests/profiling/should_run/T11489.stderr          |  1 +
 testsuite/tests/profiling/should_run/all.T                  |  5 +++++
 testsuite/tests/rts/all.T                                   |  3 +--
 8 files changed, 28 insertions(+), 11 deletions(-)

diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c
index 416f5ac..187116f 100644
--- a/rts/ProfHeap.c
+++ b/rts/ProfHeap.c
@@ -161,7 +161,7 @@ doingLDVProfiling( void )
             || RtsFlags.ProfFlags.bioSelector != NULL);
 }
 
-STATIC_INLINE rtsBool
+rtsBool
 doingRetainerProfiling( void )
 {
     return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER
diff --git a/rts/ProfHeap.h b/rts/ProfHeap.h
index e29a9f6..279eef2 100644
--- a/rts/ProfHeap.h
+++ b/rts/ProfHeap.h
@@ -16,6 +16,11 @@ nat     initHeapProfiling  (void);
 void    endHeapProfiling   (void);
 rtsBool strMatchesSelector (const char* str, const char* sel);
 
+#ifdef PROFILING
+// doingRetainerProfiling: `-hr` or `-hr<cc> -h<x>`
+rtsBool doingRetainerProfiling(void);
+#endif
+
 #include "EndPrivate.h"
 
 #endif /* PROFHEAP_H */
diff --git a/rts/Profiling.c b/rts/Profiling.c
index 2c2981a..c67b081 100644
--- a/rts/Profiling.c
+++ b/rts/Profiling.c
@@ -254,9 +254,7 @@ initProfilingLogFile(void)
     }
 #endif
 
-    if (RtsFlags.CcFlags.doCostCentres == 0 &&
-        RtsFlags.ProfFlags.doHeapProfile != HEAP_BY_RETAINER &&
-        RtsFlags.ProfFlags.retainerSelector == NULL)
+    if (RtsFlags.CcFlags.doCostCentres == 0 && !doingRetainerProfiling())
     {
         /* No need for the <prog>.prof file */
         prof_filename = NULL;
@@ -272,11 +270,11 @@ initProfilingLogFile(void)
         if ((prof_file = fopen(prof_filename, "w")) == NULL) {
             debugBelch("Can't open profiling report file %s\n", prof_filename);
             RtsFlags.CcFlags.doCostCentres = 0;
-            // The following line was added by Sung; retainer/LDV profiling may need
-            // two output files, i.e., <program>.prof/hp.
-            if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER)
+            // Retainer profiling (`-hr` or `-hr<cc> -h<x>`) writes to
+            // both <program>.hp as <program>.prof.
+            if (doingRetainerProfiling()) {
                 RtsFlags.ProfFlags.doHeapProfile = 0;
-            return;
+            }
         }
     }
 
@@ -290,7 +288,6 @@ initProfilingLogFile(void)
             debugBelch("Can't open profiling report file %s\n",
                     hp_filename);
             RtsFlags.ProfFlags.doHeapProfile = 0;
-            return;
         }
     }
 }
diff --git a/testsuite/tests/profiling/should_run/Makefile b/testsuite/tests/profiling/should_run/Makefile
index 577fc34..e46dd97 100644
--- a/testsuite/tests/profiling/should_run/Makefile
+++ b/testsuite/tests/profiling/should_run/Makefile
@@ -23,3 +23,13 @@ scc001:
 	$(call scc001Rule,-O0)
 	$(call scc001Rule,-O)
 
+.PHONY: T11489
+T11489:
+	$(RM) T11489
+	touch T11489.prof
+	chmod -w T11489.prof
+	"$(TEST_HC)" -v0 -prof T11489.hs
+	# Should print some message about not being to open the .prof file,
+	# then continue to run and exit normally.
+	# Caused a segmentation fault in GHC <= 7.10.3
+	./T11489 +RTS -hr{} -hc
diff --git a/testsuite/tests/driver/T10219.hspp b/testsuite/tests/profiling/should_run/T11489.hs
similarity index 100%
copy from testsuite/tests/driver/T10219.hspp
copy to testsuite/tests/profiling/should_run/T11489.hs
diff --git a/testsuite/tests/profiling/should_run/T11489.stderr b/testsuite/tests/profiling/should_run/T11489.stderr
new file mode 100644
index 0000000..4f19dd9
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/T11489.stderr
@@ -0,0 +1 @@
+Can't open profiling report file T11489.prof
diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T
index 7804d46..ca37fe5 100644
--- a/testsuite/tests/profiling/should_run/all.T
+++ b/testsuite/tests/profiling/should_run/all.T
@@ -134,3 +134,8 @@ test('T5363',
 test('profinline001',
     [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ],
     compile_and_run, [''])
+
+test('T11489', [
+     req_profiling,
+     extra_clean(['T11489.prof', 'T11489.hp']),
+     ], run_command, ['$MAKE -s --no-print-directory T11489'])
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index c88bd62..951acbe 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -55,8 +55,7 @@ test('divbyzero',
 
 test('outofmem', when(opsys('darwin'), skip),
                  run_command, ['$MAKE -s --no-print-directory outofmem'])
-test('outofmem2', extra_run_opts('+RTS -M5m -RTS'),
-                  run_command, ['$MAKE -s --no-print-directory outofmem2'])
+test('outofmem2', normal, run_command, ['$MAKE -s --no-print-directory outofmem2'])
 
 test('T2047', [ignore_output, extra_run_opts('+RTS -c -RTS')],
               compile_and_run, ['-package containers'])



More information about the ghc-commits mailing list