| 1 | #!./perl |
| 2 | |
| 3 | my @WARN; |
| 4 | |
| 5 | BEGIN { |
| 6 | unless(grep /blib/, @INC) { |
| 7 | chdir 't' if -d 't'; |
| 8 | @INC = '../lib'; |
| 9 | } |
| 10 | $SIG{__WARN__} = sub { push @WARN, @_ }; |
| 11 | } |
| 12 | |
| 13 | $| = 1; |
| 14 | |
| 15 | print "1..39\n"; |
| 16 | |
| 17 | use charnames ':full'; |
| 18 | |
| 19 | print "not " unless "Here\N{EXCLAMATION MARK}?" eq "Here!?"; |
| 20 | print "ok 1\n"; |
| 21 | |
| 22 | { |
| 23 | use bytes; # TEST -utf8 can switch utf8 on |
| 24 | |
| 25 | print "# \$res=$res \$\@='$@'\nnot " |
| 26 | if $res = eval <<'EOE' |
| 27 | use charnames ":full"; |
| 28 | "Here: \N{CYRILLIC SMALL LETTER BE}!"; |
| 29 | 1 |
| 30 | EOE |
| 31 | or $@ !~ /above 0xFF/; |
| 32 | print "ok 2\n"; |
| 33 | # print "# \$res=$res \$\@='$@'\n"; |
| 34 | |
| 35 | print "# \$res=$res \$\@='$@'\nnot " |
| 36 | if $res = eval <<'EOE' |
| 37 | use charnames 'cyrillic'; |
| 38 | "Here: \N{Be}!"; |
| 39 | 1 |
| 40 | EOE |
| 41 | or $@ !~ /CYRILLIC CAPITAL LETTER BE.*above 0xFF/; |
| 42 | print "ok 3\n"; |
| 43 | } |
| 44 | |
| 45 | # If octal representation of unicode char is \0xyzt, then the utf8 is \3xy\2zt |
| 46 | if (ord('A') == 65) { # as on ASCII or UTF-8 machines |
| 47 | $encoded_be = "\320\261"; |
| 48 | $encoded_alpha = "\316\261"; |
| 49 | $encoded_bet = "\327\221"; |
| 50 | $encoded_deseng = "\360\220\221\215"; |
| 51 | } |
| 52 | else { # EBCDIC where UTF-EBCDIC may be used (this may be 1047 specific since |
| 53 | # UTF-EBCDIC is codepage specific) |
| 54 | $encoded_be = "\270\102\130"; |
| 55 | $encoded_alpha = "\264\130"; |
| 56 | $encoded_bet = "\270\125\130"; |
| 57 | $encoded_deseng = "\336\102\103\124"; |
| 58 | } |
| 59 | |
| 60 | sub to_bytes { |
| 61 | pack"a*", shift; |
| 62 | } |
| 63 | |
| 64 | { |
| 65 | use charnames ':full'; |
| 66 | |
| 67 | print "not " unless to_bytes("\N{CYRILLIC SMALL LETTER BE}") eq $encoded_be; |
| 68 | print "ok 4\n"; |
| 69 | |
| 70 | use charnames qw(cyrillic greek :short); |
| 71 | |
| 72 | print "not " unless to_bytes("\N{be},\N{alpha},\N{hebrew:bet}") |
| 73 | eq "$encoded_be,$encoded_alpha,$encoded_bet"; |
| 74 | print "ok 5\n"; |
| 75 | } |
| 76 | |
| 77 | { |
| 78 | use charnames ':full'; |
| 79 | print "not " unless "\x{263a}" eq "\N{WHITE SMILING FACE}"; |
| 80 | print "ok 6\n"; |
| 81 | print "not " unless length("\x{263a}") == 1; |
| 82 | print "ok 7\n"; |
| 83 | print "not " unless length("\N{WHITE SMILING FACE}") == 1; |
| 84 | print "ok 8\n"; |
| 85 | print "not " unless sprintf("%vx", "\x{263a}") eq "263a"; |
| 86 | print "ok 9\n"; |
| 87 | print "not " unless sprintf("%vx", "\N{WHITE SMILING FACE}") eq "263a"; |
| 88 | print "ok 10\n"; |
| 89 | print "not " unless sprintf("%vx", "\xFF\N{WHITE SMILING FACE}") eq "ff.263a"; |
| 90 | print "ok 11\n"; |
| 91 | print "not " unless sprintf("%vx", "\x{ff}\N{WHITE SMILING FACE}") eq "ff.263a"; |
| 92 | print "ok 12\n"; |
| 93 | } |
| 94 | |
| 95 | { |
| 96 | use charnames qw(:full); |
| 97 | use utf8; |
| 98 | |
| 99 | my $x = "\x{221b}"; |
| 100 | my $named = "\N{CUBE ROOT}"; |
| 101 | |
| 102 | print "not " unless ord($x) == ord($named); |
| 103 | print "ok 13\n"; |
| 104 | } |
| 105 | |
| 106 | { |
| 107 | use charnames qw(:full); |
| 108 | use utf8; |
| 109 | print "not " unless "\x{100}\N{CENT SIGN}" eq "\x{100}"."\N{CENT SIGN}"; |
| 110 | print "ok 14\n"; |
| 111 | } |
| 112 | |
| 113 | { |
| 114 | use charnames ':full'; |
| 115 | |
| 116 | print "not " |
| 117 | unless to_bytes("\N{DESERET SMALL LETTER ENG}") eq $encoded_deseng; |
| 118 | print "ok 15\n"; |
| 119 | } |
| 120 | |
| 121 | { |
| 122 | # 20001114.001 |
| 123 | |
| 124 | no utf8; # naked Latin-1 |
| 125 | |
| 126 | if (ord("Ä") == 0xc4) { # Try to do this only on Latin-1. |
| 127 | use charnames ':full'; |
| 128 | my $text = "\N{LATIN CAPITAL LETTER A WITH DIAERESIS}"; |
| 129 | print "not " unless $text eq "\xc4" && ord($text) == 0xc4; |
| 130 | print "ok 16\n"; |
| 131 | } else { |
| 132 | print "ok 16 # Skip: not Latin-1\n"; |
| 133 | } |
| 134 | } |
| 135 | |
| 136 | { |
| 137 | print "not " unless charnames::viacode(0x1234) eq "ETHIOPIC SYLLABLE SEE"; |
| 138 | print "ok 17\n"; |
| 139 | |
| 140 | # Unused Hebrew. |
| 141 | print "not " unless charnames::viacode(0x0590) eq chr(0xFFFD); |
| 142 | print "ok 18\n"; |
| 143 | } |
| 144 | |
| 145 | { |
| 146 | print "not " unless |
| 147 | sprintf "%04X\n", charnames::vianame("GOTHIC LETTER AHSA") eq "10330"; |
| 148 | print "ok 19\n"; |
| 149 | |
| 150 | print "not " if |
| 151 | defined charnames::vianame("NONE SUCH"); |
| 152 | print "ok 20\n"; |
| 153 | } |
| 154 | |
| 155 | { |
| 156 | # check that caching at least hasn't broken anything |
| 157 | |
| 158 | print "not " unless charnames::viacode(0x1234) eq "ETHIOPIC SYLLABLE SEE"; |
| 159 | print "ok 21\n"; |
| 160 | |
| 161 | print "not " unless |
| 162 | sprintf "%04X\n", charnames::vianame("GOTHIC LETTER AHSA") eq "10330"; |
| 163 | print "ok 22\n"; |
| 164 | |
| 165 | } |
| 166 | |
| 167 | print "not " unless "\N{CHARACTER TABULATION}" eq "\t"; |
| 168 | print "ok 23\n"; |
| 169 | |
| 170 | print "not " unless "\N{ESCAPE}" eq "\e"; |
| 171 | print "ok 24\n"; |
| 172 | |
| 173 | print "not " unless "\N{NULL}" eq "\c@"; |
| 174 | print "ok 25\n"; |
| 175 | |
| 176 | print "not " unless "\N{LINE FEED (LF)}" eq "\n"; |
| 177 | print "ok 26\n"; |
| 178 | |
| 179 | print "not " unless "\N{LINE FEED}" eq "\n"; |
| 180 | print "ok 27\n"; |
| 181 | |
| 182 | print "not " unless "\N{LF}" eq "\n"; |
| 183 | print "ok 28\n"; |
| 184 | |
| 185 | my $nel = ord("A") == 193 ? qr/^(?:\x15|\x25)$/ : qr/^\x85$/; |
| 186 | |
| 187 | print "not " unless "\N{NEXT LINE (NEL)}" =~ $nel; |
| 188 | print "ok 29\n"; |
| 189 | |
| 190 | print "not " unless "\N{NEXT LINE}" =~ $nel; |
| 191 | print "ok 30\n"; |
| 192 | |
| 193 | print "not " unless "\N{NEL}" =~ $nel; |
| 194 | print "ok 31\n"; |
| 195 | |
| 196 | print "not " unless "\N{BYTE ORDER MARK}" eq chr(0xFEFF); |
| 197 | print "ok 32\n"; |
| 198 | |
| 199 | print "not " unless "\N{BOM}" eq chr(0xFEFF); |
| 200 | print "ok 33\n"; |
| 201 | |
| 202 | { |
| 203 | use warnings 'deprecated'; |
| 204 | |
| 205 | print "not " unless "\N{HORIZONTAL TABULATION}" eq "\t"; |
| 206 | print "ok 34\n"; |
| 207 | |
| 208 | print "not " unless grep { /"HORIZONTAL TABULATION" is deprecated/ } @WARN; |
| 209 | print "ok 35\n"; |
| 210 | |
| 211 | no warnings 'deprecated'; |
| 212 | |
| 213 | print "not " unless "\N{VERTICAL TABULATION}" eq "\013"; |
| 214 | print "ok 36\n"; |
| 215 | |
| 216 | print "not " if grep { /"VERTICAL TABULATION" is deprecated/ } @WARN; |
| 217 | print "ok 37\n"; |
| 218 | } |
| 219 | |
| 220 | print "not " unless charnames::viacode(0xFEFF) eq "ZERO WIDTH NO-BREAK SPACE"; |
| 221 | print "ok 38\n"; |
| 222 | |
| 223 | { |
| 224 | use warnings; |
| 225 | print "not " unless ord("\N{BOM}") == 0xFEFF; |
| 226 | print "ok 39\n"; |
| 227 | } |
| 228 | |