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