1#!./perl 2 3BEGIN { 4 skip_all("No perlio") unless (find PerlIO::Layer 'perlio'); 5 if (ord("A") == 193) { 6 print "1..0 # Skip: EBCDIC\n"; 7 exit 0; 8 } 9 unless( eval { require Encode } ) { 10 print "1..0 # Skip: No Encode\n"; 11 exit 0; 12 } 13 use Test::More tests => 9; 14 import Encode qw(:fallback_all); 15} 16 17# $PerlIO::encoding = 0; # WARN_ON_ERR|PERLQQ; 18 19my $file = "fallback$$.txt"; 20 21{ 22 my $message = ''; 23 local $SIG{__WARN__} = sub { $message = $_[0] }; 24 $PerlIO::encoding::fallback = Encode::PERLQQ; 25 ok(open(my $fh,">encoding(iso-8859-1)",$file),"opened iso-8859-1 file"); 26 my $str = "\x{20AC}"; 27 print $fh $str,"0.02\n"; 28 close($fh); 29 like($message, qr/does not map to iso-8859-1/o, "FB_WARN message"); 30} 31 32open($fh,$file) || die "File cannot be re-opened"; 33my $line = <$fh>; 34is($line,"\\x{20ac}0.02\n","perlqq escapes"); 35close($fh); 36 37$PerlIO::encoding::fallback = Encode::HTMLCREF; 38 39ok(open(my $fh,">encoding(iso-8859-1)",$file),"opened iso-8859-1 file"); 40my $str = "\x{20AC}"; 41print $fh $str,"0.02\n"; 42close($fh); 43 44open($fh,$file) || die "File cannot be re-opened"; 45my $line = <$fh>; 46is($line,"€0.02\n","HTML escapes"); 47close($fh); 48 49{ 50 no utf8; 51 open($fh,">$file") || die "File cannot be re-opened"; 52 binmode($fh); 53 print $fh "\xA30.02\n"; 54 close($fh); 55} 56 57ok(open($fh,"<encoding(US-ASCII)",$file),"Opened as ASCII"); 58my $line = <$fh>; 59printf "# %x\n",ord($line); 60is($line,"\\xA30.02\n","Escaped non-mapped char"); 61close($fh); 62 63$PerlIO::encoding::fallback = Encode::WARN_ON_ERROR; 64 65ok(open($fh,"<encoding(US-ASCII)",$file),"Opened as ASCII"); 66my $line = <$fh>; 67printf "# %x\n",ord($line); 68is($line,"\x{FFFD}0.02\n","Unicode replacement char"); 69close($fh); 70 71END { 72 1 while unlink($file); 73} 74