From: Vincent Pit Date: Mon, 25 Aug 2008 21:57:06 +0000 (+0200) Subject: Test real-life leaks with some XS X-Git-Tag: v0.05~1 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=8d66aa098b18f8c9724b12bf446d330905122c57;p=perl%2Fmodules%2FTest-Valgrind.git Test real-life leaks with some XS --- diff --git a/.gitignore b/.gitignore index 10678ca..8989f53 100644 --- a/.gitignore +++ b/.gitignore @@ -3,6 +3,7 @@ pm_to_blib* Makefile Makefile.old +Makefile.bak Build _build* diff --git a/FixInstall.PL b/FixInstall.PL new file mode 100755 index 0000000..958f1f9 --- /dev/null +++ b/FixInstall.PL @@ -0,0 +1,33 @@ +use strict; +use warnings; + +use File::Copy qw/copy/; + +my ($bak) = @ARGV; +exit 1 unless defined $bak; + +my $mk = './Makefile'; +exit 1 unless defined $mk and -e $mk and -r _ and -w _; + +select STDERR; + +print "Fixing Makefile install targets\n"; + +if (-e $bak && (stat $bak)[9] >= (stat $mk)[9]) { # mtime + print "Makefile is old\n"; + copy($bak, $mk); +} else { + print "Makefile is new\n"; + copy($mk, $bak); +} + +open my $in, '<', $bak or die "open(<$bak): $!"; +open my $out, '>', $mk or die "open(>$mk): $!"; +while (<$in>) { + s!^(\s*)\$\(INST_ARCHLIB\)\s+(\$\(DESTINSTALL(?:ARCHLIB|SITEARCH|VENDORARCH)\))\s*\\\s*!$1blib/archpub $2/\$(FULLEXT) \\\n!g; + print $out $_; +} +close $out; +close $in; + +utime time, time, $bak; # Update mtime diff --git a/MANIFEST b/MANIFEST index 774c1e2..074e4a0 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,8 +1,10 @@ Changes +FixInstall.PL Gensupp.PL MANIFEST Makefile.PL README +Valgrind.xs gen.pl lib/Test/Valgrind.pm lib/Test/Valgrind/perlTestValgrind.supp @@ -13,6 +15,7 @@ t/00-load.t t/01-import.t t/10-suppressions.t t/20-good.t +t/30-bad.t t/90-boilerplate.t t/91-pod.t t/92-pod-coverage.t diff --git a/Makefile.PL b/Makefile.PL index 62a9060..1ac7172 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -4,6 +4,14 @@ use strict; use warnings; use ExtUtils::MakeMaker; +BEGIN { + eval { require Config }; + die 'OS unsupported' if $@; + Config->import(qw/%Config/); + eval { require File::Spec }; + die 'OS unsupported' if $@; +} + my $vg; print 'Checking for valgrind >= 3.1.0 in PATH... '; for (split /:/, $ENV{PATH}) { @@ -13,7 +21,7 @@ for (split /:/, $ENV{PATH}) { if ($ver =~ s/^valgrind-//) { $ver = join '', map chr, split /\./, $ver; if ($ver ge v3.1.0) { - print "yes, $_\n"; + print "$_\n"; $vg = $_; last; } @@ -25,9 +33,36 @@ if (!$vg) { die 'OS unsupported'; } +# Inspired from Module::Install::Can +print "Checking for a valid C compiler in the PATH... "; +my @ccs = ($Config{cc}); +unshift @ccs, $ENV{CC} if $ENV{CC}; +my $cc; +CC: +for my $c (@ccs) { + for my $dir (split /$Config{path_sep}/, $ENV{PATH}) { + my $abs = File::Spec->catfile($dir, $c); + if (-x $abs or MM->maybe_command($abs)) { + $cc = $c; + last CC; + } + } +} +my (@C); +if ($cc) { + my $xs = 'Valgrind.xs'; + (my $c = $xs) =~ s/\.xs$/.c/; + push @C, $c; + print $cc, "\n"; +} else { + print "none\n"; +} + my $BUILD_REQUIRES = { 'ExtUtils::MakeMaker' => 0, - 'Test::More' => 0 + 'File::Copy' => 0, + 'Test::More' => 0, + 'XSLoader' => 0 }; sub build_req { @@ -58,14 +93,18 @@ WriteMakefile( LICENSE => 'perl', VERSION_FROM => 'lib/Test/Valgrind.pm', ABSTRACT_FROM => 'lib/Test/Valgrind.pm', - PL_FILES => { './Gensupp.PL' => 'lib/' . $supp }, + PL_FILES => { + './Gensupp.PL' => 'blib/archpub/' . $supp, + './FixInstall.PL' => 'Makefile.bak', + }, + OPTIMIZE => '-g', PM => { 'lib/Test/Valgrind.pm' => '$(INST_LIB)/Test/Valgrind.pm', 'lib/Test/Valgrind/Suppressions.pm' - => '$(INST_ARCHLIB)/Test/Valgrind/Suppressions.pm', - 'lib/' . $supp => '$(INST_ARCHLIB)/' . $supp, + => 'blib/archpub/Test/Valgrind/Suppressions.pm', }, + C => \@C, PREREQ_PM => { 'Carp' => 0, 'Exporter' => 0, @@ -74,20 +113,21 @@ WriteMakefile( 'Test::More' => 0, }, dist => { - PREOP => 'pod2text lib/Test/Valgrind.pm > $(DISTVNAME)/README; ' + PREOP => "touch lib/$supp; " + . 'pod2text lib/Test/Valgrind.pm > $(DISTVNAME)/README; ' . build_req, COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, - clean => { FILES => "Test-Valgrind-* lib/$supp *.gcov *.gcda *.gcno cover_db Debian_CPANTS.txt" }, + clean => { FILES => "Test-Valgrind-* lib/$supp Makefile.bak *.gcov *.gcda *.gcno cover_db Debian_CPANTS.txt" }, ); 1 while unlink 'lib/' . $supp; package MY; sub postamble { - < 1, - no_test => 1, - no_supp => 1, - extra => [ - q{--show-reachable=yes}, - q{--gen-suppressions=all}, -# q{--log-fd=1} - ] +use Test::Valgrind + diag => 1, + no_test => 1, + no_supp => 1, + callers => 50, + extra => [ qw/--show-reachable=yes --gen-suppressions=all/ ] EOD -plan skip_all => 'Test::Valgrind is required to run test your distribution with valgrind' if $@; +if ($@) { + plan skip_all => 'Test::Valgrind is required to run test your distribution with valgrind'; +} else { + eval { + require XSLoader; + XSLoader::load('Test::Valgrind', $Test::Valgrind::VERSION); + }; + unless ($@) { + Test::Valgrind::notleak("valgrind it!"); + } +} 1; diff --git a/samples/map.pl b/samples/map.pl index e291605..f19ab3a 100755 --- a/samples/map.pl +++ b/samples/map.pl @@ -3,7 +3,7 @@ use strict; use warnings; -use lib qw{blib/lib blib/arch}; +use lib qw{blib/lib blib/archpub}; use Test::Valgrind; { diff --git a/t/00-load.t b/t/00-load.t index 91a8a96..de83532 100644 --- a/t/00-load.t +++ b/t/00-load.t @@ -5,6 +5,7 @@ use warnings; use Test::More tests => 1; +use lib qw{blib/archpub}; BEGIN { use_ok( 'Test::Valgrind::Suppressions' ); } diff --git a/t/01-import.t b/t/01-import.t index cb0938f..26733da 100644 --- a/t/01-import.t +++ b/t/01-import.t @@ -5,6 +5,7 @@ use warnings; use Test::More tests => 2; +use lib qw{blib/archpub}; require Test::Valgrind::Suppressions; for (qw/supp_path VG_PATH/) { diff --git a/t/10-suppressions.t b/t/10-suppressions.t index 935dfbe..ca9db49 100644 --- a/t/10-suppressions.t +++ b/t/10-suppressions.t @@ -4,6 +4,7 @@ use strict; use warnings; use Test::More tests => 2; +use lib qw{blib/archpub}; use Test::Valgrind::Suppressions qw/supp_path VG_PATH/; my $path = supp_path(); diff --git a/t/20-good.t b/t/20-good.t index 781bf38..d13977d 100644 --- a/t/20-good.t +++ b/t/20-good.t @@ -4,7 +4,8 @@ use strict; use warnings; use Test::More; -eval 'use Test::Valgrind'; # diag => 1'; +use lib qw{blib/archpub}; +eval 'use Test::Valgrind'; plan skip_all => 'Test::Valgrind is required to run test your distribution with valgrind' if $@; 1; diff --git a/t/30-bad.t b/t/30-bad.t new file mode 100644 index 0000000..93765cf --- /dev/null +++ b/t/30-bad.t @@ -0,0 +1,46 @@ +#!perl + +use strict; +use warnings; + +use Config qw/%Config/; + +use Test::More; + +sub tester { + my ($a, $desc) = @_; + my $passed; + my $dbg = eval "Test::Valgrind::DEBUGGING()"; + if ($desc =~ /still\s+reachable/) { + $passed = $a >= 9900 && $a < 10100; + if ($dbg) { + ok($passed, $desc); + } else { + TODO: { + local $TODO = "Leak count may be off on non-debugging perls"; + ok($passed, $desc); + } + return 1; + } + } else { + $passed = defined $a && $a == 0; + is($a, 0, $desc); + } + return $passed; +} + +eval { + require XSLoader; + XSLoader::load('Test::Valgrind', 0.04); +}; +if ($@) { + plan skip_all => "XS test code not available ($@)"; +} else { + use lib qw{blib/archpub}; + eval 'use Test::Valgrind cb => \&tester;'; + if ($@) { + plan skip_all => 'Test::Valgrind is required to run test your distribution with valgrind'; + } else { + Test::Valgrind::leak(); + } +}