t/uni/lex_utf8.t

   1 #!./perl -w
   2 #
   3 # This script is written intentionally in UTF-8
   4
   5 BEGIN {
   6     $| = 1;
   7
   8     chdir 't';
   9     @INC = '../lib';
  10     require './test.pl';
  11     skip_all_if_miniperl("no dynamic loading on miniperl, no re");
  12     skip_all('EBCDIC') if $::IS_EBCDIC;
  13 }
  14
  15 use strict;
  16
  17 plan (tests => 15);
  18 use charnames ':full';
  19
  20 use utf8;
  21
  22 my $A_with_ogonek = "Ą";
  23 my $micro_sign = "µ";
  24 my $hex_first = "a\x{A2}Ą";
  25 my $hex_last = "aĄ\x{A2}";
  26 my $name_first = "b\N{MICRO SIGN}Ɓ";
  27 my $name_last = "bƁ\N{MICRO SIGN}";
  28 my $uname_first = "b\N{U+00B5}Ɓ";
  29 my $uname_last = "bƁ\N{U+00B5}";
  30 my $octal_first = "c\377Ć";
  31 my $octal_last = "cĆ\377";
  32
  33 do {
  34         use bytes;
  35         is((join "", unpack("C*", $A_with_ogonek)), "196" . "132", 'single char above 0x100');
  36         is((join "", unpack("C*", $micro_sign)), "194" . "181", 'single char in 0x80 .. 0xFF');
  37         is((join "", unpack("C*", $hex_first)), "97" . "194" . "162" . "196" . "132", 'a . \x{A2} . char above 0x100');
  38         is((join "", unpack("C*", $hex_last)), "97" . "196" . "132" . "194" . "162", 'a . char above 0x100 . \x{A2}');
  39         is((join "", unpack("C*", $name_first)), "98" . "194" . "181" . "198" . "129", 'b . \N{MICRO SIGN} . char above 0x100');
  40         is((join "", unpack("C*", $name_last)), "98" . "198" . "129" . "194" . "181", 'b . char above 0x100 . \N{MICRO SIGN}');
  41         is((join "", unpack("C*", $uname_first)), "98" . "194" . "181" . "198" . "129", 'b . \N{U+00B5} . char above 0x100');
  42         is((join "", unpack("C*", $uname_last)), "98" . "198" . "129" . "194" . "181", 'b . char above 0x100 . \N{U+00B5}');
  43         is((join "", unpack("C*", $octal_first)), "99" . "195" . "191" . "196" . "134", 'c . \377 . char above 0x100');
  44         is((join "", unpack("C*", $octal_last)), "99" . "196" . "134" . "195" . "191", 'c . char above 0x100 . \377');
  45 };
  46
  47 {
  48     local $SIG{__WARN__} = sub {};
  49     eval "our $::\xe9; $\xe9";
  50     unlike $@, qr/utf8_heavy/,
  51         'No utf8_heavy errors with our() syntax errors';
  52 }
  53
  54 # [perl #120463]
  55 $_ = "a";
  56 eval 's αaαbα';
  57 is $@, "", 's/// compiles, where / is actually a wide character';
  58 is $_, "b", 'substitution worked';
  59 $_ = "a";
  60 eval 'tr νaνbν';
  61 is $@, "", 'y/// compiles, where / is actually a wide character';
  62 is $_, "b", 'transliteration worked';
  63
  64 __END__
  65