stas 01/10/18 19:09:24
Modified: t/modperl interp.t
t/response/TestModperl interp.pm
Log:
- update the 'same interpreter' test to use the abstracted functionality
which has moved into the core of Apache::Test
Revision Changes Path
1.2 +53 -36 modperl-2.0/t/modperl/interp.t
Index: interp.t
===================================================================
RCS file: /home/cvs/modperl-2.0/t/modperl/interp.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- interp.t 2001/10/17 03:20:02 1.1
+++ interp.t 2001/10/19 02:09:24 1.2
@@ -1,49 +1,66 @@
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 constant INTERP => 'X-PerlInterpreter';
-
-plan tests => 3, \&have_lwp;
-
-my $url = "/TestModperl::interp";
-
-#request an interpreter instance
-my $res = GET $url, INTERP, 'init';
-#use this interpreter id to select the same interpreter in requests below
-my $interp = $res->header(INTERP);
+plan tests => 12, \&have_lwp;
-print "using interp: $interp\n";
+my $url = "/TestModperl::interp1";
-print $res->content;
-
-my $found_interp = "";
-my $find_interp = sub {
- $res->code == 200 and (($found_interp = $res->header(INTERP)) eq $interp);
-};
-
+# test the tie and re-tie
for (1..2) {
- my $times = 0;
+ my $same_interp = Apache::TestRequest::same_interp_tie($url);
+ ok $same_interp;
- do {
- #loop until we get a response from our interpreter instance
- $res = GET $url, INTERP, $interp;
-
- #trace info
- unless ($find_interp->()) {
- print $found_interp ?
- "wrong interpreter: $found_interp\n" :
- "no interpreter\n";
- }
-
- if ($times++ > 15) { #prevent endless loop
- die "unable to find interp $interp\n";
- }
- } while (not $find_interp->());
+ my $value = 1;
+ # test GET over the same same_interp
+ for (1..2) {
+ $value++;
+ my $res = Apache::TestRequest::same_interp_do($same_interp, \&GET,
+ $url, foo => 'bar');
+ ok t_cmp(
+ $value,
+ defined $res && $res->content,
+ "GET over the same interp");
+ }
+}
- print $res->content; #ok $value++
+{
+ # test POST over the same same_interp
+ my $same_interp = Apache::TestRequest::same_interp_tie($url);
+ ok $same_interp;
+
+ my $value = 1;
+ for (1..2) {
+ $value++;
+ my $res = Apache::TestRequest::same_interp_do($same_interp, \&POST,
+ $url, [ok => $_+3],
+ content => "foo");
+ ok t_cmp(
+ $value,
+ defined $res && $res->content,
+ "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 $value = 1;
+ for (1..2) {
+ $value++;
+ my $res = Apache::TestRequest::same_interp_do($same_interp, \&HEAD,
+ $url);
+ ok t_cmp(
+ $same_interp,
+ defined $res && $res->header(Apache::TestRequest::INTERP_KEY),
+ "HEAD over the same interp");
+ }
+}
1.2 +7 -38 modperl-2.0/t/response/TestModperl/interp.pm
Index: interp.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestModperl/interp.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- interp.pm 2001/10/17 03:20:02 1.1
+++ interp.pm 2001/10/19 02:09:24 1.2
@@ -1,53 +1,22 @@
-package TestModperl::interp;
+package TestModperl::interp1;
use warnings FATAL => 'all';
use strict;
-use APR::UUID ();
-use Apache::Const -compile => qw(OK NOT_FOUND SERVER_ERROR);
+use Apache::Const -compile => qw(OK);
-use constant INTERP => 'X-PerlInterpreter';
+my $value = '';
-my $interp_id = "";
-my $value = 0;
-
-sub fixup {
- my $r = shift;
- my $interp = $r->headers_in->get(INTERP);
- my $rc = Apache::OK;
-
- unless ($interp) {
- #shouldn't be requesting this without an INTERP header
- return Apache::SERVER_ERROR;
- }
-
- my $id = $interp_id;
- if ($interp eq 'init') { #first request for an interpreter instance
- #unique id for this instance
- $interp_id = $id = APR::UUID->new->format;
- $value = 0; #reset our global data
- }
- elsif ($interp ne $interp_id) {
- #this is not the request interpreter instance
- $rc = Apache::NOT_FOUND;
- }
-
- #so client can save the created instance id or check the existing value
- $r->headers_out->set(INTERP, $id);
-
- return $rc;
-}
-
sub handler {
my $r = shift;
- #test the actual global data
- $value++;
- $r->puts("ok $value\n");
+ # test the actual global data
+ $value = Apache::TestHandler::same_interp_counter();
+ $r->puts($value);
Apache::OK;
}
1;
__END__
-PerlFixupHandler TestModperl::interp::fixup
+PerlFixupHandler Apache::TestHandler::same_interp_fixup
