X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fpragma%2Fwarn%2Fpp_hot;h=fe874ef7efff54ee2823e782fa85b23c773940ce;hb=c9166e37736ce050b2ee05d4fdf16697211280ca;hp=2a52dfb2df61395932b4865b4dbf1e07f4a2e624;hpb=4438c4b75b842b6c829a7da9841e97abb875b1d8;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot index 2a52dfb..fe874ef 100644 --- a/t/pragma/warn/pp_hot +++ b/t/pragma/warn/pp_hot @@ -1,49 +1,60 @@ - pp_hot.c AOK + pp_hot.c - Filehandle %s never opened + Filehandle %s never opened [pp_print] $f = $a = "abc" ; print $f $a - Filehandle %s opened only for input + Filehandle %s opened only for input [pp_print] print STDIN "abc" ; - Filehandle %s opened only for output + Filehandle %s opened only for output [pp_print] print ; - print on closed filehandle %s + print() on closed filehandle %s [pp_print] close STDIN ; print STDIN "abc" ; - uninitialized + uninitialized [pp_rv2av] my $a = undef ; my @b = @$a - uninitialized + uninitialized [pp_rv2hv] my $a = undef ; my %b = %$a - Odd number of elements in hash list + Odd number of elements in hash list [pp_aassign] %X = (1,2,3) ; - Reference found where even-sized list expected + Reference found where even-sized list expected [pp_aassign] $X = [ 1 ..3 ]; - Read on closed filehandle %s + Filehandle %s opened only for output [Perl_do_readline] + open (FH, ">./xcv") ; + my $a = ; + + glob failed (can't start child: %s) [Perl_do_readline] <; - Deep recursion on subroutine \"%s\" - sub fred { fred() if $a++ < 200} fred() + glob failed (child exited with status %d%s) [Perl_do_readline] <; @@ -51,76 +62,97 @@ print ; open(FOO, ">&STDOUT") and print ; print getc(STDERR); print getc(FOO); -read(FOO,$_,1); -no warnings 'io' ; -print STDIN "anc"; #################################################################### -# N O T E # -# This test is known to fail on Linux and *BSD systems with glibc. # -# The glibc development team is aware of the problem, and has # -# determined a fix for the next release of that library. # +# The next test is known to fail on some systems (Linux+old glibc, # +# old *BSDs, and NeXT, among others. # +# 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. -Filehandle main::FOO opened only for output at - line 9. +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. ######## -# pp_hot.c +# pp_hot.c [pp_print] use warnings 'closed' ; close STDIN ; print STDIN "anc"; +opendir STDIN, "."; +print STDIN "anc"; +closedir STDIN; no warnings 'closed' ; print STDIN "anc"; +opendir STDIN, "."; +print STDIN "anc"; EXPECT -print on closed filehandle main::STDIN at - line 4. +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_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. +Use of uninitialized value in array dereference at - line 4. ######## -# pp_hot.c +# 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. +Use of uninitialized value in hash dereference at - line 4. ######## -# pp_hot.c -use warnings 'unsafe' ; +# pp_hot.c [pp_aassign] +use warnings 'misc' ; my %X ; %X = (1,2,3) ; -no warnings 'unsafe' ; +no warnings 'misc' ; my %Y ; %Y = (1,2,3) ; EXPECT Odd number of elements in hash assignment at - line 3. ######## -# pp_hot.c -use warnings 'unsafe' ; +# pp_hot.c [pp_aassign] +use warnings 'misc' ; my %X ; %X = [1 .. 3] ; -no warnings 'unsafe' ; +no warnings 'misc' ; my %Y ; %Y = [1 .. 3] ; EXPECT Reference found where even-sized list expected at - line 3. ######## -# pp_hot.c +# pp_hot.c [Perl_do_readline] use warnings 'closed' ; -close STDIN ; $a = ; +close STDIN ; $a = ; +opendir STDIN, "." ; $a = ; +closedir STDIN; no warnings 'closed' ; +opendir STDIN, "." ; $a = ; $a = ; EXPECT -Read on closed filehandle main::STDIN at - line 3. +readline() on closed filehandle STDIN at - line 3. +readline() on closed filehandle STDIN at - line 4. + (Are you trying to call readline() on dirhandle STDIN?) +######## +# pp_hot.c [Perl_do_readline] +use warnings 'io' ; +my $file = "./xcv" ; unlink $file ; +open (FH, ">./xcv") ; +my $a = ; +no warnings 'io' ; +$a = ; +unlink $file ; +EXPECT +Filehandle FH opened only for output at - line 5. ######## -# pp_hot.c +# pp_hot.c [Perl_sub_crush_depth] use warnings 'recursion' ; sub fred { @@ -135,7 +167,7 @@ sub fred EXPECT ok ######## -# pp_hot.c +# pp_hot.c [Perl_sub_crush_depth] no warnings 'recursion' ; sub fred { @@ -150,7 +182,7 @@ sub fred EXPECT ######## -# pp_hot.c +# pp_hot.c [Perl_sub_crush_depth] use warnings 'recursion' ; $b = sub { @@ -161,7 +193,7 @@ $b = sub EXPECT Deep recursion on anonymous subroutine at - line 5. ######## -# pp_hot.c +# pp_hot.c [Perl_sub_crush_depth] no warnings 'recursion' ; $b = sub { @@ -170,4 +202,25 @@ $b = sub &$b ; EXPECT - +######## +# pp_hot.c [pp_concat] +use warnings 'y2k'; +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 'y2k'; +$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.