[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