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