geoff 2003/08/12 13:34:22
Modified: ModPerl-Registry/t redirect.t
Added: ModPerl-Registry/t/cgi-bin redirect-cookie.pl
Log:
add set-cookie on redirect test
it also tests $r->status setting/Registry return code ignoring
Submitted by: geoff
Revision Changes Path
1.4 +24 -1 modperl-2.0/ModPerl-Registry/t/redirect.t
Index: redirect.t
===================================================================
RCS file: /home/cvs//modperl-2.0/ModPerl-Registry/t/redirect.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- redirect.t 6 Jun 2003 01:29:58 -0000 1.3
+++ redirect.t 12 Aug 2003 20:34:22 -0000 1.4
@@ -5,7 +5,7 @@
use Apache::TestUtil;
use Apache::TestRequest qw(GET_BODY HEAD);
-plan tests => 2, have_lwp;
+plan tests => 4, have_lwp;
# need LWP to handle redirects
@@ -32,3 +32,26 @@
"test redirect: non-existing target",
);
}
+
+$base_url = "/registry/redirect-cookie.pl";
+{
+ local $Apache::TestRequest::RedirectOK = 0;
+
+ my $redirect_path = "/registry/basic.pl";
+ my $url = "$base_url?$redirect_path";
+
+ my $response = HEAD $url;
+
+ ok t_cmp(
+ 302,
+ $response->code,
+ "test Registry style redirect: status",
+ );
+
+ ok t_cmp(
+ "mod_perl=ubercool; path=/",
+ $response->header('Set-Cookie'),
+ "test Registry style redirect: cookie",
+ );
+}
+
1.1 modperl-2.0/ModPerl-Registry/t/cgi-bin/redirect-cookie.pl
Index: redirect-cookie.pl
===================================================================
# test env vars
use Apache::URI ();
use Apache::Const -compile => qw(REDIRECT SERVER_ERROR);
my $r = shift;
my $path = $r->args || '';
$server = $r->construct_server;
$r->err_headers_out->set('Set-Cookie' => "mod_perl=ubercool; path=/");
$r->headers_out->set(Location => " http://$server$path";);
$r->status(Apache::REDIRECT);
# exit status is completely ignored in Registry
# due to $r->status hacking
return Apache::SERVER_ERROR;
__END__
