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 18:52:56 UTC
svn commit: r106584 - in perl/modperl/trunk/t: apr hooks lib/TestCommon modperl modules
Author: stas
Date: Thu Nov 25 09:52:55 2004
New Revision: 106584
URL: http://svn.apache.org/viewcvs?view=rev&rev=106584
Log:
refactor the same_interp dupped wrappers into TestCommon::SameInterp
and use that instead
Added:
perl/modperl/trunk/t/lib/TestCommon/SameInterp.pm
Modified:
perl/modperl/trunk/t/apr/pool_lifetime.t
perl/modperl/trunk/t/hooks/inlined_handlers.t
perl/modperl/trunk/t/modperl/cookie.t
perl/modperl/trunk/t/modperl/cookie2.t
perl/modperl/trunk/t/modperl/sameinterp.t
perl/modperl/trunk/t/modules/reload.t
Modified: perl/modperl/trunk/t/apr/pool_lifetime.t
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/apr/pool_lifetime.t?view=diff&rev=106584&p1=perl/modperl/trunk/t/apr/pool_lifetime.t&r1=106583&p2=perl/modperl/trunk/t/apr/pool_lifetime.t&r2=106584
==============================================================================
--- perl/modperl/trunk/t/apr/pool_lifetime.t (original)
+++ perl/modperl/trunk/t/apr/pool_lifetime.t Thu Nov 25 09:52:55 2004
@@ -4,6 +4,7 @@
use Apache::Test;
use Apache::TestUtil;
use Apache::TestRequest;
+use TestCommon::SameInterp;
plan tests => 2;
@@ -17,43 +18,12 @@
for (1..2) {
my $expected = "Pong";
- my $received = get_body($same_interp, \&GET, $location);
+ my $received = same_interp_req_body($same_interp, \&GET, $location);
$skip++ unless defined $received;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
$expected,
$received,
"Pong"
);
-}
-
-# if we fail to find the same interpreter, return undef (this is not
-# an error)
-sub get_body {
- my $res = eval {
- Apache::TestRequest::same_interp_do(@_);
- };
- 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/t/hooks/inlined_handlers.t
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/hooks/inlined_handlers.t?view=diff&rev=106584&p1=perl/modperl/trunk/t/hooks/inlined_handlers.t&r1=106583&p2=perl/modperl/trunk/t/hooks/inlined_handlers.t&r2=106584
==============================================================================
--- perl/modperl/trunk/t/hooks/inlined_handlers.t (original)
+++ perl/modperl/trunk/t/hooks/inlined_handlers.t Thu Nov 25 09:52:55 2004
@@ -4,6 +4,7 @@
use Apache::Test;
use Apache::TestUtil;
use Apache::TestRequest;
+use TestCommon::SameInterp;
plan tests => 2;
@@ -15,9 +16,9 @@
my $skip = $same_interp ? 0 : 1;
my $expected = "ok";
for (1..2) {
- my $received = get_body($same_interp, \&GET, $location);
+ my $received = same_interp_req_body($same_interp, \&GET, $location);
$skip++ unless defined $received;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
$received,
$expected,
@@ -25,33 +26,3 @@
);
}
-# if we fail to find the same interpreter, return undef (this is not
-# an error)
-sub get_body {
- my $res = eval {
- Apache::TestRequest::same_interp_do(@_);
- };
- 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
- }
-}
Added: perl/modperl/trunk/t/lib/TestCommon/SameInterp.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/lib/TestCommon/SameInterp.pm?view=auto&rev=106584
==============================================================================
--- (empty file)
+++ perl/modperl/trunk/t/lib/TestCommon/SameInterp.pm Thu Nov 25 09:52:55 2004
@@ -0,0 +1,165 @@
+package TestCommon::SameInterp;
+
+use Apache::Test;
+use Apache::TestUtil;
+
+use Exporter;
+use vars qw(@ISA @EXPORT);
+
+@ISA = qw(Exporter);
+
+@EXPORT = qw(same_interp_req same_interp_req_body
+ same_interp_skip_not_found);
+
+sub same_interp_req {
+ my $res = eval {
+ Apache::TestRequest::same_interp_do(@_);
+ };
+ return undef if $@ && $@ =~ /unable to find interp/;
+ die $@ if $@;
+ return $res;
+}
+
+sub same_interp_req_body {
+ my $res = same_interp_req(@_);
+ return $res ? $res->content : "";
+}
+
+sub same_interp_skip_not_found {
+ 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
+ }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+TestCommon::SameInterp - Helper functions for same_interp framework
+
+=head1 Synopsis
+
+ use Apache::Test;
+ use Apache::TestUtil;
+ use Apache::TestRequest;
+
+ use TestCommon::SameInterp;
+
+ plan tests => 3;
+
+ my $url = "/path";
+
+ my $same_interp = Apache::TestRequest::same_interp_tie($url);
+ ok $same_interp;
+
+ my $expected = 1;
+ my $skip = 0;
+ # test GET over the same same_interp
+ for (1..2) {
+ $expected++;
+ my $res = same_interp_req($same_interp, \&GET, $url, foo => 'bar');
+ $skip++ unless defined $res;
+ same_interp_skip_not_found(
+ $skip,
+ defined $res && $res->content,
+ $expected,
+ "GET over the same interp"
+ );
+ }
+
+
+=head1 Description
+
+In addition to same_interp base blocks from Apache::TestRequest, this
+helper module provides extra wrappers to simplify the writing of tests
+
+META: consider merging those into Apache::TestRequest (or add a new
+module, e.g. Apache::TestRequestSameInterp)
+
+=head1 API
+
+
+
+=head2 C<same_interp_req>
+
+normally one runs:
+
+ my $res = GET $url, @data;
+
+in the same_interp framework one runs
+
+ my $res = Apache::TestRequest::same_interp_do($same_interp,
+ \&GET, $url, @data);
+
+but if there is a failure to find the same interpreter we get an
+exception. and there could be other exceptions as well (e.g. failure
+to run the request). This wrapper handles all exceptions, returning
+C<undef> if the exception was in a failure to find the same
+interpreter, re-throws the exception otherwise. If there is no
+exception, the response object is returned.
+
+So one passes the same arguments to this wrapper as you'd to
+Apache::TestRequest::same_interp_do:
+
+ my $res = same_interp_req($same_interp, \&GET, $url, @data);
+
+
+
+=head2 C<same_interp_req_body>
+
+This function calls C<L<same_interp_req|/C_same_interp_req_>> and
+extracts the response body if the response object is defined. (sort of
+GET_BODY for same_interp)
+
+
+=head2 C<same_interp_skip_not_found>
+
+make the tests resistant to a failure of finding the same perl
+interpreter, which happens randomly and not an error. so instead of running:
+
+ my $res = same_interp_req($same_interp, \&GET, $url, @data);
+ ok t_cmp(defined $res && $res->content, $expected, "comment")
+
+one can run:
+
+ my $res = same_interp_req($same_interp, \&GET, $url, @data);
+ $skip = defined $res ? 0 : 1;
+ same_interp_skip_not_found(
+ $skip,
+ defined $res && $res->content,
+ $expected,
+ "comment"
+ );
+
+the first argument is used to decide whether to skip the sub-test, the
+rest of the arguments are passed to 'ok t_cmp'.
+
+This wrapper is smart enough to report the correct line number as if
+ok() was run in the test file itself and not in the wrapper, by doing:
+
+ my($package, $filename, $line) = caller;
+ return eval <<EOE;
+ #line $line $filename
+ ok &t_cmp;
+ EOE
+
+C<&t_cmp> receives C<@_>, containing all but the skip argument, as if
+the wrapper was never called.
+
+
+
+
+=cut
+
Modified: perl/modperl/trunk/t/modperl/cookie.t
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/modperl/cookie.t?view=diff&rev=106584&p1=perl/modperl/trunk/t/modperl/cookie.t&r1=106583&p2=perl/modperl/trunk/t/modperl/cookie.t&r2=106584
==============================================================================
--- perl/modperl/trunk/t/modperl/cookie.t (original)
+++ perl/modperl/trunk/t/modperl/cookie.t Thu Nov 25 09:52:55 2004
@@ -20,6 +20,8 @@
use Apache::TestUtil;
use Apache::TestRequest;
+use TestCommon::SameInterp;
+
plan tests => 3;
my $module = 'TestModperl::cookie';
@@ -48,43 +50,13 @@
my @headers = ();
push @headers, (Cookie => $cookies{$test}) unless $test eq 'nocookie';
- my $received = get_body($same_interp, \&GET, "$location?$test", @headers);
+ my $received = same_interp_req_body($same_interp, \&GET,
+ "$location?$test", @headers);
$skip++ unless defined $received;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
$received,
$expected,
"perl-script+SetupEnv/cookie: $test"
);
-}
-
-# if we fail to find the same interpreter, return undef (this is not
-# an error)
-sub get_body {
- my $res = eval {
- Apache::TestRequest::same_interp_do(@_);
- };
- 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/t/modperl/cookie2.t
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/modperl/cookie2.t?view=diff&rev=106584&p1=perl/modperl/trunk/t/modperl/cookie2.t&r1=106583&p2=perl/modperl/trunk/t/modperl/cookie2.t&r2=106584
==============================================================================
--- perl/modperl/trunk/t/modperl/cookie2.t (original)
+++ perl/modperl/trunk/t/modperl/cookie2.t Thu Nov 25 09:52:55 2004
@@ -14,13 +14,14 @@
use Apache::Test;
use Apache::TestUtil;
use Apache::TestRequest;
+use TestCommon::SameInterp;
plan tests => 3;
my $module = 'TestModperl::cookie2';
my $location = '/' . Apache::TestRequest::module2path($module);
-my %expected =
+my %expected =
(
header => "header",
subprocess_env => "subprocess_env",
@@ -36,44 +37,14 @@
for my $test (@tests_ordered) {
my $cookie = "key=$test";
- my $received = get_body($same_interp, \&GET,
- "$location?$test", Cookie => $cookie);
+ my $received = same_interp_req_body($same_interp, \&GET,
+ "$location?$test",
+ Cookie => $cookie);
$skip++ unless defined $received;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
$received,
$expected{$test},
"perl-script+SetupEnv/cookie: $test"
);
-}
-
-# if we fail to find the same interpreter, return undef (this is not
-# an error)
-sub get_body {
- my $res = eval {
- Apache::TestRequest::same_interp_do(@_);
- };
- 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/t/modperl/sameinterp.t
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/modperl/sameinterp.t?view=diff&rev=106584&p1=perl/modperl/trunk/t/modperl/sameinterp.t&r1=106583&p2=perl/modperl/trunk/t/modperl/sameinterp.t&r2=106584
==============================================================================
--- perl/modperl/trunk/t/modperl/sameinterp.t (original)
+++ perl/modperl/trunk/t/modperl/sameinterp.t Thu Nov 25 09:52:55 2004
@@ -8,6 +8,8 @@
use Apache::TestUtil;
use Apache::TestRequest;
+use TestCommon::SameInterp;
+
plan tests => 12;
my $url = "/TestModperl__sameinterp";
@@ -22,9 +24,9 @@
# test GET over the same same_interp
for (1..2) {
$expected++;
- my $res = req($same_interp, \&GET, $url, foo => 'bar');
+ my $res = same_interp_req($same_interp, \&GET, $url, foo => 'bar');
$skip++ unless defined $res;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
defined $res && $res->content,
$expected,
@@ -43,9 +45,10 @@
for (1..2) {
$expected++;
my $content = join ' ', 'ok', $_ + 3;
- my $res = req($same_interp, \&POST, $url, content => $content);
+ my $res = same_interp_req($same_interp, \&POST, $url,
+ content => $content);
$skip++ unless defined $res;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
defined $res && $res->content,
$expected,
@@ -63,45 +66,13 @@
my $skip = 0;
for (1..2) {
$expected++;
- my $res = req($same_interp, \&HEAD, $url);
+ my $res = same_interp_req($same_interp, \&HEAD, $url);
$skip++ unless defined $res;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
defined $res && $res->header(Apache::TestRequest::INTERP_KEY),
$same_interp,
"HEAD over the same interp"
);
- }
-}
-
-# if we fail to find the same interpreter, return undef (this is not
-# an error)
-sub req {
- my($same_interp, $url) = @_;
- my $res = eval {
- Apache::TestRequest::same_interp_do(@_);
- };
- return undef if $@ && $@ =~ /unable to find interp/;
- die $@ if $@;
- return $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
}
}
Modified: perl/modperl/trunk/t/modules/reload.t
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/modules/reload.t?view=diff&rev=106584&p1=perl/modperl/trunk/t/modules/reload.t&r1=106583&p2=perl/modperl/trunk/t/modules/reload.t&r2=106584
==============================================================================
--- perl/modperl/trunk/t/modules/reload.t (original)
+++ perl/modperl/trunk/t/modules/reload.t Thu Nov 25 09:52:55 2004
@@ -6,6 +6,8 @@
use Apache::TestRequest;
use File::Spec::Functions qw(catfile);
+use TestCommon::SameInterp;
+
plan tests => 3;
my $test_file = catfile Apache::Test::vars("serverroot"),
@@ -39,9 +41,10 @@
{
my $expected = join '', map { "$_:$_\n" } sort @tests;
- my $received = get_body($same_interp, \&GET, $location);
+ my $received = same_interp_req_body($same_interp, \&GET,
+ $location);
$skip++ unless defined $received;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
$expected,
$received,
@@ -54,9 +57,10 @@
{
my $expected = join '', map { "$_:" . uc($_) . "\n" } sort @tests;
- my $received = get_body($same_interp, \&GET, $location);
+ my $received = same_interp_req_body($same_interp, \&GET,
+ $location);
$skip++ unless defined $received;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
$expected,
$received,
@@ -66,45 +70,15 @@
{
my $expected = "unregistered OK";
- my $received = get_body($same_interp, \&GET, $location . '?last' );
+ my $received = same_interp_req_body($same_interp, \&GET,
+ $location . '?last' );
$skip++ unless defined $received;
- skip_not_same_interp(
+ same_interp_skip_not_found(
$skip,
$expected,
$received,
"Unregister"
);
-}
-
-# if we fail to find the same interpreter, return undef (this is not
-# an error)
-sub get_body {
- my $res = eval {
- Apache::TestRequest::same_interp_do(@_);
- };
- 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
- }
}
sub touch_mtime {