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 - } }