well heres *an* implementation, with a pretty trivial pod addition:thats precisely what -v does currently, same convenience argument applies.
I see a difference in that
prove -v
is shorthand for
TEST_VERBOSE=1 make test
I'm not against the idea. Just not sure about the implementation.
Whyncha write the manpage docs for how it'll work? That'll give us something more definite to base it on.
xoa
-o, --passopt
This option accepts an argval, and passes it thru as an
option to the tests. A dash is prepended to the argval as
the test is dispatched, as follows: prove-usage @ARGV in test-script
-o opt -opt
-o param=val -param=val-p, --passarg
This option is handled like -o, except that no dash is
prepended1st, 2 tests will hopefully gives a cursory use-case
here I repeat the -Dd test pattern in prove-switches.t, this time testing
that the pass-thru opts are stripped from switches, (implying that they go elsewhere)
+PROVE_SWITCHES_PT: {
+ local $/ = undef;
+
+ my $cmd = "$prove -v -o foo -o ot=ov -Ibork -p yup -p pt=pv -v -Dd t/echo.pl";
+ my @actual = qx/$cmd/;
+ my @expected = ( "# \$Test::Harness::Switches: -Ibork\nt/echo.pl\n" );
+ array_match_ok( [EMAIL PROTECTED], [EMAIL PROTECTED], "passthru options stripped from switches" );
+}
+
t/prove-passthru.t repeats this, but actually runs a prog that echos the @ARGV,
allowing it to be tested for in the output.
+PROVE_SWITCHES_PT: {
+ local $/ = undef;
+
+ my $cmd = "$prove -I./lib -ofoo -o ot=ov -Ibork -p yup -ppt=pv t/echo.pl";
+ my $actual = qx/$cmd/;
+ my $expect = "t/echo.pl RCVD ARGS: -foo -ot=ov yup pt=pv";
+ like ( $actual, qr/$expect/, "passthru options stripped from switches" );
+}
+
the test is questionable/broken - it fails make test thusly:
...
t/ok................ok
t/pod...............ok
t/prove-passthru....# Failed test (t/prove-passthru.t at line 27)
# 't/echo...........ok
# All tests successful.
# Files=1, Tests=1, 0 wallclock secs ( 0.01 cusr + 0.01 csys = 0.02 CPU)
# '
# doesn't match '(?-xism:t/echo.pl RCVD ARGS: -foo -ot=ov yup pt=pv)'
# Looks like you failed 1 tests of 1.
t/prove-passthru....dubious
Test returned status 1 (wstat 256, 0x100)
DIED. FAILED test 1
Failed 1/1 tests, 0.00% okay
t/prove-switches....ok
t/strap-analyze.....ok ...
it looks to me like a nested test problem, possibly compounded by a schizophrenic echo.pl, which also prints conformant test output..
[EMAIL PROTECTED] Test-Harness-2.40-new]$ perl t/echo.pl foo 1..1 ok - t/echo.pl RCVD ARGS: foo
The patch is rough - I started just to see how deep into the pms
Id have to go to shoehorn the feature in. Not too bad, with 216 lines of diff.
The worst part is the way Straps::_command_line() updates self from @_, which only has correct @passopts in the call made from Harness::run_all_tests, but not in the call from analyze_file(). This left me with a -d dependent error, which I band-aided with a simple change near 'SIDE EFFECT'.
All in all, it does some cross-package dependency abuse, and is only good to try out the feature. At any rate, its more constructive than nitpicking about the universe of %ENV.
As to the larger use-case type questions - heres a viewpoint.
current harnesses all collect test files into array, and iterate. This is fine, but it means that the harnesses cannot also exersize test features controlled by args.
Passthru gives an orthogonal control - every test-file in @tests are given the same options. Aside: I lump passthru args with opts, they came along for a bit more flexibility.
Use of ENV is not precluded, its even usable orthogonally with options, but thats not a good idea - generally the handling of ENV contents follows from the cmdline options - its merely a persistence mechanism. That convention could be construed as further evidenciary support for -option primacy :-P
Currently, torture testing only adds japh/*.t Generally speaking, torture tests belong together with thier less demanding siblings, not segregated off to some leper colony.
caveat: my 'design' of the options probly precludes effective passthru with some options schemes supported by Getopt::* Im not currently prepared to say which tho (this might take some time ;-)
Ok - Im not sure whether Im being thorough or pedantic.
have fun, jimc
Only in Test-Harness-2.40-new/: Makefile
diff -ru Test-Harness-2.40/bin/prove Test-Harness-2.40-new/bin/prove
--- Test-Harness-2.40/bin/prove Sun Dec 21 21:41:18 2003
+++ Test-Harness-2.40-new/bin/prove Thu Apr 8 01:33:19 2004
@@ -18,6 +18,7 @@
my $recurse = 0;
my @includes = ();
my @switches = ();
+my (@passopts, @passargs);
# Allow cuddling the paths with the -I
@ARGV = map { /^(-I)(.+)/ ? ($1,$2) : $_ } @ARGV;
@@ -36,6 +37,8 @@
'H|man' => sub {pod2usage({-verbose => 2, -input => \*DATA}); exit},
'I=s@' => [EMAIL PROTECTED],
'l|lib' => \$lib,
+ 'o|passopt=s@' => [EMAIL PROTECTED],
+ 'p|passarg=s@' => [EMAIL PROTECTED],
'r|recurse' => \$recurse,
's|shuffle' => \$shuffle,
't' => sub { unshift @switches, "-t" }, # Always want -t up
front
@@ -82,7 +85,10 @@
print join( "\n", @tests, "" );
} else {
print "# ", scalar @tests, " tests to run\n" if $Test::Harness::debug;
- runtests(@tests);
+ print "# @passopts, @passargs to @tests\n" if $Test::Harness::debug;
+
+ @passopts = map "-$_", @passopts;
+ runtests([EMAIL PROTECTED], @passargs], @tests);
}
}
@@ -173,6 +179,8 @@
-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.
+ -o, --passopt X pass -X in ARGV given to tests
+ -p, --passarg X pass X in ARGV given to tests
-r, --recurse Recursively descend into directories.
-s, --shuffle Run the tests in a random order.
-T Enable tainting checks
@@ -269,6 +277,21 @@
Add C<lib> to @INC. Equivalent to C<-Ilib>.
+=head2 -o, --passopt
+
+This option accepts an argval, and passes it thru as an option to the
+tests. A dash is prepended to the argval as the test is dispatched,
+as follows:
+
+ prove-usage @ARGV in test-script
+ -o param -param
+ -o param=val -param=val
+
+=head2 -p, --passarg
+
+This option is handled like -o, except that no dash is prepended
+
+
=head2 -r, --recurse
Descends into subdirectories of any directories specified, looking for tests.
Only in Test-Harness-2.40-new/bin: prove~
Only in Test-Harness-2.40-new/: blib
Only in Test-Harness-2.40-new/: blibdirs
Only in Test-Harness-2.40-new/: junk
diff -ru Test-Harness-2.40/lib/Test/Harness/Straps.pm
Test-Harness-2.40-new/lib/Test/Harness/Straps.pm
--- Test-Harness-2.40/lib/Test/Harness/Straps.pm Tue Dec 30 19:34:22 2003
+++ Test-Harness-2.40-new/lib/Test/Harness/Straps.pm Thu Apr 8 04:36:41 2004
@@ -156,6 +156,8 @@
sub _analyze_line {
my($self, $line, $totals) = @_;
+ # print "# look at: $line\n" if $Test::Harness::verbose;
+
my %result = ();
$self->{line}++;
@@ -268,6 +270,7 @@
print "can't run $file. $!\n";
return;
}
+ #print STDERR "got: ", <FILE>, "\n";
my %results = $self->analyze_fh($file, \*FILE);
my $exit = close FILE;
@@ -305,12 +308,18 @@
sub _command_line {
my $self = shift;
my $file = shift;
+ my $passopts = shift || $self->{passopts} || '';
+
+ if (ref $passopts) {
+ $passopts = join ' ', @$passopts;
+ }
+ $self->{popts} = $passopts;
my $command = $self->_command();
my $switches = $self->_switches($file);
$file = qq["$file"] if ($file =~ /\s/) && ($file !~ /^".*"$/);
- my $line = "$command $switches $file";
+ my $line = "$command $switches $file $passopts";
return $line;
}
Only in Test-Harness-2.40-new/lib/Test/Harness: Straps.pm~
diff -ru Test-Harness-2.40/lib/Test/Harness.pm
Test-Harness-2.40-new/lib/Test/Harness.pm
--- Test-Harness-2.40/lib/Test/Harness.pm Tue Dec 30 19:39:21 2003
+++ Test-Harness-2.40-new/lib/Test/Harness.pm Thu Apr 8 02:24:32 2004
@@ -467,10 +467,17 @@
my $t_start = new Benchmark;
my $width = _leader_width(@tests);
+ my $passthru;
foreach my $tfile (@tests) {
- if ( $Test::Harness::Debug ) {
- print "# Running: ", $Strap->_command_line($tfile), "\n";
+
+ if (ref $tfile eq 'ARRAY') {
+ $passthru = $tfile;
+ print "# passthru: @{$passthru}\n" if $Test::Harness::Debug;
+ next;
}
+ my $cmd = $Strap->_command_line($tfile,$passthru); # need SIDE EFFECT !
+
+ print "# Running: $cmd\n" if $Test::Harness::Debug;
$Last_ML_Print = 0; # so each test prints at least once
my($leader, $ml) = _mk_leader($tfile, $width);
Only in Test-Harness-2.40-new/lib/Test: Harness.pm~
Only in Test-Harness-2.40-new/: pm_to_blib
Only in Test-Harness-2.40-new/t: echo.pl
Only in Test-Harness-2.40-new/t: echo.pl~
Only in Test-Harness-2.40-new/t: echo.t~
Only in Test-Harness-2.40-new/t: echo~
diff -ru Test-Harness-2.40/t/prove-passthru.t Test-Harness-2.40-new/t/prove-passthru.t
--- Test-Harness-2.40/t/prove-passthru.t Thu Apr 8 03:12:50 2004
+++ Test-Harness-2.40-new/t/prove-passthru.t Thu Apr 8 01:21:20 2004
@@ -0,0 +1,29 @@
+BEGIN { # -*- perl -*-
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use strict;
+use File::Spec;
+use Test::More;
+plan skip_all => "Not installing prove" if -e "t/SKIP-PROVE";
+plan tests => 1;
+
+my $blib = File::Spec->catfile( File::Spec->curdir, "blib" );
+my $prove = File::Spec->catfile( $blib, "script", "prove" );
+
+
+PROVE_SWITCHES_PT: {
+ local $/ = undef;
+
+ my $cmd = "$prove -I./lib -ofoo -o ot=ov -Ibork -p yup -ppt=pv t/echo.pl";
+ my $actual = qx/$cmd/;
+ my $expect = "t/echo.pl RCVD ARGS: -foo -ot=ov yup pt=pv";
+ like ( $actual, qr/$expect/, "passthru options stripped from switches" );
+}
+
Only in Test-Harness-2.40-new/t: prove-passthru.t~
diff -ru Test-Harness-2.40/t/prove-switches.t Test-Harness-2.40-new/t/prove-switches.t
--- Test-Harness-2.40/t/prove-switches.t Sun Dec 21 21:39:47 2003
+++ Test-Harness-2.40-new/t/prove-switches.t Thu Apr 8 00:34:07 2004
@@ -1,4 +1,4 @@
-BEGIN {
+BEGIN { # -*- perl -*-
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
@@ -14,7 +14,7 @@
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 => 5;
+plan tests => 6;
my $blib = File::Spec->catfile( File::Spec->curdir, "blib" );
my $blib_lib = File::Spec->catfile( $blib, "lib" );
@@ -64,6 +64,15 @@
array_match_ok( [EMAIL PROTECTED], [EMAIL PROTECTED], "PROVE_SWITCHES OK" );
}
+PROVE_SWITCHES_PT: {
+ local $/ = undef;
+
+ my $cmd = "$prove -v -o foo -o ot=ov -Ibork -p yup -p pt=pv -v -Dd t/echo.pl";
+ my @actual = qx/$cmd/;
+ my @expected = ( "# \$Test::Harness::Switches: -Ibork\nt/echo.pl\n" );
+ array_match_ok( [EMAIL PROTECTED], [EMAIL PROTECTED], "passthru options stripped
from switches" );
+}
+
sub array_match_ok {
my $actual = shift;
@@ -75,7 +84,8 @@
my @expected = @$expected;
while ( @actual && @expected ) {
- return ok( 0, "Differs at element $n: $message" ) if shift @actual ne shift
@expected;
+ my ($a,$e) = (shift @actual, shift @expected);
+ return ok( 0, "Differs at element $n: $a NE $e" ) unless $a eq $e;
++$n;
}
return ok( 0, "Too many actual: $message" ) if @actual;
