ext/Encode/t/fallback.t

   1 BEGIN {
   2     if ($ENV{'PERL_CORE'}){
   3         chdir 't';
   4         unshift @INC, '../lib';
   5     }
   6     require Config; import Config;
   7     if ($Config{'extensions'} !~ /\bEncode\b/) {
   8       print "1..0 # Skip: Encode was not built\n";
   9       exit 0;
  10     }
  11     if (ord("A") == 193) {
  12         print "1..0 # Skip: EBCDIC\n";
  13         exit 0;
  14     }
  15     $| = 1;
  16 }
  17
  18 use strict;
  19 #use Test::More qw(no_plan);
  20 use Test::More tests => 22;
  21 use Encode q(:all);
  22
  23 my $original = '';
  24 my $nofallback  = '';
  25 my ($fallenback, $quiet, $perlqq, $htmlcref, $xmlcref);
  26 for my $i (0x20..0x7e){
  27     $original .= chr($i);
  28 }
  29 $fallenback = $quiet =
  30 $perlqq = $htmlcref = $xmlcref = $nofallback = $original;
  31
  32 my $residue = '';
  33 for my $i (0x80..0xff){
  34     $original   .= chr($i);
  35     $residue    .= chr($i);
  36     $fallenback .= '?';
  37     $perlqq     .= sprintf("\\x{%04x}", $i);
  38     $htmlcref    .= sprintf("&#%d;", $i);
  39     $xmlcref    .= sprintf("&#x%x;", $i);
  40 }
  41 utf8::upgrade($original);
  42 my $meth   = find_encoding('ascii');
  43
  44 my $src = $original;
  45 my $dst = $meth->encode($src, FB_DEFAULT);
  46 is($dst, $fallenback, "FB_DEFAULT");
  47 is($src, $original,   "FB_DEFAULT residue");
  48
  49 $src = $original;
  50 eval{ $dst = $meth->encode($src, FB_CROAK) };
  51 like($@, qr/does not map to ascii/o, "FB_CROAK");
  52 is($src, $original, "FB_CROAK residue");
  53
  54 $src = $original;
  55 eval{ $dst = $meth->encode($src, FB_CROAK) };
  56 like($@, qr/does not map to ascii/o, "FB_CROAK");
  57 is($src, $original, "FB_CROAK residue");
  58
  59
  60 $src = $nofallback;
  61 eval{ $dst = $meth->encode($src, FB_CROAK) };
  62 is($@, '', "FB_CROAK on success");
  63 is($src, '', "FB_CROAK on success residue");
  64
  65 $src = $original;
  66 $dst = $meth->encode($src, FB_QUIET);
  67 is($dst, $quiet,   "FB_QUIET");
  68 is($src, $residue, "FB_QUIET residue");
  69
  70 {
  71     my $message;
  72     local $SIG{__WARN__} = sub { $message = $_[0] };
  73     $src = $original;
  74     $dst = $meth->encode($src, FB_WARN);
  75     is($dst, $quiet,   "FB_WARN");
  76     is($src, $residue, "FB_WARN residue");
  77     like($message, qr/does not map to ascii/o, "FB_WARN message");
  78
  79     $message = '';
  80
  81     $src = $original;
  82     $dst = $meth->encode($src, WARN_ON_ERR);
  83
  84     is($dst, $fallenback, "WARN_ON_ERR");
  85     is($src, '',  "WARN_ON_ERR residue");
  86     like($message, qr/does not map to ascii/o, "WARN_ON_ERR message");
  87 }
  88
  89 $src = $original;
  90 $dst = $meth->encode($src, FB_PERLQQ);
  91 is($dst, $perlqq,   "FB_PERLQQ");
  92 is($src, '', "FB_PERLQQ residue");
  93
  94 $src = $original;
  95 $dst = $meth->encode($src, FB_HTMLCREF);
  96 is($dst, $htmlcref,   "FB_HTMLCREF");
  97 is($src, '', "FB_HTMLCREF residue");
  98
  99 $src = $original;
 100 $dst = $meth->encode($src, FB_XMLCREF);
 101 is($dst, $xmlcref,   "FB_XMLCREF");
 102 is($src, '', "FB_XMLCREF residue");