Get resolve -at mainline

p4raw-id: //depot/utfperl@4126

1 files changed, 192 insertions, 0 deletions

diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot
new file mode 100644
index 0000000000..6bd315148f
--- /dev/null
+++ b/t/pragma/warn/pp_hot
@@ -0,0 +1,192 @@
+  pp_hot.c	
+
+  Filehandle %s never opened			[pp_print]
+    $f = $a = "abc" ; print $f $a
+
+  Filehandle %s opened only for input		[pp_print]
+    print STDIN "abc" ;
+
+  Filehandle %s opened only for output		[pp_print]
+    print <STDOUT> ;
+
+  print on closed filehandle %s			[pp_print]
+    close STDIN ; print STDIN "abc" ;
+
+  uninitialized					[pp_rv2av]
+	my $a = undef ; my @b = @$a
+
+  uninitialized					[pp_rv2hv]
+	my $a = undef ; my %b = %$a
+
+  Odd number of elements in hash list		[pp_aassign]
+	%X = (1,2,3) ;
+
+  Reference found where even-sized list expected [pp_aassign]
+	$X = [ 1 ..3 ];
+
+  Filehandle %s opened only for output		[Perl_do_readline] 
+  	open (FH, ">./xcv") ;
+	my $a = <FH> ;
+
+  glob failed (can't start child: %s)		[Perl_do_readline] <<TODO
+
+  Read on closed filehandle %s			[Perl_do_readline]
+    close STDIN ; $a = <STDIN>;
+
+  glob failed (child exited with status %d%s)	[Perl_do_readline] <<TODO
+
+  Deep recursion on subroutine \"%s\"		[Perl_sub_crush_depth]
+     sub fred { fred() if $a++ < 200} fred()
+
+  Deep recursion on anonymous subroutine 	[Perl_sub_crush_depth]
+     $a = sub { &$a if $a++ < 200} &$a
+
+
+__END__
+# pp_hot.c [pp_print]
+use warnings 'unopened' ;
+$f = $a = "abc" ; 
+print $f $a;
+no warnings 'unopened' ;
+print $f $a;
+EXPECT
+Filehandle main::abc never opened 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/BSD+glibc, #
+# NeXT among others.  glibc should be fixed in the next version,   #
+# but it appears other platforms have little hope.  We skip it for #
+# now (on the grounds that it is "just" a warning).                #
+####################################################################
+#read(FOO,$_,1);
+no warnings 'io' ;
+print STDIN "anc";
+EXPECT
+Filehandle main::STDIN opened only for input at - line 3.
+Filehandle main::STDOUT opened only for output at - line 4.
+Filehandle main::STDERR opened only for output at - line 5.
+Filehandle main::FOO opened only for output at - line 6.
+Filehandle main::STDERR opened only for output at - line 7.
+Filehandle main::FOO opened only for output at - line 8.
+########
+# pp_hot.c [pp_print]
+use warnings 'closed' ;
+close STDIN ;
+print STDIN "anc";
+no warnings 'closed' ;
+print STDIN "anc";
+EXPECT
+print on closed filehandle main::STDIN at - line 4.
+########
+# pp_hot.c [pp_rv2av]
+use warnings 'uninitialized' ;
+my $a = undef ;
+my @b = @$a;
+no warnings 'uninitialized' ;
+my @c = @$a;
+EXPECT
+Use of uninitialized value at - line 4.
+########
+# pp_hot.c [pp_rv2hv]
+use warnings 'uninitialized' ;
+my $a = undef ;
+my %b = %$a;
+no warnings 'uninitialized' ;
+my %c = %$a;
+EXPECT
+Use of uninitialized value at - line 4.
+########
+# pp_hot.c [pp_aassign]
+use warnings 'unsafe' ;
+my %X ; %X = (1,2,3) ;
+no warnings 'unsafe' ;
+my %Y ; %Y = (1,2,3) ;
+EXPECT
+Odd number of elements in hash assignment at - line 3.
+########
+# pp_hot.c [pp_aassign]
+use warnings 'unsafe' ;
+my %X ; %X = [1 .. 3] ;
+no warnings 'unsafe' ;
+my %Y ; %Y = [1 .. 3] ;
+EXPECT
+Reference found where even-sized list expected at - line 3.
+########
+# pp_hot.c [Perl_do_readline]
+use warnings 'closed' ;
+close STDIN ; $a = <STDIN> ;
+no warnings 'closed' ;
+$a = <STDIN> ;
+EXPECT
+Read on closed filehandle main::STDIN at - line 3.
+########
+# pp_hot.c [Perl_do_readline]
+use warnings 'io' ;
+my $file = "./xcv" ; unlink $file ;
+open (FH, ">./xcv") ;
+my $a = <FH> ;
+no warnings 'io' ;
+$a = <FH> ;
+unlink $file ;
+EXPECT
+Filehandle main::FH opened only for output at - line 5.
+########
+# pp_hot.c [Perl_sub_crush_depth]
+use warnings 'recursion' ;
+sub fred 
+{ 
+    fred() if $a++ < 200
+} 
+{
+  local $SIG{__WARN__} = sub {
+    die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
+  };
+  fred();
+}
+EXPECT
+ok
+########
+# pp_hot.c [Perl_sub_crush_depth]
+no warnings 'recursion' ;
+sub fred 
+{ 
+    fred() if $a++ < 200
+} 
+{
+  local $SIG{__WARN__} = sub {
+    die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
+  };
+  fred();
+}
+EXPECT
+
+########
+# pp_hot.c [Perl_sub_crush_depth]
+use warnings 'recursion' ;
+$b = sub 
+{ 
+    &$b if $a++ < 200
+}  ;
+
+&$b ;
+EXPECT
+Deep recursion on anonymous subroutine at - line 5.
+########
+# pp_hot.c [Perl_sub_crush_depth]
+no warnings 'recursion' ;
+$b = sub 
+{ 
+    &$b if $a++ < 200
+}  ;
+
+&$b ;
+EXPECT
+