ext/PerlIO/t/fallback.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require "../t/test.pl";
   7     skip_all("No perlio") unless (find PerlIO::Layer 'perlio');
   8     plan (8);
   9 }
  10 use Encode qw(:fallback_all);
  11
  12 # $PerlIO::encoding = 0; # WARN_ON_ERR|PERLQQ;
  13
  14 my $file = "fallback$$.txt";
  15
  16 $PerlIO::encoding::fallback = Encode::PERLQQ;
  17
  18 ok(open(my $fh,">encoding(iso-8859-1)",$file),"opened iso-8859-1 file");
  19 my $str = "\x{20AC}";
  20 print $fh $str,"0.02\n";
  21 close($fh);
  22
  23 open($fh,$file) || die "File cannot be re-opened";
  24 my $line = <$fh>;
  25 is($line,"\\x{20ac}0.02\n","perlqq escapes");
  26 close($fh);
  27
  28 $PerlIO::encoding::fallback = Encode::HTMLCREF;
  29
  30 ok(open(my $fh,">encoding(iso-8859-1)",$file),"opened iso-8859-1 file");
  31 my $str = "\x{20AC}";
  32 print $fh $str,"0.02\n";
  33 close($fh);
  34
  35 open($fh,$file) || die "File cannot be re-opened";
  36 my $line = <$fh>;
  37 is($line,"&#8364;0.02\n","HTML escapes");
  38 close($fh);
  39
  40 open($fh,">$file") || die "File cannot be re-opened";
  41 print $fh "£0.02\n";
  42 close($fh);
  43
  44 ok(open($fh,"<encoding(US-ASCII)",$file),"Opened as ASCII");
  45 my $line = <$fh>;
  46 printf "# %x\n",ord($line);
  47 is($line,"\\xA30.02\n","Escaped non-mapped char");
  48 close($fh);
  49
  50 $PerlIO::encoding::fallback = Encode::WARN_ON_ERROR;
  51
  52 ok(open($fh,"<encoding(US-ASCII)",$file),"Opened as ASCII");
  53 my $line = <$fh>;
  54 printf "# %x\n",ord($line);
  55 is($line,"\x{FFFD}0.02\n","Unicode replacement char");
  56 close($fh);
  57
  58 END {
  59     1 while unlink($file);
  60 }
  61
  62
  63