|
Packit |
d0f5c2 |
BEGIN {
|
|
Packit |
d0f5c2 |
if ($ENV{'PERL_CORE'}){
|
|
Packit |
d0f5c2 |
chdir 't';
|
|
Packit |
d0f5c2 |
unshift @INC, '../lib';
|
|
Packit |
d0f5c2 |
}
|
|
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 |
if (ord("A") == 193) {
|
|
Packit |
d0f5c2 |
print "1..0 # Skip: EBCDIC\n";
|
|
Packit |
d0f5c2 |
exit 0;
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
$| = 1;
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
use strict;
|
|
Packit |
d0f5c2 |
#use Test::More qw(no_plan);
|
|
Packit |
d0f5c2 |
use Test::More tests => 58;
|
|
Packit |
d0f5c2 |
use Encode q(:all);
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
my $uo = '';
|
|
Packit |
d0f5c2 |
my $nf = '';
|
|
Packit |
d0f5c2 |
my ($af, $aq, $ap, $ah, $ax, $uf, $uq, $up, $uh, $ux, $ac, $uc);
|
|
Packit |
d0f5c2 |
for my $i (0x20..0x7e){
|
|
Packit |
d0f5c2 |
$uo .= chr($i);
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
$af = $aq = $ap = $ah = $ax = $ac =
|
|
Packit |
d0f5c2 |
$uf = $uq = $up = $uh = $ux = $uc =
|
|
Packit |
d0f5c2 |
$nf = $uo;
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
my $residue = '';
|
|
Packit |
d0f5c2 |
for my $i (0x80..0xff){
|
|
Packit |
d0f5c2 |
$uo .= chr($i);
|
|
Packit |
d0f5c2 |
$residue .= chr($i);
|
|
Packit |
d0f5c2 |
$af .= '?';
|
|
Packit |
d0f5c2 |
$uf .= "\x{FFFD}";
|
|
Packit |
d0f5c2 |
$ap .= sprintf("\\x{%04x}", $i);
|
|
Packit |
d0f5c2 |
$up .= sprintf("\\x%02X", $i);
|
|
Packit |
d0f5c2 |
$ah .= sprintf("&#%d;", $i);
|
|
Packit |
d0f5c2 |
$uh .= sprintf("\\x%02X", $i);
|
|
Packit |
d0f5c2 |
$ax .= sprintf("&#x%x;", $i);
|
|
Packit |
d0f5c2 |
$ux .= sprintf("\\x%02X", $i);
|
|
Packit |
d0f5c2 |
$ac .= sprintf("<U+%04X>", $i);
|
|
Packit |
d0f5c2 |
$uc .= sprintf("[%02X]", $i);
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
my $ao = $uo;
|
|
Packit |
d0f5c2 |
utf8::upgrade($uo);
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
my $ascii = find_encoding('ascii');
|
|
Packit |
d0f5c2 |
my $latin1 = find_encoding('latin1');
|
|
Packit |
d0f5c2 |
my $utf8 = find_encoding('utf8');
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
my $src = $uo;
|
|
Packit |
d0f5c2 |
my $dst = $ascii->encode($src, FB_DEFAULT);
|
|
Packit |
d0f5c2 |
is($dst, $af, "FB_DEFAULT ascii");
|
|
Packit |
d0f5c2 |
is($src, $uo, "FB_DEFAULT residue ascii");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = $ao;
|
|
Packit |
d0f5c2 |
$dst = $utf8->decode($src, FB_DEFAULT);
|
|
Packit |
d0f5c2 |
is($dst, $uf, "FB_DEFAULT utf8");
|
|
Packit |
d0f5c2 |
is($src, $ao, "FB_DEFAULT residue utf8");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = $uo;
|
|
Packit |
d0f5c2 |
eval{ $dst = $ascii->encode($src, FB_CROAK) };
|
|
Packit |
d0f5c2 |
like($@, qr/does not map to ascii/o, "FB_CROAK ascii");
|
|
Packit |
d0f5c2 |
is($src, $uo, "FB_CROAK residue ascii");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = $ao;
|
|
Packit |
d0f5c2 |
eval{ $dst = $utf8->decode($src, FB_CROAK) };
|
|
Packit |
d0f5c2 |
like($@, qr/does not map to Unicode/o, "FB_CROAK utf8");
|
|
Packit |
d0f5c2 |
is($src, $ao, "FB_CROAK residue utf8");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = $nf;
|
|
Packit |
d0f5c2 |
eval{ $dst = $ascii->encode($src, FB_CROAK) };
|
|
Packit |
d0f5c2 |
is($@, '', "FB_CROAK on success ascii");
|
|
Packit |
d0f5c2 |
is($src, '', "FB_CROAK on success residue ascii");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = $nf;
|
|
Packit |
d0f5c2 |
eval{ $dst = $utf8->decode($src, FB_CROAK) };
|
|
Packit |
d0f5c2 |
is($@, '', "FB_CROAK on success utf8");
|
|
Packit |
d0f5c2 |
is($src, '', "FB_CROAK on success residue utf8");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = $uo;
|
|
Packit |
d0f5c2 |
$dst = $ascii->encode($src, FB_QUIET);
|
|
Packit |
d0f5c2 |
is($dst, $aq, "FB_QUIET ascii");
|
|
Packit |
d0f5c2 |
is($src, $residue, "FB_QUIET residue ascii");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = $ao;
|
|
Packit |
d0f5c2 |
$dst = $utf8->decode($src, FB_QUIET);
|
|
Packit |
d0f5c2 |
is($dst, $uq, "FB_QUIET utf8");
|
|
Packit |
d0f5c2 |
is($src, $residue, "FB_QUIET residue utf8");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
{
|
|
Packit |
d0f5c2 |
my $message = '';
|
|
Packit |
d0f5c2 |
local $SIG{__WARN__} = sub { $message = $_[0] };
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = $uo;
|
|
Packit |
d0f5c2 |
$dst = $ascii->encode($src, FB_WARN);
|
|
Packit |
d0f5c2 |
is($dst, $aq, "FB_WARN ascii");
|
|
Packit |
d0f5c2 |
is($src, $residue, "FB_WARN residue ascii");
|
|
Packit |
d0f5c2 |
like($message, qr/does not map to ascii/o, "FB_WARN message ascii");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$message = '';
|
|
Packit |
d0f5c2 |
$src = $ao;
|
|
Packit |
d0f5c2 |
$dst = $utf8->decode($src, FB_WARN);
|
|
Packit |
d0f5c2 |
is($dst, $uq, "FB_WARN utf8");
|
|
Packit |
d0f5c2 |
is($src, $residue, "FB_WARN residue utf8");
|
|
Packit |
d0f5c2 |
like($message, qr/does not map to Unicode/o, "FB_WARN message utf8");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$message = '';
|
|
Packit |
d0f5c2 |
$src = $uo;
|
|
Packit |
d0f5c2 |
$dst = $ascii->encode($src, WARN_ON_ERR);
|
|
Packit |
d0f5c2 |
is($dst, $af, "WARN_ON_ERR ascii");
|
|
Packit |
d0f5c2 |
is($src, '', "WARN_ON_ERR residue ascii");
|
|
Packit |
d0f5c2 |
like($message, qr/does not map to ascii/o, "WARN_ON_ERR message ascii");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$message = '';
|
|
Packit |
d0f5c2 |
$src = $ao;
|
|
Packit |
d0f5c2 |
$dst = $utf8->decode($src, WARN_ON_ERR);
|
|
Packit |
d0f5c2 |
is($dst, $uf, "WARN_ON_ERR utf8");
|
|
Packit |
d0f5c2 |
is($src, '', "WARN_ON_ERR residue utf8");
|
|
Packit |
d0f5c2 |
like($message, qr/does not map to Unicode/o, "WARN_ON_ERR message ascii");
|
|
Packit |
d0f5c2 |
}
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = $uo;
|
|
Packit |
d0f5c2 |
$dst = $ascii->encode($src, FB_PERLQQ);
|
|
Packit |
d0f5c2 |
is($dst, $ap, "FB_PERLQQ encode");
|
|
Packit |
d0f5c2 |
is($src, $uo, "FB_PERLQQ residue encode");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = $ao;
|
|
Packit |
d0f5c2 |
$dst = $ascii->decode($src, FB_PERLQQ);
|
|
Packit |
d0f5c2 |
is($dst, $up, "FB_PERLQQ decode");
|
|
Packit |
d0f5c2 |
is($src, $ao, "FB_PERLQQ residue decode");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = $uo;
|
|
Packit |
d0f5c2 |
$dst = $ascii->encode($src, FB_HTMLCREF);
|
|
Packit |
d0f5c2 |
is($dst, $ah, "FB_HTMLCREF encode");
|
|
Packit |
d0f5c2 |
is($src, $uo, "FB_HTMLCREF residue encode");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = $ao;
|
|
Packit |
d0f5c2 |
$dst = $ascii->decode($src, FB_HTMLCREF);
|
|
Packit |
d0f5c2 |
is($dst, $uh, "FB_HTMLCREF decode");
|
|
Packit |
d0f5c2 |
is($src, $ao, "FB_HTMLCREF residue decode");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = $uo;
|
|
Packit |
d0f5c2 |
$dst = $ascii->encode($src, FB_XMLCREF);
|
|
Packit |
d0f5c2 |
is($dst, $ax, "FB_XMLCREF encode");
|
|
Packit |
d0f5c2 |
is($src, $uo, "FB_XMLCREF residue encode");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = $ao;
|
|
Packit |
d0f5c2 |
$dst = $ascii->decode($src, FB_XMLCREF);
|
|
Packit |
d0f5c2 |
is($dst, $ux, "FB_XMLCREF decode");
|
|
Packit |
d0f5c2 |
is($src, $ao, "FB_XMLCREF residue decode");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = $uo;
|
|
Packit |
d0f5c2 |
$dst = $ascii->encode($src, sub{ sprintf "<U+%04X>", shift });
|
|
Packit |
d0f5c2 |
is($dst, $ac, "coderef encode");
|
|
Packit |
d0f5c2 |
is($src, $uo, "coderef residue encode");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = $ao;
|
|
Packit |
d0f5c2 |
$dst = $ascii->decode($src, sub{ sprintf "[%02X]", shift });
|
|
Packit |
d0f5c2 |
is($dst, $uc, "coderef decode");
|
|
Packit |
d0f5c2 |
is($src, $ao, "coderef residue decode");
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = "\x{3000}";
|
|
Packit |
d0f5c2 |
$dst = $ascii->encode($src, sub{ $_[0] });
|
|
Packit |
d0f5c2 |
is $dst, 0x3000."", q{$ascii->encode($src, sub{ $_[0] } )};
|
|
Packit |
d0f5c2 |
$dst = encode("ascii", "\x{3000}", sub{ $_[0] });
|
|
Packit |
d0f5c2 |
is $dst, 0x3000."", q{encode("ascii", "\x{3000}", sub{ $_[0] })};
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = pack "C*", 0xFF;
|
|
Packit |
d0f5c2 |
$dst = $ascii->decode($src, sub{ $_[0] });
|
|
Packit |
d0f5c2 |
is $dst, 0xFF."", q{$ascii->encode($src, sub{ $_[0] } )};
|
|
Packit |
d0f5c2 |
$dst = decode("ascii", (pack "C*", 0xFF), sub{ $_[0] });
|
|
Packit |
d0f5c2 |
is $dst, 0xFF."", q{decode("ascii", (pack "C*", 0xFF), sub{ $_[0] })};
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = pack "C*", 0x80;
|
|
Packit |
d0f5c2 |
$dst = $utf8->decode($src, sub{ $_[0] });
|
|
Packit |
d0f5c2 |
is $dst, 0x80."", q{$utf8->encode($src, sub{ $_[0] } )};
|
|
Packit |
d0f5c2 |
$dst = decode("utf8", $src, sub{ $_[0] });
|
|
Packit |
d0f5c2 |
is $dst, 0x80."", q{decode("utf8", (pack "C*", 0x80), sub{ $_[0] })};
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = "\x{3000}";
|
|
Packit |
d0f5c2 |
$dst = $latin1->encode($src, sub { "\N{U+FF}" });
|
|
Packit |
d0f5c2 |
is $dst, "\x{ff}", q{$latin1->encode($src, sub { "\N{U+FF}" })};
|
|
Packit |
d0f5c2 |
$dst = encode("latin1", $src, sub { "\N{U+FF}" });
|
|
Packit |
d0f5c2 |
is $dst, "\x{ff}", q{encode("latin1", $src, sub { "\N{U+FF}" })};
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = "\x{3000}";
|
|
Packit |
d0f5c2 |
$dst = $latin1->encode($src, sub { utf8::upgrade(my $r = "\x{ff}"); $r });
|
|
Packit |
d0f5c2 |
is $dst, "\x{ff}", q{$latin1->encode($src, sub { utf8::upgrade(my $r = "\x{ff}"); $r })};
|
|
Packit |
d0f5c2 |
$dst = encode("latin1", $src, sub { utf8::upgrade(my $r = "\x{ff}"); $r });
|
|
Packit |
d0f5c2 |
is $dst, "\x{ff}", q{encode("latin1", $src, sub { utf8::upgrade(my $r = "\x{ff}"); $r })};
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
$src = "\x{ff}";
|
|
Packit |
d0f5c2 |
$dst = $utf8->decode($src, sub { chr($_[0]) });
|
|
Packit |
d0f5c2 |
is $dst, "\x{ff}", q{$utf8->decode($src, sub { chr($_[0]) })};
|
|
Packit |
d0f5c2 |
$dst = decode("utf8", $src, sub { chr($_[0]) });
|
|
Packit |
d0f5c2 |
is $dst, "\x{ff}", q{decode("utf8", $src, sub { chr($_[0]) })};
|
|
Packit |
d0f5c2 |
|
|
Packit |
d0f5c2 |
{
|
|
Packit |
d0f5c2 |
use charnames ':full';
|
|
Packit |
d0f5c2 |
$src = "\x{ff}";
|
|
Packit |
d0f5c2 |
$dst = $utf8->decode($src, sub { utf8::downgrade(my $r = "\N{LATIN SMALL LETTER Y WITH DIAERESIS}"); $r });
|
|
Packit |
d0f5c2 |
is $dst, "\N{LATIN SMALL LETTER Y WITH DIAERESIS}", q{$utf8->decode($src, sub { utf8::downgrade(my $r = "\N{LATIN SMALL LETTER Y WITH DIAERESIS}"); $r })};
|
|
Packit |
d0f5c2 |
$dst = decode("utf8", $src, sub { utf8::downgrade(my $r = "\N{LATIN SMALL LETTER Y WITH DIAERESIS}"); $r });
|
|
Packit |
d0f5c2 |
is $dst, "\N{LATIN SMALL LETTER Y WITH DIAERESIS}", q{decode("utf8", $src, sub { utf8::downgrade(my $r = "\N{LATIN SMALL LETTER Y WITH DIAERESIS}"); $r })};
|
|
Packit |
d0f5c2 |
}
|