partly fix perldiag regressions identified by Tom Christiansen

[p5sagit/p5-mst-13.2.git] / t / pragma / warn / pp_hot

  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

  readline() 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

  Possible Y2K bug: about to append an integer to '19' [pp_concat]
    $x     = "19$yy\n";

__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 in array dereference 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 in hash dereference 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
readline() 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
########
# pp_hot.c [pp_concat]
use warnings 'misc';
use Config;
BEGIN {
    unless ($Config{ccflags} =~ /Y2KWARN/) {
	print "SKIPPED\n# perl not built with -DPERL_Y2KWARN";
	exit 0;
    }
}
my $x;
my $yy = 78;
$x     = "19$yy\n";
$x     = "19" . $yy . "\n";
$x     = "319$yy\n";
$x     = "319" . $yy . "\n";
no warnings 'misc';
$x     = "19$yy\n";
$x     = "19" . $yy . "\n";
EXPECT
Possible Y2K bug: about to append an integer to '19' at - line 12.
Possible Y2K bug: about to append an integer to '19' at - line 13.