--- /dev/null
+blib*
+pm_to_blib*
+
+Makefile{,.old}
+Build
+_build*
+
+*.tar.gz
+Test-Valgrind-*
+lib/Test/Valgrind/perlTestValgrind.supp
+
+core.*
+*.{c,o,so,bs,out,def,exp}
+
+cover_db
+*.{gcda,gcov,gcno}
+
--- /dev/null
+Revision history for Test-Valgrind
+
+0.01 2008-04-19 15:50 UTC
+ First version, released on an unsuspecting world.
+
--- /dev/null
+use strict;
+use warnings;
+
+my ($sf) = @ARGV;
+exit 1 unless defined $sf;
+
+my $file = './gen.pl';
+
+pipe my $rdr, my $wtr or die "pipe(\$rdr, \$wtr): $!";
+my $pid = fork;
+if (!defined $pid) {
+ die "fork(): $!";
+} elsif ($pid == 0) {
+ close $rdr or die "close(\$rdr): $!";
+ open STDERR, '>&', $wtr or die "open(STDERR, '>&', \$wtr): $!";
+ exec $^X, '-Mlib=lib', $file;
+}
+close $wtr or die "close(\$rdr): $!";
+
+my ($supp, $name, $num) = ('', 'perlTestValgrind', 0);
+while (<$rdr>) {
+ s/^\s*#\s//;
+ next if /^==/;
+ next if /valgrind/ and /\Q$file\E/;
+ s/<[^>]+>/$name . ++$num/e;
+ $supp .= $_;
+}
+waitpid $pid, 0;
+
+1 while unlink $sf;
+open my $out, '>', $sf or die "$!";
+print $out $supp;
+close $out;
--- /dev/null
+Changes
+Gensupp.PL
+MANIFEST
+Makefile.PL
+README
+gen.pl
+lib/Test/Valgrind.pm
+lib/Test/Valgrind/perlTestValgrind.supp
+lib/Test/Valgrind/Suppressions.pm
+samples/map.pl
+t/00-load.t
+t/01-import.t
+t/10-suppressions.t
+t/20-good.t
+t/90-boilerplate.t
+t/91-pod.t
+t/92-pod-coverage.t
+t/95-portability-files.t
+t/99-kwalitee.t
+META.yml Module meta-data (added by MakeMaker)
--- /dev/null
+--- #YAML:1.0
+name: Test-Valgrind
+version: 0.01
+abstract: Test your code through valgrind.
+license: perl
+author:
+ - Vincent Pit <perl@profvince.com>
+generated_by: ExtUtils::MakeMaker version 6.42
+distribution_type: module
+requires:
+ Carp: 0
+ Exporter: 0
+ POSIX: 0
+ Test::More: 0
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
+build_requires:
+ ExtUtils::MakeMaker: 0
+ Test::More: 0
--- /dev/null
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+my $has_vg = 0;
+print 'Checking for valgrind >= 3.1.0 in PATH... ';
+for (split /:/, $ENV{PATH}) {
+ my $vg = $_ . '/valgrind';
+ if (-x $vg) {
+ my $ver = qx/$vg --version/;
+ if ($ver =~ s/^valgrind-//) {
+ $ver = join '', map chr, split /\./, $ver;
+ if ($ver ge v3.1.0) {
+ print "yes, $vg\n";
+ $has_vg = 1;
+ last;
+ }
+ }
+ }
+}
+if (!$has_vg) {
+ print "no\n";
+ die 'OS unsupported';
+}
+
+my $BUILD_REQUIRES = {
+ 'ExtUtils::MakeMaker' => 0,
+ 'Test::More' => 0
+};
+
+sub build_req {
+ my $tometa = ' >> $(DISTVNAME)/META.yml;';
+ my $build_req = 'echo "build_requires:" ' . $tometa;
+ foreach my $mod ( sort { lc $a cmp lc $b } keys %$BUILD_REQUIRES ) {
+ my $ver = $BUILD_REQUIRES->{$mod};
+ $build_req .= sprintf 'echo " %-30s %s" %s', "$mod:", $ver, $tometa;
+ }
+ return $build_req;
+}
+
+my $supp = 'Test/Valgrind/perlTestValgrind.supp';
+
+WriteMakefile(
+ NAME => 'Test::Valgrind',
+ AUTHOR => 'Vincent Pit <perl@profvince.com>',
+ LICENSE => 'perl',
+ VERSION_FROM => 'lib/Test/Valgrind.pm',
+ ABSTRACT_FROM => 'lib/Test/Valgrind.pm',
+ PL_FILES => { './Gensupp.PL' => 'lib/' . $supp },
+ 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,
+ },
+ PREREQ_PM => {
+ 'Carp' => 0,
+ 'Exporter' => 0,
+ 'POSIX' => 0,
+ 'Test::More' => 0,
+ },
+ dist => {
+ PREOP => '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" },
+);
+1 while unlink 'lib/' . $supp;
+
--- /dev/null
+NAME
+ Test::Valgrind - Test your code through valgrind.
+
+VERSION
+ Version 0.01
+
+SYNOPSIS
+ use Test::More;
+ eval 'use Test::Valgrind';
+ plan skip_all => 'Test::Valgrind is required to test your distribution with valgrind';
+
+ # Code to inspect for memory leaks/errors.
+
+DESCRIPTION
+ This module lets you run some code through the valgrind memory debugger,
+ to test it for memory errors and leaks. Just add "use Test::Valgrind" at
+ the beginning of the code you want to test. Behind the hood,
+ "Test::Valgrind::import" forks so that the child can basically "exec
+ 'valgrind', $^X, $0" (except that of course $0 isn't right there). The
+ parent then parses the report output by valgrind and pass or fail tests
+ accordingly.
+
+CONFIGURATION
+ You can pass parameters to "import" as a list of key / value pairs,
+ where valid keys are :
+
+ "supp => $file"
+ Also use suppressions from $file besides perl's.
+
+ "no_supp => $bool"
+ If true, do not use any suppressions.
+
+ "callers => $number"
+ Specify the maximum stack depth studied when valgrind encounters an
+ error. Raising this number improves granularity. Default is 50.
+
+ "extra => [ @args ]"
+ Add @args to valgrind parameters.
+
+ "diag => $bool"
+ If true, print the raw output of valgrind as diagnostics (may be
+ quite verbose).
+
+ "no_test => $bool"
+ If true, do not actually output the plan and the tests results.
+
+CAVEATS
+ You can't use this module to test code given by the "-e" command-line
+ switch. This module is not really secure. It's definitely not taint
+ safe. That shouldn't be a problem for test files. If your tests output
+ to STDERR, everything will be eaten in the process.
+
+DEPENDENCIES
+ Valgrind 3.1.0 (<http://valgrind.org>).
+
+ Carp, POSIX (core modules since perl 5) and Test::More (since 5.6.2).
+
+AUTHOR
+ Vincent Pit, "<perl at profvince.com>", <http://www.profvince.com>.
+
+ You can contact me by mail or on #perl @ FreeNode (vincent or
+ Prof_Vince).
+
+BUGS
+ Please report any bugs or feature requests to "bug-test-valgrind at
+ rt.cpan.org", or through the web interface at
+ <http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Valgrind>. I will
+ be notified, and then you'll automatically be notified of progress on
+ your bug as I make changes.
+
+SUPPORT
+ You can find documentation for this module with the perldoc command.
+
+ perldoc Test::Valgrind
+
+COPYRIGHT & LICENSE
+ Copyright 2008 Vincent Pit, all rights reserved.
+
+ This program is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+eval <<'EOD';
+use Test::Valgrind diag => 1,
+ no_test => 1,
+ no_supp => 1,
+ extra => [
+ q{--show-reachable=yes},
+ q{--gen-suppressions=all},
+# q{--log-fd=1}
+ ]
+EOD
+plan skip_all => 'Test::Valgrind is required to run test your distribution with valgrind' if $@;
+
+1;
+
--- /dev/null
+package Test::Valgrind;
+
+use strict;
+use warnings;
+
+use Carp qw/croak/;
+use POSIX qw/SIGTERM/;
+use Test::More;
+
+use Test::Valgrind::Suppressions;
+
+=head1 NAME
+
+Test::Valgrind - Test your code through valgrind.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+=head1 SYNOPSIS
+
+ use Test::More;
+ eval 'use Test::Valgrind';
+ plan skip_all => 'Test::Valgrind is required to test your distribution with valgrind';
+
+ # Code to inspect for memory leaks/errors.
+
+=head1 DESCRIPTION
+
+This module lets you run some code through the B<valgrind> memory debugger, to test it for memory errors and leaks. Just add C<use Test::Valgrind> at the beginning of the code you want to test. Behind the hood, C<Test::Valgrind::import> forks so that the child can basically C<exec 'valgrind', $^X, $0> (except that of course C<$0> isn't right there). The parent then parses the report output by valgrind and pass or fail tests accordingly.
+
+=head1 CONFIGURATION
+
+You can pass parameters to C<import> as a list of key / value pairs, where valid keys are :
+
+=over 4
+
+=item C<< supp => $file >>
+
+Also use suppressions from C<$file> besides perl's.
+
+=item C<< no_supp => $bool >>
+
+If true, do not use any suppressions.
+
+=item C<< callers => $number >>
+
+Specify the maximum stack depth studied when valgrind encounters an error. Raising this number improves granularity. Default is 50.
+
+=item C<< extra => [ @args ] >>
+
+Add C<@args> to valgrind parameters.
+
+=item C<< diag => $bool >>
+
+If true, print the raw output of valgrind as diagnostics (may be quite verbose).
+
+=item C<< no_test => $bool >>
+
+If true, do not actually output the plan and the tests results.
+
+=back
+
+=cut
+
+my $run;
+
+sub import {
+ shift;
+ croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
+ my %args = @_;
+ if (!defined $args{run} && !$run) {
+ my ($file, $next);
+ my $l = 0;
+ while ($l < 1000) {
+ $next = (caller $l++)[1];
+ last unless defined $next;
+ $file = $next;
+ }
+ return if not $file or $file eq '-e';
+ my $valgrind;
+ for (split /:/, $ENV{PATH}) {
+ my $vg = $_ . '/valgrind';
+ if (-x $vg) {
+ $valgrind = $vg;
+ last;
+ }
+ }
+ if (!$valgrind) {
+ plan skip_all => 'No valgrind executable could be found in your path';
+ return;
+ }
+ my $callers = $args{callers} || 50;
+ $callers = int $callers;
+ pipe my $rdr, my $wtr or croak "pipe(\$rdr, \$wtr): $!";
+ my $pid = fork;
+ if (!defined $pid) {
+ croak "fork(): $!";
+ } elsif ($pid == 0) {
+ setpgrp 0, 0 or croak "setpgrp(0, 0): $!";
+ close $rdr or croak "close(\$rdr): $!";
+ open STDERR, '>&', $wtr or croak "open(STDERR, '>&', \$wtr): $!";
+ my @args = (
+ '--tool=memcheck',
+ '--leak-check=full',
+ '--leak-resolution=high',
+ '--num-callers=' . $callers,
+ '--error-limit=yes'
+ );
+ unless ($args{no_supp}) {
+ for (Test::Valgrind::Suppressions::supppath(), $args{supp}) {
+ push @args, '--suppressions=' . $_ if $_;
+ }
+ }
+ if (defined $args{extra} and ref $args{extra} eq 'ARRAY') {
+ push @args, @{$args{extra}};
+ }
+ push @args, $^X;
+ push @args, '-I' . $_ for @INC;
+ push @args, '-MTest::Valgrind=run,1', $file;
+ print STDERR "valgrind @args\n" if $args{diag};
+ local $ENV{PERL_DESTRUCT_LEVEL} = 3;
+ local $ENV{PERL_DL_NONLAZY} = 1;
+ exec 'valgrind', @args;
+ }
+ close $wtr or croak "close(\$wtr): $!";
+ local $SIG{INT} = sub { kill -(SIGTERM) => $pid };
+ plan tests => 5 unless $args{no_test};
+ my @tests = (
+ 'errors',
+ 'definitely lost', 'indirectly lost', 'possibly lost', 'still reachable'
+ );
+ my %res = map { $_ => 0 } @tests;
+ while (<$rdr>) {
+ diag $_ if $args{diag};
+ if (/^=+\d+=+\s*FATAL\s*:\s*(.*)/) {
+ chomp(my $err = $1);
+ diag "Valgrind error: $err";
+ $res{$_} = undef for @tests;
+ }
+ if (/ERROR\s+SUMMARY\s*:\s+(\d+)/) {
+ $res{errors} = int $1;
+ } elsif (/([a-z][a-z\s]*[a-z])\s*:\s*([\d.,]+)/) {
+ my ($cat, $count) = ($1, $2);
+ if (exists $res{$cat}) {
+ $cat =~ s/\s+/ /g;
+ $count =~ s/[.,]//g;
+ $res{$cat} = int $count;
+ }
+ }
+ }
+ waitpid $pid, 0;
+ my $failed = 0;
+ for (@tests) {
+ is($res{$_}, 0, 'valgrind ' . $_) unless $args{no_test};
+ ++$failed if defined $res{$_} and $res{$_} != 0;
+ }
+ exit $failed;
+ } else {
+ $run = 1;
+ }
+}
+
+=head1 CAVEATS
+
+You can't use this module to test code given by the C<-e> command-line switch.
+This module is not really secure. It's definitely not taint safe. That shouldn't be a problem for test files.
+If your tests output to STDERR, everything will be eaten in the process.
+
+=head1 DEPENDENCIES
+
+Valgrind 3.1.0 (L<http://valgrind.org>).
+
+L<Carp>, L<POSIX> (core modules since perl 5) and L<Test::More> (since 5.6.2).
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-test-valgrind at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Valgrind>. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Test::Valgrind
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of Test::Valgrind
--- /dev/null
+package Test::Valgrind::Suppressions;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+Test::Valgrind::Suppressions - Placeholder for architecture-dependant perl suppressions.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+=head1 DESCRIPTION
+
+L<Test::Valgrind> needs suppressions so that perl's errors aren't reported. However, these suppressions depend widely on the architecture, perl's version and the features it has been build with (e.g. threads). The goal of this module is hence to be installed together with the suppression file generated when the Test-Valgrind distribution was built, and to handle back to L<Test::Valgrind> the path to the suppression file.
+
+=head1 FUNCTIONS
+
+=head2 C<supppath>
+
+Returns the path to the suppression file that applies to the current running perl, or C<undef> when no such file is available.
+
+=cut
+
+sub supppath {
+ my $pkg = __PACKAGE__;
+ $pkg =~ s!::!/!g;
+ $pkg .= '.pm';
+ return if not $INC{$pkg};
+ my $supp = $INC{$pkg};
+ $supp =~ s![^/]*$!perlTestValgrind.supp!;
+ return (-f $supp) ? $supp : undef;
+}
+
+=head1 EXPORT
+
+This module exports the L</supppath> function only on demand, either by giving its name, or by the C<:funcs> or C<:all> tags.
+
+=cut
+
+use base qw/Exporter/;
+
+our @EXPORT = ();
+our %EXPORT_TAGS = ( 'funcs' => [ qw/supppath/ ] );
+our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
+$EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
+
+=head1 SEE ALSO
+
+L<Test::Valgrind>.
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-test-valgrind-suppressions at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Valgrind>. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Test::Valgrind::Suppressions
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of Test::Valgrind::Suppressions
--- /dev/null
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use lib qw{blib/lib blib/arch};
+use Test::Valgrind;
+
+{
+ local $SIG{ALRM} = sub { kill "TERM", $$ };
+ alarm 1;
+ while (1) { map 1, 1 };
+}
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'Test::Valgrind::Suppressions' );
+}
+
+diag( "Testing Test::Valgrind $Test::Valgrind::Suppressions::VERSION, Perl $], $^X" );
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+require Test::Valgrind::Suppressions;
+
+for (qw/supppath/) {
+ eval { Test::Valgrind::Suppressions->import($_) };
+ ok(!$@, 'import ' . $_);
+}
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 1;
+
+use Test::Valgrind::Suppressions qw/supppath/;
+
+my $path = supppath();
+like($path, qr!Test/Valgrind/perlTestValgrind\.supp$!,
+ 'supppath() returns the path to the suppression file');
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+eval 'use Test::Valgrind'; # diag => 1';
+plan skip_all => 'Test::Valgrind is required to run test your distribution with valgrind' if $@;
+
+1;
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 4;
+
+sub not_in_file_ok {
+ my ($filename, %regex) = @_;
+ open( my $fh, '<', $filename )
+ or die "couldn't open $filename for reading: $!";
+
+ my %violated;
+
+ while (my $line = <$fh>) {
+ while (my ($desc, $regex) = each %regex) {
+ if ($line =~ $regex) {
+ push @{$violated{$desc}||=[]}, $.;
+ }
+ }
+ }
+
+ if (%violated) {
+ fail("$filename contains boilerplate text");
+ diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
+ } else {
+ pass("$filename contains no boilerplate text");
+ }
+}
+
+sub module_boilerplate_ok {
+ my ($module) = @_;
+ not_in_file_ok($module =>
+ 'the great new $MODULENAME' => qr/ - The great new /,
+ 'boilerplate description' => qr/Quick summary of what the module/,
+ 'stub function definition' => qr/function[12]/,
+ );
+}
+
+not_in_file_ok(README =>
+ "The README is used..." => qr/The README is used/,
+ "'version information here'" => qr/to provide version information/,
+);
+
+not_in_file_ok(Changes =>
+ "placeholder date/time" => qr(Date/time)
+);
+
+module_boilerplate_ok('lib/Test/Valgrind.pm');
+module_boilerplate_ok('lib/Test/Valgrind/Suppressions.pm');
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod
+my $min_tp = 1.22;
+eval "use Test::Pod $min_tp";
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
+
+all_pod_files_ok();
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod::Coverage
+my $min_tpc = 1.08;
+eval "use Test::Pod::Coverage $min_tpc";
+plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@;
+
+# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
+# but older versions don't recognize some common documentation styles
+my $min_pc = 0.18;
+eval "use Pod::Coverage $min_pc";
+plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@;
+
+plan tests => 1;
+pod_coverage_ok('Test::Valgrind');
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Portability::Files";
+plan skip_all => "Test::Portability::Files required for testing filenames portability" if $@;
+run_tests();
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval { require Test::Kwalitee; Test::Kwalitee->import() };
+plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@;
projects / perl / modules / Test-Valgrind.git / commitdiff