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