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