Remove the "Newline in left-justified string" warning.

[p5sagit/p5-mst-13.2.git] / t / lib / warnings / pp_hot

diff --git a/t/lib/warnings/pp_hot b/t/lib/warnings/pp_hot
index c5a3790..f5a5803 100644 (file)
--- a/t/lib/warnings/pp_hot
+++ b/t/lib/warnings/pp_hot
@@ -7,7 +7,7 @@
     print STDIN "abc" ;
 
   Filehandle %s opened only for output         [pp_print]
-    print <STDOUT> ;
+    $a = <STDOUT> ;
 
   print() on closed filehandle %s              [pp_print]
     close STDIN ; print STDIN "abc" ;
@@ -57,32 +57,40 @@ $f = $a = "abc" ;
 print $f $a;
 no warnings 'unopened' ;
 print $f $a;
+use warnings;
+no warnings 'unopened' ;
+print $f $a;
 EXPECT
 print() on unopened filehandle abc at - line 4.
 ########
 # pp_hot.c [pp_print]
 use warnings 'io' ;
-print STDIN "anc";
-print <STDOUT>;
-print <STDERR>;
-open(FOO, ">&STDOUT") and print <FOO>;
-print getc(STDERR);
-print getc(FOO);
-####################################################################
-# The next test is known to fail on some systems (Linux+old glibc, #
-# some *BSDs (including Mac OS X and NeXT), among others.          #
-# We skip it for now (on the grounds that it is "just" a warning). #
-####################################################################
-#read(FOO,$_,1);
+# There is no guarantee that STDOUT is output only, or STDIN input only.
+# Certainly on some BSDs (at least FreeBSD, Darwin, BSDi) file descriptors
+# 1 and 2 are opened read/write on the tty, and the IO layers may reflect this.
+# So we must make our own file handle that is read only.
+my $file = "./xcv" ; unlink $file ;
+open (FH, ">$file") or die $! ;
+close FH or die $! ;
+die "There is no file $file" unless -f $file ;
+open (FH, "<$file") or die $! ;
+print FH "anc" ;
+open(FOO, "<&FH") or die $! ;
+print FOO "anc" ;
 no warnings 'io' ;
-print STDIN "anc";
+print FH "anc" ;
+print FOO "anc" ;
+use warnings 'io' ;
+print FH "anc" ;
+print FOO "anc" ;
+close (FH) or die $! ;
+close (FOO) or die $! ;
+unlink $file ;
 EXPECT
-Filehandle STDIN opened only for input at - line 3.
-Filehandle STDOUT opened only for output at - line 4.
-Filehandle STDERR opened only for output at - line 5.
-Filehandle FOO opened only for output at - line 6.
-Filehandle STDERR opened only for output at - line 7.
-Filehandle FOO opened only for output at - line 8.
+Filehandle FH opened only for input at - line 12.
+Filehandle FOO opened only for input at - line 14.
+Filehandle FH opened only for input at - line 19.
+Filehandle FOO opened only for input at - line 20.
 ########
 # pp_hot.c [pp_print]
 use warnings 'closed' ;
@@ -95,11 +103,41 @@ no warnings 'closed' ;
 print STDIN "anc";
 opendir STDIN, ".";
 print STDIN "anc";
+use warnings;
+no warnings 'closed' ;
+print STDIN "anc";
 EXPECT
 print() on closed filehandle STDIN at - line 4.
 print() on closed filehandle STDIN at - line 6.
        (Are you trying to call print() on dirhandle STDIN?)
 ########
+# pp_hot.c [pp_print]
+# [ID 20020425.012] from Dave Steiner <steiner@bakerst.rutgers.edu>
+# This goes segv on 5.7.3
+use warnings 'closed' ;
+my $fh = *STDOUT{IO};
+close STDOUT or die "Can't close STDOUT";
+print $fh "Shouldn't print anything, but shouldn't SEGV either\n";
+EXPECT
+print() on closed filehandle at - line 7.
+########
+# pp_hot.c [pp_print]
+package foo;
+use warnings 'closed';
+open my $fh1, "nonexistent";
+print $fh1 42;
+open $fh2, "nonexistent";
+print $fh2 42;
+open $bar::fh3, "nonexistent";
+print $bar::fh3 42;
+open bar::FH4, "nonexistent";
+print bar::FH4 42;
+EXPECT
+print() on closed filehandle $fh1 at - line 5.
+print() on closed filehandle $fh2 at - line 7.
+print() on closed filehandle $fh3 at - line 9.
+print() on closed filehandle FH4 at - line 11.
+########
 # pp_hot.c [pp_rv2av]
 use warnings 'uninitialized' ;
 my $a = undef ;
@@ -107,7 +145,7 @@ my @b = @$a;
 no warnings 'uninitialized' ;
 my @c = @$a;
 EXPECT
-Use of uninitialized value in array dereference at - line 4.
+Use of uninitialized value $a in array dereference at - line 4.
 ########
 # pp_hot.c [pp_rv2hv]
 use warnings 'uninitialized' ;
@@ -116,7 +154,7 @@ my %b = %$a;
 no warnings 'uninitialized' ;
 my %c = %$a;
 EXPECT
-Use of uninitialized value in hash dereference at - line 4.
+Use of uninitialized value $a in hash dereference at - line 4.
 ########
 # pp_hot.c [pp_aassign]
 use warnings 'misc' ;
@@ -150,14 +188,26 @@ readline() on closed filehandle STDIN at - line 4.
 # pp_hot.c [Perl_do_readline]
 use warnings 'io' ;
 my $file = "./xcv" ; unlink $file ;
-open (FH, ">./xcv") ;
+open (FH, ">$file") or die $! ;
 my $a = <FH> ;
 no warnings 'io' ;
 $a = <FH> ;
-close (FH) ;
+use warnings 'io' ;
+open(FOO, ">&FH") or die $! ;
+$a = <FOO> ;
+no warnings 'io' ;
+$a = <FOO> ;
+use warnings 'io' ;
+$a = <FOO> ;
+$a = <FH> ;
+close (FH) or die $! ;
+close (FOO) or die $! ;
 unlink $file ;
 EXPECT
 Filehandle FH opened only for output at - line 5.
+Filehandle FOO opened only for output at - line 10.
+Filehandle FOO opened only for output at - line 14.
+Filehandle FH opened only for output at - line 15.
 ########
 # pp_hot.c [Perl_sub_crush_depth]
 use warnings 'recursion' ;
@@ -219,11 +269,11 @@ a($x . $y);       # should warn twice
 $x .= $y;      # should warn once
 $y .= $y;      # should warn once
 EXPECT
-Use of uninitialized value in concatenation (.) or string at - line 5.
-Use of uninitialized value in concatenation (.) or string at - line 6.
-Use of uninitialized value in concatenation (.) or string at - line 6.
-Use of uninitialized value in concatenation (.) or string at - line 7.
-Use of uninitialized value in concatenation (.) or string at - line 8.
+Use of uninitialized value $x in concatenation (.) or string at - line 5.
+Use of uninitialized value $y in concatenation (.) or string at - line 6.
+Use of uninitialized value $x in concatenation (.) or string at - line 6.
+Use of uninitialized value $y in concatenation (.) or string at - line 7.
+Use of uninitialized value $y in concatenation (.) or string at - line 8.
 ########
 # pp_hot.c [pp_concat]
 use warnings 'y2k';