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