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(10);
  19
  20 ＬＡＢＥＬ: {
  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 ＬＯＯＰ;';
  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
  57 my $d = 2;
  58 LÁ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
  73 like $@, qr/Unrecognized character/, "redo to downgradeable labels";
  74 is $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 }