BEGIN { if ($ENV{'PERL_CORE'}){ chdir 't'; unshift @INC, '../lib'; } require Config; import Config; if ($Config{'extensions'} !~ /\bEncode\b/) { print "1..0 # Skip: Encode was not built\n"; exit 0; } if (ord("A") == 193) { print "1..0 # Skip: EBCDIC\n"; exit 0; } $| = 1; } use strict; #use Test::More qw(no_plan); use Test::More tests => 22; use Encode q(:all); my $original = ''; my $nofallback = ''; my ($fallenback, $quiet, $perlqq, $htmlcref, $xmlcref); for my $i (0x20..0x7e){ $original .= chr($i); } $fallenback = $quiet = $perlqq = $htmlcref = $xmlcref = $nofallback = $original; my $residue = ''; for my $i (0x80..0xff){ $original .= chr($i); $residue .= chr($i); $fallenback .= '?'; $perlqq .= sprintf("\\x{%04x}", $i); $htmlcref .= sprintf("&#%d;", $i); $xmlcref .= sprintf("&#x%x;", $i); } utf8::upgrade($original); my $meth = find_encoding('ascii'); my $src = $original; my $dst = $meth->encode($src, FB_DEFAULT); is($dst, $fallenback, "FB_DEFAULT"); is($src, $original, "FB_DEFAULT residue"); $src = $original; eval{ $dst = $meth->encode($src, FB_CROAK) }; like($@, qr/does not map to ascii/o, "FB_CROAK"); is($src, $original, "FB_CROAK residue"); $src = $original; eval{ $dst = $meth->encode($src, FB_CROAK) }; like($@, qr/does not map to ascii/o, "FB_CROAK"); is($src, $original, "FB_CROAK residue"); $src = $nofallback; eval{ $dst = $meth->encode($src, FB_CROAK) }; is($@, '', "FB_CROAK on success"); is($src, '', "FB_CROAK on success residue"); $src = $original; $dst = $meth->encode($src, FB_QUIET); is($dst, $quiet, "FB_QUIET"); is($src, $residue, "FB_QUIET residue"); { my $message; local $SIG{__WARN__} = sub { $message = $_[0] }; $src = $original; $dst = $meth->encode($src, FB_WARN); is($dst, $quiet, "FB_WARN"); is($src, $residue, "FB_WARN residue"); like($message, qr/does not map to ascii/o, "FB_WARN message"); $message = ''; $src = $original; $dst = $meth->encode($src, WARN_ON_ERR); is($dst, $fallenback, "WARN_ON_ERR"); is($src, '', "WARN_ON_ERR residue"); like($message, qr/does not map to ascii/o, "WARN_ON_ERR message"); } $src = $original; $dst = $meth->encode($src, FB_PERLQQ); is($dst, $perlqq, "FB_PERLQQ"); is($src, '', "FB_PERLQQ residue"); $src = $original; $dst = $meth->encode($src, FB_HTMLCREF); is($dst, $htmlcref, "FB_HTMLCREF"); is($src, '', "FB_HTMLCREF residue"); $src = $original; $dst = $meth->encode($src, FB_XMLCREF); is($dst, $xmlcref, "FB_XMLCREF"); is($src, '', "FB_XMLCREF residue");