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' if -d 't';
   9     require './test.pl';
  10     set_up_inc('../lib');
  11     require './charset_tools.pl';
  12     skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
  13     skip_all_without_unicode_tables();
  14 }
  15
  16 use strict;
  17
  18 plan (tests => 16);
  19 use charnames ':full';
  20
  21 use utf8;
  22
  23 my $A_with_ogonek = "Ą";
  24 my $micro_sign = "µ";
  25 my $hex_first = "a\x{A2}Ą";
  26 my $hex_last = "aĄ\x{A2}";
  27 my $name_first = "b\N{MICRO SIGN}Ɓ";
  28 my $name_last = "bƁ\N{MICRO SIGN}";
  29 my $uname_first = "b\N{U+00B5}Ɓ";
  30 my $uname_last = "bƁ\N{U+00B5}";
  31 my $octal_first = "c\377Ć";
  32 my $octal_last = "cĆ\377";
  33
  34 sub fixup (@) {
  35     # @_ is a list of strings.  Each string is comprised of the digits that
  36     # form a byte of the UTF-8 representation of a character, or sequence of
  37     # characters
  38
  39     my $string = join "", map { chr 0 + $_ } @_;
  40     $string = byte_utf8a_to_utf8n($string);
  41
  42     # Return the concatenation of each byte of $string converted to a string of
  43     # its decimal ordinal value.  This is just the input array converted to
  44     # native, and joined together.
  45     return join "", map { sprintf "%d", ord $_ } split "", $string;
  46 }
  47
  48 do {
  49         use bytes;
  50         is((join "", unpack("C*", $A_with_ogonek)), fixup("196", "132"), 'single char above 0x100');
  51         is((join "", unpack("C*", $micro_sign)), fixup("194", "181"), 'single char in 0x80 .. 0xFF');
  52         SKIP: {
  53             skip("ASCII-centric tests", 2) if $::IS_EBCDIC;
  54             is((join "", unpack("C*", $hex_first)), fixup("97", "194", "162", "196", "132"), 'a, \x{A2}, char above 0x100');
  55             is((join "", unpack("C*", $hex_last)), fixup("97", "196", "132", "194", "162"), 'a, char above 0x100, \x{A2}');
  56         }
  57         is((join "", unpack("C*", $name_first)), fixup("98", "194", "181", "198", "129"), 'b, \N{MICRO SIGN}, char above 0x100');
  58         is((join "", unpack("C*", $name_last)), fixup("98", "198", "129", "194", "181"), 'b, char above 0x100, \N{MICRO SIGN}');
  59         is((join "", unpack("C*", $uname_first)), fixup("98", "194", "181", "198", "129"), 'b, \N{U+00B5}, char above 0x100');
  60         is((join "", unpack("C*", $uname_last)), fixup("98", "198", "129", "194", "181"), 'b, char above 0x100, \N{U+00B5}');
  61         SKIP: {
  62             skip("ASCII-centric tests", 2) if $::IS_EBCDIC;
  63             is((join "", unpack("C*", $octal_first)), fixup("99", "195", "191", "196", "134"), 'c, \377, char above 0x100');
  64             is((join "", unpack("C*", $octal_last)), fixup("99", "196", "134", "195", "191"), 'c, char above 0x100, \377');
  65         }
  66 };
  67
  68 {
  69     local $SIG{__WARN__} = sub {};
  70     eval "our $::\xe9; $\xe9";
  71     unlike $@, qr/utf8_heavy/,
  72         'No utf8_heavy errors with our() syntax errors';
  73 }
  74
  75 # [perl #120463]
  76 $_ = "a";
  77 eval 's αaαbα';
  78 is $@, "", 's/// compiles, where / is actually a wide character';
  79 is $_, "b", 'substitution worked';
  80 $_ = "a";
  81 eval 'tr νaνbν';
  82 is $@, "", 'y/// compiles, where / is actually a wide character';
  83 is $_, "b", 'transliteration worked';
  84
  85 SKIP: {
  86     skip("ASCII-centric test", 1) if $::IS_EBCDIC;
  87     use constant foofoo=>qq|\xc4\xb5|;
  88     { no strict; ()=${"\xc4\xb5::foo"} } # vivify Äµ package
  89     eval 'my foofoo $dog'; # foofoo was resolving to ĵ, not Äµ
  90     is $@, '', 'my constant $var in utf8 scope where constant is not utf8';
  91 }
  92
  93 __END__
  94