|
Packit |
d0f5c2 |
BEGIN {
|
|
Packit |
d0f5c2 |
require Config; import Config;
|
|
Packit |
d0f5c2 |
if ($Config{'extensions'} !~ /\bEncode\b/) {
|
|
Packit |
d0f5c2 |
print "1..0 # Skip: Encode was not built\n";
|
|
Packit |
d0f5c2 |
exit 0;
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
unless (find PerlIO::Layer 'perlio') {
|
|
Packit |
d0f5c2 |
print "1..0 # Skip: PerlIO was not built\n";
|
|
Packit |
d0f5c2 |
exit 0;
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
if (ord("A") == 193) {
|
|
Packit |
d0f5c2 |
print "1..0 # Skip: encoding pragma does not support EBCDIC platforms\n";
|
|
Packit |
d0f5c2 |
exit(0);
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
if ($] >= 5.025 and !$Config{usecperl}) {
|
|
Packit |
d0f5c2 |
print "1..0 # Skip: encoding pragma not supported in Perl 5.26\n";
|
|
Packit |
d0f5c2 |
exit(0);
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "1..33\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
no warnings "deprecated";
|
|
Packit |
d0f5c2 |
use encoding "latin1"; # ignored (overwritten by the next line)
|
|
Packit |
d0f5c2 |
use encoding "greek"; # iso 8859-7 (no "latin" alias, surprise...)
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
# "greek" is "ISO 8859-7", and \xDF in ISO 8859-7 is
|
|
Packit |
d0f5c2 |
# \x{3AF} in Unicode (GREEK SMALL LETTER IOTA WITH TONOS),
|
|
Packit |
d0f5c2 |
# instead of \xDF in Unicode (LATIN SMALL LETTER SHARP S)
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$a = "\xDF";
|
|
Packit |
d0f5c2 |
$b = "\x{100}";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless ord($a) == 0x3af;
|
|
Packit |
d0f5c2 |
print "ok 1\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless ord($b) == 0x100;
|
|
Packit |
d0f5c2 |
print "ok 2\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
my $c;
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$c = $a . $b;
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless ord($c) == 0x3af;
|
|
Packit |
d0f5c2 |
print "ok 3\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless length($c) == 2;
|
|
Packit |
d0f5c2 |
print "ok 4\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless ord(substr($c, 1, 1)) == 0x100;
|
|
Packit |
d0f5c2 |
print "ok 5\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless ord(chr(0xdf)) == 0x3af; # spooky
|
|
Packit |
d0f5c2 |
print "ok 6\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless ord(pack("C", 0xdf)) == 0x3af;
|
|
Packit |
d0f5c2 |
print "ok 7\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
# we didn't break pack/unpack, I hope
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless unpack("C", pack("C", 0xdf)) == 0xdf;
|
|
Packit |
d0f5c2 |
print "ok 8\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
# the first octet of UTF-8 encoded 0x3af
|
|
Packit |
d0f5c2 |
print "not " unless unpack("U0 C", chr(0xdf)) == 0xce;
|
|
Packit |
d0f5c2 |
print "ok 9\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless unpack("U", pack("U", 0xdf)) == 0xdf;
|
|
Packit |
d0f5c2 |
print "ok 10\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless unpack("U", chr(0xdf)) == 0x3af;
|
|
Packit |
d0f5c2 |
print "ok 11\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
# charnames must still work
|
|
Packit |
d0f5c2 |
use charnames ':full';
|
|
Packit |
d0f5c2 |
print "not " unless ord("\N{LATIN SMALL LETTER SHARP S}") == 0xdf;
|
|
Packit |
d0f5c2 |
print "ok 12\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
# combine
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$c = "\xDF\N{LATIN SMALL LETTER SHARP S}" . chr(0xdf);
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless ord($c) == 0x3af;
|
|
Packit |
d0f5c2 |
print "ok 13\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless ord(substr($c, 1, 1)) == 0xdf;
|
|
Packit |
d0f5c2 |
print "ok 14\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless ord(substr($c, 2, 1)) == 0x3af;
|
|
Packit |
d0f5c2 |
print "ok 15\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
# regex literals
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless "\xDF" =~ /\x{3AF}/;
|
|
Packit |
d0f5c2 |
print "ok 16\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless "\x{3AF}" =~ /\xDF/;
|
|
Packit |
d0f5c2 |
print "ok 17\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless "\xDF" =~ /\xDF/;
|
|
Packit |
d0f5c2 |
print "ok 18\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless "\x{3AF}" =~ /\x{3AF}/;
|
|
Packit |
d0f5c2 |
print "ok 19\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
# eq, cmp
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
my ($byte,$bytes,$U,$Ub,$g1,$g2,$l) = (
|
|
Packit |
d0f5c2 |
pack("C*", 0xDF ), # byte
|
|
Packit |
d0f5c2 |
pack("C*", 0xDF, 0x20), # ($bytes2 cmp $U) > 0
|
|
Packit |
d0f5c2 |
pack("U*", 0x3AF), # $U eq $byte
|
|
Packit |
d0f5c2 |
pack("U*", 0xDF ), # $Ub would eq $bytev w/o use encoding
|
|
Packit |
d0f5c2 |
pack("U*", 0x3B1), # ($g1 cmp $byte) > 0; === chr(0xe1)
|
|
Packit |
d0f5c2 |
pack("U*", 0x3AF, 0x20), # ($g2 cmp $byte) > 0;
|
|
Packit |
d0f5c2 |
pack("U*", 0x3AB), # ($l cmp $byte) < 0; === chr(0xdb)
|
|
Packit |
d0f5c2 |
);
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
# all the tests in this section that compare a byte encoded string
|
|
Packit |
d0f5c2 |
# ato UTF-8 encoded are run in all possible vairants
|
|
Packit |
d0f5c2 |
# all of the eq, ne, cmp operations tested,
|
|
Packit |
d0f5c2 |
# $v z $u tested as well as $u z $v
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
sub alleq($$){
|
|
Packit |
d0f5c2 |
my ($a,$b) = (shift, shift);
|
|
Packit |
d0f5c2 |
$a eq $b && $b eq $a &&
|
|
Packit |
d0f5c2 |
!( $a ne $b ) && !( $b ne $a ) &&
|
|
Packit |
d0f5c2 |
( $a cmp $b ) == 0 && ( $b cmp $a ) == 0;
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
sub anyeq($$){
|
|
Packit |
d0f5c2 |
my ($a,$b) = (shift, shift);
|
|
Packit |
d0f5c2 |
$a eq $b || $b eq $a ||
|
|
Packit |
d0f5c2 |
!( $a ne $b ) || !( $b ne $a ) ||
|
|
Packit |
d0f5c2 |
( $a cmp $b ) == 0 || ( $b cmp $a ) == 0;
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
sub allgt($$){
|
|
Packit |
d0f5c2 |
my ($a,$b) = (shift, shift);
|
|
Packit |
d0f5c2 |
( $a cmp $b ) == 1 && ( $b cmp $a ) == -1;
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
#match the correct UTF-8 string
|
|
Packit |
d0f5c2 |
print "not " unless alleq($byte, $U);
|
|
Packit |
d0f5c2 |
print "ok 20\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
#do not match a wrong UTF-8 string
|
|
Packit |
d0f5c2 |
print "not " if anyeq($byte, $Ub);
|
|
Packit |
d0f5c2 |
print "ok 21\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
#string ordering
|
|
Packit |
d0f5c2 |
print "not " unless allgt ( $g1, $byte ) &&
|
|
Packit |
d0f5c2 |
allgt ( $g2, $byte ) &&
|
|
Packit |
d0f5c2 |
allgt ( $byte, $l ) &&
|
|
Packit |
d0f5c2 |
allgt ( $bytes, $U );
|
|
Packit |
d0f5c2 |
print "ok 22\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
# upgrade, downgrade
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
my ($u,$v,$v2);
|
|
Packit |
d0f5c2 |
$u = $v = $v2 = pack("C*", 0xDF);
|
|
Packit |
d0f5c2 |
utf8::upgrade($v); #explicit upgrade
|
|
Packit |
d0f5c2 |
$v2 = substr( $v2."\x{410}", 0, -1); #implicit upgrade
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
# implicit upgrade === explicit upgrade
|
|
Packit |
d0f5c2 |
print "not " if do{{use bytes; $v ne $v2}} || $v ne $v2;
|
|
Packit |
d0f5c2 |
print "ok 23\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
# utf8::upgrade is transparent and does not break equality
|
|
Packit |
d0f5c2 |
print "not " unless alleq( $u, $v );
|
|
Packit |
d0f5c2 |
print "ok 24\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$u = $v = pack("C*", 0xDF);
|
|
Packit |
d0f5c2 |
utf8::upgrade($v);
|
|
Packit |
d0f5c2 |
#test for a roundtrip, we should get back from where we left
|
|
Packit |
d0f5c2 |
eval {utf8::downgrade( $v )};
|
|
Packit |
d0f5c2 |
print "not " if $@ !~ /^Wide / || do{{use bytes; $u eq $v}} || $u ne $v;
|
|
Packit |
d0f5c2 |
print "ok 25\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
# some more eq, cmp
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$byte=pack("C*", 0xDF);
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless pack("U*", 0x3AF) eq $byte;
|
|
Packit |
d0f5c2 |
print "ok 26\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " if chr(0xDF) cmp $byte;
|
|
Packit |
d0f5c2 |
print "ok 27\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
print "not " unless ((pack("U*", 0x3B0) cmp $byte) == 1) &&
|
|
Packit |
d0f5c2 |
((pack("U*", 0x3AE) cmp $byte) == -1) &&
|
|
Packit |
d0f5c2 |
((pack("U*", 0x3AF, 0x20) cmp $byte) == 1) &&
|
|
Packit |
d0f5c2 |
((pack("U*", 0x3AF) cmp pack("C*",0xDF,0x20))==-1);
|
|
Packit |
d0f5c2 |
print "ok 28\n";
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
{
|
|
Packit |
d0f5c2 |
# Used to core dump in 5.7.3
|
|
Packit |
d0f5c2 |
no warnings; # so test goes noiselessly
|
|
Packit |
d0f5c2 |
print ord(undef) == 0 ? "ok 29\n" : "not ok 29\n";
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
{
|
|
Packit |
d0f5c2 |
my %h1;
|
|
Packit |
d0f5c2 |
my %h2;
|
|
Packit |
d0f5c2 |
$h1{"\xdf"} = 41;
|
|
Packit |
d0f5c2 |
$h2{"\x{3af}"} = 42;
|
|
Packit |
d0f5c2 |
print $h1{"\x{3af}"} == 41 ? "ok 30\n" : "not ok 30\n";
|
|
Packit |
d0f5c2 |
print $h2{"\xdf"} == 42 ? "ok 31\n" : "not ok 31\n";
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
# Order of finding the above-Latin1 code point should not matter: both should
|
|
Packit |
d0f5c2 |
# assume Latin1/Unicode encoding
|
|
Packit |
d0f5c2 |
{
|
|
Packit |
d0f5c2 |
use bytes;
|
|
Packit |
d0f5c2 |
print "not " if "\xDF\x{100}" =~ /\x{3af}\x{100}/;
|
|
Packit |
d0f5c2 |
print "ok 32\n";
|
|
Packit |
d0f5c2 |
print "not " if "\x{100}\xDF" =~ /\x{100}\x{3af}/;
|
|
Packit |
d0f5c2 |
print "ok 33\n";
|
|
Packit |
d0f5c2 |
}
|