whatpm/t/URIChecker.t

#!/usr/bin/perl
use strict;

use lib qw[/home/wakaba/work/manakai/lib];
## ISSUE: Message::URI::URIReference module.

use Test;
BEGIN { plan tests => 49 }

my $Cases = [
  {
    data => q<http://localhost/%40/>,
    errors => [],
  },
  {
    data => q<>,
    errors => [],
  },
  {
    data => q<abcdef>,
    errors => [],
  },
  {
    data => q<%7Fabc:efg>,
    errors => ['m::syntax error'],
  },
  {
    data => q<http://test/[53::0]>,
    errors => ['m::syntax error'],
  },
  {
    data => q<100%!>,
    errors => ['m::syntax error'],
  },
  {
    data => q<%a2>,
    errors => ['s:1:lowercase hexadecimal digit'],
  },
  {
    data => q<%a2?>,
    errors => ['s:1:lowercase hexadecimal digit'],
  },
  {
    data => q<?%a2>,
    errors => ['s:2:lowercase hexadecimal digit'],
  },
  {
    data => q<%a2%1b>,
    errors => ['s:1:lowercase hexadecimal digit',
               's:4:lowercase hexadecimal digit'],
  },
  {
    data => q<http://%5b/>,
    errors => ['s:8:lowercase hexadecimal digit',
               's::non-DNS host'],
  },
  {
    data => q<http://%5b/%25a/bv/%cc>,
    errors => ['s:8:lowercase hexadecimal digit',
               's:20:lowercase hexadecimal digit',
               's::non-DNS host'],
  },
  {
    data => q<%41>,
    errors => ['s:1:percent-encoded unreserved'],
  },
  {
    data => q<%41%7E>,
    errors => ['s:1:percent-encoded unreserved',
               's:4:percent-encoded unreserved'],
  },
  {
    data => q</%41>,
    errors => ['s:2:percent-encoded unreserved'],
  },
  {
    data => q<http://%5a/>,
    errors => ['s:8:lowercase hexadecimal digit',
               's:8:percent-encoded unreserved'],
  },
  {
    data => q<./%2E%2E>,
    errors => ['s:3:percent-encoded unreserved',
               's:6:percent-encoded unreserved'],
  },
  {
    data => q<http://www.example.com/%7Euser/>,
    errors => ['s:24:percent-encoded unreserved'],
  },
  {
    data => q<HTTP://example/>,
    errors => ['s:1:uppercase scheme name'],
  },
  {
    data => q<Http://example/>,
    errors => ['s:1:uppercase scheme name'],
  },
  {
    data => q<datA:,>,
    errors => ['s:1:uppercase scheme name'],
  },
  {
    data => q<dat%41:,>,
    errors => ['m::syntax error',
               's:4:percent-encoded unreserved'],
  },
  {
    data => q<g%5A:,>,
    errors => ['m::syntax error',
               's:2:percent-encoded unreserved'],
  },
  {
    data => q<g%7A:,>,
    errors => ['m::syntax error',
               's:2:percent-encoded unreserved'],
  },
  {
    data => q<http://www.test:2222/>,
    errors => [],
  },
  {
    data => q<http://www.example:0/>,
    errors => [],
  },
  {
    data => q<http://www@example:/>,
    errors => ['s::empty port'],
  },
  {
    data => q<http://www.test:/>,
    errors => ['s::empty port'],
  },
  {
    data => q<http://user:password@example/>,
    errors => ['s::password'],
  },
  {
    data => q<http://EXAMPLE/>,
    errors => ['s::uppercase host'],
  },
  {
    data => q<http://USER@example/>,
    errors => [],
  },
  {
    data => q<http://[v0.aaa]/>,
    errors => ['w::address format not supported:v0'],
  },
  {
    data => q<http://user@[v0.aaa]/>,
    errors => ['w::address format not supported:v0'],
  },
  {
    data => q<http://127.0.0.1/>,
    errors => [],
  },
  {
    data => q<http://123456789012345678901234567890123456789012345678901234567890123.test/>,
    errors => [],
  },
  {
    data => q<http://1234567890123456789012345678901234567890123456789012345678901234.test/>,
    errors => ['s::non-DNS host'],
  },
  {
    data => q<http://123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123/>,
    errors => [],
  },
  {
    data => q<http://123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123./>,
    errors => ['s::long host'],
  },
  {
    data => q<http://a_b.test/>,
    errors => ['s::non-DNS host'],
  },
  {
    data => q<http://%61.test/>,
    errors => ['s:8:percent-encoded unreserved'],
  },
  {
    data => q<http://a.test/>,
    errors => [],
  },
  {
    data => q<http://1.test/>,
    errors => [],
  },
  {
    data => q<http://a-1.test/>,
    errors => [],
  },
  {
    data => q<http://1-a.test/>,
    errors => [],
  },
  {
    data => q<http://a-.test/>,
    errors => ['s::non-DNS host'],
  },
  {
    data => q<http://-a.test/>,
    errors => ['s::non-DNS host'],
  },
  {
    data => q<http://a.b.test/>,
    errors => [],
  },
  {
    data => q<http://a.bc.test/>,
    errors => [],
  },
  {
    data => q<http://a.b-c.test/>,
    errors => [],
  },
];

