You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by st...@apache.org on 2004/11/25 19:03:29 UTC
svn commit: r106587 - /perl/modperl/trunk/ModPerl-Registry/t/TEST.PL /perl/modperl/trunk/ModPerl-Registry/t/closure.t /perl/modperl/trunk/ModPerl-Registry/t/perlrun_extload.t /perl/modperl/trunk/ModPerl-Registry/t/special_blocks.t
Author: stas
Date: Thu Nov 25 10:03:28 2004
New Revision: 106587
URL: http://svn.apache.org/viewcvs?view=rev&rev=106587
Log:
refactor the same_interp tests to use TestCommon::SameInterp
Modified:
perl/modperl/trunk/ModPerl-Registry/t/TEST.PL
perl/modperl/trunk/ModPerl-Registry/t/closure.t
perl/modperl/trunk/ModPerl-Registry/t/perlrun_extload.t
perl/modperl/trunk/ModPerl-Registry/t/special_blocks.t
Modified: perl/modperl/trunk/ModPerl-Registry/t/TEST.PL
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/ModPerl-Registry/t/TEST.PL?view=diff&rev=106587&p1=perl/modperl/trunk/ModPerl-Registry/t/TEST.PL&r1=106586&p2=perl/modperl/trunk/ModPerl-Registry/t/TEST.PL&r2=106587
==============================================================================
--- perl/modperl/trunk/ModPerl-Registry/t/TEST.PL (original)
+++ perl/modperl/trunk/ModPerl-Registry/t/TEST.PL Thu Nov 25 10:03:28 2004
@@ -6,6 +6,9 @@
use lib "$FindBin::Bin/../lib";
use lib grep { -d } map "$FindBin::Bin/../../$_", qw(lib Apache-Test/lib);
+# pick the common test libs
+use lib "$FindBin::Bin/../../t/lib";
+
MyTest->new->run(@ARGV);
Modified: perl/modperl/trunk/ModPerl-Registry/t/closure.t
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/ModPerl-Registry/t/closure.t?view=diff&rev=106587&p1=perl/modperl/trunk/ModPerl-Registry/t/closure.t&r1=106586&p2=perl/modperl/trunk/ModPerl-Registry/t/closure.t&r2=106587
==============================================================================
--- perl/modperl/trunk/ModPerl-Registry/t/closure.t (original)
+++ perl/modperl/trunk/ModPerl-Registry/t/closure.t Thu Nov 25 10:03:28 2004
@@ -4,6 +4,8 @@
use Apache::Test;
use Apache::TestUtil;
use Apache::TestRequest;
+use TestCommon::SameInterp;
+
use File::Spec::Functions;
# this test tests how various registry packages cache and flush the
@@ -36,9 +38,9 @@
my $same_interp = Apache::TestRequest::same_interp_tie($url);
# should be no closure effect, always returns 1
- my $first = get_body($same_interp, $url);
- my $second = get_body($same_interp, $url);
- skip_not_same_interp(
+ my $first = same_interp_req_body($same_interp, \&GET, $url);
+ my $second = same_interp_req_body($same_interp, \&GET, $url);
+ same_interp_skip_not_found(
(scalar(grep defined, $first, $second) != 2),
$first && $second && ($second - $first),
0,
@@ -49,8 +51,8 @@
touch_mtime($path);
# it doesn't matter, since the script is not cached anyway
- my $third = get_body($same_interp, $url);
- skip_not_same_interp(
+ my $third = same_interp_req_body($same_interp, \&GET, $url);
+ same_interp_skip_not_found(
(scalar(grep defined, $first, $second, $third) != 3),
$third,
1,
@@ -70,9 +72,9 @@
# we don't know what other test has called this uri before, so we
# check the difference between two subsequent calls. In this case
# the difference should be 1.
- my $first = get_body($same_interp, $url);
- my $second = get_body($same_interp, $url);
- skip_not_same_interp(
+ my $first = same_interp_req_body($same_interp, \&GET, $url);
+ my $second = same_interp_req_body($same_interp, \&GET, $url);
+ same_interp_skip_not_found(
(scalar(grep defined, $first, $second) != 2),
$first && $second && ($second - $first),
1,
@@ -83,8 +85,8 @@
touch_mtime($path);
# should not notice closure effect on the first request
- my $third = get_body($same_interp, $url);
- skip_not_same_interp(
+ my $third = same_interp_req_body($same_interp, \&GET, $url);
+ same_interp_skip_not_found(
(scalar(grep defined, $first, $second, $third) != 3),
$third,
1,
@@ -104,9 +106,9 @@
# we don't know what other test has called this uri before, so we
# check the difference between two subsequent calls. In this case
# the difference should be 1.
- my $first = get_body($same_interp, $url);
- my $second = get_body($same_interp, $url);
- skip_not_same_interp(
+ my $first = same_interp_req_body($same_interp, \&GET, $url);
+ my $second = same_interp_req_body($same_interp, \&GET, $url);
+ same_interp_skip_not_found(
(scalar(grep defined, $first, $second) != 2),
$first && $second && ($second - $first),
1,
@@ -117,8 +119,8 @@
touch_mtime($path);
# modification shouldn't be noticed
- my $third = get_body($same_interp, $url);
- skip_not_same_interp(
+ my $third = same_interp_req_body($same_interp, \&GET, $url);
+ same_interp_skip_not_found(
(scalar(grep defined, $first, $second, $third) != 3),
$first && $second && $third - $second,
1,
@@ -140,37 +142,4 @@
my $file = shift;
# reset the timestamp to the original mod-time
utime $orig_mtime, $orig_mtime, $file;
-}
-
-# if we fail to find the same interpreter, return undef (this is not
-# an error)
-sub get_body {
- my($same_interp, $url) = @_;
- my $res = eval {
- Apache::TestRequest::same_interp_do($same_interp, \&GET, $url);
- };
- return undef if $@ =~ /unable to find interp/;
- return $res->content if $res;
- die $@ if $@;
-}
-
-
-# make the tests resistant to a failure of finding the same perl
-# interpreter, which happens randomly and not an error.
-# the first argument is used to decide whether to skip the sub-test,
-# the rest of the arguments are passed to 'ok t_cmp';
-sub skip_not_same_interp {
- my $skip_cond = shift;
- if ($skip_cond) {
- skip "Skip couldn't find the same interpreter", 0;
- }
- else {
- my($package, $filename, $line) = caller;
- # trick ok() into reporting the caller filename/line when a
- # sub-test fails in sok()
- return eval <<EOE;
-#line $line $filename
- ok &t_cmp;
-EOE
- }
}
Modified: perl/modperl/trunk/ModPerl-Registry/t/perlrun_extload.t
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/ModPerl-Registry/t/perlrun_extload.t?view=diff&rev=106587&p1=perl/modperl/trunk/ModPerl-Registry/t/perlrun_extload.t&r1=106586&p2=perl/modperl/trunk/ModPerl-Registry/t/perlrun_extload.t&r2=106587
==============================================================================
--- perl/modperl/trunk/ModPerl-Registry/t/perlrun_extload.t (original)
+++ perl/modperl/trunk/ModPerl-Registry/t/perlrun_extload.t Thu Nov 25 10:03:28 2004
@@ -4,6 +4,7 @@
use Apache::Test;
use Apache::TestUtil;
use Apache::TestRequest qw(GET);
+use TestCommon::SameInterp;
plan tests => 2;
@@ -12,8 +13,8 @@
for (1..2) {
# should not fail on the second request
- my $res = get_body($same_interp, $url);
- skip_not_same_interp(
+ my $res = same_interp_req_body($same_interp, \&GET, $url);
+ same_interp_skip_not_found(
!defined($res),
$res,
"d1nd1234",
@@ -21,34 +22,3 @@
);
}
-# if we fail to find the same interpreter, return undef (this is not
-# an error)
-sub get_body {
- my($same_interp, $url) = @_;
- my $res = eval {
- Apache::TestRequest::same_interp_do($same_interp, \&GET, $url);
- };
- return undef if $@ =~ /unable to find interp/;
- return $res->content if $res;
- die $@ if $@;
-}
-
-# make the tests resistant to a failure of finding the same perl
-# interpreter, which happens randomly and not an error.
-# the first argument is used to decide whether to skip the sub-test,
-# the rest of the arguments are passed to 'ok t_cmp';
-sub skip_not_same_interp {
- my $skip_cond = shift;
- if ($skip_cond) {
- skip "Skip couldn't find the same interpreter", 0;
- }
- else {
- my($package, $filename, $line) = caller;
- # trick ok() into reporting the caller filename/line when a
- # sub-test fails in sok()
- return eval <<EOE;
-#line $line $filename
- ok &t_cmp;
-EOE
- }
-}
Modified: perl/modperl/trunk/ModPerl-Registry/t/special_blocks.t
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/ModPerl-Registry/t/special_blocks.t?view=diff&rev=106587&p1=perl/modperl/trunk/ModPerl-Registry/t/special_blocks.t&r1=106586&p2=perl/modperl/trunk/ModPerl-Registry/t/special_blocks.t&r2=106587
==============================================================================
--- perl/modperl/trunk/ModPerl-Registry/t/special_blocks.t (original)
+++ perl/modperl/trunk/ModPerl-Registry/t/special_blocks.t Thu Nov 25 10:03:28 2004
@@ -6,6 +6,7 @@
use Apache::Test;
use Apache::TestUtil;
use Apache::TestRequest;
+use TestCommon::SameInterp;
my %modules = (
registry => 'ModPerl::Registry',
@@ -31,36 +32,39 @@
# the rest in the same group
my $skip = 0;
- my $res = get_body($same_interp, "$url?begin");
+ my $res = same_interp_req_body($same_interp, \&GET, "$url?begin");
$skip++ unless defined $res;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
$res,
"begin ok",
"$modules{$alias} is running BEGIN blocks on the first request",
);
- $res = $skip ? undef : get_body($same_interp, "$url?begin");
+ $res = $skip ? undef : same_interp_req_body($same_interp, \&GET,
+ "$url?begin");
$skip++ unless defined $res;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
$res,
"begin ok",
"$modules{$alias} is running BEGIN blocks on the second request",
);
- $res = $skip ? undef : get_body($same_interp, "$url?end");
+ $res = $skip ? undef : same_interp_req_body($same_interp, \&GET,
+ "$url?end");
$skip++ unless defined $res;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
$res,
"end ok",
"$modules{$alias} is running END blocks on the third request",
);
- $res = $skip ? undef : get_body($same_interp, "$url?end");
+ $res = $skip ? undef : same_interp_req_body($same_interp, \&GET,
+ "$url?end");
$skip++ unless defined $res;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
$res,
"end ok",
@@ -82,22 +86,24 @@
my $skip = 0;
# clear the cache of the registry package for the script in $url
- my $res = get_body($same_interp, "$url?uncache");
+ my $res = same_interp_req_body($same_interp, \&GET, "$url?uncache");
$skip++ unless defined $res;
- $res = $skip ? undef : get_body($same_interp, "$url?begin");
+ $res = $skip ? undef : same_interp_req_body($same_interp, \&GET,
+ "$url?begin");
$skip++ unless defined $res;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
$res,
"begin ok",
"$modules{$alias} is running BEGIN blocks on the first request",
);
- $res = $skip ? undef : get_body($same_interp, "$url?begin");
+ $res = $skip ? undef : same_interp_req_body($same_interp, \&GET,
+ "$url?begin");
$skip++ unless defined $res;
t_debug($res);
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
$res,
"",
@@ -108,56 +114,26 @@
$skip = 0;
# clear the cache of the registry package for the script in $url
- $res = get_body($same_interp, "$url?uncache");
+ $res = same_interp_req_body($same_interp, \&GET, "$url?uncache");
$skip++ unless defined $res;
- $res = $skip ? undef : get_body($same_interp, "$url?end");
+ $res = $skip ? undef : same_interp_req_body($same_interp, \&GET,
+ "$url?end");
$skip++ unless defined $res;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
$res,
"end ok",
"$modules{$alias} is running END blocks on the first request",
);
- $res = $skip ? undef : get_body($same_interp, "$url?end");
+ $res = $skip ? undef : same_interp_req_body($same_interp, \&GET,
+ "$url?end");
$skip++ unless defined $res;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
$res,
"end ok",
"$modules{$alias} is running END blocks on the second request",
);
-}
-
-# if we fail to find the same interpreter, return undef (this is not
-# an error)
-sub get_body {
- my($same_interp, $url) = @_;
- my $res = eval {
- Apache::TestRequest::same_interp_do($same_interp, \&GET, $url);
- };
- return undef if $@ && $@ =~ /unable to find interp/;
- die $@ if $@;
- return $res->content if defined $res;
-}
-
-# make the tests resistant to a failure of finding the same perl
-# interpreter, which happens randomly and not an error.
-# the first argument is used to decide whether to skip the sub-test,
-# the rest of the arguments are passed to 'ok t_cmp';
-sub skip_not_same_interp {
- my $skip_cond = shift;
- if ($skip_cond) {
- skip "Skip couldn't find the same interpreter", 0;
- }
- else {
- my($package, $filename, $line) = caller;
- # trick ok() into reporting the caller filename/line when a
- # sub-test fails in sok()
- return eval <<EOE;
-#line $line $filename
- ok &t_cmp;
-EOE
- }
}