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 => 81 }

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::uppercase scheme name'],
  },
  {
    data => q<Http://example/>,
    errors => ['s::uppercase scheme name'],
  },
  {
    data => q<datA:,>,
    errors => ['s::uppercase scheme name'],
  },
  {
    data => q<dat%41:,>,
    errors => ['m::syntax error',
               's::uppercase scheme name',
               's:4:percent-encoded unreserved'],
  },
  {
    data => q<g%5A:,>,
    errors => ['m::syntax error',
               's::uppercase scheme name',
               '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://user@[V0A.aaa]/>,
    errors => ['w::address format not supported:V0A',
               's::uppercase host'],
  },
  {
    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 => [],
  },
  {
    data => qq<http://\x{123}\x{456}.test/>,
    errors => ['s::non-DNS host'],
  },
  {
    data => qq<http://\x{4E00}%80.test/>,
    errors => ['s::non-DNS host',
               'm::non UTF-8 host'],
  },
  {
    data => q<http://a.%E3%81%82%E3%81%84.test/>,
    errors => ['s::non-DNS host'],
  },
  {
    data => q<example://a/b/c/%7Bfoo%7D>,
    errors => [],
  },
  {
    data => q<eXAMPLE://a/./b/../b/%63/%7bfoo%7d>,
    errors => ['s::uppercase scheme name',
               's:22:percent-encoded unreserved',
               's:26:lowercase hexadecimal digit',
               's:32:lowercase hexadecimal digit',
               's::dot-segment'],
  },
  {
    data => q<example://a/.htaccess>,
    errors => [],
  },
  {
    data => q<example://a/.>,
    errors => ['s::dot-segment'],
  },
  {
    data => q<http://example.com>,
    errors => ['s::empty path'],
  },
  {
    data => q<http://example.com/>,
    errors => [],
  },
  {
    data => q<http://example.com:/>,
    errors => ['s::empty port'],
  },
  {
    data => q<http://example.com:80/>,
    errors => ['s::default port'],
  },
  {
    data => q<hTTP://example.com:80/>,
    errors => ['s::uppercase scheme name',
               's::default port'],
  },
  {
    data => q<%68ttp://example.com:80/>,
    errors => ['m::syntax error',
               's:1:percent-encoded unreserved',
               's::default port'],
  },
  {
    data => q<file://user@/>,
    errors => ['s::empty host'],
  },
  {
    data => q<http://example.com/?>,
    errors => [],
  },
  {
    data => q<mailto:Joe@Example.COM>,
    errors => [],
  },
  {
    data => q<mailto:Joe@example.com>,
    errors => [],
  },
  {
    data => q<http://example.com/data>,
    errors => [],
  },
  {
    data => q<ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm>,
    errors => [],
  },
  {
    data => qq<http://r\xE9sum\xE9.example.org>,
    errors => ['s::non-DNS host',
               's::empty path'],
  },
  {
    data => qq<http://validator.w3.org/check?uri=http%3A%2F%2Fr\xE9;sum\xE9.example.com>,
    errors => [],
  },
  {
    data => q<http://validator.w3.org/check?uri=http%3A%2F%2Fr%C3%A9sum%C3%A9.example.com>,
    errors => [],
  },
  {
    data => qq<http://example.com/\x{10300}\x{10301}\x{10302}>,
    errors => [],
  },
  {
    data => q<http://example.com/%F0%90%8C%80%F0%90%8C%81%F0%90%8C%82>,
    errors => [],
  },
  {
    data => q<http://www.example.org/r%E9sum%E9.html>,
    errors => [],
  },
  {
    data => q<http://xn--99zt52a.example.org/%e2%80%ae>,
    errors => ['s:32:lowercase hexadecimal digit',
               's:38:lowercase hexadecimal digit'],
  },
  {
    data => qq<example://a/b/c/%7Bfoo%7D/ros\xE9>,
    errors => [],
  },
  {
    data => qq<eXAMPLE://a/./b/../b/%63/%7bfoo%7d/ros%C3%A9>,
    errors => ['s::uppercase scheme name',
               's:22:percent-encoded unreserved',
               's:26:lowercase hexadecimal digit',
               's:32:lowercase hexadecimal digit',
               's::dot-segment'],
  },
  {
    data => qq<http://www.example.org/r\xE9sum\xE9.html>,
    errors => [],
  },
  {
    data => qq<http://www.example.org/re\x{301}sume\x{301}.html>,
    errors => [], ## TODO: not in NFC
  },
  {
    data => q<http://www.example.org/r%E9sum%E9.xml#r%C3%A9sum%C3%A9>,
    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	wakaba	1.2	BEGIN { plan tests => 81 }
9	wakaba	1.1
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	wakaba	1.2	errors => ['s::uppercase scheme name'],
93	wakaba	1.1	},
94			{
95			data => q<Http://example/>,
96	wakaba	1.2	errors => ['s::uppercase scheme name'],
97	wakaba	1.1	},
98			{
99			data => q<datA:,>,
100	wakaba	1.2	errors => ['s::uppercase scheme name'],
101	wakaba	1.1	},
102			{
103			data => q<dat%41:,>,
104			errors => ['m::syntax error',
105	wakaba	1.2	's::uppercase scheme name',
106	wakaba	1.1	's:4:percent-encoded unreserved'],
107			},
108			{
109			data => q<g%5A:,>,
110			errors => ['m::syntax error',
111	wakaba	1.2	's::uppercase scheme name',
112	wakaba	1.1	's:2:percent-encoded unreserved'],
113			},
114			{
115			data => q<g%7A:,>,
116			errors => ['m::syntax error',
117			's:2:percent-encoded unreserved'],
118			},
119			{
120			data => q<http://www.test:2222/>,
121			errors => [],
122			},
123			{
124			data => q<http://www.example:0/>,
125			errors => [],
126			},
127			{
128			data => q<http://www@example:/>,
129			errors => ['s::empty port'],
130			},
131			{
132			data => q<http://www.test:/>,
133			errors => ['s::empty port'],
134			},
135			{
136			data => q<http://user:password@example/>,
137			errors => ['s::password'],
138			},
139			{
140			data => q<http://EXAMPLE/>,
141			errors => ['s::uppercase host'],
142			},
143			{
144			data => q<http://USER@example/>,
145			errors => [],
146			},
147			{
148			data => q<http://[v0.aaa]/>,
149			errors => ['w::address format not supported:v0'],
150			},
151			{
152			data => q<http://user@[v0.aaa]/>,
153			errors => ['w::address format not supported:v0'],
154			},
155			{
156	wakaba	1.2	data => q<http://user@[V0A.aaa]/>,
157			errors => ['w::address format not supported:V0A',
158			's::uppercase host'],
159			},
160			{
161	wakaba	1.1	data => q<http://127.0.0.1/>,
162			errors => [],
163			},
164			{
165			data => q<http://123456789012345678901234567890123456789012345678901234567890123.test/>,
166			errors => [],
167			},
168			{
169			data => q<http://1234567890123456789012345678901234567890123456789012345678901234.test/>,
170			errors => ['s::non-DNS host'],
171			},
172			{
173			data => q<http://123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123/>,
174			errors => [],
175			},
176			{
177			data => q<http://123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123.123456789012345678901234567890123456789012345678901234567890123./>,
178			errors => ['s::long host'],
179			},
180			{
181			data => q<http://a_b.test/>,
182			errors => ['s::non-DNS host'],
183			},
184			{
185			data => q<http://%61.test/>,
186			errors => ['s:8:percent-encoded unreserved'],
187			},
188			{
189			data => q<http://a.test/>,
190			errors => [],
191			},
192			{
193			data => q<http://1.test/>,
194			errors => [],
195			},
196			{
197			data => q<http://a-1.test/>,
198			errors => [],
199			},
200			{
201			data => q<http://1-a.test/>,
202			errors => [],
203			},
204			{
205			data => q<http://a-.test/>,
206			errors => ['s::non-DNS host'],
207			},
208			{
209			data => q<http://-a.test/>,
210			errors => ['s::non-DNS host'],
211			},
212			{
213			data => q<http://a.b.test/>,
214			errors => [],
215			},
216			{
217			data => q<http://a.bc.test/>,
218			errors => [],
219			},
220			{
221			data => q<http://a.b-c.test/>,
222	wakaba	1.2	errors => [],
223			},
224			{
225			data => qq<http://\x{123}\x{456}.test/>,
226			errors => ['s::non-DNS host'],
227			},
228			{
229			data => qq<http://\x{4E00}%80.test/>,
230			errors => ['s::non-DNS host',
231			'm::non UTF-8 host'],
232			},
233			{
234			data => q<http://a.%E3%81%82%E3%81%84.test/>,
235			errors => ['s::non-DNS host'],
236			},
237			{
238			data => q<example://a/b/c/%7Bfoo%7D>,
239			errors => [],
240			},
241			{
242			data => q<eXAMPLE://a/./b/../b/%63/%7bfoo%7d>,
243			errors => ['s::uppercase scheme name',
244			's:22:percent-encoded unreserved',
245			's:26:lowercase hexadecimal digit',
246			's:32:lowercase hexadecimal digit',
247			's::dot-segment'],
248			},
249			{
250			data => q<example://a/.htaccess>,
251			errors => [],
252			},
253			{
254			data => q<example://a/.>,
255			errors => ['s::dot-segment'],
256			},
257			{
258			data => q<http://example.com>,
259			errors => ['s::empty path'],
260			},
261			{
262			data => q<http://example.com/>,
263			errors => [],
264			},
265			{
266			data => q<http://example.com:/>,
267			errors => ['s::empty port'],
268			},
269			{
270			data => q<http://example.com:80/>,
271			errors => ['s::default port'],
272			},
273			{
274			data => q<hTTP://example.com:80/>,
275			errors => ['s::uppercase scheme name',
276			's::default port'],
277			},
278			{
279			data => q<%68ttp://example.com:80/>,
280			errors => ['m::syntax error',
281			's:1:percent-encoded unreserved',
282			's::default port'],
283			},
284			{
285			data => q<file://user@/>,
286			errors => ['s::empty host'],
287			},
288			{
289			data => q<http://example.com/?>,
290			errors => [],
291			},
292			{
293			data => q<mailto:Joe@Example.COM>,
294			errors => [],
295			},
296			{
297			data => q<mailto:Joe@example.com>,
298			errors => [],
299			},
300			{
301			data => q<http://example.com/data>,
302			errors => [],
303			},
304			{
305			data => q<ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm>,
306			errors => [],
307			},
308			{
309			data => qq<http://r\xE9sum\xE9.example.org>,
310			errors => ['s::non-DNS host',
311			's::empty path'],
312			},
313			{
314			data => qq<http://validator.w3.org/check?uri=http%3A%2F%2Fr\xE9;sum\xE9.example.com>,
315			errors => [],
316			},
317			{
318			data => q<http://validator.w3.org/check?uri=http%3A%2F%2Fr%C3%A9sum%C3%A9.example.com>,
319			errors => [],
320			},
321			{
322			data => qq<http://example.com/\x{10300}\x{10301}\x{10302}>,
323			errors => [],
324			},
325			{
326			data => q<http://example.com/%F0%90%8C%80%F0%90%8C%81%F0%90%8C%82>,
327			errors => [],
328			},
329			{
330			data => q<http://www.example.org/r%E9sum%E9.html>,
331			errors => [],
332			},
333			{
334			data => q<http://xn--99zt52a.example.org/%e2%80%ae>,
335			errors => ['s:32:lowercase hexadecimal digit',
336			's:38:lowercase hexadecimal digit'],
337			},
338			{
339			data => qq<example://a/b/c/%7Bfoo%7D/ros\xE9>,
340			errors => [],
341			},
342			{
343			data => qq<eXAMPLE://a/./b/../b/%63/%7bfoo%7d/ros%C3%A9>,
344			errors => ['s::uppercase scheme name',
345			's:22:percent-encoded unreserved',
346			's:26:lowercase hexadecimal digit',
347			's:32:lowercase hexadecimal digit',
348			's::dot-segment'],
349			},
350			{
351			data => qq<http://www.example.org/r\xE9sum\xE9.html>,
352			errors => [],
353			},
354			{
355			data => qq<http://www.example.org/re\x{301}sume\x{301}.html>,
356			errors => [], ## TODO: not in NFC
357			},
358			{
359			data => q<http://www.example.org/r%E9sum%E9.xml#r%C3%A9sum%C3%A9>,
360	wakaba	1.1	errors => [],
361			},
362			];
363
364			require Whatpm::URIChecker;
365
366			for my $test (@$Cases) {
367			@{$test->{errors}} = sort {$a cmp $b} @{$test->{errors}};
368			my @errors;
369			Whatpm::URIChecker->check_iri_reference ($test->{data}, sub {
370			my %opt = @_;
371			push @errors, $opt{level} . ':' .
372			(defined $opt{position} ? $opt{position} : '') . ':' .
373			$opt{type};
374			});
375			@errors = sort {$a cmp $b} @errors;
376
377			ok join ("\n", @errors), join ("\n", @{$test->{errors}}), $test->{data};
378			}