require Whatpm::URIChecker;

for my $test (@$Cases) {
  @{$test->{errors}} = sort {$a cmp $b} @{$test->{errors}};
  my @errors;
  Whatpm::URIChecker->check_iri_reference ($test->{data}, sub {
    my %opt = @_;
    push @errors, $opt{level} . ':' .
        (defined $opt{position} ? $opt{position} : '') . ':' . 
        $opt{type};
  });
  @errors = sort {$a cmp $b} @errors;

  ok join ("\n", @errors), join ("\n", @{$test->{errors}}), $test->{data};
}
1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3
4			use lib qw[/home/wakaba/work/manakai/lib];
5			## ISSUE: Message::URI::URIReference module.
6
7			use Test;
8			BEGIN { plan tests => 49 }
9
10			my $Cases = [
11			{
12			data => q<http://localhost/%40/>,
13			errors => [],
14			},
15			{
16			data => q<>,
17			errors => [],
18			},
19			{
20			data => q<abcdef>,
21			errors => [],
22			},
23			{
24			data => q<%7Fabc:efg>,
25			errors => ['m::syntax error'],
26			},
27			{
28			data => q<http://test/[53::0]>,
29			errors => ['m::syntax error'],
30			},
31			{
32			data => q<100%!>,
33			errors => ['m::syntax error'],
34			},
35			{
36			data => q<%a2>,
37			errors => ['s:1:lowercase hexadecimal digit'],
38			},
39			{
40			data => q<%a2?>,
41			errors => ['s:1:lowercase hexadecimal digit'],
42			},
43			{
44			data => q<?%a2>,
45			errors => ['s:2:lowercase hexadecimal digit'],
46			},
47			{
48			data => q<%a2%1b>,
49			errors => ['s:1:lowercase hexadecimal digit',
50			's:4:lowercase hexadecimal digit'],
51			},
52			{
53			data => q<http://%5b/>,
54			errors => ['s:8:lowercase hexadecimal digit',
55			's::non-DNS host'],
56			},
57			{
58			data => q<http://%5b/%25a/bv/%cc>,
59			errors => ['s:8:lowercase hexadecimal digit',
60			's:20:lowercase hexadecimal digit',
61			's::non-DNS host'],
62			},
63			{
64			data => q<%41>,
65			errors => ['s:1:percent-encoded unreserved'],
66			},
67			{
68			data => q<%41%7E>,
69			errors => ['s:1:percent-encoded unreserved',
70			's:4:percent-encoded unreserved'],
71			},
72			{
73			data => q</%41>,
74			errors => ['s:2:percent-encoded unreserved'],
75			},
76			{
77			data => q<http://%5a/>,
78			errors => ['s:8:lowercase hexadecimal digit',
79			's:8:percent-encoded unreserved'],
80			},
81			{
82			data => q<./%2E%2E>,
83			errors => ['s:3:percent-encoded unreserved',
84			's:6:percent-encoded unreserved'],
85			},
86			{
87			data => q<http://www.example.com/%7Euser/>,
88			errors => ['s:24:percent-encoded unreserved'],
89			},
90			{
91			data => q<HTTP://example/>,
92			errors => ['s:1:uppercase scheme name'],
93			},
94			{
95			data => q<Http://example/>,
96			errors => ['s:1:uppercase scheme name'],
97			},
98			{
99			data => q<datA:,>,
100			errors => ['s:1:uppercase scheme name'],
101			},
102			{
103			data => q<dat%41:,>,
104			errors => ['m::syntax error',
105			's:4:percent-encoded unreserved'],
106			},
107			{
108			data => q<g%5A:,>,
109			errors => ['m::syntax error',
110			's:2:percent-encoded unreserved'],
111			},
112			{
113			data => q<g%7A:,>,
114			errors => ['m::syntax error',
115			's:2:percent-encoded unreserved'],
116			},
117			{
118			data => q<http://www.test:2222/>,
119			errors => [],
120			},
121			{
122			data => q<http://www.example:0/>,
123			errors => [],
124			},
125			{
126			data => q<http://www@example:/>,
127			errors => ['s::empty port'],
128			},
129			{
130			data => q<http://www.test:/>,
131			errors => ['s::empty port'],
132			},
133			{
134			data => q<http://user:password@example/>,
135			errors => ['s::password'],
136			},
137			{
138			data => q<http://EXAMPLE/>,
139			errors => ['s::uppercase host'],
140			},
141			{
142			data => q<http://USER@example/>,
143			errors => [],
144			},
145			{
146			data => q<http://[v0.aaa]/>,
147			errors => ['w::address format not supported:v0'],
148			},
149			{
150			data => q<http://user@[v0.aaa]/>,
151			errors => ['w::address format not supported:v0'],
152			},
153			{
154			data => q<http://127.0.0.1/>,
155			errors => [],
156			},
157			{
158			data => q<http://123456789012345678901234567890123456789012345678901234567890123.test/>,
159			errors => [],
160			},
161			{
162			data => q<http://1234567890123456789012345678901234567890123456789012345678901234.test/>,
163			errors => ['s::non-DNS host'],
164			},
165			{
166			data => q<http://123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123/>,
167			errors => [],
168			},
169			{
170			data => q<http://123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123./>,
171			errors => ['s::long host'],
172			},
173			{
174			data => q<http://a_b.test/>,
175			errors => ['s::non-DNS host'],
176			},
177			{
178			data => q<http://%61.test/>,
179			errors => ['s:8:percent-encoded unreserved'],
180			},
181			{
182			data => q<http://a.test/>,
183			errors => [],
184			},
185			{
186			data => q<http://1.test/>,
187			errors => [],
188			},
189			{
190			data => q<http://a-1.test/>,
191			errors => [],
192			},
193			{
194			data => q<http://1-a.test/>,
195			errors => [],
196			},
197			{
198			data => q<http://a-.test/>,
199			errors => ['s::non-DNS host'],
200			},
201			{
202			data => q<http://-a.test/>,
203			errors => ['s::non-DNS host'],
204			},
205			{
206			data => q<http://a.b.test/>,
207			errors => [],
208			},
209			{
210			data => q<http://a.bc.test/>,
211			errors => [],
212			},
213			{
214			data => q<http://a.b-c.test/>,
215			errors => [],
216			},
217			];
218
219			require Whatpm::URIChecker;
220
221			for my $test (@$Cases) {
222			@{$test->{errors}} = sort {$a cmp $b} @{$test->{errors}};
223			my @errors;
224			Whatpm::URIChecker->check_iri_reference ($test->{data}, sub {
225			my %opt = @_;
226			push @errors, $opt{level} . ':' .
227			(defined $opt{position} ? $opt{position} : '') . ':' .
228			$opt{type};
229			});
230			@errors = sort {$a cmp $b} @errors;
231
232			ok join ("\n", @errors), join ("\n", @{$test->{errors}}), $test->{data};
233			}