r24185 - in /branches/upstream/libtest-strict-perl: ./ current/ current/lib/ current/lib/Test/ current/t/

jeremiah-guest at users.alioth.debian.org jeremiah-guest at users.alioth.debian.org
Tue Aug 12 10:18:30 UTC 2008


Author: jeremiah-guest
Date: Tue Aug 12 10:18:16 2008
New Revision: 24185

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=24185
Log:
[svn-inject] Installing original source of libtest-strict-perl

Added:
    branches/upstream/libtest-strict-perl/
    branches/upstream/libtest-strict-perl/current/
    branches/upstream/libtest-strict-perl/current/Changes
    branches/upstream/libtest-strict-perl/current/MANIFEST
    branches/upstream/libtest-strict-perl/current/META.yml
    branches/upstream/libtest-strict-perl/current/Makefile.PL
    branches/upstream/libtest-strict-perl/current/README
    branches/upstream/libtest-strict-perl/current/lib/
    branches/upstream/libtest-strict-perl/current/lib/Test/
    branches/upstream/libtest-strict-perl/current/lib/Test/Strict.pm
    branches/upstream/libtest-strict-perl/current/t/
    branches/upstream/libtest-strict-perl/current/t/01all.t
    branches/upstream/libtest-strict-perl/current/t/02fail.t
    branches/upstream/libtest-strict-perl/current/t/03pod.t
    branches/upstream/libtest-strict-perl/current/t/04cover.t
    branches/upstream/libtest-strict-perl/current/t/05coverpod.t

Added: branches/upstream/libtest-strict-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-strict-perl/current/Changes?rev=24185&op=file
==============================================================================
--- branches/upstream/libtest-strict-perl/current/Changes (added)
+++ branches/upstream/libtest-strict-perl/current/Changes Tue Aug 12 10:18:16 2008
@@ -1,0 +1,40 @@
+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

Added: branches/upstream/libtest-strict-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-strict-perl/current/MANIFEST?rev=24185&op=file
==============================================================================
--- branches/upstream/libtest-strict-perl/current/MANIFEST (added)
+++ branches/upstream/libtest-strict-perl/current/MANIFEST Tue Aug 12 10:18:16 2008
@@ -1,0 +1,11 @@
+Changes
+lib/Test/Strict.pm
+Makefile.PL
+MANIFEST			This list of files
+META.yml
+README
+t/01all.t
+t/02fail.t
+t/03pod.t
+t/04cover.t
+t/05coverpod.t

Added: branches/upstream/libtest-strict-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-strict-perl/current/META.yml?rev=24185&op=file
==============================================================================
--- branches/upstream/libtest-strict-perl/current/META.yml (added)
+++ branches/upstream/libtest-strict-perl/current/META.yml Tue Aug 12 10:18:16 2008
@@ -1,0 +1,23 @@
+---
+name: Test-Strict
+version: 0.09
+author:
+  - 'Pierre Denis, C<< <pierre at itrelease.net> >>.'
+abstract: 'Check syntax, presence of use strict; and test coverage'
+license: perl
+requires:
+  Devel::Cover: 0.43
+  File::Find: 0.01
+  File::Spec: 0.01
+  FindBin: 0.01
+  Test::Builder: 0.01
+  Test::Simple: 0.47
+build_requires:
+  File::Temp: 0.01
+  Test::Pod: 0.01
+dynamic_config: 0
+provides:
+  Test::Strict:
+    file: lib/Test/Strict.pm
+    version: 0.09
+generated_by: Module::Build version 0.26

Added: branches/upstream/libtest-strict-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-strict-perl/current/Makefile.PL?rev=24185&op=file
==============================================================================
--- branches/upstream/libtest-strict-perl/current/Makefile.PL (added)
+++ branches/upstream/libtest-strict-perl/current/Makefile.PL Tue Aug 12 10:18:16 2008
@@ -1,0 +1,15 @@
+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,
+        },
+);

Added: branches/upstream/libtest-strict-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-strict-perl/current/README?rev=24185&op=file
==============================================================================
--- branches/upstream/libtest-strict-perl/current/README (added)
+++ branches/upstream/libtest-strict-perl/current/README Tue Aug 12 10:18:16 2008
@@ -1,0 +1,11 @@
+This is the README file for Test::Strict, for
+testing strictness in a distribution, by Pierre Denis <pierre at itrelease.net>.
+
+* Installation
+
+Test::Strict uses the standard perl module install process:
+
+perl Makefile.PL
+make
+make test
+make install

