diff options
| -rw-r--r-- | Makefile.SH | 25 | ||||
| -rw-r--r-- | pod/perlhack.pod | 23 | ||||
| -rwxr-xr-x | t/TEST | 49 |
3 files changed, 95 insertions, 2 deletions
diff --git a/Makefile.SH b/Makefile.SH index cb04d7cc98..865620796f 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -603,6 +603,17 @@ purecovperl$(EXE_EXT): $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_e quantperl$(EXE_EXT): $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs $(PERLEXPORT) $(SHRPENV) $(LDLIBPTH) quantify $(CC) -o quantperl $(CLDFLAGS) $(CCDLFLAGS) perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) +# Valgrind perl (currently Linux only) + +perl.valgrind.config: config.sh + @echo "To build perl.valgrind you must Configure -Doptimize=-g -Uusemymalloc, checking..." + @$(MAKE) perl.config.dashg + @echo "Checking usemymalloc='n' in config.sh..." + @grep "^usemymalloc=" config.sh + @grep "^usemymalloc='n'" config.sh >/dev/null || exit 1 + @echo "And of course you have to have valgrind..." + valgrind --help >/dev/null || exit 1 + # Third Degree Perl (Tru64 only) perl.config.dashg: @@ -1105,6 +1116,20 @@ test-notty: test_notty test.torture torturetest: test_prep PERL=./perl TEST_ARGS=-torture $(MAKE) _test +# Targets for valgrind testing: + +test_prep.valgrind: test_prep perl.valgrind + PERL=./perl $(MAKE) _test_prep + +test.valgrind check.valgrind: test_prep perl.valgrind.config + PERL=./perl PERL_DEBUG=PERL_VALGRIND=1 $(MAKE) _test + +utest.valgrind ucheck.valgrind: test_prep.valgrind perl.valgrind + PERL=./perl PERL_DEBUG=PERL_VALGRIND=1 TEST_ARGS=-utf8 $(MAKE) _test + +test_notty.valgrind: test_prep.valgrind perl.valgrind + PERL=./perl $(MAKE) PERL_DEBUG=PERL_VALGRIND=1 _test_notty + # Targets for Third Degree testing. test_prep.third: test_prep perl.third diff --git a/pod/perlhack.pod b/pod/perlhack.pod index 01692806ad..c1b0c4ad5e 100644 --- a/pod/perlhack.pod +++ b/pod/perlhack.pod @@ -1817,6 +1817,12 @@ Run all the tests through the B::Deparse. Not all tests will succeed. Run F<miniperl> on F<t/base>, F<t/comp>, F<t/cmd>, F<t/run>, F<t/io>, F<t/op>, and F<t/uni> tests. +=item test.valgrind check.valgrind utest.valgrind ucheck.valgrind + +(Only in Linux) Run all the tests using the memory leak + naughty +memory access tool "valgrind". The log files will be named +F<testname.valgrind>. + =item test.third check.third utest.third ucheck.third (Only in Tru64) Run all the tests using the memory leak + naughty @@ -2060,6 +2066,23 @@ the Third Degree tool, so the said test must be doing something that is quite unfriendly for memory debuggers.) It is suggested that you simply kill away that testing process. +=head2 valgrind + +The excellent valgrind tool can be used to find out both memory leaks +and illegal memory accesses. As of August 2003 it unfortunately works +only on x86 (ELF) Linux. The special "test.valgrind" target can be used +to run the tests under valgrind. Note that in the test script (t/TEST) +currently (as of Perl 5.8.1) only naughty memory accesses are logged, +not memory leaks. Found errors are logged in files named F<test.valgrind>. +Also note that with Perl built with ithreads, the glibc (at least 2.2.5) +seems to have a bug of its own, where a non-locked POSIX mutex is +unlocked, and valgrind catches this, for every test-- therefore the +test script ignores that error. + +To get valgrind and for more information see + + http://developer.kde.org/~sewardj/ + =head2 Compaq's/Digital's/HP's Third Degree Third Degree is a tool for memory leak detection and memory access checks. @@ -183,6 +183,7 @@ EOT } # + 3 : we want three dots between the test name and the "ok" $dotdotdot = $maxlen + 3 ; + my $valgrind = 0; while ($test = shift @tests) { if ( $infinite{$test} && $type eq 'compile' ) { @@ -197,7 +198,7 @@ EOT # Redefinition happens at compile time next; } - elsif ($test eq "lib/switch.t") { + elsif ($test =~ m{lib/Switch/t/}) { # B::Deparse doesn't support source filtering next; } @@ -262,7 +263,10 @@ EOT } elsif ($type eq 'perl') { my $perl = $ENV{PERL} || './perl'; - my $redir = ($^O eq 'VMS' ? '2>&1' : ''); + my $redir = ($^O eq 'VMS' || $ENV{PERL_VALGRIND} ? '2>&1' : ''); + if ($ENV{PERL_VALGRIND}) { + $perl = "valgrind --num-callers=50 --leak-check=yes $perl"; + } my $run = "$perl" . _quote_args("$testswitch $switch $utf") . " $test $redir|"; open(RESULTS,$run) or print "can't run '$run': $!.\n"; } @@ -302,11 +306,16 @@ EOT $next = 0; my $seen_leader = 0; my $seen_ok = 0; + my @valgrind; while (<RESULTS>) { next if /^\s*$/; # skip blank lines if ($verbose) { print $_; } + if ($ENV{PERL_VALGRIND} && /^==\d+== /) { + push @valgrind, $_; + next; + } unless (/^\#/) { if (/^1\.\.([0-9]+)( todo ([\d ]+))?/) { $max = $1; @@ -353,6 +362,38 @@ EOT } } close RESULTS; + if ($ENV{PERL_VALGRIND}) { + if (@valgrind) { + my $skip_pthread_mutex_unlock; + for my $i (0..$#valgrind) { + local $_ = $valgrind[$i]; + my $pid; + if (/^==(\d+)== pthread_mutex_unlock: mutex is not locked/ && + ($pid = $1) && + $valgrind[$i+2] =~ m{\(in .+/libc.+\.so\)}) { + $skip_pthread_mutex_unlock++; + } elsif (/^==\d+== ERROR SUMMARY: (\d+) errors? /) { + $errors = $1; + } + } + if (defined $errors) { + $errors -= $skip_pthread_mutex_unlock; + if ($errors) { + if (open(V, ">$test.valgrind")) { + for (@valgrind) { + print V $_; + } + close V; + $valgrind++; + } else { + warn "$0: Failed to create '$test.valgrind': $!\n"; + } + } + } + } else { + warn "No valgrind output?\n"; + } + } if ($type eq 'deparse') { unlink "./$test.dp"; } @@ -447,5 +488,9 @@ SHRDLU_5 ($user,$sys,$cuser,$csys) = times; print sprintf("u=%g s=%g cu=%g cs=%g scripts=%d tests=%d\n", $user,$sys,$cuser,$csys,$files,$totmax); + if ($ENV{PERL_VALGRIND}) { + my $s = $valgrind == 1 ? '' : 's'; + print "$valgrind valgrind report$s created.\n", ; + } } exit ($bad != 0); |