perl 5.8.8 import

7 files changed, 291 insertions, 99 deletions

diff --git a/gnu/usr.bin/perl/t/io/binmode.t b/gnu/usr.bin/perl/t/io/binmode.t
index be198ae645c..41eff4a24f4 100644
--- a/gnu/usr.bin/perl/t/io/binmode.t
+++ b/gnu/usr.bin/perl/t/io/binmode.t
@@ -35,7 +35,7 @@ SKIP: {
     skip "minitest", 1 if $ENV{PERL_CORE_MINITEST};
     skip "no EBADF", 1 if (!exists &Errno::EBADF);
 
-    no warnings 'io';
+    no warnings 'io', 'once';
     $! = 0;
     binmode(B);
     ok($! == &Errno::EBADF);
diff --git a/gnu/usr.bin/perl/t/io/crlf.t b/gnu/usr.bin/perl/t/io/crlf.t
index be514003a5c..c3c23e04ac3 100644
--- a/gnu/usr.bin/perl/t/io/crlf.t
+++ b/gnu/usr.bin/perl/t/io/crlf.t
@@ -15,72 +15,72 @@ END {
 }
 
 if (find PerlIO::Layer 'perlio') {
- plan(tests => 16);
- ok(open(FOO,">:crlf",$file));
- ok(print FOO 'a'.((('a' x 14).qq{\n}) x 2000) || close(FOO));
- ok(open(FOO,"<:crlf",$file));
+    plan(tests => 16);
+    ok(open(FOO,">:crlf",$file));
+    ok(print FOO 'a'.((('a' x 14).qq{\n}) x 2000) || close(FOO));
+    ok(open(FOO,"<:crlf",$file));
 
- my $text;
- { local $/; $text = <FOO> }
- is(count_chars($text, "\015\012"), 0);
- is(count_chars($text, "\n"), 2000);
+    my $text;
+    { local $/; $text = <FOO> }
+    is(count_chars($text, "\015\012"), 0);
+    is(count_chars($text, "\n"), 2000);
 
- binmode(FOO);
- seek(FOO,0,0);
- { local $/; $text = <FOO> }
- is(count_chars($text, "\015\012"), 2000);
+    binmode(FOO);
+    seek(FOO,0,0);
+    { local $/; $text = <FOO> }
+    is(count_chars($text, "\015\012"), 2000);
 
- SKIP:
- {
-  skip("miniperl can't rely on loading PerlIO::scalar")
-      if $ENV{PERL_CORE_MINITEST};
-  skip("no PerlIO::scalar") unless $Config{extensions} =~ m!\bPerlIO/scalar\b!;
-  require PerlIO::scalar;
-  my $fcontents = join "", map {"$_\015\012"} "a".."zzz";
-  open my $fh, "<:crlf", \$fcontents;
-  local $/ = "xxx";
-  local $_ = <$fh>;
-  my $pos = tell $fh; # pos must be behind "xxx", before "\nyyy\n"
-  seek $fh, $pos, 0;
-  $/ = "\n";
-  $s = <$fh>.<$fh>;
-  ok($s eq "\nxxy\n");
- }
+    SKIP:
+    {
+	skip("miniperl can't rely on loading PerlIO::scalar")
+	if $ENV{PERL_CORE_MINITEST};
+	skip("no PerlIO::scalar") unless $Config{extensions} =~ m!\bPerlIO/scalar\b!;
+	require PerlIO::scalar;
+	my $fcontents = join "", map {"$_\015\012"} "a".."zzz";
+	open my $fh, "<:crlf", \$fcontents;
+	local $/ = "xxx";
+	local $_ = <$fh>;
+	my $pos = tell $fh; # pos must be behind "xxx", before "\nxxy\n"
+	seek $fh, $pos, 0;
+	$/ = "\n";
+	$s = <$fh>.<$fh>;
+	ok($s eq "\nxxy\n");
+    }
 
- ok(close(FOO));
+    ok(close(FOO));
 
- # binmode :crlf should not cumulate.
- # Try it first once and then twice so that even UNIXy boxes
- # get to exercise this, for DOSish boxes even once is enough.
- # Try also pushing :utf8 first so that there are other layers
- # in between (this should not matter: CRLF layers still should
- # not accumulate).
- for my $utf8 ('', ':utf8') {
-     for my $binmode (1..2) {
-	 open(FOO, ">$file");
-	 # require PerlIO; print PerlIO::get_layers(FOO), "\n";
-	 binmode(FOO, "$utf8:crlf") for 1..$binmode;
-	 # require PerlIO; print PerlIO::get_layers(FOO), "\n";
-	 print FOO "Hello\n";
-	 close FOO;
-	 open(FOO, "<$file");
-	 binmode(FOO);
-	 my $foo = scalar <FOO>;
-	 close FOO;
-	 print join(" ", "#", map { sprintf("%02x", $_) } unpack("C*", $foo)),
-	       "\n";
-	 ok($foo =~ /\x0d\x0a$/);
-	 ok($foo !~ /\x0d\x0d/);
-     }
- }
+    # binmode :crlf should not cumulate.
+    # Try it first once and then twice so that even UNIXy boxes
+    # get to exercise this, for DOSish boxes even once is enough.
+    # Try also pushing :utf8 first so that there are other layers
+    # in between (this should not matter: CRLF layers still should
+    # not accumulate).
+    for my $utf8 ('', ':utf8') {
+	for my $binmode (1..2) {
+	    open(FOO, ">$file");
+	    # require PerlIO; print PerlIO::get_layers(FOO), "\n";
+	    binmode(FOO, "$utf8:crlf") for 1..$binmode;
+	    # require PerlIO; print PerlIO::get_layers(FOO), "\n";
+	    print FOO "Hello\n";
+	    close FOO;
+	    open(FOO, "<$file");
+	    binmode(FOO);
+	    my $foo = scalar <FOO>;
+	    close FOO;
+	    print join(" ", "#", map { sprintf("%02x", $_) } unpack("C*", $foo)),
+	    "\n";
+	    ok($foo =~ /\x0d\x0a$/);
+	    ok($foo !~ /\x0d\x0d/);
+	}
+    }
 }
 else {
- skip_all("No perlio, so no :crlf");
+    skip_all("No perlio, so no :crlf");
 }
 
 sub count_chars {
-  my($text, $chars) = @_;
-  my $seen = 0;
-  $seen++ while $text =~ /$chars/g;
-  return $seen;
+    my($text, $chars) = @_;
+    my $seen = 0;
+    $seen++ while $text =~ /$chars/g;
+    return $seen;
 }
diff --git a/gnu/usr.bin/perl/t/io/crlf_through.t b/gnu/usr.bin/perl/t/io/crlf_through.t
new file mode 100755
index 00000000000..c08099598ef
--- /dev/null
+++ b/gnu/usr.bin/perl/t/io/crlf_through.t
@@ -0,0 +1,10 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+no warnings 'once';
+$main::use_crlf = 1;
+do './io/through.t' or die "no kid script";
diff --git a/gnu/usr.bin/perl/t/io/layers.t b/gnu/usr.bin/perl/t/io/layers.t
index e2c63a957c3..62f77e864a0 100644
--- a/gnu/usr.bin/perl/t/io/layers.t
+++ b/gnu/usr.bin/perl/t/io/layers.t
@@ -31,18 +31,33 @@ my $DOSISH    = $^O =~ /^(?:MSWin32|os2|dos|NetWare|mint)$/ ? 1 : 0;
    $DOSISH    = 1 if !$DOSISH and $^O =~ /^uwin/;
 my $NONSTDIO  = exists $ENV{PERLIO} && $ENV{PERLIO} ne 'stdio'     ? 1 : 0;
 my $FASTSTDIO = $Config{d_faststdio} && $Config{usefaststdio}      ? 1 : 0;
-
-my $NTEST = 43 - (($DOSISH || !$FASTSTDIO) ? 7 : 0) - ($DOSISH ? 5 : 0);
+my $UNICODE_STDIN;
+if (${^UNICODE} & 1) {
+    if (${^UNICODE} & 64) {
+	# Conditional on the locale
+	$UNICODE_STDIN = ${^UTF8LOCALE};
+    } else {
+	# Unconditional
+	$UNICODE_STDIN = 1;
+    }
+} else {
+    $UNICODE_STDIN = 0;
+}
+my $NTEST = 44 - (($DOSISH || !$FASTSTDIO) ? 7 : 0) - ($DOSISH ? 5 : 0)
+    + $UNICODE_STDIN;
 
 sub PerlIO::F_UTF8 () { 0x00008000 } # from perliol.h
 
 plan tests => $NTEST;
 
 print <<__EOH__;
-# PERLIO    = $PERLIO
-# DOSISH    = $DOSISH
-# NONSTDIO  = $NONSTDIO
-# FASTSTDIO = $FASTSTDIO
+# PERLIO        = $PERLIO
+# DOSISH        = $DOSISH
+# NONSTDIO      = $NONSTDIO
+# FASTSTDIO     = $FASTSTDIO
+# UNICODE       = ${^UNICODE}
+# UTF8LOCALE    = ${^UTF8LOCALE}
+# UNICODE_STDIN = $UNICODE_STDIN
 __EOH__
 
 SKIP: {
@@ -93,7 +108,7 @@ SKIP: {
 	    @$expected = grep { $_ ne 'crlf' } @$expected;
 	}
 	my $n = scalar @$expected;
-	is($n, scalar @$expected, "$id - layers == $n");
+	is(scalar @$result, $n, "$id - layers == $n");
 	for (my $i = 0; $i < $n; $i++) {
 	    my $j = $expected->[$i];
 	    if (ref $j eq 'CODE') {
@@ -107,7 +122,7 @@ SKIP: {
     }
 
     check([ PerlIO::get_layers(STDIN) ],
-	  [ "stdio" ],
+	  $UNICODE_STDIN ? [ "stdio", "utf8" ] : [ "stdio" ],
 	  "STDIN");
 
     open(F, ">:crlf", "afile");
@@ -199,5 +214,12 @@ SKIP: {
 	close G;
     }
 
+    # Check that PL_sigwarn's reference count is correct, and that 
+    # &PerlIO::Layer::NoWarnings isn't prematurely freed.
+    fresh_perl_like (<<'EOT', qr/^CODE/);
+open(UTF, "<:raw:encoding(utf8)", "afile") or die $!;
+print ref *PerlIO::Layer::NoWarnings{CODE};
+EOT
+
     1 while unlink "afile";
 }
diff --git a/gnu/usr.bin/perl/t/io/openpid.t b/gnu/usr.bin/perl/t/io/openpid.t
index c6ed8402258..23d75ef074d 100644
--- a/gnu/usr.bin/perl/t/io/openpid.t
+++ b/gnu/usr.bin/perl/t/io/openpid.t
@@ -23,6 +23,7 @@ plan tests => 10;
 use Config;
 $| = 1;
 $SIG{PIPE} = 'IGNORE';
+$SIG{HUP} = 'IGNORE' if $^O eq 'interix';
 
 my $perl = which_perl();
 $perl .= qq[ "-I../lib"];
diff --git a/gnu/usr.bin/perl/t/io/through.t b/gnu/usr.bin/perl/t/io/through.t
new file mode 100755
index 00000000000..60c75c99217
--- /dev/null
+++ b/gnu/usr.bin/perl/t/io/through.t
@@ -0,0 +1,148 @@
+#!./perl
+
+BEGIN {
+    if ($^O eq 'VMS') {
+        print "1..0 # Skip on VMS -- too picky about line endings for record-oriented pipes\n";
+        exit;
+    }
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use strict;
+require './test.pl';
+
+my $Perl = which_perl();
+
+my $data = <<'EOD';
+x
+ yy
+z
+EOD
+
+(my $data2 = $data) =~ s/\n/\n\n/g;
+
+my $t1 = { data => $data,  write_c => [1,2,length $data],  read_c => [1,2,3,length $data]};
+my $t2 = { data => $data2, write_c => [1,2,length $data2], read_c => [1,2,3,length $data2]};
+
+$_->{write_c} = [1..length($_->{data})],
+  $_->{read_c} = [1..length($_->{data})+1, 0xe000]  # Need <0xffff for REx
+    for (); # $t1, $t2;
+
+my $c;	# len write tests, for each: one _all test, and 3 each len+2
+$c += @{$_->{write_c}} * (1 + 3*@{$_->{read_c}}) for $t1, $t2;
+$c *= 3*2*2;	# $how_w, file/pipe, 2 reports
+
+$c += 6;	# Tests with sleep()...
+
+print "1..$c\n";
+
+my $set_out = '';
+$set_out = "binmode STDOUT, ':crlf'"
+    if defined  $main::use_crlf && $main::use_crlf == 1;
+
+sub testread ($$$$$$$) {
+  my ($fh, $str, $read_c, $how_r, $write_c, $how_w, $why) = @_;
+  my $buf = '';
+  if ($how_r eq 'readline_all') {
+    $buf .= $_ while <$fh>;
+  } elsif ($how_r eq 'readline') {
+    $/ = \$read_c;
+    $buf .= $_ while <$fh>;
+  } elsif ($how_r eq 'read') {
+    my($in, $c);
+    $buf .= $in while $c = read($fh, $in, $read_c);
+  } elsif ($how_r eq 'sysread') {
+    my($in, $c);
+    $buf .= $in while $c = sysread($fh, $in, $read_c);
+  } else {
+    die "Unrecognized read: '$how_r'";
+  }
+  close $fh or die "close: $!";
+  # The only contamination allowed is with sysread/prints
+  $buf =~ s/\r\n/\n/g if $how_r eq 'sysread' and $how_w =~ /print/;
+  is(length $buf, length $str, "length with wrc=$write_c, rdc=$read_c, $how_w, $how_r, $why");
+  is($buf, $str, "content with wrc=$write_c, rdc=$read_c, $how_w, $how_r, $why");
+}
+
+sub testpipe ($$$$$$) {
+  my ($str, $write_c, $read_c, $how_w, $how_r, $why) = @_;
+  (my $quoted = $str) =~ s/\n/\\n/g;;
+  my $fh;
+  if ($how_w eq 'print') {	# AUTOFLUSH???
+    # Should be shell-neutral:
+    open $fh, '-|', qq[$Perl -we "$set_out;print for grep length, split /(.{1,$write_c})/s, qq($quoted)"] or die "open: $!";
+  } elsif ($how_w eq 'print/flush') {
+    # shell-neutral and miniperl-enabled autoflush? qq(\x24\x7c) eq '$|'
+    open $fh, '-|', qq[$Perl -we "$set_out;eval qq(\\x24\\x7c = 1) or die;print for grep length, split /(.{1,$write_c})/s, qq($quoted)"] or die "open: $!";
+  } elsif ($how_w eq 'syswrite') {
+    ### How to protect \$_
+    open $fh, '-|', qq[$Perl -we "$set_out;eval qq(sub w {syswrite STDOUT, \\x24_} 1) or die; w() for grep length, split /(.{1,$write_c})/s, qq($quoted)"] or die "open: $!";
+  } else {
+    die "Unrecognized write: '$how_w'";
+  }
+  binmode $fh, ':crlf'
+      if defined $main::use_crlf && $main::use_crlf == 1;
+  testread($fh, $str, $read_c, $how_r, $write_c, $how_w, "pipe$why");
+}
+
+sub testfile ($$$$$$) {
+  my ($str, $write_c, $read_c, $how_w, $how_r, $why) = @_;
+  my @data = grep length, split /(.{1,$write_c})/s, $str;
+
+  open my $fh, '>', 'io_io.tmp' or die;
+  select $fh;
+  binmode $fh, ':crlf' 
+      if defined $main::use_crlf && $main::use_crlf == 1;
+  if ($how_w eq 'print') {	# AUTOFLUSH???
+    $| = 0;
+    print $fh $_ for @data;
+  } elsif ($how_w eq 'print/flush') {
+    $| = 1;
+    print $fh $_ for @data;
+  } elsif ($how_w eq 'syswrite') {
+    syswrite $fh, $_ for @data;
+  } else {
+    die "Unrecognized write: '$how_w'";
+  }
+  close $fh or die "close: $!";
+  open $fh, '<', 'io_io.tmp' or die;
+  binmode $fh, ':crlf'
+      if defined $main::use_crlf && $main::use_crlf == 1;
+  testread($fh, $str, $read_c, $how_r, $write_c, $how_w, "file$why");
+}
+
+# shell-neutral and miniperl-enabled autoflush? qq(\x24\x7c) eq '$|'
+open my $fh, '-|', qq[$Perl -we "eval qq(\\x24\\x7c = 1) or die; binmode STDOUT; sleep 1, print for split //, qq(a\nb\n\nc\n\n\n)"] or die "open: $!";
+ok(1, 'open pipe');
+binmode $fh, q(:crlf);
+ok(1, 'binmode');
+$c = undef;
+my @c;
+push @c, ord $c while $c = getc $fh;
+ok(1, 'got chars');
+is(scalar @c, 9, 'got 9 chars');
+is("@c", '97 10 98 10 10 99 10 10 10', 'got expected chars');
+ok(close($fh), 'close');
+
+for my $s (1..2) {
+  my $t = ($t1, $t2)[$s-1];
+  my $str = $t->{data};
+  my $r = $t->{read_c};
+  my $w = $t->{write_c};
+  for my $read_c (@$r) {
+    for my $write_c (@$w) {
+      for my $how_r (qw(readline_all readline read sysread)) {
+	next if $how_r eq 'readline_all' and $read_c != 1;
+        for my $how_w (qw(print print/flush syswrite)) {
+	  testfile($str, $write_c, $read_c, $how_w, $how_r, $s);
+	  testpipe($str, $write_c, $read_c, $how_w, $how_r, $s);
+        }
+      }
+    }
+  }
+}
+
+unlink 'io_io.tmp';
+
+1;
diff --git a/gnu/usr.bin/perl/t/io/utf8.t b/gnu/usr.bin/perl/t/io/utf8.t
index 721d7dbd1f7..532ea7fb5ee 100644
--- a/gnu/usr.bin/perl/t/io/utf8.t
+++ b/gnu/usr.bin/perl/t/io/utf8.t
@@ -13,42 +13,42 @@ no utf8; # needed for use utf8 not griping about the raw octets
 
 require "./test.pl";
 
-plan(tests => 53);
+plan(tests => 55);
 
 $| = 1;
 
 open(F,"+>:utf8",'a');
 print F chr(0x100).'£';
-ok( tell(F) == 4, tell(F) );
+cmp_ok( tell(F), '==', 4, tell(F) );
 print F "\n";
-ok( tell(F) >= 5, tell(F) );
+cmp_ok( tell(F), '>=', 5, tell(F) );
 seek(F,0,0);
-ok( getc(F) eq chr(0x100) );
-ok( getc(F) eq "£" );
-ok( getc(F) eq "\n" );
+is( getc(F), chr(0x100) );
+is( getc(F), "£" );
+is( getc(F), "\n" );
 seek(F,0,0);
 binmode(F,":bytes");
 my $chr = chr(0xc4);
 if (ord('A') == 193) { $chr = chr(0x8c); } # EBCDIC
-ok( getc(F) eq $chr );
+is( getc(F), $chr );
 $chr = chr(0x80);
 if (ord('A') == 193) { $chr = chr(0x41); } # EBCDIC
-ok( getc(F) eq $chr );
+is( getc(F), $chr );
 $chr = chr(0xc2);
 if (ord('A') == 193) { $chr = chr(0x80); } # EBCDIC
-ok( getc(F) eq $chr );
+is( getc(F), $chr );
 $chr = chr(0xa3);
 if (ord('A') == 193) { $chr = chr(0x44); } # EBCDIC
-ok( getc(F) eq $chr );
-ok( getc(F) eq "\n" );
+is( getc(F), $chr );
+is( getc(F), "\n" );
 seek(F,0,0);
 binmode(F,":utf8");
-ok( scalar(<F>) eq "\x{100}£\n" );
+is( scalar(<F>), "\x{100}£\n" );
 seek(F,0,0);
 $buf = chr(0x200);
 $count = read(F,$buf,2,1);
-ok( $count == 2 );
-ok( $buf eq "\x{200}\x{100}£" );
+cmp_ok( $count, '==', 2 );
+is( $buf, "\x{200}\x{100}£" );
 close(F);
 
 {
@@ -62,7 +62,7 @@ close(F);
     open F, "<:utf8", 'a' or die $!;
     $x = <F>;
     chomp($x);
-    ok( $x eq chr(300) );
+    is( $x, chr(300) );
 
     open F, "a" or die $!; # Not UTF
     binmode(F, ":bytes");
@@ -70,7 +70,7 @@ close(F);
     chomp($x);
     $chr = chr(196).chr(172);
     if (ord('A') == 193) { $chr = chr(141).chr(83); } # EBCDIC
-    ok( $x eq $chr );
+    is( $x, $chr );
     close F;
 
     open F, ">:utf8", 'a' or die $!;
@@ -80,25 +80,25 @@ close(F);
     my $y;
     { my $x = tell(F);
       { use bytes; $y = length($a);}
-      ok( $x == $y );
+      cmp_ok( $x, '==', $y );
   }
 
     { # Check byte length of $b
 	use bytes; my $y = length($b);
-	ok( $y == 1 );
+	cmp_ok( $y, '==', 1 );
     }
 
     print F $b,"\n"; # Don't upgrades $b
 
     { # Check byte length of $b
 	use bytes; my $y = length($b);
-	ok( $y == 1 );
+	cmp_ok( $y, '==', 1 );
     }
 
     {
 	my $x = tell(F);
 	{ use bytes; if (ord('A')==193){$y += 2;}else{$y += 3;}} # EBCDIC ASCII
-	ok( $x == $y );
+	cmp_ok( $x, '==', $y );
     }
 
     close F;
@@ -109,13 +109,13 @@ close(F);
     chomp($x);
     $chr = v196.172.194.130;
     if (ord('A') == 193) { $chr = v141.83.130; } # EBCDIC
-    ok( $x eq $chr, sprintf('(%vd)', $x) );
+    is( $x, $chr, sprintf('(%vd)', $x) );
 
     open F, "<:utf8", "a" or die $!;
     $x = <F>;
     chomp($x);
     close F;
-    ok( $x eq chr(300).chr(130), sprintf('(%vd)', $x) );
+    is( $x, chr(300).chr(130), sprintf('(%vd)', $x) );
 
     open F, ">", "a" or die $!;
     if (${^OPEN} =~ /:utf8/) {
@@ -128,7 +128,8 @@ close(F);
 	use warnings 'utf8';
 	local $SIG{__WARN__} = sub { $w = $_[0] };
 	print F $a;
-        ok( !($@ || $w !~ /Wide character in print/i) );
+        ok( (!$@));
+	like($w, qr/Wide character in print/i );
     }
 }
 
@@ -144,30 +145,39 @@ binmode(F, ":bytes");
 $x = <F>; chomp $x;
 $chr = v196.172.130;
 if (ord('A') == 193) { $chr = v141.83.130; } # EBCDIC
-ok( $x eq $chr );
+is( $x, $chr );
 
 # Right.
 open F, ">:utf8", "a" or die $!;
 print F $a;
 close F;
 open F, ">>", "a" or die $!;
+binmode(F, ":bytes");
 print F chr(130)."\n";
 close F;
 
 open F, "<", "a" or die $!;
+binmode(F, ":bytes");
 $x = <F>; chomp $x;
-ok( $x eq $chr );
+SKIP: {
+    skip("Defaulting to UTF-8 output means that we can't generate a mangled file")
+	if $UTF8_OUTPUT;
+    is( $x, $chr );
+}
 
 # Now we have a deformed file.
 
 SKIP: {
     if (ord('A') == 193) {
-	skip( "EBCDIC doesn't complain" );
+	skip("EBCDIC doesn't complain", 2);
     } else {
+	my @warnings;
 	open F, "<:utf8", "a" or die $!;
 	$x = <F>; chomp $x;
-	local $SIG{__WARN__} = sub { ok( 1 ) };
+	local $SIG{__WARN__} = sub { push @warnings, $_[0]; };
 	eval { sprintf "%vd\n", $x };
+	is (scalar @warnings, 1);
+	like ($warnings[0], qr/Malformed UTF-8 character \(unexpected continuation byte 0x82, with no preceding start byte/);
     }
 }
 
@@ -185,6 +195,7 @@ my $c;
 # read() should work on characters, not bytes
 open F, "<:utf8", "a";
 $a = 0;
+my $failed;
 for (@a) {
     unless (($c = read(F, $b, 1) == 1)  &&
             length($b)           == 1  &&
@@ -197,12 +208,12 @@ for (@a) {
         print '# tell(F)           == ', tell(F), "\n";
         print '# $a                == ', $a, "\n";
         print '# $c                == ', $c, "\n";
-        print "not ";
+	$failed++;
         last;
     }
 }
 close F;
-ok( 1 );
+is($failed, undef);
 
 {
     # Check that warnings are on on I/O, and that they can be muffled.
@@ -258,7 +269,7 @@ ok( 1 );
     open F, "<:bytes", "a";
     my $b = chr 0x100;
     $b .= <F>;
-    ok( $b eq chr(0x100).chr(0xde), "21395 '.= <>' utf8 vs. bytes" );
+    is( $b, chr(0x100).chr(0xde), "21395 '.= <>' utf8 vs. bytes" );
     close F;
 }
 
@@ -268,7 +279,7 @@ ok( 1 );
     open F, "<:utf8", "a";
     my $b = "\xde";
     $b .= <F>;
-    ok( $b eq chr(0xde).chr(0x100), "21395 '.= <>' bytes vs. utf8" );
+    is( $b, chr(0xde).chr(0x100), "21395 '.= <>' bytes vs. utf8" );
     close F;
 }
 
@@ -293,7 +304,7 @@ ok( 1 );
 	    utf8::upgrade($s) if $v->[1] eq "utf8";
 
 	    $s .= <F>;
-	    ok( $s eq chr($v->[0]) . chr($u->[0]), 'rcatline utf8' );
+	    is( $s, chr($v->[0]) . chr($u->[0]), 'rcatline utf8' );
 	    close F;
 	    $t++;
 	}