-
Notifications
You must be signed in to change notification settings - Fork 4
/
01.t
98 lines (77 loc) · 3.15 KB
/
01.t
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
use v6;
use Test;
plan 43;
use URI;
ok(1,'We use URI and we are still alive');
my $u = URI.new('http://example.com:80/about/us?foo#bar');
is($u.scheme, 'http', 'scheme');
is($u.host, 'example.com', 'host');
is($u.port, '80', 'port');
is($u.path, '/about/us', 'path');
is($u.query, 'foo', 'query');
is($u.frag, 'bar', 'frag');
is($u.segments, 'about us', 'segements');
is($u.segments[0], 'about', 'first chunk');
is($u.segments[1], 'us', 'second chunk');
is( ~$u, 'http://example.com:80/about/us?foo#bar',
'Complete path stringification');
# allow uri as named argument too
$u = URI.new(uri => 'https://eXAMplE.COM');
is($u.scheme, 'https', 'scheme');
is($u.host, 'example.com', 'host');
is( "$u", 'https://example.com',
'https://eXAMplE.COM stringifies to https://example.com');
is($u.port, 443, 'default https port');
is($u._port, Int, 'no specified port');
$u.parse('/foo/bar/baz');
is($u.segments, 'foo bar baz', 'setments from absolute path');
ok($u.absolute, 'absolute path');
nok($u.relative, 'not relative path');
$u.parse('foo/bar/baz');
is($u.segments, 'foo bar baz', 'segements from relative path');
ok( $u.relative, 'relative path');
nok($u.absolute, 'not absolute path');
is($u.segments[0], 'foo', 'first segment');
is($u.segments[1], 'bar', 'second segment');
is($u.segments[*-1], 'baz', 'last segment');
# actual uri parameter not required
$u = URI.new;
$u.parse('http://foo.com');
ok($u.segments == 1 && $u.segments[0] eq '', ".segments return [''] for empty path");
ok($u.absolute, 'http://foo.com has an absolute path');
nok($u.relative, 'http://foo.com does not have a relative path');
is($u.port, 80, 'default http port');
# test URI parsing with <> or "" and spaces
$u.parse("<http://foo.com> ");
is("$u", 'http://foo.com', '<> removed from str');
$u.parse(' "http://foo.com"');
is("$u", 'http://foo.com', '"" removed from str');
my $host_in_grammar =
$u.grammar.parse_result<URI_reference><URI><hier_part><authority><host>;
is($host_in_grammar<IPv4address>, '', 'grammar detected host not ip'
);
is($host_in_grammar<reg_name>, 'foo.com', 'grammar detected registered domain style');
$u.parse('http://10.0.0.1');
is($u.host, '10.0.0.1', 'numeric host');
$host_in_grammar =
$u.grammar.parse_result<URI_reference><URI><hier_part><authority><host>;
is($host_in_grammar<IPv4address>, '10.0.0.1', 'grammar detected ipv4');
is($host_in_grammar<reg_name>, '', 'grammar detected no registered domain style');
$u.parse('http://example.com:80/about?foo=cod&bell=bob#bar');
is($u.query, 'foo=cod&bell=bob', 'query with form params');
is($u.query_form<foo>, 'cod', 'query param foo');
is($u.query_form<bell>, 'bob', 'query param bell');
$u.parse('http://example.com:80/about?foo=cod&foo=trout#bar');
is($u.query_form<foo>[0], 'cod', 'query param foo - el 1');
is($u.query_form<foo>[1], 'trout', 'query param foo - el 2');
my ($url_1_valid, $url_2_valid) = (1, 1);
try {
my $u_v = URI.new('http:://www.perl.com', :is_validating<1>);
is($url_1_valid, 1, 'validating parser okd good URI');
$u_v = URI.new('http:://?#?#', :is_validating<1>);
CATCH {
default { $url_2_valid = 0 }
}
}
is($url_2_valid, 0, 'validating parser rejected bad URI');
# vim:ft=perl6