# -*- Mode: cperl; cperl-indent-level: 4 -*-
-# $Id: Harness.pm,v 1.76 2003/11/25 04:41:03 andy Exp $
+# $Id: Harness.pm,v 1.80 2003/12/31 02:39:21 andy Exp $
package Test::Harness;
=head1 VERSION
-Version 2.38
+Version 2.40
- $Header: /home/cvs/test-harness/lib/Test/Harness.pm,v 1.76 2003/11/25 04:41:03 andy Exp $
+ $Header: /home/cvs/test-harness/lib/Test/Harness.pm,v 1.80 2003/12/31 02:39:21 andy Exp $
=cut
-$VERSION = '2.38';
+$VERSION = '2.40';
# Backwards compatibility for exportable variable names.
*verbose = *Verbose;
}
elsif($results{seen}) {
if (@{$test{failed}} and $test{max}) {
- my ($txt, $canon) = canonfailed($test{max},$test{skipped},
+ my ($txt, $canon) = _canonfailed($test{max},$test{skipped},
@{$test{failed}});
print "$test{ml}$txt";
$failedtests{$tfile} = { canon => $canon,
$wstatus,$wstatus;
print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS';
- if (corestatus($wstatus)) { # until we have a wait module
+ if (_corestatus($wstatus)) { # until we have a wait module
if ($Have_Devel_Corestack) {
Devel::CoreStack::stack($^X);
} else {
else {
push @{$test->{failed}}, $test->{'next'}..$test->{max};
$failed = @{$test->{failed}};
- (my $txt, $canon) = canonfailed($test->{max},$test->{skipped},@{$test->{failed}});
+ (my $txt, $canon) = _canonfailed($test->{max},$test->{skipped},@{$test->{failed}});
$percent = 100*(scalar @{$test->{failed}})/$test->{max};
print "DIED. ",$txt;
}
{
my $tried_devel_corestack;
- sub corestatus {
+ sub _corestatus {
my($st) = @_;
my $did_core;
}
}
-sub canonfailed ($$@) {
+sub _canonfailed ($$@) {
my($max,$skipped,@failed) = @_;
my %seen;
@failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
Revision history for Perl extension Test::Harness
+2.40 Tue Dec 30 20:38:59 CST 2003
+ [FIXES]
+ * Test::Harness::Straps should now properly quote on VMS.
+
+ [ENHANCEMENTS]
+ * prove now takes a -l option to add lib/ to @INC. Now when you're
+ building a module, you don't have to do a make before you run
+ the prove. Thanks to David Wheeler for the idea.
+
+ [INTERNALS]
+ * Internal functions corestatus() and canonfailed() prepended with
+ underscores, to indicate such.
+
+ * Gratuitous text-only changes in Test::Harness::Iterator.
+
+ * All tests now do their use_ok() in a BEGIN block. Some of the
+ use_ok() calls were too much of a hassle to put into a BEGIN block,
+ so I changed them to regular use calls.
+
+
2.38 Mon Nov 24 22:36:18 CST 2003
Released. See changes below.
use strict;
use vars qw($VERSION);
-$VERSION = 0.01;
-
+$VERSION = 0.02;
=head1 NAME
This is a simple iterator wrapper for arrays and filehandles.
+=head2 new()
+
+Create an iterator.
+
+=head2 next()
+
+Iterate through it, of course.
+
=cut
sub new {
# -*- Mode: cperl; cperl-indent-level: 4 -*-
-# $Id: Straps.pm,v 1.34 2003/11/23 00:02:11 andy Exp $
+# $Id: Straps.pm,v 1.35 2003/12/31 02:34:22 andy Exp $
package Test::Harness::Straps;
use strict;
use vars qw($VERSION);
use Config;
-$VERSION = '0.18';
+$VERSION = '0.19';
use Test::Harness::Assert;
use Test::Harness::Iterator;
push @derived_switches, map { "-I$_" } @inc;
}
- # Quote all switches to prevent shell interference, or VMS downcasing
+ # Quote the argument if there's any whitespace in it, or if
+ # we're VMS, since VMS requires all parms quoted. Also, don't quote
+ # it if it's already quoted.
for ( @derived_switches ) {
- $_ = qq["$_"] if /\S/ && !/^".*"$/;
+ $_ = qq["$_"] if ((/\s/ || $self->{_is_vms}) && !/^".*"$/ );
}
return join( " ", @existing_switches, @derived_switches );
}
my $shuffle = 0;
my $dry = 0;
my $blib = 0;
+my $lib = 0;
my $recurse = 0;
my @includes = ();
my @switches = ();
'h|help|?' => sub {pod2usage({-verbose => 1, -input => \*DATA}); exit},
'H|man' => sub {pod2usage({-verbose => 2, -input => \*DATA}); exit},
'I=s@' => \@includes,
+ 'l|lib' => \$lib,
'r|recurse' => \$recurse,
's|shuffle' => \$shuffle,
't' => sub { unshift @switches, "-t" }, # Always want -t up front
}
}
+# Handle lib includes
+if ( $lib ) {
+ unshift @includes, "lib";
+}
+
# Build up TH switches
push( @switches, map { /\s/ && !/^".*"$/ ? qq["-I$_"] : "-I$_" } @includes );
$Test::Harness::Switches = join( " ", @switches );
-h, --help Display this help
-H, --man Longer manpage for prove
-I Add libraries to @INC, as Perl's -I
+ -l, --lib Add lib to the path for your tests.
-r, --recurse Recursively descend into directories.
-s, --shuffle Run the tests in a random order.
-T Enable tainting checks
=head2 -I
-Add libraries to @INC, as Perl's -I
+Add libraries to @INC, as Perl's -I.
+
+=head2 -l, --lib
+
+Add C<lib> to @INC. Equivalent to C<-Ilib>.
=head2 -r, --recurse
Shuffled tests must be recreatable
-=item *
-
-Add a flag to run prove under Devel::Cover
-
=back
=head1 AUTHORS
use Test::More tests => 5;
BEGIN { use_ok 'Test::Harness' }
+BEGIN { diag( "Testing Test::Harness $Test::Harness::VERSION" ) }
BEGIN { use_ok 'Test::Harness::Straps' }
BEGIN { use_ok 'Test::Harness::Assert' }
# If the $VERSION is set improperly, this will spew big warnings.
-use_ok 'Test::Harness', 1.1601;
+BEGIN { use_ok 'Test::Harness', 1.1601 }
+
use Test::More tests => 7;
-use_ok( 'Test::Harness::Assert' );
+BEGIN { use_ok( 'Test::Harness::Assert' ); }
ok( defined &assert, 'assert() exported' );
use Test::More;
use File::Spec;
-my $Curdir = File::Spec->curdir;
-my $SAMPLE_TESTS = $ENV{PERL_CORE}
- ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
- : File::Spec->catdir($Curdir, 't', 'sample-tests');
-
-%samples = (
+BEGIN {
+ use vars qw( %samples );
+
+ %samples = (
bailout => [qw( header test test test bailout )],
combined => ['header', ('test') x 10],
descriptive => ['header', ('test') x 5 ],
with_comments => [qw( other header other test other test test
test other other test other )],
);
+ plan tests => 2 + scalar keys %samples;
+}
+
+BEGIN { use_ok( 'Test::Harness::Straps' ); }
-plan tests => 2 + scalar keys %samples;
+my $Curdir = File::Spec->curdir;
+my $SAMPLE_TESTS = $ENV{PERL_CORE}
+ ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
+ : File::Spec->catdir($Curdir, 't', 'sample-tests');
-use_ok( 'Test::Harness::Straps' );
my $strap = Test::Harness::Straps->new;
isa_ok( $strap, 'Test::Harness::Straps' );
$strap->{callback} = sub {
plan skip_all => "Not adapted to perl core" if $ENV{PERL_CORE};
plan skip_all => "Not installing prove" if -e "t/SKIP-PROVE";
-plan tests => 3;
-local $/ = undef;
+plan tests => 5;
my $blib = File::Spec->catfile( File::Spec->curdir, "blib" );
my $blib_lib = File::Spec->catfile( $blib, "lib" );
CAPITAL_TAINT: {
local $ENV{PROVE_SWITCHES};
+ local $/ = undef;
+
my @actual = qx/$prove -Ifirst -D -I second -Ithird -Tvdb/;
my @expected = ( "# \$Test::Harness::Switches: -T -I$blib_arch -I$blib_lib -Ifirst -Isecond -Ithird\n" );
array_match_ok( \@actual, \@expected, "Capital taint flags OK" );
LOWERCASE_TAINT: {
local $ENV{PROVE_SWITCHES};
+ local $/ = undef;
+
my @actual = qx/$prove -dD -Ifirst -I second -t -Ithird -vb/;
my @expected = ( "# \$Test::Harness::Switches: -t -I$blib_arch -I$blib_lib -Ifirst -Isecond -Ithird\n" );
array_match_ok( \@actual, \@expected, "Lowercase taint OK" );
PROVE_SWITCHES: {
local $ENV{PROVE_SWITCHES} = "-dvb -I fark";
+ local $/ = undef;
+
my @actual = qx/$prove -Ibork -Dd/;
my @expected = ( "# \$Test::Harness::Switches: -I$blib_arch -I$blib_lib -Ifark -Ibork\n" );
array_match_ok( \@actual, \@expected, "PROVE_SWITCHES OK" );
}
+PROVE_SWITCHES_L: {
+ local $/ = undef;
+
+ my @actual = qx/$prove -l -Ibongo -Dd/;
+ my @expected = ( "# \$Test::Harness::Switches: -Ilib -Ibongo\n" );
+ array_match_ok( \@actual, \@expected, "PROVE_SWITCHES OK" );
+}
+
+PROVE_SWITCHES_LB: {
+ local $/ = undef;
+
+ my @actual = qx/$prove -lb -Dd/;
+ my @expected = ( "# \$Test::Harness::Switches: -Ilib -I$blib_arch -I$blib_lib\n" );
+ array_match_ok( \@actual, \@expected, "PROVE_SWITCHES OK" );
+}
+
+
sub array_match_ok {
my $actual = shift;
my $expected = shift;
},
);
-plan tests => (keys(%samples) * 5) + 4;
+plan tests => (keys(%samples) * 5) + 3;
-use_ok('Test::Harness::Straps');
+use Test::Harness::Straps;
$SIG{__WARN__} = sub {
warn @_ unless $_[0] =~ /^Enormous test number/ ||
}
is_deeply(\%results, $expect, " the rest $test" );
-}
-
+} # for %samples
-my $strap = Test::Harness::Straps->new;
-isa_ok( $strap, 'Test::Harness::Straps' );
-ok( !$strap->analyze_file('I_dont_exist') );
-is( $strap->{error}, "I_dont_exist does not exist" );
+NON_EXISTENT_FILE: {
+ my $strap = Test::Harness::Straps->new;
+ isa_ok( $strap, 'Test::Harness::Straps' );
+ ok( !$strap->analyze_file('I_dont_exist') );
+ is( $strap->{error}, "I_dont_exist does not exist" );
+}
use Test::More tests => 170;
-use_ok('Test::Harness::Straps');
+BEGIN { use_ok('Test::Harness::Straps'); }
my $strap = Test::Harness::Straps->new;
isa_ok( $strap, 'Test::Harness::Straps', 'new()' );
},
);
-plan tests => (keys(%samples) * 8) + 1;
+plan tests => (keys(%samples) * 8);
-use_ok('Test::Harness');
-use Test::Harness; # So that we don't get "used only once" warnings on the next line
+use Test::Harness;
$Test::Harness::Switches = '"-Mstrict"';
tie *NULL, 'Dev::Null' or die $!;