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