2 require Config; import Config;
3 if ($Config{'extensions'} !~ /\bEncode\b/) {
4 print "1..0 # Skip: Encode was not built\n";
8 print "1..0 # encoding pragma does not support EBCDIC platforms\n";
15 use encoding "latin1"; # ignored (overwritten by the next line)
16 use encoding "greek"; # iso 8859-7 (no "latin" alias, surprise...)
18 # "greek" is "ISO 8859-7", and \xDF in ISO 8859-7 is
19 # \x{3AF} in Unicode (GREEK SMALL LETTER IOTA WITH TONOS),
20 # instead of \xDF in Unicode (LATIN SMALL LETTER SHARP S)
25 print "not " unless ord($a) == 0x3af;
28 print "not " unless ord($b) == 0x100;
35 print "not " unless ord($c) == 0x3af;
38 print "not " unless length($c) == 2;
41 print "not " unless ord(substr($c, 1, 1)) == 0x100;
44 print "not " unless ord(chr(0xdf)) == 0x3af; # spooky
47 print "not " unless ord(pack("C", 0xdf)) == 0x3af;
50 # we didn't break pack/unpack, I hope
52 print "not " unless unpack("C", pack("C", 0xdf)) == 0xdf;
55 # the first octet of UTF-8 encoded 0x3af
56 print "not " unless unpack("C", chr(0xdf)) == 0xce;
59 print "not " unless unpack("U", pack("U", 0xdf)) == 0xdf;
62 print "not " unless unpack("U", chr(0xdf)) == 0x3af;
65 # charnames must still work
66 use charnames ':full';
67 print "not " unless ord("\N{LATIN SMALL LETTER SHARP S}") == 0xdf;
72 $c = "\xDF\N{LATIN SMALL LETTER SHARP S}" . chr(0xdf);
74 print "not " unless ord($c) == 0x3af;
77 print "not " unless ord(substr($c, 1, 1)) == 0xdf;
80 print "not " unless ord(substr($c, 2, 1)) == 0x3af;
85 print "not " unless "\xDF" =~ /\x{3AF}/;
88 print "not " unless "\x{3AF}" =~ /\xDF/;
91 print "not " unless "\xDF" =~ /\xDF/;
94 print "not " unless "\x{3AF}" =~ /\x{3AF}/;
99 my ($byte,$bytes,$U,$Ub,$g1,$g2,$l) = (
100 pack("C*", 0xDF ), # byte
101 pack("C*", 0xDF, 0x20), # ($bytes2 cmp $U) > 0
102 pack("U*", 0x3AF), # $U eq $byte
103 pack("U*", 0xDF ), # $Ub would eq $bytev w/o use encoding
104 pack("U*", 0x3B1), # ($g1 cmp $byte) > 0; === chr(0xe1)
105 pack("U*", 0x3AF, 0x20), # ($g2 cmp $byte) > 0;
106 pack("U*", 0x3AB), # ($l cmp $byte) < 0; === chr(0xdb)
109 # all the tests in this section that compare a byte encoded string
110 # ato UTF-8 encoded are run in all possible vairants
111 # all of the eq, ne, cmp operations tested,
112 # $v z $u tested as well as $u z $v
115 my ($a,$b) = (shift, shift);
116 $a eq $b && $b eq $a &&
117 !( $a ne $b ) && !( $b ne $a ) &&
118 ( $a cmp $b ) == 0 && ( $b cmp $a ) == 0;
122 my ($a,$b) = (shift, shift);
123 $a eq $b || $b eq $a ||
124 !( $a ne $b ) || !( $b ne $a ) ||
125 ( $a cmp $b ) == 0 || ( $b cmp $a ) == 0;
129 my ($a,$b) = (shift, shift);
130 ( $a cmp $b ) == 1 && ( $b cmp $a ) == -1;
132 #match the correct UTF-8 string
133 print "not " unless alleq($byte, $U);
136 #do not match a wrong UTF-8 string
137 print "not " if anyeq($byte, $Ub);
141 print "not " unless allgt ( $g1, $byte ) &&
142 allgt ( $g2, $byte ) &&
143 allgt ( $byte, $l ) &&
144 allgt ( $bytes, $U );
150 $u = $v = $v2 = pack("C*", 0xDF);
151 utf8::upgrade($v); #explicit upgrade
152 $v2 = substr( $v2."\x{410}", 0, -1); #implicit upgrade
154 # implicit upgrade === explicit upgrade
155 print "not " if do{{use bytes; $v ne $v2}} || $v ne $v2;
158 # utf8::upgrade is transparent and does not break equality
159 print "not " unless alleq( $u, $v );
162 $u = $v = pack("C*", 0xDF);
164 #test for a roundtrip, we should get back from where we left
165 eval {utf8::downgrade( $v )};
166 print "not " if $@ !~ /^Wide / || do{{use bytes; $u eq $v}} || $u ne $v;
171 my $byte=pack("C*", 0xDF);
173 print "not " unless pack("U*", 0x3AF) eq $byte;
176 print "not " if chr(0xDF) cmp $byte;
179 print "not " unless ((pack("U*", 0x3B0) cmp $byte) == 1) &&
180 ((pack("U*", 0x3AE) cmp $byte) == -1) &&
181 ((pack("U*", 0x3AF, 0x20) cmp $byte) == 1) &&
182 ((pack("U*", 0x3AF) cmp pack("C*",0xDF,0x20))==-1);
185 # Used to core dump in 5.7.3
186 print ord undef == 0 ? "ok 29\n" : "not ok 29\n";