Commit | Line | Data |
---|---|---|
5db1eb8d BF |
1 | #!./perl |
2 | ||
3 | # Tests for labels in UTF-8 | |
4 | ||
5 | BEGIN { | |
6 | chdir 't' if -d 't'; | |
7 | @INC = '../lib'; | |
8 | require './test.pl'; | |
9 | } | |
10 | ||
11 | use utf8; | |
12 | use open qw( :utf8 :std ); | |
13 | use warnings; | |
f232b41c | 14 | use feature qw 'unicode_strings evalbytes'; |
5db1eb8d BF |
15 | |
16 | use charnames qw( :full ); | |
17 | ||
07f72646 | 18 | plan(10); |
5db1eb8d BF |
19 | |
20 | LABEL: { | |
21 | pass("Sanity check, UTF-8 labels don't throw a syntax error."); | |
22 | } | |
23 | ||
24 | ||
25 | SKIP: { | |
3c5bc6de | 26 | skip_if_miniperl("no dynamic loading, no Encode", 2); |
5db1eb8d BF |
27 | no warnings 'exiting'; |
28 | require Encode; | |
29 | ||
30 | my $prog = 'last LOOP;'; | |
31 | ||
32 | LOOP: { | |
33 | eval $prog; | |
34 | } | |
35 | is $@, '', "last with a UTF-8 label works,"; | |
36 | ||
37 | LOOP: { | |
38 | Encode::_utf8_off($prog); | |
f232b41c | 39 | evalbytes $prog; |
5db1eb8d BF |
40 | like $@, qr/^Unrecognized character/, "..but turn off the UTF-8 flag and it explodes"; |
41 | } | |
42 | } | |
43 | ||
44 | { | |
45 | no warnings 'exiting'; | |
46 | ||
47 | eval "last E"; | |
48 | like $@, qr/Label not found for "last E" at/u, "last's error is UTF-8 clean"; | |
49 | ||
50 | eval "redo E"; | |
51 | like $@, qr/Label not found for "redo E" at/u, "redo's error is UTF-8 clean"; | |
52 | ||
53 | eval "next E"; | |
54 | like $@, qr/Label not found for "next E" at/u, "next's error is UTF-8 clean"; | |
55 | } | |
56 | ||
07f72646 | 57 | my $d = 2; |
5db1eb8d | 58 | LÁBEL: { |
07f72646 | 59 | my $e = $@; |
5db1eb8d BF |
60 | my $prog = "redo L\N{LATIN CAPITAL LETTER A WITH ACUTE}BEL"; |
61 | ||
07f72646 BF |
62 | if ($d == 1) { |
63 | is $e, '', "redo UTF8 works"; | |
5db1eb8d BF |
64 | utf8::downgrade($prog); |
65 | } | |
66 | if ($d--) { | |
dd53ca2f | 67 | use feature 'unicode_eval'; |
5db1eb8d BF |
68 | no warnings 'exiting'; |
69 | eval $prog; | |
70 | } | |
71 | } | |
72 | ||
07f72646 BF |
73 | like $@, qr/Unrecognized character/, "redo to downgradeable labels"; |
74 | is $d, 0, "Latin-1 labels are reachable"; | |
5db1eb8d BF |
75 | |
76 | { | |
77 | no warnings; | |
78 | goto ここ; | |
79 | ||
80 | if (undef) { | |
81 | ここ: { | |
82 | pass("goto UTF-8 LABEL works."); | |
83 | } | |
84 | } | |
85 | } |