This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make unicode label tests use unicode_eval.
[perl5.git] / t / uni / labels.t
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;
14 use feature qw 'unicode_strings evalbytes';
15
16 use charnames qw( :full );
17
18 plan(9);
19
20 LABEL: {
21     pass("Sanity check, UTF-8 labels don't throw a syntax error.");
22 }
23
24
25 SKIP: {
26     skip_if_miniperl("no dynamic loading, no Encode", 2);
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);
39         evalbytes $prog;
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
57 my $d = 4;
58 LÁBEL: {
59     my $prog = "redo L\N{LATIN CAPITAL LETTER A WITH ACUTE}BEL";
60
61     if ($d % 2) {
62         utf8::downgrade($prog);
63     }
64     if ($d--) {
65         use feature 'unicode_eval';
66         no warnings 'exiting';
67         eval $prog;
68     }
69 }
70
71 is $@, '', "redo to downgradeable labels works";
72 is $d, -1, "Latin-1 labels reachable regardless of UTF-8ness";
73
74 {
75     no warnings;
76     goto ここ;
77     
78     if (undef) {
79         ここ: {
80             pass("goto UTF-8 LABEL works.");
81         }
82     }
83 }