You are viewing a plain text version of this content. The canonical link for it is here.
Posted to test-commits@perl.apache.org by to...@apache.org on 2010/12/27 21:53:43 UTC
svn commit: r1053181 - in /perl/Apache-Test/trunk: Changes
lib/Apache/Test.pm t/sok.t
Author: torsten
Date: Mon Dec 27 20:53:42 2010
New Revision: 1053181
URL: http://svn.apache.org/viewvc?rev=1053181&view=rev
Log:
Make AT::sok() aware of the -withtestmore flag.
Added:
perl/Apache-Test/trunk/t/sok.t
Modified:
perl/Apache-Test/trunk/Changes
perl/Apache-Test/trunk/lib/Apache/Test.pm
Modified: perl/Apache-Test/trunk/Changes
URL: http://svn.apache.org/viewvc/perl/Apache-Test/trunk/Changes?rev=1053181&r1=1053180&r2=1053181&view=diff
==============================================================================
--- perl/Apache-Test/trunk/Changes (original)
+++ perl/Apache-Test/trunk/Changes Mon Dec 27 20:53:42 2010
@@ -8,6 +8,9 @@ Changes - Apache::Test change logfile
=item 1.35-dev
+Make Apache::Test::sok() compatible with the -withtestmore option
+[Torsten Foertsch]
+
Make -withtestmore a per-package option (make it behave sane).
[Torsten Foertsch]
Modified: perl/Apache-Test/trunk/lib/Apache/Test.pm
URL: http://svn.apache.org/viewvc/perl/Apache-Test/trunk/lib/Apache/Test.pm?rev=1053181&r1=1053180&r2=1053181&view=diff
==============================================================================
--- perl/Apache-Test/trunk/lib/Apache/Test.pm (original)
+++ perl/Apache-Test/trunk/lib/Apache/Test.pm Mon Dec 27 20:53:42 2010
@@ -54,10 +54,6 @@ my @have = map { (my $need = $_) =~ s/ne
%SubTests = ();
@SkipReasons = ();
-if (my $subtests = $ENV{HTTPD_TEST_SUBTESTS}) {
- %SubTests = map { $_, 1 } split /\s+/, $subtests;
-}
-
sub cp {
my @l;
for( my $i=1; (@l=caller $i)[0] eq __PACKAGE__; $i++ ) {};
@@ -152,21 +148,37 @@ sub sok (&;$) {
my $sub = shift;
my $nok = shift || 1; #allow sok to have 'ok' within
- if (%SubTests and not $SubTests{ $Test::ntest }) {
- for my $n (1..$nok) {
- skip("skipping this subtest", 0);
- }
- return;
- }
+ my ($caller,$f,$l)=cp;
- my($package, $filename, $line) = caller;
+ if (exists $wtm{$caller} and $wtm{$caller}->[0]==1) { # -withtestmore
+ require Test::Builder;
+ my $tb=Test::Builder->new;
- # trick ok() into reporting the caller filename/line when a
- # sub-test fails in sok()
- return eval <<EOE;
-#line $line $filename
- ok(\$sub->());
+ if (%SubTests and not $SubTests{ 1+$tb->current_test }) {
+ $tb->skip("skipping this subtest") for (1..$nok);
+ return;
+ }
+
+ # trick ok() into reporting the caller filename/line when a
+ # sub-test fails in sok()
+ return eval <<EOE;
+#line $l $f
+ Test::More::ok(\$sub->());
EOE
+ }
+ else {
+ if (%SubTests and not $SubTests{ $Test::ntest }) {
+ skip("skipping this subtest", 0) for (1..$nok);
+ return;
+ }
+
+ # trick ok() into reporting the caller filename/line when a
+ # sub-test fails in sok()
+ return eval <<EOE;
+#line $l $f
+ Test::ok(\$sub->());
+EOE
+ }
}
#so Perl's Test.pm can be run inside mod_perl
@@ -270,6 +282,11 @@ sub plan {
my ($caller,$f,$l)=cp;
+ %SubTests=();
+ if (my $subtests=$ENV{HTTPD_TEST_SUBTESTS}) {
+ %SubTests=map { $_, 1 } split /\s+/, $subtests;
+ }
+
if (exists $wtm{$caller} and $wtm{$caller}->[0]==1) { # -withtestmore
Test::More::plan(@_);
}
Added: perl/Apache-Test/trunk/t/sok.t
URL: http://svn.apache.org/viewvc/perl/Apache-Test/trunk/t/sok.t?rev=1053181&view=auto
==============================================================================
--- perl/Apache-Test/trunk/t/sok.t (added)
+++ perl/Apache-Test/trunk/t/sok.t Mon Dec 27 20:53:42 2010
@@ -0,0 +1,167 @@
+#!perl
+
+use strict;
+use warnings FATAL=>'all';
+
+use Test ();
+use Config ();
+unless ($Config::Config{useperlio}) {
+ print
+}
+
+Test::plan tests=>8;
+
+my $output;
+{
+ package X0;
+ use Apache::Test;
+
+ local ($Test::planned, $Test::ntest, %Test::todo);
+ local *STDOUT;
+ open STDOUT, '>', \$output;
+
+ local $ENV{HTTPD_TEST_SUBTESTS}="";
+
+ plan tests=>3;
+
+ sok {1};
+ sok {1};
+ sok {1};
+}
+Test::ok $output=~/^ok 1$/m &&
+ $output=~/^ok 2$/m &&
+ $output=~/^ok 3$/m;
+
+{
+ package Y0;
+ use Apache::Test qw/-withtestmore/;
+
+ local *STDOUT;
+ open STDOUT, '>', \$output;
+
+ local $ENV{HTTPD_TEST_SUBTESTS}="";
+
+ plan tests=>3;
+
+ sok {1};
+ sok {1};
+ sok {1};
+}
+Test::ok $output=~/^ok 1$/m &&
+ $output=~/^ok 2$/m &&
+ $output=~/^ok 3$/m;
+
+{
+ package X0;
+
+ local ($Test::planned, $Test::ntest, %Test::todo);
+ local *STDOUT;
+ open STDOUT, '>', \$output;
+
+ local $ENV{HTTPD_TEST_SUBTESTS}="1 3";
+
+ plan tests=>3;
+
+ sok {1};
+ sok {1};
+ sok {1};
+}
+Test::ok $output=~/^ok 1$/m &&
+ $output=~/^ok 2 # skip skipping this subtest$/m &&
+ $output=~/^ok 3$/m;
+
+{
+ package Y0;
+
+ local *STDOUT;
+ open STDOUT, '>', \$output;
+
+ local $ENV{HTTPD_TEST_SUBTESTS}="1 3";
+
+ plan tests=>3;
+
+ sok {1};
+ sok {1};
+ sok {1};
+}
+Test::ok $output=~/^ok 1$/m &&
+ $output=~/^ok 2 # skip skipping this subtest$/m &&
+ $output=~/^ok 3$/m;
+
+{
+ package X0;
+
+ local ($Test::planned, $Test::ntest, %Test::todo);
+ local *STDOUT;
+ open STDOUT, '>', \$output;
+
+ local $ENV{HTTPD_TEST_SUBTESTS}="";
+
+ plan tests=>4;
+
+ sok {1};
+ sok {ok 1; 1} 2;
+ sok {1};
+}
+Test::ok $output=~/^ok 1$/m &&
+ $output=~/^ok 2$/m &&
+ $output=~/^ok 3$/m &&
+ $output=~/^ok 4$/m;
+
+{
+ package Y0;
+
+ local *STDOUT;
+ open STDOUT, '>', \$output;
+
+ local $ENV{HTTPD_TEST_SUBTESTS}="";
+
+ plan tests=>4;
+
+ sok {1};
+ sok {ok 1, "erwin"} 2;
+ sok {1};
+}
+Test::ok $output=~/^ok 1$/m &&
+ $output=~/^ok 2 - erwin$/m &&
+ $output=~/^ok 3$/m &&
+ $output=~/^ok 4$/m;
+
+{
+ package X0;
+
+ local ($Test::planned, $Test::ntest, %Test::todo);
+ local *STDOUT;
+ open STDOUT, '>', \$output;
+
+ local $ENV{HTTPD_TEST_SUBTESTS}="1 4";
+
+ plan tests=>4;
+
+ sok {1};
+ sok {ok 1; 1} 2;
+ sok {1};
+}
+Test::ok $output=~/^ok 1$/m &&
+ $output=~/^ok 2 # skip skipping this subtest$/m &&
+ $output=~/^ok 3 # skip skipping this subtest$/m &&
+ $output=~/^ok 4$/m;
+
+{
+ package Y0;
+
+ local *STDOUT;
+ open STDOUT, '>', \$output;
+
+ local $ENV{HTTPD_TEST_SUBTESTS}="1 4";
+
+ plan tests=>4;
+
+ sok {1};
+ sok {ok 1} 2;
+ sok {1};
+}
+Test::ok $output=~/^ok 1$/m &&
+ $output=~/^ok 2 # skip skipping this subtest$/m &&
+ $output=~/^ok 3 # skip skipping this subtest$/m &&
+ $output=~/^ok 4$/m;