Commit | Line | Data |
---|---|---|
e4206093 | 1 | #!./perl -w |
77a135fe KW |
2 | # |
3 | # This script is written intentionally in UTF-8 | |
4 | ||
5 | BEGIN { | |
77a135fe | 6 | $| = 1; |
e4206093 | 7 | |
e68dd03a FC |
8 | chdir 't'; |
9 | @INC = '../lib'; | |
e4206093 | 10 | require './test.pl'; |
632e037a | 11 | skip_all_if_miniperl("no dynamic loading on miniperl, no re"); |
95e2dc41 | 12 | skip_all('EBCDIC') if $::IS_EBCDIC; |
77a135fe KW |
13 | } |
14 | ||
15 | use strict; | |
16 | ||
e68dd03a | 17 | plan (tests => 15); |
77a135fe KW |
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'); | |
ba6ff154 FC |
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'; | |
77a135fe | 52 | } |
e68dd03a FC |
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 | ||
77a135fe KW |
64 | __END__ |
65 |