Blame t/enc_utf8.t

Packit d0f5c2
# $Id: enc_utf8.t,v 2.5 2017/06/10 17:23:50 dankogai Exp $
Packit d0f5c2
# This is the twin of enc_eucjp.t .
Packit d0f5c2
Packit d0f5c2
BEGIN {
Packit d0f5c2
    require Config; import Config;
Packit d0f5c2
    if ($Config{'extensions'} !~ /\bEncode\b/) {
Packit d0f5c2
      print "1..0 # Skip: Encode was not built\n";
Packit d0f5c2
      exit 0;
Packit d0f5c2
    }
Packit d0f5c2
    unless (find PerlIO::Layer 'perlio') {
Packit d0f5c2
    print "1..0 # Skip: PerlIO was not built\n";
Packit d0f5c2
    exit 0;
Packit d0f5c2
    }
Packit d0f5c2
    if (ord("A") == 193) {
Packit d0f5c2
    print "1..0 # encoding pragma does not support EBCDIC platforms\n";
Packit d0f5c2
    exit(0);
Packit d0f5c2
    }
Packit d0f5c2
    if ($] >= 5.025003 and !$Config{usecperl}){
Packit d0f5c2
    print "1..0 # Skip: Perl <=5.25.2 or cperl required\n";
Packit d0f5c2
    exit 0;
Packit d0f5c2
    }
Packit d0f5c2
}
Packit d0f5c2
Packit d0f5c2
no warnings "deprecated";
Packit d0f5c2
use encoding 'utf8';
Packit d0f5c2
Packit d0f5c2
my @c = (127, 128, 255, 256);
Packit d0f5c2
Packit d0f5c2
print "1.." . (scalar @c + 2) . "\n";
Packit d0f5c2
Packit d0f5c2
my @f;
Packit d0f5c2
Packit d0f5c2
for my $i (0..$#c) {
Packit d0f5c2
  my $file = filename("f$i");
Packit d0f5c2
  push @f, $file;
Packit d0f5c2
  open(F, ">$file") or die "$0: failed to open '$file' for writing: $!";
Packit d0f5c2
  binmode(F, ":utf8");
Packit d0f5c2
  print F chr($c[$i]);
Packit d0f5c2
  close F;
Packit d0f5c2
}
Packit d0f5c2
Packit d0f5c2
my $t = 1;
Packit d0f5c2
Packit d0f5c2
for my $i (0..$#c) {
Packit d0f5c2
  my $file = filename("f$i");
Packit d0f5c2
  open(F, "<$file") or die "$0: failed to open '$file' for reading: $!";
Packit d0f5c2
  binmode(F, ":utf8");
Packit d0f5c2
  my $c = <F>;
Packit d0f5c2
  my $o = ord($c);
Packit d0f5c2
  print $o == $c[$i] ? "ok $t - utf8 I/O $c[$i]\n" : "not ok $t - utf8 I/O $c[$i]: $o != $c[$i]\n";
Packit d0f5c2
  $t++;
Packit d0f5c2
}
Packit d0f5c2
Packit d0f5c2
my $f = filename("f" . @f);
Packit d0f5c2
Packit d0f5c2
push @f, $f;
Packit d0f5c2
open(F, ">$f") or die "$0: failed to open '$f' for writing: $!";
Packit d0f5c2
binmode(F, ":raw"); # Output raw bytes.
Packit d0f5c2
print F chr(128); # Output illegal UTF-8.
Packit d0f5c2
close F;
Packit d0f5c2
open(F, $f) or die "$0: failed to open '$f' for reading: $!";
Packit d0f5c2
binmode(F, ":encoding(UTF-8)");
Packit d0f5c2
{
Packit d0f5c2
    local $^W = 1;
Packit d0f5c2
    local $SIG{__WARN__} = sub { $a = shift };
Packit d0f5c2
    eval { <F> }; # This should get caught.
Packit d0f5c2
}
Packit d0f5c2
close F;
Packit d0f5c2
print $a =~ qr{^UTF-8 "\\x80" does not map to Unicode} ?
Packit d0f5c2
  "ok $t - illegal UTF-8 input\n" : "not ok $t - illegal UTF-8 input: a = " . unpack("H*", $a) . "\n";
Packit d0f5c2
$t++;
Packit d0f5c2
Packit d0f5c2
open(F, $f) or die "$0: failed to open '$f' for reading: $!";
Packit d0f5c2
binmode(F, ":encoding(utf8)");
Packit d0f5c2
{
Packit d0f5c2
    local $^W = 1;
Packit d0f5c2
    local $SIG{__WARN__} = sub { $a = shift };
Packit d0f5c2
    eval { <F> }; # This should get caught.
Packit d0f5c2
}
Packit d0f5c2
close F;
Packit d0f5c2
print $a =~ qr{^utf8 "\\x80" does not map to Unicode} ?
Packit d0f5c2
  "ok $t - illegal utf8 input\n" : "not ok $t - illegal utf8 input: a = " . unpack("H*", $a) . "\n";
Packit d0f5c2
$t++;
Packit d0f5c2
Packit d0f5c2
# On VMS temporary file names like "f0." may be more readable than "f0" since
Packit d0f5c2
# "f0" could be a logical name pointing elsewhere.
Packit d0f5c2
sub filename {
Packit d0f5c2
    my $name = shift;
Packit d0f5c2
    $name .= '.' if $^O eq 'VMS';
Packit d0f5c2
    return $name;
Packit d0f5c2
}
Packit d0f5c2
Packit d0f5c2
END {
Packit d0f5c2
  1 while unlink @f;
Packit d0f5c2
}