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