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); + [EMAIL PROTECTED] = qw(Exporter); + [EMAIL PROTECTED] = 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 {
