1#!./perl -w 2# 3# This script is written intentionally in UTF-8 4 5BEGIN { 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 15use strict; 16 17plan (tests => 15); 18use charnames ':full'; 19 20use utf8; 21 22my $A_with_ogonek = "Ą"; 23my $micro_sign = "µ"; 24my $hex_first = "a\x{A2}Ą"; 25my $hex_last = "aĄ\x{A2}"; 26my $name_first = "b\N{MICRO SIGN}Ɓ"; 27my $name_last = "bƁ\N{MICRO SIGN}"; 28my $uname_first = "b\N{U+00B5}Ɓ"; 29my $uname_last = "bƁ\N{U+00B5}"; 30my $octal_first = "c\377Ć"; 31my $octal_last = "cĆ\377"; 32 33do { 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"; 56eval 's αaαbα'; 57is $@, "", 's/// compiles, where / is actually a wide character'; 58is $_, "b", 'substitution worked'; 59$_ = "a"; 60eval 'tr νaνbν'; 61is $@, "", 'y/// compiles, where / is actually a wide character'; 62is $_, "b", 'transliteration worked'; 63 64__END__ 65 66