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 ＬＡＢＥＬ: {
  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 = 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         no warnings 'exiting';
  66         eval $prog;
  67     }
  68 }
  69
  70 is $@, '', "redo to downgradeable labels works";
  71 is $d, -1, "Latin-1 labels reachable regardless of UTF-8ness";
  72
  73 {
  74     no warnings;
  75     goto ここ;
  76
  77     if (undef) {
  78         ここ: {
  79             pass("goto UTF-8 LABEL works.");
  80         }
  81     }
  82 }