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