Didn't see the attachment come through, so it's in-lined below.
Jim
On Aug 26, 2005, at 12:59 PM, Jim Brandt wrote:
Attached is my diff -urN output. I think I removed all the
extraneous stuff so just the real changes are in there.
I'm svn illiterate, so this was a little easier.
Jim
On Aug 26, 2005, at 12:07 PM, Geoffrey Young wrote:
I changed a decent amount of stuff and added a few files. What's the
easiest way to post something for review? Should I just tar/zip
up the
Apache::Test distribution I have working with my changes?
in the mp2 sources there is util/getdiff.pl which is a simple way to
generate a unified diff from svn including any new files you may
have added.
http://svn.apache.org/repos/asf/perl/modperl/trunk/util/getdiff.pl
HTH
--Geoff
diff -urN orig/Apache-Test-1.26/lib/Apache/SameInterp.pm perl/Apache-
Test-1.26/lib/Apache/SameInterp.pm
--- orig/Apache-Test-1.26/lib/Apache/SameInterp.pm 1969-12-31
19:00:00.000000000 -0500
+++ perl/Apache-Test-1.26/lib/Apache/SameInterp.pm 2005-08-26
10:41:57.000000000 -0400
@@ -0,0 +1,162 @@
+package Apache::SameInterp;
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+
+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
+
+Apache::SameInterp - Helper functions for same_interp framework
+
+=head1 Synopsis
+
+ use Apache::Test;
+ use Apache::TestUtil;
+ use Apache::TestRequest;
+
+ use Apache::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.
+
+=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
+
diff -urN orig/Apache-Test-1.26/lib/Apache/TestHandler.pm perl/Apache-
Test-1.26/lib/Apache/TestHandler.pm
--- orig/Apache-Test-1.26/lib/Apache/TestHandler.pm 2005-07-22
11:27:54.000000000 -0400
+++ perl/Apache-Test-1.26/lib/Apache/TestHandler.pm 2005-08-26
08:23:40.000000000 -0400
@@ -19,15 +19,27 @@
use Apache::Test ();
use Apache::TestRequest ();
-
-use Apache2::Const -compile => qw(OK NOT_FOUND SERVER_ERROR);
+use Apache::TestConfig ();
+use mod_perl;
+use constant MP2 => Apache::TestConfig::IS_MOD_PERL_2;
+
+BEGIN {
+ if (MP2) {
+ require Apache2::Const;
+ Apache2::Const->import(-compile => qw(OK NOT_FOUND SERVER_ERROR));
+ }
+ else {
+ require Apache::Constants;
+ }
+}
#some utility handlers for testing hooks other than response
#see modperl-2.0/t/hooks/TestHooks/authen.pm
-if ($ENV{MOD_PERL} && require mod_perl2) {
- require Apache2::RequestIO; # puts
-}
+if (MP2) {
+ require Apache2::RequestIO;
+ }
+
#compat with 1.xx
my $send_http_header = Apache->can('send_http_header') || sub {};
@@ -86,7 +98,9 @@
}
elsif ($interp ne $same_interp_id) {
# this is not the request interpreter instance
- return Apache2::Const::NOT_FOUND;
+ return MP2
+ ? Apache2::Const::NOT_FOUND
+ : Apache::Constants::NOT_FOUND;
}
$same_interp_counter++;
@@ -95,7 +109,7 @@
# value
$r->headers_out->set(Apache::TestRequest::INTERP_KEY, $id);
- return Apache2::Const::OK;
+ return MP2 ? Apache2::Const::OK : Apache::Constants::OK;
}
1;
diff -urN orig/Apache-Test-1.26/lib/Apache/TestRequest.pm perl/Apache-
Test-1.26/lib/Apache/TestRequest.pm
--- orig/Apache-Test-1.26/lib/Apache/TestRequest.pm 2005-07-22
11:27:54.000000000 -0400
+++ perl/Apache-Test-1.26/lib/Apache/TestRequest.pm 2005-08-26
10:38:19.000000000 -0400
@@ -1153,8 +1153,24 @@
http://$hostname:$port/foo
+=head1 Testing A Single Interpreter
+The following functions allow you to send requests to a single
interpreter in the test server.
+=head2 same_interp_tie
+
+ my $url = "/some/url";
+ my $same_interp = Apache::TestRequest::same_interp_tie($url);
+
+This method requests an interpreter instance and retrieves an
interpreter ID. It then uses this ID to select the same interpreter
in subsequent requests.
+
+=head2 same_interp_do
+
+ my $res = Apache::TestRequest::same_interp_do($same_interp, \&GET,
$url);
+
+This method uses the interpreter ID retrieved from same_interp_tie
to get the same interpreter for subsequent requests. It does so by
polling until the same interpreter ID is found, so it can spawn
several requests. It returns a HTTP::Response object.
+
+This method currently supports only GET, HEAD, PUT, and POST requests.
=head1 ENVIRONMENT VARIABLES
diff -urN orig/Apache-Test-1.26/t/TestModperl/SameInterp.pm perl/
Apache-Test-1.26/t/TestModperl/SameInterp.pm
--- orig/Apache-Test-1.26/t/TestModperl/SameInterp.pm 1969-12-31
19:00:00.000000000 -0500
+++ perl/Apache-Test-1.26/t/TestModperl/SameInterp.pm 2005-08-26
09:39:51.000000000 -0400
@@ -0,0 +1,38 @@
+package TestModperl::SameInterp;
+
+use Apache::TestHandler;
+use Apache::TestConfig ();
+use mod_perl;
+use constant MP2 => Apache::TestConfig::IS_MOD_PERL_2;
+
+BEGIN {
+ if (MP2) {
+ require Apache2::Const;
+ Apache2::Const->import(-compile => qw(OK));
+ }
+ else {
+ require Apache::Constants;
+ }
+}
+
+my $value = '';
+
+sub handler {
+ my $r = shift;
+ # test the actual global data
+ $value = Apache::TestHandler::same_interp_counter();
+
+ if (MP2) {
+ $r->puts($value);
+ }
+ else {
+ # Don't know why this made it work, but without it, the page size
+ # was zero. Buffer flushing issue?
+ $r->print("blah blah blah");
+ $r->print($value);
+ }
+
+ return MP2 ? Apache2::Const::OK : Apache::Constants::OK;
+}
+
+1;
diff -urN orig/Apache-Test-1.26/t/conf/extra.conf.in perl/Apache-
Test-1.26/t/conf/extra.conf.in
--- orig/Apache-Test-1.26/t/conf/extra.conf.in 2005-07-08
10:36:05.000000000 -0400
+++ perl/Apache-Test-1.26/t/conf/extra.conf.in 2005-08-26
08:22:23.000000000 -0400
@@ -1,5 +1,8 @@
#this file will be Include-d by @ServerRoot@/httpd.conf
+PerlModule Apache::TestHandler
+PerlModule TestModperl::SameInterp
+
#the subclass inside t/TEST added the authname and allowed_users
variables
<IfModule mod_alias.c>
Redirect /redirect http://@ServerName@/redirected/
@@ -26,8 +29,22 @@
PerlHandler TestMore::testmorepm
</IfDefine>
</Location>
-</IfModule>
+ <Location /test/sameinterp>
+ <IfDefine APACHE2>
+ SetHandler modperl
+ PerlFixupHandler Apache::TestHandler::same_interp_fixup
+ PerlInitHandler TestModperl::SameInterp
+ </IfDefine>
+ <IfDefine APACHE1>
+ SetHandler perl-script
+ PerlHandler Apache::TestHandler::same_interp_fixup
+ PerlHandler TestModperl::SameInterp
+ PerlSendHeader On
+ </IfDefine>
+ </Location>
+
+</IfModule>
<IfModule @CGI_MODULE@>
ScriptAlias /cgi-bin/ "@ServerRoot@/cgi-bin/"
@@ -37,4 +54,3 @@
Options +ExecCGI
</Directory>
</IfModule>
-
diff -urN orig/Apache-Test-1.26/t/sameinterp.t perl/Apache-Test-1.26/
t/sameinterp.t
--- orig/Apache-Test-1.26/t/sameinterp.t 1969-12-31
19:00:00.000000000 -0500
+++ perl/Apache-Test-1.26/t/sameinterp.t 2005-08-26
10:47:51.000000000 -0400
@@ -0,0 +1,77 @@
+use strict;
+use warnings FATAL => 'all';
+
+# run tests through the same interpreter, even if the server is
+# running more than one
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+use Apache::SameInterp;
+
+plan tests => 12, need 'HTML::HeadParser';
+
+my $url = "/test/sameinterp";
+
+# test the tie and re-tie
+for (1..2) {
+ 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 = Apache::SameInterp::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"
+ );
+ }
+}
+
+{
+ # test POST over the same same_interp
+ my $same_interp = Apache::TestRequest::same_interp_tie($url);
+ ok $same_interp;
+
+ my $expected = 1;
+ my $skip = 0;
+ for (1..2) {
+ $expected++;
+ my $content = join ' ', 'ok', $_ + 3;
+ my $res = same_interp_req($same_interp, \&POST, $url,
+ content => $content);
+ $skip++ unless defined $res;
+ same_interp_skip_not_found(
+ $skip,
+ defined $res && $res->content,
+ $expected,
+ "POST over the same interp"
+ );
+ }
+}
+
+{
+ # test HEAD over the same same_interp
+ my $same_interp = Apache::TestRequest::same_interp_tie($url);
+ ok $same_interp;
+
+ my $expected = 1;
+ my $skip = 0;
+ for (1..2) {
+ $expected++;
+ my $res = same_interp_req($same_interp, \&HEAD, $url);
+ $skip++ unless defined $res;
+ same_interp_skip_not_found(
+ $skip,
+ defined $res && $res->header
(Apache::TestRequest::INTERP_KEY),
+ $same_interp,
+ "HEAD over the same interp"
+ );
+ }
+}
