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__