#!./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); LABEL: { pass("Sanity check, UTF-8 labels don't throw a syntax error."); } SKIP: { skip_if_miniperl("no dynamic loading, no Encode", 2); no warnings 'exiting'; require Encode; my $prog = 'last LOOP;'; LOOP: { eval $prog; } is $@, '', "last with a UTF-8 label works,"; LOOP: { 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 E"; like $@, qr/Label not found for "last E" at/u, "last's error is UTF-8 clean"; eval "redo E"; like $@, qr/Label not found for "redo E" at/u, "redo's error is UTF-8 clean"; eval "next E"; like $@, qr/Label not found for "next E" 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--) { use feature 'unicode_eval'; 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."); } } }