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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
|
utf8.c AOK
[utf8_to_uv]
Malformed UTF-8 character
my $a = ord "\x80" ;
Malformed UTF-8 character
my $a = ord "\xf080" ;
<<<<<< this warning can't be easily triggered from perl anymore
[utf16_to_utf8]
Malformed UTF-16 surrogate
<<<<<< Add a test when something actually calls utf16_to_utf8
__END__
# utf8.c [utf8_to_uv] -W
BEGIN {
if (ord('A') == 193) {
print "SKIPPED\n# ebcdic platforms do not generate Malformed UTF-8 warnings.";
exit 0;
}
}
use utf8 ;
my $a = "snøstorm" ;
{
no warnings 'utf8' ;
my $a = "snøstorm";
use warnings 'utf8' ;
my $a = "snøstorm";
}
EXPECT
Malformed UTF-8 character (unexpected non-continuation byte 0x73, immediately after start byte 0xf8) at - line 9.
Malformed UTF-8 character (unexpected non-continuation byte 0x73, immediately after start byte 0xf8) at - line 14.
########
use warnings 'utf8';
my $d7ff = uc(chr(0xD7FF));
my $d800 = uc(chr(0xD800));
my $dfff = uc(chr(0xDFFF));
my $e000 = uc(chr(0xE000));
my $feff = uc(chr(0xFEFF));
my $fffd = uc(chr(0xFFFD));
my $fffe = uc(chr(0xFFFE));
my $ffff = uc(chr(0xFFFF));
my $hex4 = uc(chr(0x10000));
my $hex5 = uc(chr(0x100000));
my $maxm1 = uc(chr(0x10FFFE));
my $max = uc(chr(0x10FFFF));
my $nonUnicode = uc(chr(0x110000));
no warnings 'utf8';
my $d7ff = uc(chr(0xD7FF));
my $d800 = uc(chr(0xD800));
my $dfff = uc(chr(0xDFFF));
my $e000 = uc(chr(0xE000));
my $feff = uc(chr(0xFEFF));
my $fffd = uc(chr(0xFFFD));
my $fffe = uc(chr(0xFFFE));
my $ffff = uc(chr(0xFFFF));
my $hex4 = uc(chr(0x10000));
my $hex5 = uc(chr(0x100000));
my $maxm1 = uc(chr(0x10FFFE));
my $max = uc(chr(0x10FFFF));
my $nonUnicode = uc(chr(0x110000));
EXPECT
Operation "uc" returns its argument for UTF-16 surrogate U+D800 at - line 3.
Operation "uc" returns its argument for UTF-16 surrogate U+DFFF at - line 4.
Operation "uc" returns its argument for non-Unicode code point 0x110000 at - line 14.
########
use warnings 'utf8';
my $d800 = uc(chr(0xD800));
my $nonUnicode = uc(chr(0x110000));
no warnings 'surrogate';
my $d800 = uc(chr(0xD800));
my $nonUnicode = uc(chr(0x110000));
EXPECT
Operation "uc" returns its argument for UTF-16 surrogate U+D800 at - line 2.
Operation "uc" returns its argument for non-Unicode code point 0x110000 at - line 3.
Operation "uc" returns its argument for non-Unicode code point 0x110000 at - line 6.
########
use warnings 'utf8';
my $d800 = uc(chr(0xD800));
my $nonUnicode = uc(chr(0x110000));
my $big_nonUnicode = uc(chr(0x8000_0000));
no warnings 'non_unicode';
my $d800 = uc(chr(0xD800));
my $nonUnicode = uc(chr(0x110000));
my $big_nonUnicode = uc(chr(0x8000_0000));
EXPECT
Operation "uc" returns its argument for UTF-16 surrogate U+D800 at - line 2.
Operation "uc" returns its argument for non-Unicode code point 0x110000 at - line 3.
Operation "uc" returns its argument for non-Unicode code point 0x80000000 at - line 4.
Operation "uc" returns its argument for UTF-16 surrogate U+D800 at - line 6.
########
use warnings 'utf8';
my $d7ff = lc pack("U", 0xD7FF);
my $d800 = lc pack("U", 0xD800);
my $dfff = lc pack("U", 0xDFFF);
my $e000 = lc pack("U", 0xE000);
my $feff = lc pack("U", 0xFEFF);
my $fffd = lc pack("U", 0xFFFD);
my $fffe = lc pack("U", 0xFFFE);
my $ffff = lc pack("U", 0xFFFF);
my $hex4 = lc pack("U", 0x10000);
my $hex5 = lc pack("U", 0x100000);
my $maxm1 = lc pack("U", 0x10FFFE);
my $max = lc pack("U", 0x10FFFF);
my $nonUnicode = lc(pack("U", 0x110000));
no warnings 'utf8';
my $d7ff = lc pack("U", 0xD7FF);
my $d800 = lc pack("U", 0xD800);
my $dfff = lc pack("U", 0xDFFF);
my $e000 = lc pack("U", 0xE000);
my $feff = lc pack("U", 0xFEFF);
my $fffd = lc pack("U", 0xFFFD);
my $fffe = lc pack("U", 0xFFFE);
my $ffff = lc pack("U", 0xFFFF);
my $hex4 = lc pack("U", 0x10000);
my $hex5 = lc pack("U", 0x100000);
my $maxm1 = lc pack("U", 0x10FFFE);
my $max = lc pack("U", 0x10FFFF);
my $nonUnicode = lc(pack("U", 0x110000));
EXPECT
Operation "lc" returns its argument for UTF-16 surrogate U+D800 at - line 3.
Operation "lc" returns its argument for UTF-16 surrogate U+DFFF at - line 4.
Operation "lc" returns its argument for non-Unicode code point 0x110000 at - line 14.
########
use warnings 'utf8';
my $d7ff = ucfirst "\x{D7FF}";
my $d800 = ucfirst "\x{D800}";
my $dfff = ucfirst "\x{DFFF}";
my $e000 = ucfirst "\x{E000}";
my $feff = ucfirst "\x{FEFF}";
my $fffd = ucfirst "\x{FFFD}";
my $fffe = ucfirst "\x{FFFE}";
my $ffff = ucfirst "\x{FFFF}";
my $hex4 = ucfirst "\x{10000}";
my $hex5 = ucfirst "\x{100000}";
my $maxm1 = ucfirst "\x{10FFFE}";
my $max = ucfirst "\x{10FFFF}";
my $nonUnicode = ucfirst "\x{110000}";
no warnings 'utf8';
my $d7ff = ucfirst "\x{D7FF}";
my $d800 = ucfirst "\x{D800}";
my $dfff = ucfirst "\x{DFFF}";
my $e000 = ucfirst "\x{E000}";
my $feff = ucfirst "\x{FEFF}";
my $fffd = ucfirst "\x{FFFD}";
my $fffe = ucfirst "\x{FFFE}";
my $ffff = ucfirst "\x{FFFF}";
my $hex4 = ucfirst "\x{10000}";
my $hex5 = ucfirst "\x{100000}";
my $maxm1 = ucfirst "\x{10FFFE}";
my $max = ucfirst "\x{10FFFF}";
my $nonUnicode = ucfirst "\x{110000}";
EXPECT
Operation "ucfirst" returns its argument for UTF-16 surrogate U+D800 at - line 3.
Operation "ucfirst" returns its argument for UTF-16 surrogate U+DFFF at - line 4.
Operation "ucfirst" returns its argument for non-Unicode code point 0x110000 at - line 14.
########
use warnings 'utf8';
chr(0xD7FF) =~ /\p{Any}/;
chr(0xD800) =~ /\p{Any}/;
chr(0xDFFF) =~ /\p{Any}/;
chr(0xE000) =~ /\p{Any}/;
chr(0xFEFF) =~ /\p{Any}/;
chr(0xFFFD) =~ /\p{Any}/;
chr(0xFFFE) =~ /\p{Any}/;
chr(0xFFFF) =~ /\p{Any}/;
chr(0x10000) =~ /\p{Any}/;
chr(0x100000) =~ /\p{Any}/;
chr(0x10FFFE) =~ /\p{Any}/;
chr(0x10FFFF) =~ /\p{Any}/;
chr(0x110000) =~ /\p{Any}/;
no warnings 'utf8';
chr(0xD7FF) =~ /\p{Any}/;
chr(0xD800) =~ /\p{Any}/;
chr(0xDFFF) =~ /\p{Any}/;
chr(0xE000) =~ /\p{Any}/;
chr(0xFEFF) =~ /\p{Any}/;
chr(0xFFFD) =~ /\p{Any}/;
chr(0xFFFE) =~ /\p{Any}/;
chr(0xFFFF) =~ /\p{Any}/;
chr(0x10000) =~ /\p{Any}/;
chr(0x100000) =~ /\p{Any}/;
chr(0x10FFFE) =~ /\p{Any}/;
chr(0x10FFFF) =~ /\p{Any}/;
chr(0x110000) =~ /\p{Any}/;
EXPECT
Code point 0x110000 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 14.
########
use warnings 'utf8';
chr(0x110000) =~ /\p{Any}/;
no warnings 'non_unicode';
chr(0x110000) =~ /\p{Any}/;
EXPECT
Code point 0x110000 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 2.
########
require "../test.pl";
use warnings 'utf8';
sub Is_Super { return '!utf8::Any' }
# The extra char is to avoid an optimization that avoids the problem when the
# property is the only non-latin1 char in a class
print "\x{1100000}" =~ /^[\p{Is_Super}\x{100}]$/, "\n";
EXPECT
1
########
require "../test.pl";
use warnings 'utf8';
my $file = tempfile();
open(my $fh, "+>:utf8", $file);
print $fh "\x{D7FF}", "\n";
print $fh "\x{D800}", "\n";
print $fh "\x{DFFF}", "\n";
print $fh "\x{E000}", "\n";
print $fh "\x{FDCF}", "\n";
print $fh "\x{FDD0}", "\n";
print $fh "\x{FDEF}", "\n";
print $fh "\x{FDF0}", "\n";
print $fh "\x{FEFF}", "\n";
print $fh "\x{FFFD}", "\n";
print $fh "\x{FFFE}", "\n";
print $fh "\x{FFFF}", "\n";
print $fh "\x{10000}", "\n";
print $fh "\x{1FFFE}", "\n";
print $fh "\x{1FFFF}", "\n";
print $fh "\x{2FFFE}", "\n";
print $fh "\x{2FFFF}", "\n";
print $fh "\x{3FFFE}", "\n";
print $fh "\x{3FFFF}", "\n";
print $fh "\x{4FFFE}", "\n";
print $fh "\x{4FFFF}", "\n";
print $fh "\x{5FFFE}", "\n";
print $fh "\x{5FFFF}", "\n";
print $fh "\x{6FFFE}", "\n";
print $fh "\x{6FFFF}", "\n";
print $fh "\x{7FFFE}", "\n";
print $fh "\x{7FFFF}", "\n";
print $fh "\x{8FFFE}", "\n";
print $fh "\x{8FFFF}", "\n";
print $fh "\x{9FFFE}", "\n";
print $fh "\x{9FFFF}", "\n";
print $fh "\x{AFFFE}", "\n";
print $fh "\x{AFFFF}", "\n";
print $fh "\x{BFFFE}", "\n";
print $fh "\x{BFFFF}", "\n";
print $fh "\x{CFFFE}", "\n";
print $fh "\x{CFFFF}", "\n";
print $fh "\x{DFFFE}", "\n";
print $fh "\x{DFFFF}", "\n";
print $fh "\x{EFFFE}", "\n";
print $fh "\x{EFFFF}", "\n";
print $fh "\x{FFFFE}", "\n";
print $fh "\x{FFFFF}", "\n";
print $fh "\x{100000}", "\n";
print $fh "\x{10FFFE}", "\n";
print $fh "\x{10FFFF}", "\n";
print $fh "\x{110000}", "\n";
close $fh;
EXPECT
Unicode surrogate U+D800 is illegal in UTF-8 at - line 6.
Unicode surrogate U+DFFF is illegal in UTF-8 at - line 7.
Unicode non-character U+FDD0 is illegal for open interchange at - line 10.
Unicode non-character U+FDEF is illegal for open interchange at - line 11.
Unicode non-character U+FFFE is illegal for open interchange at - line 15.
Unicode non-character U+FFFF is illegal for open interchange at - line 16.
Unicode non-character U+1FFFE is illegal for open interchange at - line 18.
Unicode non-character U+1FFFF is illegal for open interchange at - line 19.
Unicode non-character U+2FFFE is illegal for open interchange at - line 20.
Unicode non-character U+2FFFF is illegal for open interchange at - line 21.
Unicode non-character U+3FFFE is illegal for open interchange at - line 22.
Unicode non-character U+3FFFF is illegal for open interchange at - line 23.
Unicode non-character U+4FFFE is illegal for open interchange at - line 24.
Unicode non-character U+4FFFF is illegal for open interchange at - line 25.
Unicode non-character U+5FFFE is illegal for open interchange at - line 26.
Unicode non-character U+5FFFF is illegal for open interchange at - line 27.
Unicode non-character U+6FFFE is illegal for open interchange at - line 28.
Unicode non-character U+6FFFF is illegal for open interchange at - line 29.
Unicode non-character U+7FFFE is illegal for open interchange at - line 30.
Unicode non-character U+7FFFF is illegal for open interchange at - line 31.
Unicode non-character U+8FFFE is illegal for open interchange at - line 32.
Unicode non-character U+8FFFF is illegal for open interchange at - line 33.
Unicode non-character U+9FFFE is illegal for open interchange at - line 34.
Unicode non-character U+9FFFF is illegal for open interchange at - line 35.
Unicode non-character U+AFFFE is illegal for open interchange at - line 36.
Unicode non-character U+AFFFF is illegal for open interchange at - line 37.
Unicode non-character U+BFFFE is illegal for open interchange at - line 38.
Unicode non-character U+BFFFF is illegal for open interchange at - line 39.
Unicode non-character U+CFFFE is illegal for open interchange at - line 40.
Unicode non-character U+CFFFF is illegal for open interchange at - line 41.
Unicode non-character U+DFFFE is illegal for open interchange at - line 42.
Unicode non-character U+DFFFF is illegal for open interchange at - line 43.
Unicode non-character U+EFFFE is illegal for open interchange at - line 44.
Unicode non-character U+EFFFF is illegal for open interchange at - line 45.
Unicode non-character U+FFFFE is illegal for open interchange at - line 46.
Unicode non-character U+FFFFF is illegal for open interchange at - line 47.
Unicode non-character U+10FFFE is illegal for open interchange at - line 49.
Unicode non-character U+10FFFF is illegal for open interchange at - line 50.
Code point 0x110000 is not Unicode, may not be portable at - line 51.
########
require "../test.pl";
use warnings 'utf8';
my $file = tempfile();
open(my $fh, "+>:utf8", $file);
print $fh "\x{D800}", "\n";
print $fh "\x{FFFF}", "\n";
print $fh "\x{110000}", "\n";
close $fh;
EXPECT
Unicode surrogate U+D800 is illegal in UTF-8 at - line 5.
Unicode non-character U+FFFF is illegal for open interchange at - line 6.
Code point 0x110000 is not Unicode, may not be portable at - line 7.
########
require "../test.pl";
use warnings 'utf8';
no warnings 'surrogate';
my $file = tempfile();
open(my $fh, "+>:utf8", $file);
print $fh "\x{D800}", "\n";
print $fh "\x{FFFF}", "\n";
print $fh "\x{110000}", "\n";
close $fh;
EXPECT
Unicode non-character U+FFFF is illegal for open interchange at - line 7.
Code point 0x110000 is not Unicode, may not be portable at - line 8.
########
require "../test.pl";
use warnings 'utf8';
no warnings 'nonchar';
my $file = tempfile();
open(my $fh, "+>:utf8", $file);
print $fh "\x{D800}", "\n";
print $fh "\x{FFFF}", "\n";
print $fh "\x{110000}", "\n";
close $fh;
EXPECT
Unicode surrogate U+D800 is illegal in UTF-8 at - line 6.
Code point 0x110000 is not Unicode, may not be portable at - line 8.
########
require "../test.pl";
use warnings 'utf8';
no warnings 'non_unicode';
my $file = tempfile();
open(my $fh, "+>:utf8", $file);
print $fh "\x{D800}", "\n";
print $fh "\x{FFFF}", "\n";
print $fh "\x{110000}", "\n";
close $fh;
EXPECT
Unicode surrogate U+D800 is illegal in UTF-8 at - line 6.
Unicode non-character U+FFFF is illegal for open interchange at - line 7.
########
# TODO
# NAME C<use warnings "nonchar"> works in isolation
require "../test.pl";
use warnings 'nonchar';
my $file = tempfile();
open(my $fh, "+>:utf8", $file);
print $fh "\x{FFFF}", "\n";
close $fh;
EXPECT
Unicode non-character U+FFFF is illegal for open interchange at - line 5.
########
# TODO
# NAME C<use warnings "surrogate"> works in isolation
require "../test.pl";
use warnings 'surrogate';
my $file = tempfile();
open(my $fh, "+>:utf8", $file);
print $fh "\x{D800}", "\n";
close $fh;
EXPECT
Unicode surrogate U+D800 is illegal in UTF-8 at - line 5.
########
# TODO
# NAME C<use warnings "non_unicode"> works in isolation
require "../test.pl";
use warnings 'non_unicode';
my $file = tempfile();
open(my $fh, "+>:utf8", $file);
print $fh "\x{110000}", "\n";
close $fh;
EXPECT
Code point 0x110000 is not Unicode, may not be portable at - line 5.
########
require "../test.pl";
no warnings 'utf8';
my $file = tempfile();
open(my $fh, "+>:utf8", $file);
print $fh "\x{D7FF}", "\n";
print $fh "\x{D800}", "\n";
print $fh "\x{DFFF}", "\n";
print $fh "\x{E000}", "\n";
print $fh "\x{FDCF}", "\n";
print $fh "\x{FDD0}", "\n";
print $fh "\x{FDEF}", "\n";
print $fh "\x{FDF0}", "\n";
print $fh "\x{FEFF}", "\n";
print $fh "\x{FFFD}", "\n";
print $fh "\x{FFFE}", "\n";
print $fh "\x{FFFF}", "\n";
print $fh "\x{10000}", "\n";
print $fh "\x{1FFFE}", "\n";
print $fh "\x{1FFFF}", "\n";
print $fh "\x{2FFFE}", "\n";
print $fh "\x{2FFFF}", "\n";
print $fh "\x{3FFFE}", "\n";
print $fh "\x{3FFFF}", "\n";
print $fh "\x{4FFFE}", "\n";
print $fh "\x{4FFFF}", "\n";
print $fh "\x{5FFFE}", "\n";
print $fh "\x{5FFFF}", "\n";
print $fh "\x{6FFFE}", "\n";
print $fh "\x{6FFFF}", "\n";
print $fh "\x{7FFFE}", "\n";
print $fh "\x{7FFFF}", "\n";
print $fh "\x{8FFFE}", "\n";
print $fh "\x{8FFFF}", "\n";
print $fh "\x{9FFFE}", "\n";
print $fh "\x{9FFFF}", "\n";
print $fh "\x{AFFFE}", "\n";
print $fh "\x{AFFFF}", "\n";
print $fh "\x{BFFFE}", "\n";
print $fh "\x{BFFFF}", "\n";
print $fh "\x{CFFFE}", "\n";
print $fh "\x{CFFFF}", "\n";
print $fh "\x{DFFFE}", "\n";
print $fh "\x{DFFFF}", "\n";
print $fh "\x{EFFFE}", "\n";
print $fh "\x{EFFFF}", "\n";
print $fh "\x{FFFFE}", "\n";
print $fh "\x{FFFFF}", "\n";
print $fh "\x{100000}", "\n";
print $fh "\x{10FFFE}", "\n";
print $fh "\x{10FFFF}", "\n";
print $fh "\x{110000}", "\n";
close $fh;
EXPECT
|