Test-Strict-0.22/0000755000175000017500000000000012114045231012561 5ustar gaborgaborTest-Strict-0.22/Changes0000644000175000017500000000645712114037452014076 0ustar gaborgabor0.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/README0000644000175000017500000000036211335634720013455 0ustar gaborgaborThis is the README file for Test::Strict, for testing strictness in a distribution, by Pierre Denis . * Installation Test::Strict uses the standard perl module install process: perl Makefile.PL make make test make installTest-Strict-0.22/MANIFEST0000644000175000017500000000047412114045231013717 0ustar gaborgaborChanges 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/Makefile.PL0000755000175000017500000000150412113177371014550 0ustar gaborgaboruse 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 ', META_MERGE => { resources => { repository => 'https://github.com/szabgab/Test-Strict', license => 'http://dev.perl.org/licenses/', }, x_contributors => [ 'Gabor Szabo ', 'Peter Vereshagin ', 'Graham Knop ', ], }, ); Test-Strict-0.22/MANIFEST.SKIP0000644000175000017500000000022712114037342014464 0ustar gaborgabor^\.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/lib/0000755000175000017500000000000012114045231013327 5ustar gaborgaborTest-Strict-0.22/lib/Test/0000755000175000017500000000000012114045231014246 5ustar gaborgaborTest-Strict-0.22/lib/Test/Strict.pm0000644000175000017500000003700512114045103016057 0ustar gaborgaborpackage Test::Strict; =head1 NAME Test::Strict - Check syntax, presence of use strict; and test coverage =head1 SYNOPSIS C lets you check the syntax, presence of C and presence C in your perl code. It report its results in standard C 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 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 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 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 modules. Another good practice this module can test is to "use strict;" in all perl files. By setting a minimum test coverage through C, a code author can ensure his code is tested above a preset level of I throughout the development cycle. Along with L, 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 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 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 from L 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 statement. C and C 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 or C or C or C statement. use Modern::Perl is also accepted. If the perl version is <= 5.6, this test is skipped (C 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 or C or C or C 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 and C 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 and calculate the global test coverage of the code loaded by the tests. If the test coverage is greater or equal than C, 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 for the list of available options. The default is '+ignore,"/Test/Strict\b"'. The path to C 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. =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 to work properly, it is strongly advised to install the most recent version of L and use perl 5.8.1 or above. In the case of a C scenario, C re-run all the tests in a separate perl interpreter, this may lead to some side effects. =head1 SEE ALSO L, L. L, L =head1 REPOSITORY L =head1 AUTHOR Pierre Denis, C<< >>. =head1 MAINTAINER L =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/0000755000175000017500000000000012114045231013024 5ustar gaborgaborTest-Strict-0.22/t/04cover.t0000644000175000017500000000113312066662070014505 0ustar gaborgabor #!/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/01all.t0000755000175000017500000001233612111357741014143 0ustar gaborgabor#!/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.t0000755000175000017500000001134612111130667014303 0ustar gaborgabor#!/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.t0000755000175000017500000000024011335644271014152 0ustar gaborgabor#!/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/05coverpod.t0000644000175000017500000000025511335644271015216 0ustar gaborgaboruse 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(); Test-Strict-0.22/META.json0000664000175000017500000000257412114045231014214 0ustar gaborgabor{ "abstract" : "unknown", "author" : [ "Pierre Denis " ], "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 ", "Peter Vereshagin ", "Graham Knop " ] } Test-Strict-0.22/META.yml0000664000175000017500000000146112114045231014036 0ustar gaborgabor--- abstract: unknown author: - 'Pierre Denis ' 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 ' - 'Peter Vereshagin ' - 'Graham Knop '