ext/Encode/t/enc_utf8.t

   1 # $Id: enc_utf8.t,v 1.2 2003/01/22 03:29:07 dankogai Exp $
   2 # This is the twin of enc_eucjp.t, the only difference is that
   3 # this has "use encoding 'utf8'".
   4
   5 BEGIN {
   6 #     if ($] <= 5.008){
   7 #       print "1..0 # Skip: Perl 5.8.1 or later required\n";
   8 #       exit 0;
   9 #     }
  10     require Config; import Config;
  11     if ($Config{'extensions'} !~ /\bEncode\b/) {
  12       print "1..0 # Skip: Encode was not built\n";
  13       exit 0;
  14     }
  15     unless (find PerlIO::Layer 'perlio') {
  16         print "1..0 # Skip: PerlIO was not built\n";
  17         exit 0;
  18     }
  19     if (ord("A") == 193) {
  20         print "1..0 # encoding pragma does not support EBCDIC platforms\n";
  21         exit(0);
  22     }
  23 }
  24
  25 use encoding 'utf8';
  26
  27 my @c = (127, 128, 255, 256);
  28
  29 print "1.." . (scalar @c + 1) . "\n";
  30
  31 my @f;
  32
  33 for my $i (0..$#c) {
  34   push @f, "f$i";
  35   open(F, ">f$i") or die "$0: failed to open 'f$i' for writing: $!";
  36   binmode(F, ":utf8");
  37   print F chr($c[$i]);
  38   close F;
  39 }
  40
  41 my $t = 1;
  42
  43 for my $i (0..$#c) {
  44   open(F, "<f$i") or die "$0: failed to open 'f$i' for reading: $!";
  45   binmode(F, ":utf8");
  46   my $c = <F>;
  47   my $o = ord($c);
  48   print $o == $c[$i] ? "ok $t - utf8 I/O $c[$i]\n" : "not ok $t - utf8 I/O $c[$i]: $o != $c[$i]\n";
  49   $t++;
  50 }
  51
  52 my $f = "f" . @f;
  53
  54 push @f, $f;
  55 open(F, ">$f") or die "$0: failed to open '$f' for writing: $!";
  56 binmode(F, ":raw"); # Output raw bytes.
  57 print F chr(128); # Output illegal UTF-8.
  58 close F;
  59 open(F, $f) or die "$0: failed to open '$f' for reading: $!";
  60 binmode(F, ":encoding(utf-8)");
  61 {
  62         local $^W = 1;
  63         local $SIG{__WARN__} = sub { $a = shift };
  64         eval { <F> }; # This should get caught.
  65 }
  66 print $a =~ qr{^utf8 "\\x80" does not map to Unicode} ?
  67   "ok $t - illegal utf8 input\n" : "not ok $t - illegal utf8 input: a = " . unpack("H*", $a) . "\n";
  68
  69 END {
  70   1 while unlink @f;
  71 }