@@ -5,33 +5,34 @@ use strict;
5
5
use warnings;
6
6
7
7
use Test::More;
8
- use Test::Fatal qw( dies_ok lives_ok ) ;
9
8
plan tests => 15;
10
9
11
10
use HTTP::Request;
11
+ use Try::Tiny qw( catch try ) ;
12
12
13
- my $req = HTTP::Request-> new(GET => " http://www.example.com" );
13
+ my $req = HTTP::Request-> new( GET => " http://www.example.com" );
14
14
$req -> accept_decodable;
15
15
16
- is($req -> method, " GET" );
17
- is($req -> uri, " http://www.example.com" );
18
- like($req -> header(" Accept-Encoding" ), qr /\b gzip\b / ); # assuming IO::Uncompress::Gunzip is there
16
+ is( $req -> method, " GET" );
17
+ is( $req -> uri, " http://www.example.com" );
18
+ like( $req -> header(" Accept-Encoding" ), qr /\b gzip\b / )
19
+ ; # assuming IO::Uncompress::Gunzip is there
19
20
20
- $req -> dump (prefix => " # " );
21
+ $req -> dump ( prefix => " # " );
21
22
22
- is($req -> method(" DELETE" ), " GET" );
23
- is($req -> method, " DELETE" );
23
+ is( $req -> method(" DELETE" ), " GET" );
24
+ is( $req -> method, " DELETE" );
24
25
25
- is($req -> uri(" http:" ), " http://www.example.com" );
26
- is($req -> uri, " http:" );
26
+ is( $req -> uri(" http:" ), " http://www.example.com" );
27
+ is( $req -> uri, " http:" );
27
28
28
29
$req -> protocol(" HTTP/1.1" );
29
30
30
- my $r2 = HTTP::Request-> parse($req -> as_string);
31
- is($r2 -> method, " DELETE" );
32
- is($r2 -> uri, " http:" );
33
- is($r2 -> protocol, " HTTP/1.1" );
34
- is($r2 -> header(" Accept-Encoding" ), $req -> header(" Accept-Encoding" ));
31
+ my $r2 = HTTP::Request-> parse( $req -> as_string );
32
+ is( $r2 -> method, " DELETE" );
33
+ is( $r2 -> uri, " http:" );
34
+ is( $r2 -> protocol, " HTTP/1.1" );
35
+ is( $r2 -> header(" Accept-Encoding" ), $req -> header(" Accept-Encoding" ) );
35
36
36
37
# Test objects which are accepted as URI-like
37
38
{
@@ -57,16 +58,31 @@ is($r2->header("Accept-Encoding"), $req->header("Accept-Encoding"));
57
58
58
59
package main ;
59
60
60
- ok( Foo::URI-> new-> can( ' scheme' ), ' Object can scheme()' );
61
- dies_ok(
62
- sub { HTTP::Request-> new( GET => Foo::URI-> new ) },
61
+ ok( Foo::URI-> new-> can(' scheme' ), ' Object can scheme()' );
62
+ ok(
63
+ !do {
64
+ try {
65
+ HTTP::Request-> new( GET => Foo::URI-> new );
66
+ return 1;
67
+ }
68
+ catch { return 0 };
69
+ },
63
70
' Object without canonical method triggers an exception'
64
71
);
65
72
66
- ok( Foo::URI::WithCanonical-> new-> can( ' canonical' ),
67
- ' Object can canonical()' );
68
- lives_ok(
69
- sub { HTTP::Request-> new( GET => Foo::URI::WithCanonical-> new ) },
73
+ ok(
74
+ Foo::URI::WithCanonical-> new-> can(' canonical' ),
75
+ ' Object can canonical()'
76
+ );
77
+
78
+ ok(
79
+ do {
80
+ try {
81
+ HTTP::Request-> new( GET => Foo::URI::WithCanonical-> new );
82
+ return 1;
83
+ }
84
+ catch { return 0 };
85
+ },
70
86
' Object with canonical method does not trigger an exception'
71
87
);
72
88
}
0 commit comments