Group :: Development/Perl
RPM: perl-Test-Strict
Navigation
Main Changelog Spec Patches Sources Download Gear Bugs and FR Repocop
Test-Strict-0.22/ 0000755 0000000 0000000 00000000000 12227241320 0013613 5 ustar 00root root 0000000 0000000 Test-Strict-0.22/Changes 0000644 0000000 0000000 00000006457 12227241320 0015122 0 ustar 00root root 0000000 0000000 0.22 Fri Mar 1 07:39:05 2013
- Exclude the MYMETA files from the distribution.
0.21 Tue Feb 26 20:32:03 2013
- Add x_contributors to the META files.
- Add Moose::Exporter to the strict and warnings providers (Graham Knop)
0.20 Fri Feb 22 12:32:03 2013
- Add more modules that set strict and warnings. (suggested by RIBASUSHI, DAXIM)
- Remove warnings::register
- Experimental function modules_enabling_strict() to return thos module names.
- Experimental function modules_enabling_warnings() to return thos module names.
0.19 Wed Feb 20 11:12:39 2013
- Skip test if Moose::Autobox is not installed.
0.18 Sun Feb 17 13:54:13 2013
- RT #83388 - use Moose::Autobox should not be seen as use Moose; (Peter Vereshagin)
0.17 Sun Dec 30 08:13:42 2012
- Add license field to META files
- eliminate unwanted dependency on Modern::Perl
0.16 Fri Dec 28 09:38:47 2012
- Fix the Windows recognition regex in the code as well.
- rt #80341: Accept use Modern::Perl as strict and warnings. (Peter Vereshagin)
- rt #55186: Be less strict about filenames when calling syntax_ok directly
(Frank Lichtenheld)
0.15 - Thu Dec 27 09:59:29 2012
- rt #81849 and rt #79515: disable the coverage testing unless
a flag is enabled as that was stuck on Windows.
- rt #44187: Fix test on Cygwin.
- Add link to Github repository.
- Co-maintainer: Gabor Szabo (SZABGAB).
0.14 - Sat Feb 13 19:40:00 2010 EST
- rt #44216: now taint safe - thanks Lars
- rt #44607: compatible with Moose and Mouse - thanks Apocalypse
- Removed Test::Pod dependency
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
0.08 - Tue Sep 5 16:50:00 2006 GMT
- Adressed ticket #21196. (smueller)
- Made the untaint pattern less vulnerable to win32
paths. (smueller)
- Now quoting meta-characters before use in regex.
(smueller)
- Skipping tests that fail on win32 because of the
testing procedure (smueller)
0.07 - Mon May 29 03:45:00 2005 GMT
Skip blib/man directory in all_perl_files_ok() and all_cover_ok()
0.06 - Mon Mar 25 00:10:00 2005 GMT
Skip blib/libdoc directory in all_perl_files_ok() and all_cover_ok()
0.05 - Mon Mar 21 21:10:00 2005 GMT
Added $TEST_SYNTAX
$TEST_STRICT
$TEST_WARNINGS
- Thanks Christopher Laco
0.04 - Mon Mar 21 20:40:00 2005 GMT
Fixed warnings_ok() - now it detects "use warnings FATAL => 'all';" - Thanks Christopher Laco
0.03 - Sun Mar 20 23:10:00 2005 GMT
Added untainting - Thanks Christopher Laco
Added $Test::Strict::UNTAINT_PATTERN
Added better detection of cover binary
Added warnings_ok()
0.02 - Sat Mar 19 00:17:00 2005 GMT
Added detection of 'cover' binary
Added $Test::Strict::COVER
0.01 - Sat Mar 12 01:14:13 2005 GMT
Initial release
Test-Strict-0.22/MANIFEST 0000644 0000000 0000000 00000000474 12227241320 0014751 0 ustar 00root root 0000000 0000000 Changes
lib/Test/Strict.pm
Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
README
t/01all.t
t/02fail.t
t/03pod.t
t/04cover.t
t/05coverpod.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
Test-Strict-0.22/MANIFEST.SKIP 0000644 0000000 0000000 00000000227 12227241320 0015512 0 ustar 00root root 0000000 0000000 ^\.git
maint
^tags$
.last_cover_stats
Makefile$
^blib
^pm_to_blib
^.*.bak
^.*.old
^t.*sessions
^cover_db
^.*\.log
^.*\.swp$
^.*~$
Test-Strict
MYMETA.*
Test-Strict-0.22/META.json 0000644 0000000 0000000 00000002574 12227241320 0015244 0 ustar 00root root 0000000 0000000 {
"abstract" : "unknown",
"author" : [
"Pierre Denis <pdenis@cpan.org>"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120921",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "Test-Strict",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Devel::Cover" : "0.43",
"File::Find" : "0.01",
"File::Spec" : "0.01",
"File::Temp" : "0.01",
"FindBin" : "0.01",
"Test::Builder" : "0.01",
"Test::Simple" : "0.47"
}
}
},
"release_status" : "stable",
"resources" : {
"license" : [
"http://dev.perl.org/licenses/"
],
"repository" : {
"url" : "https://github.com/szabgab/Test-Strict"
}
},
"version" : "0.22",
"x_contributors" : [
"Gabor Szabo <szabgab@cpan.org>",
"Peter Vereshagin <veresc@cpan.org>",
"Graham Knop <haarg@cpan.org>"
]
}
Test-Strict-0.22/META.yml 0000644 0000000 0000000 00000001461 12227241320 0015066 0 ustar 00root root 0000000 0000000 ---
abstract: unknown
author:
- 'Pierre Denis <pdenis@cpan.org>'
build_requires:
ExtUtils::MakeMaker: 0
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120921'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: Test-Strict
no_index:
directory:
- t
- inc
requires:
Devel::Cover: 0.43
File::Find: 0.01
File::Spec: 0.01
File::Temp: 0.01
FindBin: 0.01
Test::Builder: 0.01
Test::Simple: 0.47
resources:
license: http://dev.perl.org/licenses/
repository: https://github.com/szabgab/Test-Strict
version: 0.22
x_contributors:
- 'Gabor Szabo <szabgab@cpan.org>'
- 'Peter Vereshagin <veresc@cpan.org>'
- 'Graham Knop <haarg@cpan.org>'
Test-Strict-0.22/Makefile.PL 0000755 0000000 0000000 00000001504 12227241320 0015570 0 ustar 00root root 0000000 0000000 use ExtUtils::MakeMaker;
use strict;
WriteMakefile(
NAME => "Test::Strict",
VERSION_FROM => 'lib/Test/Strict.pm',
PREREQ_PM => {
'Test::Simple' => 0.47,
'Test::Builder' => 0.01,
'File::Spec' => 0.01,
'FindBin' => 0.01,
'File::Find' => 0.01,
'Devel::Cover' => 0.43,
'File::Temp' => 0.01,
},
LICENSE => 'perl',
AUTHOR => 'Pierre Denis <pdenis@cpan.org>',
META_MERGE => {
resources => {
repository => 'https://github.com/szabgab/Test-Strict',
license => 'http://dev.perl.org/licenses/',
},
x_contributors => [
'Gabor Szabo <szabgab@cpan.org>',
'Peter Vereshagin <veresc@cpan.org>',
'Graham Knop <haarg@cpan.org>',
],
},
);
Test-Strict-0.22/README 0000644 0000000 0000000 00000000362 12227241320 0014474 0 ustar 00root root 0000000 0000000 This is the README file for Test::Strict, for
testing strictness in a distribution, by Pierre Denis <pdenis@gmail.com>.
* Installation
Test::Strict uses the standard perl module install process:
perl Makefile.PL
make
make test
make install Test-Strict-0.22/lib/ 0000755 0000000 0000000 00000000000 12227241320 0014361 5 ustar 00root root 0000000 0000000 Test-Strict-0.22/lib/Test/ 0000755 0000000 0000000 00000000000 12227241320 0015300 5 ustar 00root root 0000000 0000000 Test-Strict-0.22/lib/Test/Strict.pm 0000644 0000000 0000000 00000037005 12227241320 0017113 0 ustar 00root root 0000000 0000000 package Test::Strict;
=head1 NAME
Test::Strict - Check syntax, presence of use strict; and test coverage
=head1 SYNOPSIS
C<Test::Strict> lets you check the syntax, presence of C<use strict;>
and presence C<use warnings;>
in your perl code.
It report its results in standard C<Test::Simple> fashion:
use Test::Strict tests => 3;
syntax_ok( 'bin/myscript.pl' );
strict_ok( 'My::Module', "use strict; in My::Module" );
warnings_ok( 'lib/My/Module.pm' );
Module authors can include the following in a t/strict.t
and have C<Test::Strict> automatically find and check
all perl files in a module distribution:
use Test::Strict;
all_perl_files_ok(); # Syntax ok and use strict;
or
use Test::Strict;
all_perl_files_ok( @mydirs );
C<Test::Strict> can also enforce a minimum test coverage
the test suite should reach.
Module authors can include the following in a t/cover.t
and have C<Test::Strict> automatically check the test coverage:
use Test::Strict;
all_cover_ok( 80 ); # at least 80% coverage
or
use Test::Strict;
all_cover_ok( 80, 't/' );
=head1 DESCRIPTION
The most basic test one can write is "does it compile ?".
This module tests if the code compiles and play nice with C<Test::Simple> modules.
Another good practice this module can test is to "use strict;" in all perl files.
By setting a minimum test coverage through C<all_cover_ok()>, a code author
can ensure his code is tested above a preset level of I<kwality> throughout the development cycle.
Along with L<Test::Pod>, this module can provide the first tests to setup for a module author.
This module should be able to run under the -T flag for perl >= 5.6.
All paths are untainted with the following pattern: C<qr|^([-+@\w./:\\]+)$|>
controlled by C<$Test::Strict::UNTAINT_PATTERN>.
=cut
use strict;
use 5.004;
use Test::Builder;
use File::Spec;
use FindBin qw($Bin);
use File::Find;
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.22';
$PERL = $^X || 'perl';
$COVERAGE_THRESHOLD = 50; # 50%
$UNTAINT_PATTERN = qr|^(.*)$|;
$PERL_PATTERN = qr/^#!.*perl/;
$CAN_USE_WARNINGS = ($] >= 5.006);
$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 =~ /MSwin/i;
my $Test = Test::Builder->new;
my $updir = File::Spec->updir();
my %file_find_arg = ($] <= 5.006) ? ()
: (
untaint => 1,
untaint_pattern => $UNTAINT_PATTERN,
untaint_skip => 1,
);
sub import {
my $self = shift;
my $caller = caller;
{
no strict 'refs';
*{$caller.'::strict_ok'} = \&strict_ok;
*{$caller.'::warnings_ok'} = \&warnings_ok;
*{$caller.'::syntax_ok'} = \&syntax_ok;
*{$caller.'::all_perl_files_ok'} = \&all_perl_files_ok;
*{$caller.'::all_cover_ok'} = \&all_cover_ok;
}
$Test->exported_to($caller);
$Test->plan(@_);
}
##
## _all_perl_files( @dirs )
## Returns a list of perl files in @dir
## if @dir is not provided, it searches from one dir level above
##
sub _all_perl_files {
my @all_files = _all_files(@_);
return grep { _is_perl_module($_) || _is_perl_script($_) } @all_files;
}
sub _all_files {
my @base_dirs = @_ ? @_
: File::Spec->catdir($Bin, $updir);
my @found;
my $want_sub = sub {
return if ($File::Find::dir =~ m![\\/]?CVS[\\/]|[\\/]?.svn[\\/]!); # Filter out cvs or subversion dirs/
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->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); # 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
}
=head1 FUNCTIONS
=head2 syntax_ok( $file [, $text] )
Run a syntax check on C<$file> by running C<perl -c $file> with an external perl interpreter.
The external perl interpreter path is stored in C<$Test::Strict::PERL> which can be modified.
You may prefer C<use_ok()> from L<Test::More> to syntax test a module.
For a module, the path (lib/My/Module.pm) or the name (My::Module) can be both used.
=cut
sub syntax_ok {
my $file = shift;
my $test_txt = shift || "Syntax check $file";
$file = _module_to_path($file);
unless (-f $file && -r _) {
$Test->ok( 0, $test_txt );
$Test->diag( "File $file not found or not readable" );
return;
}
my $is_script = _is_perl_script($file);
# if (not $is_script and not _is_perl_module($file)) {
# $Test->ok( 0, $test_txt );
# $Test->diag( "$file is not a perl module or a perl script" );
# return;
# }
# Set the environment to compile the script or module
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};
# Add the -t -T switches if they are set in the #! line
my $switch = '';
$switch = _taint_switch($file) || '' if $is_script;
# Compile and check for errors
my $eval = `$perl_bin $inc -c$switch \"$file\" 2>&1`;
$file = quotemeta($file);
my $ok = $eval =~ qr!$file syntax OK!ms;
$Test->ok($ok, $test_txt);
unless ($ok) {
$Test->diag( $eval );
}
return $ok;
}
=head2 strict_ok( $file [, $text] )
Check if C<$file> contains a C<use strict;> statement.
C<use Moose> and C<use Mouse> are also considered valid.
use Modern::Perl is also accepted.
This is a pretty naive test which may be fooled in some edge cases.
For a module, the path (lib/My/Module.pm) or the name (My::Module) can be both used.
=cut
sub strict_ok {
my $file = shift;
my $test_txt = shift || "use strict $file";
$file = _module_to_path($file);
open my $fh, '<', $file or do { $Test->ok(0, $test_txt); $Test->diag("Could not open $file: $!"); return; };
my $ok = _strict_ok($fh);
$Test->ok($ok, $test_txt);
return $ok;
}
sub _strict_ok {
my ($in) = @_;
while (<$in>) {
next if (/^\s*#/); # Skip comments
next if (/^\s*=.+/ .. /^\s*=(cut|back|end)/); # Skip pod
last if (/^\s*(__END__|__DATA__)/); # End of code
foreach my $name (modules_enabling_strict()) {
# TODO: improve this matching (e.g. see TODO test)
if (/\buse\s+$name(?:[;\s]|$)/) {
return 1;
}
}
}
return;
}
=head2 modules_enabling_strict
Experimental. Returning a list of modules and pragmata that enable strict
List taken from https://metacpan.org/source/DAXIM/Module-CPANTS-Analyse-0.86/lib/Module/CPANTS/Kwalitee/Uses.pm
=cut
sub modules_enabling_strict {
return qw(
strict
Any::Moose
Class::Spiffy
Coat
common::sense
Dancer
Mo
Modern::Perl
Mojo::Base
Moo
Moose
Moose::Exporter
Moose::Role
MooseX::Declare
MooseX::Types
Mouse
Mouse::Role
perl5
perl5i::1
perl5i::2
perl5i::latest
Spiffy
strictures
);
}
=head2 modules_enabling_warnings
Experimental. Returning a list of modules and pragmata that enable strict
List taken from https://metacpan.org/source/DAXIM/Module-CPANTS-Analyse-0.86/lib/Module/CPANTS/Kwalitee/Uses.pm
=cut
sub modules_enabling_warnings {
return qw(
warnings
Any::Moose
Class::Spiffy
Coat
common::sense
Dancer
Mo
Modern::Perl
Mojo::Base
Moo
Moose
Moose::Exporter
Moose::Role
MooseX::Declare
MooseX::Types
Mouse
Mouse::Role
perl5
perl5i::1
perl5i::2
perl5i::latest
Spiffy
strictures
);
}
=head2 warnings_ok( $file [, $text] )
Check if warnings have been turned on.
If C<$file> is a module, check if it contains a C<use warnings;> or C<use warnings::...>
or C<use Moose> or C<use Mouse> statement. use Modern::Perl is also accepted.
If the perl version is <= 5.6, this test is skipped (C<use warnings> appeared in perl 5.6).
If C<$file> is a script, check if it starts with C<#!...perl -w>.
If the -w is not found and perl is >= 5.6, check for a C<use warnings;> or C<use warnings::...>
or C<use Moose> or C<use Mouse> statement. use Modern::Perl is also accepted.
This is a pretty naive test which may be fooled in some edge cases.
For a module, the path (lib/My/Module.pm) or the name (My::Module) can be both used.
=cut
sub warnings_ok {
my $file = shift;
my $test_txt = shift || "use warnings $file";
$file = _module_to_path($file);
my $is_module = _is_perl_module( $file );
my $is_script = _is_perl_script( $file );
if (!$is_script and $is_module and ! $CAN_USE_WARNINGS) {
$Test->skip();
$Test->diag("This version of perl ($]) does not have use warnings - perl 5.6 or higher is required");
return;
}
open my $fh, '<', $file or do { $Test->ok(0, $test_txt); $Test->diag("Could not open $file: $!"); return; };
my $ok = _warnings_ok($is_script, $fh);
$Test->ok($ok, $test_txt);
return $ok
}
# TODO unite with _strict_ok
sub _warnings_ok {
my ($is_script, $in) = @_;
while (<$in>) {
if ($. == 1 and $is_script and $_ =~ $PERL_PATTERN) {
if (/perl\s+\-\w*[wW]/) {
return 1;
}
}
last unless $CAN_USE_WARNINGS;
next if (/^\s*#/); # Skip comments
next if (/^\s*=.+/ .. /^\s*=(cut|back|end)/); # Skip pod
last if (/^\s*(__END__|__DATA__)/); # End of code
foreach my $name (modules_enabling_warnings()) {
if (/\buse\s+$name(?:[;\s]|$)/) {
return 1;
}
}
}
return;
}
=head2 all_perl_files_ok( [ @directories ] )
Applies C<strict_ok()> and C<syntax_ok()> to all perl files found in C<@directories> (and sub directories).
If no <@directories> is given, the starting point is one level above the current running script,
that should cover all the files of a typical CPAN distribution.
A perl file is *.pl or *.pm or *.t or a file starting with C<#!...perl>
If the test plan is defined:
use Test::Strict tests => 18;
all_perl_files_ok();
the total number of files tested must be specified.
You can control which tests are run on each perl site through:
$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
sub all_perl_files_ok {
my @files = _all_perl_files( @_ );
_make_plan();
foreach my $file ( @files ) {
syntax_ok( $file ) if $TEST_SYNTAX;
strict_ok( $file ) if $TEST_STRICT;
warnings_ok( $file ) if $TEST_WARNINGS;
}
}
=head2 all_cover_ok( [coverage_threshold [, @t_dirs]] )
This will run all the tests in @t_dirs
(or current script's directory if @t_dirs is undef)
under L<Devel::Cover>
and calculate the global test coverage of the code loaded by the tests.
If the test coverage is greater or equal than C<coverage_threshold>, it is a pass,
otherwise it's a fail. The default coverage threshold is 50
(meaning 50% of the code loaded has been covered by test).
The threshold can be modified through C<$Test::Strict::COVERAGE_THRESHOLD>.
You may want to select which files are selected for code
coverage through C<$Test::Strict::DEVEL_COVER_OPTIONS>,
see L<Devel::Cover> for the list of available options.
The default is '+ignore,"/Test/Strict\b"'.
The path to C<cover> utility can be modified through C<$Test::Strict::COVER>.
The 50% threshold is a completely arbitrary value, which should not be considered
as a good enough coverage.
The total coverage is the return value of C<all_cover_ok()>.
=cut
sub all_cover_ok {
my $threshold = shift || $COVERAGE_THRESHOLD;
my @dirs = @_ ? @_
: (File::Spec->splitpath( $0 ))[1] || '.';
my @all_files = grep { ! /$0$/o && $0 !~ /$_$/ }
grep { _is_perl_script($_) }
_all_files(@dirs);
_make_plan();
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};
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 at $cover_bin got error $?: $res");
return;
}
foreach my $file ( @all_files ) {
$file = _untaint($file);
`$perl_bin -MDevel::Cover=$DEVEL_COVER_OPTIONS $file`;
$Test->ok(! $?, "Coverage captured from $file" );
}
$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}%");
return $total;
}
sub _is_perl_module {
$_[0] =~ /\.pm$/i
||
$_[0] =~ /::/;
}
sub _is_perl_script {
my $file = shift;
return 1 if $file =~ /\.pl$/i;
return 1 if $file =~ /\.t$/;
open my $fh, '<', $file or return;
my $first = <$fh>;
return 1 if defined $first && ($first =~ $PERL_PATTERN);
return;
}
##
## Returns the taint switches -tT in the #! line of a perl script
##
sub _taint_switch {
my $file = shift;
open my $fh, '<', $file or return;
my $first = <$fh>;
$first =~ /^#!.*\bperl.*\s-\w*([Tt]+)/ or return;
return $1;
}
##
## Return the path of a module
##
sub _module_to_path {
my $file = shift;
return $file unless ($file =~ /::/);
my @parts = split /::/, $file;
my $module = File::Spec->catfile(@parts) . '.pm';
foreach my $dir (@INC) {
my $candidate = File::Spec->catfile($dir, $module);
next unless (-e $candidate && -f _ && -r _);
return $candidate;
}
return $file; # non existing file - error is catched elsewhere
}
sub _cover_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');
if ($IS_WINDOWS) {
next unless (-f $path_cover && -r _);
}
else {
next unless -x $path_cover;
}
return $COVER = _untaint($path_cover);
}
return;
}
sub _make_plan {
unless ($Test->has_plan) {
$Test->plan( 'no_plan' );
}
$Test->expected_tests;
}
sub _untaint {
my @untainted = map {($_ =~ $UNTAINT_PATTERN)} @_;
wantarray ? @untainted
: $untainted[0];
}
=head1 CAVEATS
For C<all_cover_ok()> to work properly, it is strongly advised to install the most recent version of L<Devel::Cover>
and use perl 5.8.1 or above.
In the case of a C<make test> scenario, C<all_perl_files_ok()> re-run all the tests in a separate perl interpreter,
this may lead to some side effects.
=head1 SEE ALSO
L<Test::More>, L<Test::Pod>. L<Test::Distribution>, L<Test:NoWarnings>
=head1 REPOSITORY
L<https://github.com/szabgab/Test-Strict>
=head1 AUTHOR
Pierre Denis, C<< <pdenis@gmail.com> >>.
=head1 MAINTAINER
L<Gabor Szabo|http://szabgab.com/>
=head1 COPYRIGHT
Copyright 2005, 2010 Pierre Denis, All Rights Reserved.
You may use, modify, and distribute this package under the
same terms as Perl itself.
=cut
1;
Test-Strict-0.22/t/ 0000755 0000000 0000000 00000000000 12227241320 0014056 5 ustar 00root root 0000000 0000000 Test-Strict-0.22/t/01all.t 0000755 0000000 0000000 00000012336 12227241320 0015164 0 ustar 00root root 0000000 0000000 #!/usr/bin/perl -w
use strict;
use Test::More;
use Test::Strict;
use File::Temp qw( tempdir tempfile );
my $HAS_WIN32 = 0;
if ($^O =~ /MSWin/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;
}
}
plan tests => 39;
##
## This should check all perl files in the distribution
## including this current file, the Makefile.PL etc.
## and check for "use strict;" and syntax ok
##
diag "First all_perl_files_ok starting";
my $res = all_perl_files_ok();
is $res, '', 'returned empty string??';
diag "First all_perl_files_ok done";
strict_ok( $0, "got strict" );
syntax_ok( $0, "syntax" );
syntax_ok( 'Test::Strict' );
strict_ok( 'Test::Strict' );
warnings_ok( $0 );
diag 'Start creating files';
my $modern_perl_file1 = make_modern_perl_file1();
diag $modern_perl_file1;
warnings_ok( $modern_perl_file1, 'warn modern_perl1' );
strict_ok( $modern_perl_file1, 'strict modern_perl1' );
# let's make sure that a file that is not recognized as "Perl file"
# still lets the syntax_ok test work
my $extensionless_file = make_extensionless_perl_file1();
diag $extensionless_file;
ok ! Test::Strict::_is_perl_module($extensionless_file);
ok ! Test::Strict::_is_perl_script($extensionless_file);
warnings_ok( $extensionless_file, 'warn extensionless_file' );
strict_ok( $extensionless_file, 'strict extensionless_file' );
syntax_ok( $extensionless_file, 'syntax extensionless_file' );
my $warning_file1 = make_warning_file1();
diag "File1: $warning_file1";
warnings_ok( $warning_file1, 'file1' );
my $warning_file2 = make_warning_file2();
diag "File2: $warning_file2";
warnings_ok( $warning_file2, 'file2' );
# TODO: does warnings::register turn on warnings?
#my $warning_file3 = make_warning_file3();
#diag "File3: $warning_file3";
#warnings_ok( $warning_file3, 'file3' );
my $warning_file4 = make_warning_file4();
diag "File4: $warning_file4";
warnings_ok( $warning_file4, 'file4' );
my $warning_file5 = make_warning_file5();
diag "File5: $warning_file5";
warnings_ok( $warning_file5, 'file5' );
{
my ($warnings_files_dir, $files, $file_to_skip) = make_warning_files();
diag explain $files;
diag "File to skip: $file_to_skip";
local $Test::Strict::TEST_WARNINGS = 1;
local $Test::Strict::TEST_SKIP = [ $file_to_skip ];
all_perl_files_ok( $warnings_files_dir );
}
exit;
sub make_modern_perl_file1 {
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
print $fh <<'DUMMY';
#!/usr/bin/perl
use Modern::Perl;
print "hello world";
DUMMY
return $HAS_WIN32 ? Win32::GetLongPathName($filename) : $filename;
}
sub make_extensionless_perl_file1 {
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '' );
print $fh <<'DUMMY';
use strict;
use warnings;
print "hello world";
DUMMY
return $HAS_WIN32 ? Win32::GetLongPathName($filename) : $filename;
}
sub make_warning_file1 {
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
print $fh <<'DUMMY';
#!/usr/bin/perl -w
print "hello world";
DUMMY
return $HAS_WIN32 ? Win32::GetLongPathName($filename) : $filename;
}
sub make_warning_file2 {
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
print $fh <<'DUMMY';
use warnings FATAL => 'all' ;
print "Hello world";
DUMMY
return $HAS_WIN32 ? Win32::GetLongPathName($filename) : $filename;
}
sub make_warning_file3 {
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' );
print $fh <<'DUMMY';
use strict;
use warnings::register ;
print "Hello world";
DUMMY
return $HAS_WIN32 ? Win32::GetLongPathName($filename) : $filename;
}
sub make_warning_file4 {
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' );
print $fh <<'DUMMY';
use Mouse ;
print "Hello world";
DUMMY
return $HAS_WIN32 ? Win32::GetLongPathName($filename) : $filename;
}
sub make_warning_file5 {
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' );
print $fh <<'DUMMY';
use Moose;
print "Hello world";
DUMMY
return $HAS_WIN32 ? Win32::GetLongPathName($filename) : $filename;
}
sub make_warning_files {
my $tmpdir = tempdir( CLEANUP => 1 );
my @files;
# TODO: does warnings::register turn on warnings?
# my ($fh1, $filename1) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' );
# print $fh1 <<'DUMMY';
#use strict;
#use warnings::register ;
#print "Hello world";
#
#DUMMY
# push @files, $filename1;
my ($fh2, $filename2) = tempfile( DIR => $tmpdir, SUFFIX => '.pl' );
print $fh2 <<'DUMMY';
#!/usr/bin/perl -vw
use strict;
print "Hello world";
DUMMY
push @files, $filename2;
my ($fh3, $filename3) = tempfile( DIR => $tmpdir, SUFFIX => '.pl' );
print $fh3 <<'DUMMY';
use strict;
local $^W = 1;
print "Hello world";
DUMMY
push @files, $filename3;
my ($fh4, $filename4) = tempfile( DIR => $tmpdir, SUFFIX => '.pl' );
print $fh4 <<'DUMMY';
#!/usr/bin/perl -Tw
use strict;
print "Hello world";
DUMMY
push @files, $filename4;
return ($tmpdir, \@files, $filename3);
}
Test-Strict-0.22/t/02fail.t 0000755 0000000 0000000 00000011346 12227241320 0015330 0 ustar 00root root 0000000 0000000 #!/usr/bin/perl -w
##
## Tests errors
## by creating files with incorrect syntax or no "use strict;"
## and run Test::Strict under an external perl interpreter.
## The output is parsed to check result.
##
use strict;
BEGIN {
if ($^O =~ /win32/i) {
require Test::More;
Test::More->import(
skip_all => "Windows does not allow two processes to access the same file."
);
}
}
use Test::More tests => 15;
use File::Temp qw( tempdir tempfile );
my $perl = $^X || 'perl';
my $inc = join(' -I ', @INC) || '';
$inc = "-I $inc" if $inc;
require Test::Strict;
test1();
test2();
test3();
test4();
test5();
TODO: {
local $TODO = 'improve strict matching!';
my $code = q{print "use strict "};
open my $fh1, '<', \$code;
ok !Test::Strict::_strict_ok($fh1), 'use strict in print';
}
exit;
sub test1 {
my $bad_file_content = _bad_file_content();
open my $fh1, '<', \$bad_file_content;
ok !Test::Strict::_strict_ok($fh1), 'bad_file';
my $dir = make_bad_file();
my ($fh, $outfile) = tempfile( UNLINK => 1 );
ok( `$perl $inc -MTest::Strict -e "all_perl_files_ok( '$dir' )" 2>&1 > $outfile`, 'all_perl_files_ok' );
local $/ = undef;
my $content = <$fh>;
like( $content, qr/^ok 1 - Syntax check /m, "Syntax ok" );
like( $content, qr/not ok 2 - use strict /, "Does not have use strict" );
}
sub test2 {
my $dir = make_another_bad_file();
my ($fh, $outfile) = tempfile( UNLINK => 1 );
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" );
}
sub test3 {
my $file = make_bad_warning();
my ($fh, $outfile) = tempfile( UNLINK => 1 );
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" );
}
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 test5 {
eval "require Moose::Autobox";
my $err = $@;
SKIP: {
skip 'Moose::Autobox is needed for this test', 3 if $err;
my $dir = make_moose_bad_file();
my ($fh, $outfile) = tempfile( UNLINK => 1 );
ok( `$perl $inc -MTest::Strict -e "all_perl_files_ok( '$dir' )" 2>&1 > $outfile` );
local $/ = undef;
my $content = <$fh>;
like( $content, qr/^ok 1 - Syntax check /m, "Syntax ok" );
like( $content, qr/not ok 2 - use strict /, "Does not have use strict" );
}
}
sub make_bad_file {
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
print $fh _bad_file_content();
return $tmpdir;
}
sub _bad_file_content {
return <<'DUMMY';
print "Hello world without use strict";
# use strict;
=over
use strict;
=back
=for
use strict;
=end
=pod
use strict;
=cut
DUMMY
}
sub make_another_bad_file {
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' );
print $fh <<'DUMMY';
=pod
blah
=cut
# a comment
undef;use strict ; foobarbaz + 1; # another comment
DUMMY
return $tmpdir;
}
sub make_moose_bad_file {
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' );
print $fh <<'DUMMY';
# Makes methods for plain Perl types with autobox
# No 'use Moose' here and no strictures turned on
use Moose::Autobox;
DUMMY
return $tmpdir;
}
sub make_bad_warning {
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
print $fh <<'DUMMY';
print "Hello world without use warnings";
# use warnings;
=over
use warnings;
=back
=for
use warnings;
=end
=pod
use warnings;
=cut
DUMMY
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;
}
Test-Strict-0.22/t/03pod.t 0000755 0000000 0000000 00000000240 12227241320 0015167 0 ustar 00root root 0000000 0000000 #!/usr/bin/perl -w
use strict;
use Test::More;
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
all_pod_files_ok();
Test-Strict-0.22/t/04cover.t 0000644 0000000 0000000 00000001133 12227241320 0015523 0 ustar 00root root 0000000 0000000 #!/usr/bin/perl -w
use strict;
use Test::More;
use Test::Strict;
unless (Test::Strict::_cover_path) {
plan skip_all => "cover binary required to run test coverage - Set \$Test::Strict::COVER to the path to 'cover'";
exit;
}
unless ($ENV{CHECK_COVERAGE}) {
plan skip_all => 'Checking coverage only if the CHECK_COVERAGE environment variable is true';
exit;
}
# On Windows this test seems to be stuck
$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 );
Test-Strict-0.22/t/05coverpod.t 0000644 0000000 0000000 00000000255 12227241320 0016233 0 ustar 00root root 0000000 0000000 use strict;
use Test::More;
eval "use Test::Pod::Coverage 1.00";
plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
all_pod_coverage_ok();