lib/encoding.t

   1 BEGIN {
   2     if (ord("A") == 193) {
   3         print "1..0 # encoding pragma does not support EBCDIC platforms\n";
   4         exit(0);
   5     }
   6 }
   7
   8 print "1..23\n";
   9
  10 use encoding "latin1"; # ignored (overwritten by the next line)
  11 use encoding "greek";  # iso 8859-7 (no "latin" alias, surprise...)
  12
  13 # "greek" is "ISO 8859-7", and \xDF in ISO 8859-7 is
  14 # \x{3AF} in Unicode (GREEK SMALL LETTER IOTA WITH TONOS),
  15 # instead of \xDF in Unicode (LATIN SMALL LETTER SHARP S)
  16
  17 $a = "\xDF";
  18 $b = "\x{100}";
  19
  20 print "not " unless ord($a) == 0x3af;
  21 print "ok 1\n";
  22
  23 print "not " unless ord($b) == 0x100;
  24 print "ok 2\n";
  25
  26 my $c;
  27
  28 $c = $a . $b;
  29
  30 print "not " unless ord($c) == 0x3af;
  31 print "ok 3\n";
  32
  33 print "not " unless length($c) == 2;
  34 print "ok 4\n";
  35
  36 print "not " unless ord(substr($c, 1, 1)) == 0x100;
  37 print "ok 5\n";
  38
  39 print "not " unless ord(chr(0xdf)) == 0x3af; # spooky
  40 print "ok 6\n";
  41
  42 print "not " unless ord(pack("C", 0xdf)) == 0x3af;
  43 print "ok 7\n";
  44
  45 # we didn't break pack/unpack, I hope
  46
  47 print "not " unless unpack("C", pack("C", 0xdf)) == 0xdf;
  48 print "ok 8\n";
  49
  50 # the first octet of UTF-8 encoded 0x3af
  51 print "not " unless unpack("C", chr(0xdf)) == 0xce;
  52 print "ok 9\n";
  53
  54 print "not " unless unpack("U", pack("U", 0xdf)) == 0xdf;
  55 print "ok 10\n";
  56
  57 print "not " unless unpack("U", chr(0xdf)) == 0x3af;
  58 print "ok 11\n";
  59
  60 # charnames must still work
  61 use charnames ':full';
  62 print "not " unless ord("\N{LATIN SMALL LETTER SHARP S}") == 0xdf;
  63 print "ok 12\n";
  64
  65 # combine
  66
  67 $c = "\xDF\N{LATIN SMALL LETTER SHARP S}" . chr(0xdf);
  68
  69 print "not " unless ord($c) == 0x3af;
  70 print "ok 13\n";
  71
  72 print "not " unless ord(substr($c, 1, 1)) == 0xdf;
  73 print "ok 14\n";
  74
  75 print "not " unless ord(substr($c, 2, 1)) == 0x3af;
  76 print "ok 15\n";
  77
  78 # regex literals
  79
  80 print "not " unless "\xDF"    =~ /\x{3AF}/;
  81 print "ok 16\n";
  82
  83 print "not " unless "\x{3AF}" =~ /\xDF/;
  84 print "ok 17\n";
  85
  86 print "not " unless "\xDF"    =~ /\xDF/;
  87 print "ok 18\n";
  88
  89 print "not " unless "\x{3AF}" =~ /\x{3AF}/;
  90 print "ok 19\n";
  91
  92 # eq, cmp
  93
  94 my $byte=pack("C*", 0xDF);
  95
  96 print "not " unless pack("U*", 0x3AF) eq $byte;
  97 print "ok 20\n";
  98
  99 print "not " if chr(0xDF) cmp $byte;
 100 print "ok 21\n";
 101
 102 print "not " unless ((pack("U*", 0x3B0)       cmp $byte) ==  1) &&
 103                     ((pack("U*", 0x3AE)       cmp $byte) == -1) &&
 104                     ((pack("U*", 0x3AF, 0x20) cmp $byte) ==  1) &&
 105                     ((pack("U*", 0x3AF) cmp pack("C*",0xDF,0x20))==-1);
 106 print "ok 22\n";
 107
 108 # Used to core dump in 5.7.3
 109 print ord undef == 0 ? "ok 23\n" : "not ok 23\n";