1#!./perl -w 2# 3# This script is written intentionally in UTF-8 4 5BEGIN { 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 16use strict; 17 18plan (tests => 16); 19use charnames ':full'; 20 21use utf8; 22 23my $A_with_ogonek = "Ą"; 24my $micro_sign = "µ"; 25my $hex_first = "a\x{A2}Ą"; 26my $hex_last = "aĄ\x{A2}"; 27my $name_first = "b\N{MICRO SIGN}Ɓ"; 28my $name_last = "bƁ\N{MICRO SIGN}"; 29my $uname_first = "b\N{U+00B5}Ɓ"; 30my $uname_last = "bƁ\N{U+00B5}"; 31my $octal_first = "c\377Ć"; 32my $octal_last = "cĆ\377"; 33 34sub fixup (@) { 35 # @_ is a list of strings. Each string consists of the digits that form 36 # 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 48do { 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"; 77eval 's αaαbα'; 78is $@, "", 's/// compiles, where / is actually a wide character'; 79is $_, "b", 'substitution worked'; 80$_ = "a"; 81eval 'tr νaνbν'; 82is $@, "", 'y/// compiles, where / is actually a wide character'; 83is $_, "b", 'transliteration worked'; 84 85SKIP: { 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 95