Integrate mainline.

p4raw-id: //depot/perlio@8202

7 files changed, 304 insertions, 175 deletions

diff --git a/t/base/commonsense.t b/t/base/commonsense.t
index 155c5345b6..6e313073d2 100644
--- a/t/base/commonsense.t
+++ b/t/base/commonsense.t
@@ -15,7 +15,8 @@ if (($Config{'extensions'} !~ /\bIO\b/) ){
   print "Bail out! Perl configured without IO module\n";
   exit 0;
 }
-if (($Config{'extensions'} !~ /\bFile\/Glob\b/) ){
+# hey, DOS users do not need this kind of common sense ;-)
+if ($^O ne 'dos' && ($Config{'extensions'} !~ /\bFile\/Glob\b/) ){
   print "Bail out! Perl configured without File::Glob module\n";
   exit 0;
 }
diff --git a/t/lib/glob-basic.t b/t/lib/glob-basic.t
index e8a2905add..be3280c8ca 100755
--- a/t/lib/glob-basic.t
+++ b/t/lib/glob-basic.t
@@ -39,7 +39,7 @@ print "ok 2\n";
 
 # look up the user's home directory
 # should return a list with one item, and not set ERROR
-if ($^O ne 'MSWin32' && $^O ne 'VMS') {
+if ($^O ne 'MSWin32' && $^O ne 'VMS' && $^O ne 'cygwin') {
   eval {
     ($name, $home) = (getpwuid($>))[0,7];
     1;
diff --git a/t/op/64bitint.t b/t/op/64bitint.t
index 88fbc55c67..47779dd058 100644
--- a/t/op/64bitint.t
+++ b/t/op/64bitint.t
@@ -16,7 +16,7 @@ BEGIN {
 # 32+ bit integers don't cause noise
 no warnings qw(overflow portable);
 
-print "1..55\n";
+print "1..57\n";
 
 my $q = 12345678901;
 my $r = 23456789012;
@@ -294,4 +294,30 @@ $q = 18446744073709551615;
 print "# $q ne\n# 18446744073709551615\nnot " unless "$q" eq "18446744073709551615";
 print "ok 55\n";
 
+# Test that sv_2nv then sv_2iv is the same as sv_2iv direct
+# fails if whatever Atol is defined as can't actually cope with >32 bits.
+my $num = 4294967297;
+my $string = "4294967297";
+{
+  use integer;
+  $num += 0;
+  $string += 0;
+}
+if ($num eq $string) {
+  print "ok 56\n";
+} else {
+  print "not ok 56 # \"$num\" ne \"$string\"\n";
+}
+
+# Test that sv_2nv then sv_2uv is the same as sv_2uv direct
+$num = 4294967297;
+$string = "4294967297";
+$num &= 0;
+$string &= 0;
+if ($num eq $string) {
+  print "ok 57\n";
+} else {
+  print "not ok 57 # \"$num\" ne \"$string\"\n";
+}
+
 # eof
diff --git a/t/op/goto_xs.t b/t/op/goto_xs.t
index cf2cafd467..dc8e7d77aa 100755
--- a/t/op/goto_xs.t
+++ b/t/op/goto_xs.t
@@ -35,7 +35,7 @@ $VALID = 'LOCK_SH';
 ### First, we check whether Fcntl::constant returns sane answers.
 # Fcntl::constant("LOCK_SH",0) should always succeed.
 
-$value = Fcntl::constant($VALID,0);
+$value = Fcntl::constant($VALID);
 print((!defined $value)
       ? "not ok 1\n# Sanity check broke, remaining tests will fail.\n"
       : "ok 1\n");
@@ -45,20 +45,20 @@ print((!defined $value)
 # test "goto &function_constant"
 sub goto_const { goto &Fcntl::constant; }
 
-$ret = goto_const($VALID,0);
+$ret = goto_const($VALID);
 print(($ret == $value) ? "ok 2\n" : "not ok 2\n# ($ret != $value)\n");
 
 # test "goto &$function_package_and_name"
 $FNAME1 = 'Fcntl::constant';
 sub goto_name1 { goto &$FNAME1; }
 
-$ret = goto_name1($VALID,0);
+$ret = goto_name1($VALID);
 print(($ret == $value) ? "ok 3\n" : "not ok 3\n# ($ret != $value)\n");
 
 # test "goto &$function_package_and_name" again, with dirtier stack
-$ret = goto_name1($VALID,0);
+$ret = goto_name1($VALID);
 print(($ret == $value) ? "ok 4\n" : "not ok 4\n# ($ret != $value)\n");
-$ret = goto_name1($VALID,0);
+$ret = goto_name1($VALID);
 print(($ret == $value) ? "ok 5\n" : "not ok 5\n# ($ret != $value)\n");
 
 # test "goto &$function_name" from local package
@@ -67,14 +67,14 @@ $FNAME2 = 'constant';
 sub goto_name2 { goto &$FNAME2; }
 package main;
 
-$ret = Fcntl::goto_name2($VALID,0);
+$ret = Fcntl::goto_name2($VALID);
 print(($ret == $value) ? "ok 6\n" : "not ok 6\n# ($ret != $value)\n");
 
 # test "goto &$function_ref"
 $FREF = \&Fcntl::constant;
 sub goto_ref { goto &$FREF; }
 
-$ret = goto_ref($VALID,0);
+$ret = goto_ref($VALID);
 print(($ret == $value) ? "ok 7\n" : "not ok 7\n# ($ret != $value)\n");
 
 ### tests where the args are not on stack but in GvAV(defgv) (ie, @_)
@@ -82,17 +82,17 @@ print(($ret == $value) ? "ok 7\n" : "not ok 7\n# ($ret != $value)\n");
 # test "goto &function_constant" from a sub called without arglist
 sub call_goto_const { &goto_const; }
 
-$ret = call_goto_const($VALID,0);
+$ret = call_goto_const($VALID);
 print(($ret == $value) ? "ok 8\n" : "not ok 8\n# ($ret != $value)\n");
 
 # test "goto &$function_package_and_name" from a sub called without arglist
 sub call_goto_name1 { &goto_name1; }
 
-$ret = call_goto_name1($VALID,0);
+$ret = call_goto_name1($VALID);
 print(($ret == $value) ? "ok 9\n" : "not ok 9\n# ($ret != $value)\n");
 
 # test "goto &$function_ref" from a sub called without arglist
 sub call_goto_ref { &goto_ref; }
 
-$ret = call_goto_ref($VALID,0);
+$ret = call_goto_ref($VALID);
 print(($ret == $value) ? "ok 10\n" : "not ok 10\n# ($ret != $value)\n");
diff --git a/t/op/utf8decode.t b/t/op/utf8decode.t
index ac42b85577..cd9d56a5c4 100644
--- a/t/op/utf8decode.t
+++ b/t/op/utf8decode.t
@@ -5,6 +5,8 @@ BEGIN {
     @INC = '../lib';
 }
 
+no utf8; # this test contains raw 8-bit data on purpose; don't switch to \x{}
+
 print "1..78\n";
 
 my $test = 1;
diff --git a/t/pragma/utf8.t b/t/pragma/utf8.t
index 6986720aab..89416dcfab 100755
--- a/t/pragma/utf8.t
+++ b/t/pragma/utf8.t
@@ -10,7 +10,7 @@ BEGIN {
     }
 }
 
-print "1..90\n";
+print "1..104\n";
 
 my $test = 1;
 
@@ -42,6 +42,7 @@ sub nok_bytes {
 
 {
     use utf8;
+
     $_ = ">\x{263A}<"; 
     s/([\x{80}-\x{10ffff}])/"&#".ord($1).";"/eg; 
     ok $_, '>&#9786;<';
@@ -106,212 +107,191 @@ sub nok_bytes {
 }
 
 {
-    use utf8;
-
-    $_ = "\x{263A}>\x{263A}\x{263A}"; 
-
-    ok length, 4;
-    $test++;				# 13
-
-    ok length((m/>(.)/)[0]), 1;
-    $test++;				# 14
-
-    ok length($&), 2;
-    $test++;				# 15
+    # no use utf8 needed
+    $_ = "\x{263A}\x{263A}x\x{263A}y\x{263A}";
+    
+    ok length($_), 6;			# 13
+    $test++;
 
-    ok length($'), 1;
-    $test++;				# 16
+    ($a) = m/x(.)/;
 
-    ok length($`), 1;
-    $test++;				# 17
+    ok length($a), 1;			# 14
+    $test++;
 
-    ok length($1), 1;
-    $test++;				# 18
+    ok length($`), 2;			# 15
+    $test++;
+    ok length($&), 2;			# 16
+    $test++;
+    ok length($'), 2;			# 17
+    $test++;
 
-    ok length($tmp=$&), 2;
-    $test++;				# 19
+    ok length($1), 1;			# 18
+    $test++;
 
-    ok length($tmp=$'), 1;
-    $test++;				# 20
+    ok length($b=$`), 2;		# 19
+    $test++;
 
-    ok length($tmp=$`), 1;
-    $test++;				# 21
+    ok length($b=$&), 2;		# 20
+    $test++;
 
-    ok length($tmp=$1), 1;
-    $test++;				# 22
+    ok length($b=$'), 2;		# 21
+    $test++;
 
-    {
-	use bytes;
+    ok length($b=$1), 1;		# 22
+    $test++;
 
-	my $tmp = $&;
-	ok $tmp, pack("C*", ord(">"), 0342, 0230, 0272);
-	$test++;				# 23
+    ok $a, "\x{263A}";			# 23
+    $test++;
 
-	$tmp = $';
-	ok $tmp, pack("C*", 0342, 0230, 0272);
-	$test++;				# 24
+    ok $`, "\x{263A}\x{263A}";		# 24
+    $test++;
 
-	$tmp = $`;
-	ok $tmp, pack("C*", 0342, 0230, 0272);
-	$test++;				# 25
+    ok $&, "x\x{263A}";			# 25
+    $test++;
 
-	$tmp = $1;
-	ok $tmp, pack("C*", 0342, 0230, 0272);
-	$test++;				# 26
-    }
+    ok $', "y\x{263A}";			# 26
+    $test++;
 
-    ok_bytes $&, pack("C*", ord(">"), 0342, 0230, 0272);
-    $test++;				# 27
+    ok $1, "\x{263A}";			# 27
+    $test++;
 
-    ok_bytes $', pack("C*", 0342, 0230, 0272);
-    $test++;				# 28
+    ok_bytes $a, "\342\230\272";	# 28
+    $test++;
 
-    ok_bytes $`, pack("C*", 0342, 0230, 0272);
-    $test++;				# 29
+    ok_bytes $1, "\342\230\272";	# 29
+    $test++;
 
-    ok_bytes $1, pack("C*", 0342, 0230, 0272);
-    $test++;				# 30
+    ok_bytes $&, "x\342\230\272";	# 30
+    $test++;
 
     {
-	use bytes;
-	no utf8;
-
-	ok length, 10;
-	$test++;				# 31
+	use utf8; # required
+	$_ = chr(0x263A) . chr(0x263A) . 'x' . chr(0x263A) . 'y' . chr(0x263A);
+    }
 
-    	ok length((m/>(.)/)[0]), 1;
-    	$test++;				# 32
+    ok length($_), 6;			# 31
+    $test++;
 
-    	ok length($&), 2;
-    	$test++;				# 33
+    ($a) = m/x(.)/;
 
-    	ok length($'), 5;
-    	$test++;				# 34
+    ok length($a), 1;			# 32
+    $test++;
 
-    	ok length($`), 3;
-    	$test++;				# 35
+    ok length($`), 2;			# 33
+    $test++;
 
-    	ok length($1), 1;
-    	$test++;				# 36
+    ok length($&), 2;			# 34
+    $test++;
 
-	ok $&, pack("C*", ord(">"), 0342);
-	$test++;				# 37
+    ok length($'), 2;			# 35
+    $test++;
 
-	ok $', pack("C*", 0230, 0272, 0342, 0230, 0272);
-	$test++;				# 38
+    ok length($1), 1;			# 36
+    $test++;
 
-	ok $`, pack("C*", 0342, 0230, 0272);
-	$test++;				# 39
+    ok length($b=$`), 2;		# 37
+    $test++;
 
-	ok $1, pack("C*", 0342);
-	$test++;				# 40
-    }
+    ok length($b=$&), 2;		# 38
+    $test++;
 
-    {
-	no utf8;
-	$_="\342\230\272>\342\230\272\342\230\272";
-    }
+    ok length($b=$'), 2;		# 39
+    $test++;
 
-    ok length, 10;
-    $test++;				# 41
+    ok length($b=$1), 1;		# 40
+    $test++;
 
-    ok length((m/>(.)/)[0]), 1;
-    $test++;				# 42
+    ok $a, "\x{263A}";			# 41
+    $test++;
 
-    ok length($&), 2;
-    $test++;				# 43
+    ok $`, "\x{263A}\x{263A}";		# 42
+    $test++;
 
-    ok length($'), 1;
-    $test++;				# 44
+    ok $&, "x\x{263A}";			# 43
+    $test++;
 
-    ok length($`), 1;
-    $test++;				# 45
+    ok $', "y\x{263A}";			# 44
+    $test++;
 
-    ok length($1), 1;
-    $test++;				# 46
+    ok $1, "\x{263A}";			# 45
+    $test++;
 
-    ok length($tmp=$&), 2;
-    $test++;				# 47
+    ok_bytes $a, "\342\230\272";	# 46
+    $test++;
 
-    ok length($tmp=$'), 1;
-    $test++;				# 48
+    ok_bytes $1, "\342\230\272";	# 47
+    $test++;
 
-    ok length($tmp=$`), 1;
-    $test++;				# 49
+    ok_bytes $&, "x\342\230\272";	# 48
+    $test++;
 
-    ok length($tmp=$1), 1;
-    $test++;				# 50
+    $_ = "\342\230\272\342\230\272x\342\230\272y\342\230\272";
 
-    {
-	use bytes;
+    ok length($_), 14;			# 49
+    $test++;
 
-        my $tmp = $&;
-	ok $tmp, pack("C*", ord(">"), 0342, 0230, 0272);
-	$test++;				# 51
+    ($a) = m/x(.)/;
 
-        $tmp = $';
-	ok $tmp, pack("C*", 0342, 0230, 0272);
-	$test++;				# 52
+    ok length($a), 1;			# 50
+    $test++;
 
-        $tmp = $`;
-	ok $tmp, pack("C*", 0342, 0230, 0272);
-	$test++;				# 53
+    ok length($`), 6;			# 51
+    $test++;
 
-        $tmp = $1;
-	ok $tmp, pack("C*", 0342, 0230, 0272);
-	$test++;				# 54
-    }
+    ok length($&), 2;			# 52
+    $test++;
 
-    {
-	use bytes;
-	no utf8;
+    ok length($'), 6;			# 53
+    $test++;
 
-	ok length, 10;
-	$test++;				# 55
+    ok length($1), 1;			# 54
+    $test++;
 
-    	ok length((m/>(.)/)[0]), 1;
-    	$test++;				# 56
+    ok length($b=$`), 6;		# 55
+    $test++;
 
-    	ok length($&), 2;
-    	$test++;				# 57
+    ok length($b=$&), 2;		# 56
+    $test++;
 
-    	ok length($'), 5;
-    	$test++;				# 58
+    ok length($b=$'), 6;		# 57
+    $test++;
 
-    	ok length($`), 3;
-    	$test++;				# 59
+    ok length($b=$1), 1;		# 58
+    $test++;
 
-    	ok length($1), 1;
-    	$test++;				# 60
+    ok $a, "\342";			# 59
+    $test++;
 
-	ok $&, pack("C*", ord(">"), 0342);
-	$test++;				# 61
+    ok $`, "\342\230\272\342\230\272";	# 60
+    $test++;
 
-	ok $', pack("C*", 0230, 0272, 0342, 0230, 0272);
-	$test++;				# 62
+    ok $&, "x\342";			# 61
+    $test++;
 
-	ok $`, pack("C*", 0342, 0230, 0272);
-	$test++;				# 63
+    ok $', "\230\272y\342\230\272";	# 62
+    $test++;
 
-	ok $1, pack("C*", 0342);
-	$test++;				# 64
-    }
+    ok $1, "\342";			# 63
+    $test++;
+}
 
+{
+    use utf8;
     ok "\x{ab}" =~ /^\x{ab}$/, 1;
-    $test++;					# 65
+    $test++;				# 64
 }
 
 {
     use utf8;
     ok_bytes chr(0xe2), pack("C*", 0xc3, 0xa2);
-    $test++;                # 66
+    $test++;                # 65
 }
 
 {
     use utf8;
     my @a = map ord, split(//, join("", map chr, (1234, 123, 2345)));
     ok "@a", "1234 123 2345";
-    $test++;                # 67
+    $test++;                # 66
 }
 
 {
@@ -319,7 +299,7 @@ sub nok_bytes {
     my $x = chr(123);
     my @a = map ord, split(/$x/, join("", map chr, (1234, 123, 2345)));
     ok "@a", "1234 2345";
-    $test++;                # 68
+    $test++;                # 67
 }
 
 {
@@ -331,10 +311,10 @@ sub nok_bytes {
     { use utf8;  $b = "\xe4"     } # \xXX must not produce UTF-8
 
     print "not " if $a eq $b;
-    print "ok $test\n"; $test++;
+    print "ok $test\n"; $test++;	# 68
 
     { use utf8; print "not " if $a eq $b; }
-    print "ok $test\n"; $test++;
+    print "ok $test\n"; $test++;	# 69
 }
 
 {
@@ -344,7 +324,7 @@ sub nok_bytes {
     for (@x) {
 	s/(\d+)\s*([\w\-]+)/$1 . uc $2/e;
 	my($latin) = /^(.+)(?:\s+\d)/;
-	print $latin eq "stra\337e" ? "ok $test\n" :
+	print $latin eq "stra\337e" ? "ok $test\n" :	# 70, 71
 	    "#latin[$latin]\nnot ok $test\n";
 	$test++;
 	$latin =~ s/stra\337e/straße/; # \303\237 after the 2nd a
@@ -369,7 +349,7 @@ sub nok_bytes {
     }
 
     print "not " unless $r eq " U+B36C U+5A8C U+FF5B U+5079 U+505B";
-    print "ok $test\n";
+    print "ok $test\n";			# 72
     $test++;
 }
 
@@ -384,27 +364,27 @@ sub nok_bytes {
     print "not "
 	unless $a eq "\x20" && $b eq "\x{80}\x{100}\x{80}" && $c eq $a;
     print "ok $test\n";
-    $test++;
+    $test++;				# 73
 
     my ($a, $b) = split(/\x{100}/, $s);
     print "not " unless $a eq "\x20\x40\x{80}" && $b eq "\x{80}\x40\x20";
     print "ok $test\n";
-    $test++;
+    $test++;				# 74
 
     my ($a, $b) = split(/\x{80}\x{100}\x{80}/, $s);
     print "not " unless $a eq "\x20\x40" && $b eq "\x40\x20";
     print "ok $test\n";
-    $test++;
+    $test++;				# 75
 
     my ($a, $b) = split(/\x40\x{80}/, $s);
     print "not " unless $a eq "\x20" && $b eq "\x{100}\x{80}\x40\x20";
     print "ok $test\n";
-    $test++;
+    $test++;				# 76
 
     my ($a, $b, $c) = split(/[\x40\x{80}]+/, $s);
     print "not " unless $a eq "\x20" && $b eq "\x{100}" && $c eq "\x20";
     print "ok $test\n";
-    $test++;
+    $test++;				# 77
 }
 
 {
@@ -414,14 +394,14 @@ sub nok_bytes {
 
     my $smiley = "\x{263a}";
 
-    for my $s ("\x{263a}",                     #  1
-	       $smiley,                        #  2
+    for my $s ("\x{263a}",                     # 78
+	       $smiley,                        # 79
 		
-	       "" . $smiley,                   #  3
-	       "" . "\x{263a}",                #  4
+	       "" . $smiley,                   # 80
+	       "" . "\x{263a}",                # 81
 
-	       $smiley    . "",                #  5
-	       "\x{263a}" . "",                #  6
+	       $smiley    . "",                # 82
+	       "\x{263a}" . "",                # 83
 	       ) {
 	my $length_chars = length($s);
 	my $length_bytes;
@@ -437,14 +417,14 @@ sub nok_bytes {
 	$test++;
     }
 
-    for my $s ("\x{263a}" . "\x{263a}",        #  7
-	       $smiley    . $smiley,           #  8
+    for my $s ("\x{263a}" . "\x{263a}",        # 84
+	       $smiley    . $smiley,           # 85
 
-	       "\x{263a}\x{263a}",             #  9
-	       "$smiley$smiley",               # 10
+	       "\x{263a}\x{263a}",             # 86
+	       "$smiley$smiley",               # 87
 	       
-	       "\x{263a}" x 2,                 # 11
-	       $smiley    x 2,                 # 12
+	       "\x{263a}" x 2,                 # 88
+	       $smiley    x 2,                 # 89
 	       ) {
 	my $length_chars = length($s);
 	my $length_bytes;
@@ -460,3 +440,106 @@ sub nok_bytes {
 	$test++;
     }
 }
+
+{
+    use utf8;
+
+    print "not " unless "ba\xd4c" =~ /([a\xd4]+)/ && $1 eq "a\xd4";
+    print "ok $test\n";
+    $test++;					# 90
+
+    print "not " unless "ba\xd4c" =~ /([a\xd4]+)/ && $1 eq "a\x{d4}";
+    print "ok $test\n";
+    $test++;					# 91
+
+    print "not " unless "ba\x{d4}c" =~ /([a\xd4]+)/ && $1 eq "a\x{d4}";
+    print "ok $test\n";
+    $test++;					# 92
+
+    print "not " unless "ba\x{d4}c" =~ /([a\xd4]+)/ && $1 eq "a\xd4";
+    print "ok $test\n";
+    $test++;					# 93
+
+    print "not " unless "ba\xd4c" =~ /([a\x{d4}]+)/ && $1 eq "a\xd4";
+    print "ok $test\n";
+    $test++;					# 94
+
+    print "not " unless "ba\xd4c" =~ /([a\x{d4}]+)/ && $1 eq "a\x{d4}";
+    print "ok $test\n";
+    $test++;					# 95
+
+    print "not " unless "ba\x{d4}c" =~ /([a\x{d4}]+)/ && $1 eq "a\x{d4}";
+    print "ok $test\n";
+    $test++;					# 96
+
+    print "not " unless "ba\x{d4}c" =~ /([a\x{d4}]+)/ && $1 eq "a\xd4";
+    print "ok $test\n";
+    $test++;					# 97
+}
+
+{
+    # the first half of 20001028.003
+
+    my $X = chr(1448);
+    my ($Y) = $X =~ /(.*)/;
+    print "not " unless length $Y == 1;
+    print "ok $test\n";
+    $test++;					# 98
+}
+
+{
+    # 20001108.001
+
+    use utf8;
+    my $X = "Szab\x{f3},Bal\x{e1}zs";
+    my $Y = $X;
+    $Y =~ s/(B)/$1/ for 0..3;
+    print "not " unless $Y eq $X;
+    print "ok $test\n";
+    $test++;					# 99
+}
+
+{
+    # 20001114.001	
+
+    use utf8;
+    use charnames ':full';
+    my $text = "\N{LATIN CAPITAL LETTER A WITH DIAERESIS}";
+    print "not " unless ord($text) == 0xc4;
+    print "ok $test\n";
+    $test++;                                    # 100
+}
+
+{
+    # 20001205.014
+
+    use utf8;
+
+    my $a = "ABC\x{263A}";
+
+    my @b = split( //, $a );
+
+    print "not " unless @b == 4;
+    print "ok $test\n";
+    $test++;                                    # 101
+
+    print "not " unless length($b[3]) == 1;
+    print "ok $test\n";
+    $test++;                                    # 102
+
+    $a =~ s/^A/Z/;
+    print "not " unless length($a) == 4;
+    print "ok $test\n";
+    $test++;                                    # 103
+}
+
+{
+    # the second half of 20001028.003
+
+    use utf8;
+    $X =~ s/^/chr(1488)/e;
+    print "not " unless length $X == 1;
+    print "ok $test\n";
+    $test++;					# 104
+}
+
diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys
index 66f3e750db..e30637b0d4 100644
--- a/t/pragma/warn/pp_sys
+++ b/t/pragma/warn/pp_sys
@@ -3,6 +3,15 @@
   untie attempted while %d inner references still exist	[pp_untie]
     sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
 
+  fileno() on unopened filehandle abc		[pp_fileno]
+    $a = "abc"; fileno($a)
+
+  binmode() on unopened filehandle abc		[pp_binmode]
+    $a = "abc"; fileno($a)
+
+  printf() on unopened filehandle abc		[pp_prtf]
+    $a = "abc"; printf $a "fred"
+
   Filehandle %s opened only for input		[pp_leavewrite]
     format STDIN =
     .
@@ -400,3 +409,11 @@ close F ;
 unlink $file ;
 EXPECT
 Filehandle F opened only for output at - line 12.
+########
+# pp_sys.c [pp_binmode]
+use warnings 'unopened' ;
+binmode(BLARG);
+$a = "BLERG";binmode($a);
+EXPECT
+binmode() on unopened filehandle BLARG at - line 3.
+binmode() on unopened filehandle at - line 4.