Added: branches/upstream/libtest-strict-perl/current/lib/Test/Strict.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-strict-perl/current/lib/Test/Strict.pm?rev=24185&op=file
==============================================================================
--- branches/upstream/libtest-strict-perl/current/lib/Test/Strict.pm (added)
+++ branches/upstream/libtest-strict-perl/current/lib/Test/Strict.pm Tue Aug 12 10:18:16 2008
@@ -1,0 +1,434 @@
+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 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';
+$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"';
+
+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->no_upwards( $File::Find::name );
+  };
+  my $find_arg = {
+                    %file_find_arg,
+                    wanted   => $want_sub,
+                    no_chdir => 1,
+                 };
+  find( $find_arg, @base_dirs);
+  @found;
+}
+
+
+=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;
+  }
+  if (! _is_perl_module($file) and ! _is_perl_script($file)) {
+    $Test->ok( 0, $test_txt );
+    $Test->diag( "$file is not a perl module or a perl script" );
+    return;
+  }
+
+  my $inc = join(' -I ', @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`;
+  $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.
+
+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; };
+  while (<$fh>) {
+    next if (/^\s*#/); # Skip comments
+    next if (/^\s*=.+/ .. /^\s*=(cut|back|end)/); # Skip pod
+    last if (/^\s*(__END__|__DATA__)/); # End of code
+    if ( /\buse\s+strict\s*;/ ) {
+      $Test->ok(1, $test_txt);
+      return 1;
+    }
+  }
+  $Test->ok(0, $test_txt);
+  return;
+}
+
+
+=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::...> statement.
+However, 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::...> statement.
+
+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; };
+  while (<$fh>) {
+    if ($. == 1 and $is_script and $_ =~ $PERL_PATTERN) {
+      if (/perl\s+\-\w*[wW]/) {
+        $Test->ok(1, $test_txt);
+        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
+    if ( /\buse\s+warnings(\s|::|;)/ ) {
+      $Test->ok(1, $test_txt);
+      return 1;
+    }
+  }
+  $Test->ok(0, $test_txt);
+  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)
+
+=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};
+  `$cover_bin -delete`;
+  if ($?) {
+    $Test->skip();
+    $Test->diag("Cover binary $cover_bin not found");
+    return;
+  }
+  foreach my $file ( @all_files ) {
+    $file = _untaint($file);
+    `$perl_bin -MDevel::Cover=$DEVEL_COVER_OPTIONS $file 2>&1 > /dev/null`;
+    $Test->ok(! $?, "Coverage captured from $file" );
+  }
+  $Test->ok(my $cover = `$cover_bin 2>/dev/null`, "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;
+}
+
+
+##
+## 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 $COVER;
+  foreach my $path (split /:/, $ENV{PATH}) {
+    my $path_cover = File::Spec->catfile($path, 'cover');
+    next unless -x $path_cover;
+    return $COVER = _untaint($path_cover);
+  }
+  return;
+}
+
+
+sub _make_plan {
+  unless ($Test->has_plan) {
+    $Test->plan( no_plan => 1 );
+  }
+  $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 AUTHOR
+
+Pierre Denis, C<< <pierre at itrelease.net> >>.
+
+=head1 COPYRIGHT
+
+Copyright 2005, Pierre Denis, All Rights Reserved.
+
+You may use, modify, and distribute this package under the
+same terms as Perl itself.
+
+=cut
+
+1;

Added: branches/upstream/libtest-strict-perl/current/t/01all.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-strict-perl/current/t/01all.t?rev=24185&op=file
==============================================================================
--- branches/upstream/libtest-strict-perl/current/t/01all.t (added)
+++ branches/upstream/libtest-strict-perl/current/t/01all.t Tue Aug 12 10:18:16 2008
@@ -1,0 +1,64 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::Strict;
+use File::Temp qw( tempdir tempfile );
+
+##
+## 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
+##
+
+all_perl_files_ok();
+
+strict_ok( $0, "got strict" );
+syntax_ok( $0, "syntax" );
+syntax_ok( 'Test::Strict' );
+strict_ok( 'Test::Strict' );
+warnings_ok( $0 );
+
+my $warning_file1 = make_warning_file1();
+warnings_ok( $warning_file1 );
+
+my $warning_file2 = make_warning_file2();
+warnings_ok( $warning_file2 );
+
+my $warning_file3 = make_warning_file3();
+warnings_ok( $warning_file3 );
+
+
+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 $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 $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 $filename;
+}
+

Added: branches/upstream/libtest-strict-perl/current/t/02fail.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-strict-perl/current/t/02fail.t?rev=24185&op=file
==============================================================================
--- branches/upstream/libtest-strict-perl/current/t/02fail.t (added)
+++ branches/upstream/libtest-strict-perl/current/t/02fail.t Tue Aug 12 10:18:16 2008
@@ -1,0 +1,122 @@
+#!/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 => 8;
+use File::Temp qw( tempdir tempfile );
+
+my $perl  = $^X || 'perl';
+my $inc = join(' -I ', @INC) || '';
+$inc = "-I $inc" if $inc;
+
+test1();
+test2();
+test3();
+
+exit;
+
+
+sub test1 {
+  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` );
+  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 make_bad_file {
+  my $tmpdir = tempdir( CLEANUP => 1 );
+  my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
+  print $fh <<'DUMMY';
+print "Hello world without use strict";
+# use strict;
+=over
+use strict;
+=back
+
+=for
+use strict;
+=end
+
+=pod
+use strict;
+=cut
+
+DUMMY
+  return $tmpdir;
+}
+
+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_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;
+}
+

Added: branches/upstream/libtest-strict-perl/current/t/03pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-strict-perl/current/t/03pod.t?rev=24185&op=file
==============================================================================
--- branches/upstream/libtest-strict-perl/current/t/03pod.t (added)
+++ branches/upstream/libtest-strict-perl/current/t/03pod.t Tue Aug 12 10:18:16 2008
@@ -1,0 +1,6 @@
+#!/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();

Added: branches/upstream/libtest-strict-perl/current/t/04cover.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-strict-perl/current/t/04cover.t?rev=24185&op=file
==============================================================================
--- branches/upstream/libtest-strict-perl/current/t/04cover.t (added)
+++ branches/upstream/libtest-strict-perl/current/t/04cover.t Tue Aug 12 10:18:16 2008
@@ -1,0 +1,14 @@
+#!/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;
+}
+
+$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 );

Added: branches/upstream/libtest-strict-perl/current/t/05coverpod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-strict-perl/current/t/05coverpod.t?rev=24185&op=file
==============================================================================
--- branches/upstream/libtest-strict-perl/current/t/05coverpod.t (added)
+++ branches/upstream/libtest-strict-perl/current/t/05coverpod.t Tue Aug 12 10:18:16 2008
@@ -1,0 +1,5 @@
+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();




More information about the Pkg-perl-cvs-commits mailing list