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
|
#!./perl
# Tests for labels in UTF-8
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
}
use utf8;
use open qw( :utf8 :std );
use warnings;
use feature qw 'unicode_strings evalbytes';
use charnames qw( :full );
plan(9);
ＬＡＢＥＬ: {
pass("Sanity check, UTF-8 labels don't throw a syntax error.");
}
SKIP: {
skip_if_miniperl("no dynamic loading, no Encode");
no warnings 'exiting';
require Encode;
my $prog = 'last ＬＯＯＰ;';
ＬＯＯＰ: {
eval $prog;
}
is $@, '', "last with a UTF-8 label works,";
ＬＯＯＰ: {
Encode::_utf8_off($prog);
evalbytes $prog;
like $@, qr/^Unrecognized character/, "..but turn off the UTF-8 flag and it explodes";
}
}
{
no warnings 'exiting';
eval "last Ｅ";
like $@, qr/Label not found for "last Ｅ" at/u, "last's error is UTF-8 clean";
eval "redo Ｅ";
like $@, qr/Label not found for "redo Ｅ" at/u, "redo's error is UTF-8 clean";
eval "next Ｅ";
like $@, qr/Label not found for "next Ｅ" at/u, "next's error is UTF-8 clean";
}
my $d = 4;
LÁBEL: {
my $prog = "redo L\N{LATIN CAPITAL LETTER A WITH ACUTE}BEL";
if ($d % 2) {
utf8::downgrade($prog);
}
if ($d--) {
no warnings 'exiting';
eval $prog;
}
}
is $@, '', "redo to downgradeable labels works";
is $d, -1, "Latin-1 labels reachable regardless of UTF-8ness";
{
no warnings;
goto ここ;
if (undef) {
ここ: {
pass("goto UTF-8 LABEL works.");
}
}
}
|
