r35157 - in /trunk/libtest-strict-perl: Changes META.yml debian/changelog lib/Test/Strict.pm t/01all.t t/02fail.t t/04cover.t
jeremiah-guest at users.alioth.debian.org
jeremiah-guest at users.alioth.debian.org
Mon May 11 09:58:22 UTC 2009
Author: jeremiah-guest
Date: Mon May 11 09:58:17 2009
New Revision: 35157
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=35157
Log:
New upstream release
Modified:
trunk/libtest-strict-perl/Changes
trunk/libtest-strict-perl/META.yml
trunk/libtest-strict-perl/debian/changelog
trunk/libtest-strict-perl/lib/Test/Strict.pm
trunk/libtest-strict-perl/t/01all.t
trunk/libtest-strict-perl/t/02fail.t
trunk/libtest-strict-perl/t/04cover.t
Modified: trunk/libtest-strict-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-strict-perl/Changes?rev=35157&op=diff
==============================================================================
--- trunk/libtest-strict-perl/Changes (original)
+++ trunk/libtest-strict-perl/Changes Mon May 11 09:58:17 2009
@@ -1,3 +1,16 @@
+0.13 - Fri Jan 30 19:25:00 2009 PST
+ - rt #42922: Assignment to read only value - thanks Andreas
+
+0.12 - Sun Jan 25 17:55:00 2009 PST
+ - rt #42575: Can deal with filenames with spaces - thanks Renee
+ - rt #42576: Deal with windows dos shorten filnames - thanks Renee
+
+0.11 - Sun Jan 18 20:30:00 2009 PST
+ - rt #41604: Allow to skip "trusted" files - thanks Jon
+
+0.10 - Sun Jan 18 19:50:00 2009 PST
+ - rt #41524: Fixed warning "no_plan takes no arguments ..." - thanks Apocalypse
+
0.09 - Sat Feb 23 23:50:00 2008 GMT
- Addressed rt #32704 Cleaning up /tmp directory (ANDK)
- Added $DEVEL_COVER_OPTIONS to give more control on which files to select for code coverage
Modified: trunk/libtest-strict-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-strict-perl/META.yml?rev=35157&op=diff
==============================================================================
--- trunk/libtest-strict-perl/META.yml (original)
+++ trunk/libtest-strict-perl/META.yml Mon May 11 09:58:17 2009
@@ -1,10 +1,12 @@
---
name: Test-Strict
-version: 0.09
+version: 0.13
author:
- 'Pierre Denis, C<< <pierre at itrelease.net> >>.'
abstract: 'Check syntax, presence of use strict; and test coverage'
license: perl
+resources:
+ license: http://dev.perl.org/licenses/
requires:
Devel::Cover: 0.43
File::Find: 0.01
@@ -19,5 +21,8 @@
provides:
Test::Strict:
file: lib/Test/Strict.pm
- version: 0.09
-generated_by: Module::Build version 0.26
+ version: 0.13
+generated_by: Module::Build version 0.280801
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Modified: trunk/libtest-strict-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-strict-perl/debian/changelog?rev=35157&op=diff
==============================================================================
--- trunk/libtest-strict-perl/debian/changelog (original)
+++ trunk/libtest-strict-perl/debian/changelog Mon May 11 09:58:17 2009
@@ -1,3 +1,9 @@
+libtest-strict-perl (0.13-1) unstable; urgency=low
+
+ * New upstream release
+
+ -- Jeremiah C. Foster <jeremiah at jeremiahfoster.com> Mon, 11 May 2009 11:57:30 +0200
+
libtest-strict-perl (0.09-1) unstable; urgency=low
* Initial Release. Closes: #499402
Modified: trunk/libtest-strict-perl/lib/Test/Strict.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-strict-perl/lib/Test/Strict.pm?rev=35157&op=diff
==============================================================================
--- trunk/libtest-strict-perl/lib/Test/Strict.pm (original)
+++ trunk/libtest-strict-perl/lib/Test/Strict.pm Mon May 11 09:58:17 2009
@@ -65,18 +65,22 @@
use File::Spec;
use FindBin qw($Bin);
use File::Find;
-
-use vars qw( $VERSION $PERL $COVERAGE_THRESHOLD $COVER $UNTAINT_PATTERN $PERL_PATTERN $CAN_USE_WARNINGS $TEST_SYNTAX $TEST_STRICT $TEST_WARNINGS $DEVEL_COVER_OPTIONS );
-$VERSION = '0.09';
+use Config;
+
+use vars qw( $VERSION $PERL $COVERAGE_THRESHOLD $COVER $UNTAINT_PATTERN $PERL_PATTERN $CAN_USE_WARNINGS $TEST_SYNTAX $TEST_STRICT $TEST_WARNINGS $TEST_SKIP $DEVEL_COVER_OPTIONS $DEVEL_COVER_DB );
+$VERSION = '0.13';
$PERL = $^X || 'perl';
$COVERAGE_THRESHOLD = 50; # 50%
$UNTAINT_PATTERN = qr|^(.*)$|;
$PERL_PATTERN = qr/^#!.*perl/;
$CAN_USE_WARNINGS = ($] >= 5.006);
-$TEST_SYNTAX = 1;
-$TEST_STRICT = 1;
-$TEST_WARNINGS = 0;
-$DEVEL_COVER_OPTIONS = '+ignore,"/Test/Strict\b"';
+$TEST_SYNTAX = 1; # Check compile
+$TEST_STRICT = 1; # Check use strict;
+$TEST_WARNINGS = 0; # Check use warnings;
+$TEST_SKIP = []; # List of files to skip check
+$DEVEL_COVER_OPTIONS = '+ignore,".Test.Strict\b"';
+$DEVEL_COVER_DB = 'cover_db';
+my $IS_WINDOWS = $^O =~ /win|dos/i;
my $Test = Test::Builder->new;
my $updir = File::Spec->updir();
@@ -123,15 +127,18 @@
return if ($File::Find::dir =~ m![\\/]?blib[\\/]libdoc$!); # Filter out pod doc in dist
return if ($File::Find::dir =~ m![\\/]?blib[\\/]man\d$!); # Filter out pod doc in dist
return unless (-f $File::Find::name && -r _);
- push @found, File::Spec->no_upwards( $File::Find::name );
+ push @found, File::Spec->canonpath( File::Spec->no_upwards( $File::Find::name ) );
};
my $find_arg = {
%file_find_arg,
wanted => $want_sub,
no_chdir => 1,
};
- find( $find_arg, @base_dirs);
- @found;
+ find( $find_arg, @base_dirs); # Find all potential file candidates
+
+ my $files_to_skip = $TEST_SKIP || [];
+ my %skip = map { $_ => undef } @$files_to_skip;
+ return grep { ! exists $skip{$_} } @found; # Exclude files to skip
}
@@ -161,13 +168,13 @@
return;
}
- my $inc = join(' -I ', @INC) || '';
+ my $inc = join(' -I ', map{ qq{"$_"} } @INC ) || '';
$inc = "-I $inc" if $inc;
$file = _untaint($file);
my $perl_bin = _untaint($PERL);
local $ENV{PATH} = _untaint($ENV{PATH}) if $ENV{PATH};
- my $eval = `$perl_bin $inc -c $file 2>&1`;
+ my $eval = `$perl_bin $inc -c \"$file\" 2>&1`;
$file = quotemeta($file);
my $ok = $eval =~ qr!$file syntax OK!ms;
$Test->ok($ok, $test_txt);
@@ -274,6 +281,7 @@
$Test::Strict::TEST_SYNTAX (default = 1)
$Test::Strict::TEST_STRICT (default = 1)
$Test::Strict::TEST_WARNINGS (default = 0)
+ $Test::Strict::TEST_SKIP (default = []) "Trusted" files to skip
=cut
@@ -327,18 +335,21 @@
my $cover_bin = _cover_path() or do{ $Test->skip(); $Test->diag("Cover binary not found"); return};
my $perl_bin = _untaint($PERL);
local $ENV{PATH} = _untaint($ENV{PATH}) if $ENV{PATH};
- `$cover_bin -delete`;
+ if ($IS_WINDOWS and ! -d $DEVEL_COVER_DB) {
+ mkdir $DEVEL_COVER_DB or warn "$DEVEL_COVER_DB: $!";
+ }
+ my $res = `$cover_bin -delete 2>&1`;
if ($?) {
$Test->skip();
- $Test->diag("Cover binary $cover_bin not found");
+ $Test->diag("Cover at $cover_bin got error $?: $res");
return;
}
foreach my $file ( @all_files ) {
$file = _untaint($file);
- `$perl_bin -MDevel::Cover=$DEVEL_COVER_OPTIONS $file 2>&1 > /dev/null`;
+ `$perl_bin -MDevel::Cover=$DEVEL_COVER_OPTIONS $file`;
$Test->ok(! $?, "Coverage captured from $file" );
}
- $Test->ok(my $cover = `$cover_bin 2>/dev/null`, "Got cover");
+ $Test->ok(my $cover = `$cover_bin 2>&1`, "Got cover");
my ($total) = ($cover =~ /^\s*Total.+?([\d\.]+)\s*$/m);
$Test->ok( $total >= $threshold, "coverage = ${total}% > ${threshold}%");
@@ -382,10 +393,18 @@
sub _cover_path {
- return $COVER if $COVER;
- foreach my $path (split /:/, $ENV{PATH}) {
+ return $COVER if defined $COVER;
+
+ my $os_separator = $IS_WINDOWS ? ';' : ':';
+ foreach ((split /$os_separator/, $ENV{PATH}), @Config{qw(bin sitedir scriptdir)} ) {
+ my $path = $_ || '.';
my $path_cover = File::Spec->catfile($path, 'cover');
- next unless -x $path_cover;
+ if ($IS_WINDOWS) {
+ next unless (-f $path_cover && -r _);
+ }
+ else {
+ next unless -x $path_cover;
+ }
return $COVER = _untaint($path_cover);
}
return;
@@ -394,7 +413,7 @@
sub _make_plan {
unless ($Test->has_plan) {
- $Test->plan( no_plan => 1 );
+ $Test->plan( 'no_plan' );
}
$Test->expected_tests;
}
Modified: trunk/libtest-strict-perl/t/01all.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-strict-perl/t/01all.t?rev=35157&op=diff
==============================================================================
--- trunk/libtest-strict-perl/t/01all.t (original)
+++ trunk/libtest-strict-perl/t/01all.t Mon May 11 09:58:17 2009
@@ -2,6 +2,17 @@
use strict;
use Test::Strict;
use File::Temp qw( tempdir tempfile );
+
+my $HAS_WIN32 = 0;
+if ($^O =~ /Win|Dos/i) { # Load Win32 if we are under Windows and if module is available
+ eval q{ use Win32 };
+ if ($@) {
+ warn "Optional module Win32 missing, consider installing\n";
+ }
+ else {
+ $HAS_WIN32 = 1;
+ }
+}
##
## This should check all perl files in the distribution
@@ -26,6 +37,14 @@
my $warning_file3 = make_warning_file3();
warnings_ok( $warning_file3 );
+{
+ my ($warnings_files_dir, $file_to_skip) = make_warning_files();
+ local $Test::Strict::TEST_WARNINGS = 1;
+ local $Test::Strict::TEST_SKIP = [ $file_to_skip ];
+ all_perl_files_ok( $warnings_files_dir );
+}
+
+
sub make_warning_file1 {
my $tmpdir = tempdir( CLEANUP => 1 );
@@ -36,7 +55,7 @@
print "hello world";
DUMMY
- return $filename;
+ return $HAS_WIN32 ? Win32::GetLongPathName($filename) : $filename;
}
sub make_warning_file2 {
@@ -47,7 +66,7 @@
print "Hello world";
DUMMY
- return $filename;
+ return $HAS_WIN32 ? Win32::GetLongPathName($filename) : $filename;
}
sub make_warning_file3 {
@@ -59,6 +78,34 @@
print "Hello world";
DUMMY
- return $filename;
+ return $HAS_WIN32 ? Win32::GetLongPathName($filename) : $filename;
}
+sub make_warning_files {
+ my $tmpdir = tempdir( CLEANUP => 1 );
+ my ($fh1, $filename1) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' );
+ print $fh1 <<'DUMMY';
+use strict;
+use warnings::register ;
+print "Hello world";
+
+DUMMY
+
+ my ($fh2, $filename2) = tempfile( DIR => $tmpdir, SUFFIX => '.pl' );
+ print $fh2 <<'DUMMY';
+#!/usr/bin/perl -vw
+use strict;
+print "Hello world";
+
+DUMMY
+
+ my ($fh3, $filename3) = tempfile( DIR => $tmpdir, SUFFIX => '.pl' );
+ print $fh3 <<'DUMMY';
+use strict;
+local $^W = 1;
+print "Hello world";
+
+DUMMY
+
+ return ($tmpdir, $HAS_WIN32 ? Win32::GetLongPathName($filename3) : $filename3);
+}
Modified: trunk/libtest-strict-perl/t/02fail.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-strict-perl/t/02fail.t?rev=35157&op=diff
==============================================================================
--- trunk/libtest-strict-perl/t/02fail.t (original)
+++ trunk/libtest-strict-perl/t/02fail.t Mon May 11 09:58:17 2009
@@ -17,7 +17,7 @@
}
}
-use Test::More tests => 8;
+use Test::More tests => 10;
use File::Temp qw( tempdir tempfile );
my $perl = $^X || 'perl';
@@ -27,6 +27,7 @@
test1();
test2();
test3();
+test4();
exit;
@@ -47,8 +48,8 @@
ok( `$perl $inc -MTest::Strict -e "all_perl_files_ok( '$dir' )" 2>&1 > $outfile` );
local $/ = undef;
my $content = <$fh>;
- like( $content, qr/not ok 1 - Syntax check /, "Syntax error" );
- like( $content, qr/^ok 2 - use strict /m, "Does have use strict" );
+ like( $content, qr/not ok 1 \- Syntax check /, "Syntax error" );
+ like( $content, qr/^ok 2 \- use strict /m, "Does have use strict" );
}
sub test3 {
@@ -57,9 +58,17 @@
ok( `$perl $inc -e "use Test::Strict no_plan =>1; warnings_ok( '$file' )" 2>&1 > $outfile` );
local $/ = undef;
my $content = <$fh>;
- like( $content, qr/not ok 1 - use warnings /, "Does not have use warnings" );
+ like( $content, qr/not ok 1 \- use warnings /, "Does not have use warnings" );
}
+sub test4 {
+ my $test_file = make_warning_files();
+ my ($fh, $outfile) = tempfile( UNLINK => 1 );
+ ok( `$perl $inc $test_file 2>&1 > $outfile` );
+ local $/ = undef;
+ my $content = <$fh>;
+ like( $content, qr/not ok \d+ \- use warnings/, "Does not have use warnings" );
+}
sub make_bad_file {
@@ -120,3 +129,41 @@
return $filename;
}
+sub make_warning_files {
+ my $tmpdir = tempdir( CLEANUP => 1 );
+ my ($fh1, $filename1) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' );
+ print $fh1 <<'DUMMY';
+use strict;
+use warnings::register ;
+print "Hello world";
+
+DUMMY
+
+ my ($fh2, $filename2) = tempfile( DIR => $tmpdir, SUFFIX => '.pl' );
+ print $fh2 <<'DUMMY';
+#!/usr/bin/perl -vw
+use strict;
+print "Hello world";
+
+DUMMY
+
+ my ($fh3, $filename3) = tempfile( DIR => $tmpdir, SUFFIX => '.pl' );
+ print $fh3 <<'DUMMY';
+use strict;
+local $^W = 1;
+print "Hello world";
+
+DUMMY
+
+ my ($fh4, $filename4) = tempfile( DIR => $tmpdir, SUFFIX => '.pl' );
+ print $fh4 <<"TEST";
+use strict;
+use warnings;
+use Test::Strict 'no_plan';
+local \$Test::Strict::TEST_WARNINGS = 1;
+all_perl_files_ok( '$tmpdir' );
+
+TEST
+
+ return $filename4;
+}
Modified: trunk/libtest-strict-perl/t/04cover.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-strict-perl/t/04cover.t?rev=35157&op=diff
==============================================================================
--- trunk/libtest-strict-perl/t/04cover.t (original)
+++ trunk/libtest-strict-perl/t/04cover.t Mon May 11 09:58:17 2009
@@ -8,7 +8,7 @@
exit;
}
-$Test::Strict::DEVEL_COVER_OPTIONS = '-select,"Test/Strict\b",+ignore,"/Test"';
+$Test::Strict::DEVEL_COVER_OPTIONS = '-select,"Test.Strict\b",+ignore,".Test"';
my $covered = all_cover_ok(); # 50% coverage
ok( $covered > 50 );
is( $Test::Strict::COVERAGE_THRESHOLD, 50 );
More information about the Pkg-perl-cvs-commits
mailing list