lib/charnames.t

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