Commit | Line | Data |
affa35d5 |
1 | #!perl |
6bc86362 |
2 | use strict; |
3 | use warnings; |
4 | use lib 'lib'; |
705f22fa |
5 | use Test::More tests => 30; |
6bc86362 |
6 | use lib 't/lib'; |
7 | use Test::WWW::Mechanize::Catalyst 'Catty'; |
705f22fa |
8 | use HTTP::Request::Common; |
9 | use URI; |
10 | use Test::utf8; |
6bc86362 |
11 | |
12 | my $root = "http://localhost"; |
13 | |
14 | my $m; |
15 | foreach my $where (qw{hi greetings bonjour}) { |
16 | $m = Test::WWW::Mechanize::Catalyst->new; |
17 | $m->get_ok( "$root/$where", "got something when we $where" ); |
18 | |
19 | is( $m->base, "http://localhost/hello", "check got to hello 1/4" ); |
20 | is( $m->ct, "text/html", "check got to hello 2/4" ); |
21 | $m->title_is( "Hello",, "check got to hello 3/4" ); |
22 | $m->content_contains( "Hi there",, "check got to hello 4/4" ); |
23 | |
24 | # check that the previous response is still there |
25 | my $prev = $m->response->previous; |
26 | ok( $prev, "have a previous" ); |
27 | is( $prev->code, 302, "was a redirect" ); |
28 | like( $prev->header('Location'), '/hello$/', "to the right place" ); |
29 | } |
30 | |
31 | # extra checks for bonjour (which is a double redirect) |
32 | my $prev = $m->response->previous->previous; |
33 | ok( $prev, "have a previous previous" ); |
34 | is( $prev->code, 302, "was a redirect" ); |
35 | like( $prev->header('Location'), '/hi$/', "to the right place" ); |
affa35d5 |
36 | |
37 | $m->get("$root/redirect_with_500"); |
38 | is ($m->status, 500, "Redirect not followed on 500"); |
74649ca9 |
39 | |
705f22fa |
40 | my $req = GET "$root/redirect_to_utf8_upgraded_string"; |
41 | my $loc = $m->_do_catalyst_request($req)->header('Location'); |
42 | my $uri = URI->new_abs( $loc, $req->uri )->as_string; |
43 | is_sane_utf8($uri); |
44 | isnt_flagged_utf8($uri); |