You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by ge...@apache.org on 2003/08/12 22:34:22 UTC
cvs commit: modperl-2.0/ModPerl-Registry/t/cgi-bin redirect-cookie.pl
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__
Re: cvs commit: modperl-2.0/ModPerl-Registry/t/cgi-bin redirect-cookie.pl
Posted by Stas Bekman <st...@stason.org>.
geoff@apache.org wrote:
> 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",
> + );
> +}
> +
one tiny tweak: each test runs inside {} and defines its own vars, outside of
{} we define only vars which are relevant to all tests. redefining those is
bad idea when more tests are added.
Index: t/redirect.t
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/redirect.t,v
retrieving revision 1.4
diff -u -r1.4 redirect.t
--- t/redirect.t 12 Aug 2003 20:34:22 -0000 1.4
+++ t/redirect.t 12 Aug 2003 20:53:03 -0000
@@ -33,10 +33,10 @@
);
}
-$base_url = "/registry/redirect-cookie.pl";
{
local $Apache::TestRequest::RedirectOK = 0;
+ my $base_url = "/registry/redirect-cookie.pl";
my $redirect_path = "/registry/basic.pl";
my $url = "$base_url?$redirect_path";
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org