diff options
Diffstat (limited to 't')
| -rw-r--r-- | t/pragma/warn/3both | 135 | ||||
| -rw-r--r-- | t/pragma/warn/6default | 34 | ||||
| -rw-r--r-- | t/pragma/warn/av | 9 | ||||
| -rw-r--r-- | t/pragma/warn/doio | 70 | ||||
| -rw-r--r-- | t/pragma/warn/doop | 25 | ||||
| -rw-r--r-- | t/pragma/warn/gv | 14 | ||||
| -rw-r--r-- | t/pragma/warn/hv | 8 | ||||
| -rw-r--r-- | t/pragma/warn/malloc | 9 | ||||
| -rw-r--r-- | t/pragma/warn/mg | 19 | ||||
| -rw-r--r-- | t/pragma/warn/op | 216 | ||||
| -rw-r--r-- | t/pragma/warn/perl | 45 | ||||
| -rw-r--r-- | t/pragma/warn/perlio | 10 | ||||
| -rw-r--r-- | t/pragma/warn/perly | 6 | ||||
| -rw-r--r-- | t/pragma/warn/pp | 48 | ||||
| -rw-r--r-- | t/pragma/warn/pp_ctl | 67 | ||||
| -rw-r--r-- | t/pragma/warn/pp_hot | 48 | ||||
| -rw-r--r-- | t/pragma/warn/pp_sys | 40 | ||||
| -rw-r--r-- | t/pragma/warn/regcomp | 12 | ||||
| -rw-r--r-- | t/pragma/warn/regexec | 52 | ||||
| -rw-r--r-- | t/pragma/warn/run | 8 | ||||
| -rw-r--r-- | t/pragma/warn/sv | 83 | ||||
| -rw-r--r-- | t/pragma/warn/taint | 56 | ||||
| -rw-r--r-- | t/pragma/warn/toke | 213 | ||||
| -rw-r--r-- | t/pragma/warn/universal | 2 | ||||
| -rw-r--r-- | t/pragma/warn/utf8 | 56 | ||||
| -rw-r--r-- | t/pragma/warn/util | 53 | ||||
| -rwxr-xr-x | t/pragma/warning.t | 2 |
27 files changed, 1295 insertions, 45 deletions
diff --git a/t/pragma/warn/3both b/t/pragma/warn/3both index 7c3260126b..1d7deb8636 100644 --- a/t/pragma/warn/3both +++ b/t/pragma/warn/3both @@ -18,6 +18,20 @@ Use of uninitialized value at - line 6. # Check interaction of $^W and use warning sub fred { + use warning ; + my $b ; + chop $b ; +} +{ $^W = 0 ; + fred() ; +} + +EXPECT +Use of uninitialized value at - line 6. +######## + +# Check interaction of $^W and use warning +sub fred { no warning ; my $b ; chop $b ; @@ -27,7 +41,21 @@ sub fred { } EXPECT -Use of uninitialized value at - line 6. + +######## + +# Check interaction of $^W and use warning +sub fred { + no warning ; + my $b ; + chop $b ; +} +{ $^W = 1 ; + fred() ; +} + +EXPECT + ######## # Check interaction of $^W and use warning @@ -54,7 +82,7 @@ no warning ; my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 6. + ######## # Check interaction of $^W and use warning @@ -63,4 +91,107 @@ $^W = 1 ; my $b ; chop $b ; EXPECT + +######## +-w +# Check interaction of $^W and use warning +no warning ; +my $b ; +chop $b ; +EXPECT + +######## +-w +# Check interaction of $^W and use warning +use warning ; +my $b ; +chop $b ; +EXPECT +Use of uninitialized value at - line 5. +######## + +# Check interaction of $^W and use warning +sub fred { + use warning ; + my $b ; + chop $b ; +} +BEGIN { $^W = 0 } +fred() ; +EXPECT +Use of uninitialized value at - line 6. +######## + +# Check interaction of $^W and use warning +sub fred { + no warning ; + my $b ; + chop $b ; +} +BEGIN { $^W = 1 } +fred() ; + +EXPECT + +######## + +# Check interaction of $^W and use warning +use warning ; +BEGIN { $^W = 1 } +my $b ; +chop $b ; +EXPECT Use of uninitialized value at - line 6. +######## + +# Check interaction of $^W and use warning +BEGIN { $^W = 1 } +use warning ; +my $b ; +chop $b ; +EXPECT +Use of uninitialized value at - line 6. +######## + +# Check interaction of $^W and use warning +BEGIN { $^W = 1 } +no warning ; +my $b ; +chop $b ; +EXPECT + +######## + +# Check interaction of $^W and use warning +no warning ; +BEGIN { $^W = 1 } +my $b ; +chop $b ; +EXPECT + +######## + +# Check interaction of $^W and use warning +BEGIN { $^W = 1 } +{ + no warning ; + my $b ; + chop $b ; +} +my $b ; +chop $b ; +EXPECT +Use of uninitialized value at - line 10. +######## + +# Check interaction of $^W and use warning +BEGIN { $^W = 0 } +{ + use warning ; + my $b ; + chop $b ; +} +my $b ; +chop $b ; +EXPECT +Use of uninitialized value at - line 7. diff --git a/t/pragma/warn/6default b/t/pragma/warn/6default new file mode 100644 index 0000000000..c095b20827 --- /dev/null +++ b/t/pragma/warn/6default @@ -0,0 +1,34 @@ +Check default warnings + +__END__ +# default warning should be displayed if you don't add anything +# optional shouldn't +my $a = oct "7777777777777777777777777777777777779" ; +EXPECT +Integer overflow in octal number at - line 3. +######## +# no warning should be displayed +no warning ; +my $a = oct "7777777777777777777777777777777777779" ; +EXPECT +######## +# all warning should be displayed +use warning ; +my $a = oct "7777777777777777777777777777777777779" ; +EXPECT +Integer overflow in octal number at - line 3. +Illegal octal digit '9' ignored at - line 3. +######## +# check scope +use warning ; +my $a = oct "7777777777777777777777777777777777779" ; +{ + no warning ; + my $a = oct "7777777777777777777777777777777777779" ; +} +my $c = oct "7777777777777777777777777777777777779" ; +EXPECT +Integer overflow in octal number at - line 3. +Illegal octal digit '9' ignored at - line 3. +Integer overflow in octal number at - line 8. +Illegal octal digit '9' ignored at - line 8. diff --git a/t/pragma/warn/av b/t/pragma/warn/av new file mode 100644 index 0000000000..79bd3b7600 --- /dev/null +++ b/t/pragma/warn/av @@ -0,0 +1,9 @@ + av.c + + Mandatory Warnings ALL TODO + ------------------ + av_reify called on tied array [av_reify] + + Attempt to clear deleted array [av_clear] + +__END__ diff --git a/t/pragma/warn/doio b/t/pragma/warn/doio index 97f0804bfa..5bcca8d78c 100644 --- a/t/pragma/warn/doio +++ b/t/pragma/warn/doio @@ -41,29 +41,50 @@ Can't exec \"%s\": %s + Mandatory Warnings ALL TODO + ------------------ + Can't do inplace edit: %s is not a regular file + edit a directory + + Can't do inplace edit: %s would not be unique + Can't rename %s to %s: %s, skipping file + Can't rename %s to %s: %s, skipping file + Can't remove %s: %s, skipping file + Can't do inplace edit on %s: %s + + __END__ # doio.c use warning 'io' ; open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|"); close(F); +no warning 'io' ; +open(G, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|"); +close(G); EXPECT Can't do bidirectional pipe at - line 3. ######## # doio.c use warning 'io' ; -open(F, "| ") +open(F, "| "); +no warning 'io' ; +open(G, "| "); EXPECT Missing command in piped open at - line 3. ######## # doio.c use warning 'io' ; -open(F, " |") +open(F, " |"); +no warning 'io' ; +open(G, " |"); EXPECT Missing command in piped open at - line 3. ######## # doio.c use warning 'io' ; -open(F, "<true\ncd") +open(F, "<true\ncd"); +no warning 'io' ; +open(G, "<true\ncd"); EXPECT Unsuccessful open on filename containing newline at - line 3. ######## @@ -74,6 +95,12 @@ tell(STDIN); $a = seek(STDIN,1,1); $a = sysseek(STDIN,1,1); -x STDIN ; +no warning 'io' ; +close STDIN ; +tell(STDIN); +$a = seek(STDIN,1,1); +$a = sysseek(STDIN,1,1); +-x STDIN ; EXPECT tell() on unopened file at - line 4. seek() on unopened file at - line 5. @@ -83,6 +110,8 @@ Stat on unopened file <STDIN> at - line 7. # doio.c use warning 'uninitialized' ; print $a ; +no warning 'uninitialized' ; +print $b ; EXPECT Use of uninitialized value at - line 3. ######## @@ -96,6 +125,9 @@ EXPECT use warning 'io' ; stat "ab\ncd"; lstat "ab\ncd"; +no warning 'io' ; +stat "ab\ncd"; +lstat "ab\ncd"; EXPECT Unsuccessful stat on filename containing newline at - line 3. Unsuccessful stat on filename containing newline at - line 4. @@ -103,6 +135,8 @@ Unsuccessful stat on filename containing newline at - line 4. # doio.c use warning 'io' ; exec "lskdjfalksdjfdjfkls","" ; +no warning 'io' ; +exec "lskdjfalksdjfdjfkls","" ; EXPECT OPTION regex Can't exec "lskdjfalksdjfdjfkls": .+ @@ -110,6 +144,36 @@ Can't exec "lskdjfalksdjfdjfkls": .+ # doio.c use warning 'io' ; exec "lskdjfalksdjfdjfkls", "abc" ; +no warning 'io' ; +exec "lskdjfalksdjfdjfkls", "abc" ; EXPECT OPTION regex Can't exec "lskdjfalksdjfdjfkls(:? abc)?": .+ +######## +# doio.c +$^W = 0 ; +my $filename = "./temp" ; +mkdir $filename, 0777 + or die "Cannot create directory $filename: $!\n" ; +{ + local (@ARGV) = ($filename) ; + local ($^I) = "" ; + my $x = <> ; +} +{ + no warning 'inplace' ; + local (@ARGV) = ($filename) ; + local ($^I) = "" ; + my $x = <> ; +} +{ + use warning 'inplace' ; + local (@ARGV) = ($filename) ; + local ($^I) = "" ; + my $x = <> ; +} +rmdir $filename ; +EXPECT +Can't do inplace edit: ./temp is not a regular file at - line 9. +Can't do inplace edit: ./temp is not a regular file at - line 21. + diff --git a/t/pragma/warn/doop b/t/pragma/warn/doop new file mode 100644 index 0000000000..458a3b2803 --- /dev/null +++ b/t/pragma/warn/doop @@ -0,0 +1,25 @@ + doop.c AOK + + Malformed UTF-8 character + + +__END__ +# doop.c +use utf8 ; +$_ = "\x80 \xff" ; +chop ; +EXPECT +Malformed UTF-8 character at - line 4. +######## +# doop.c +use warning 'utf8' ; +use utf8 ; +$_ = "\x80 \xff" ; +chop ; +no warning 'utf8' ; +$_ = "\x80 \xff" ; +chop ; +EXPECT +\x80 will produce malformed UTF-8 character; use \x{80} for that at - line 4. +\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 4. +Malformed UTF-8 character at - line 5. diff --git a/t/pragma/warn/gv b/t/pragma/warn/gv index bd442b97d6..e33f8ca04f 100644 --- a/t/pragma/warn/gv +++ b/t/pragma/warn/gv @@ -14,7 +14,12 @@ $a = ${"#"} ; $a = ${"*"} ; + Mandatory Warnings ALL TODO + ------------------ + Had to create %s unexpectedly [gv_fetchpv] + Attempt to free unreferenced glob pointers [gp_free] + __END__ # gv.c use warning 'misc' ; @@ -24,6 +29,12 @@ Can't locate package Fred for @main::ISA at - line 3. Undefined subroutine &main::joe called at - line 3. ######## # gv.c +no warning 'misc' ; +@ISA = qw(Fred); joe() +EXPECT +Undefined subroutine &main::joe called at - line 3. +######## +# gv.c sub Other::AUTOLOAD { 1 } sub Other::fred {} @ISA = qw(Other) ; use warning 'deprecated' ; @@ -35,6 +46,9 @@ Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5. use warning 'deprecated' ; $a = ${"#"}; $a = ${"*"}; +no warning 'deprecated' ; +$a = ${"#"}; +$a = ${"*"}; EXPECT Use of $# is deprecated at - line 3. Use of $* is deprecated at - line 4. diff --git a/t/pragma/warn/hv b/t/pragma/warn/hv new file mode 100644 index 0000000000..c9eec028f1 --- /dev/null +++ b/t/pragma/warn/hv @@ -0,0 +1,8 @@ + hv.c + + + Mandatory Warnings ALL TODO + ------------------ + Attempt to free non-existent shared string [unsharepvn] + +__END__ diff --git a/t/pragma/warn/malloc b/t/pragma/warn/malloc new file mode 100644 index 0000000000..2f8b096a51 --- /dev/null +++ b/t/pragma/warn/malloc @@ -0,0 +1,9 @@ + malloc.c + + + Mandatory Warnings ALL TODO + ------------------ + %s free() ignored [Perl_mfree] + %s", "Bad free() ignored [Perl_mfree] + +__END__ diff --git a/t/pragma/warn/mg b/t/pragma/warn/mg index 14307e0de0..7f40ded7f8 100644 --- a/t/pragma/warn/mg +++ b/t/pragma/warn/mg @@ -6,6 +6,9 @@ SIG%s handler \"%s\" not defined. $SIG{"INT"} = "ok3"; kill "INT",$$; + Mandatory Warnings TODO + ------------------ + Can't break at that line [magic_setdbline] __END__ # mg.c @@ -15,6 +18,12 @@ EXPECT No such signal: SIGFRED at - line 3. ######## # mg.c +no warning 'signal' ; +$SIG{FRED} = sub {}; +EXPECT + +######## +# mg.c use warning 'signal' ; if ($^O eq 'MSWin32' || $^O eq 'VMS') { print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit; @@ -23,3 +32,13 @@ $|=1; $SIG{"INT"} = "fred"; kill "INT",$$; EXPECT SIGINT handler "fred" not defined. +######## +# mg.c +no warning 'signal' ; +if ($^O eq 'MSWin32' || $^O eq 'VMS') { + print "SKIPPED\n# win32, can't kill() to raise()\n"; exit; +} +$|=1; +$SIG{"INT"} = "fred"; kill "INT",$$; +EXPECT + diff --git a/t/pragma/warn/op b/t/pragma/warn/op index 7c2b6b8050..dce52d8c93 100644 --- a/t/pragma/warn/op +++ b/t/pragma/warn/op @@ -98,11 +98,27 @@ defined %h ; my %h ; defined %h ; + Mandatory Warnings + ------------------ + Prototype mismatch: [cv_ckproto] + sub fred() ; + sub fred($) {} + + %s never introduced [pad_leavemy] TODO + Runaway prototype [newSUB] TODO + oops: oopsAV [oopsAV] TODO + oops: oopsHV [oopsHV] TODO + + + + __END__ # op.c use warning 'unsafe' ; my $x ; my $x ; +no warning 'unsafe' ; +my $x ; EXPECT "my" variable $x masks earlier declaration in same scope at - line 4. ######## @@ -118,6 +134,17 @@ EXPECT Variable "$x" will not stay shared at - line 7. ######## # op.c +no warning 'unsafe' ; +sub x { + my $x; + sub y { + $x + } + } +EXPECT + +######## +# op.c use warning 'unsafe' ; sub x { my $x; @@ -129,20 +156,37 @@ EXPECT Variable "$x" may be unavailable at - line 6. ######## # op.c +no warning 'unsafe' ; +sub x { + my $x; + sub y { + sub { $x } + } + } +EXPECT + +######## +# op.c use warning 'syntax' ; 1 if $a = 1 ; +no warning 'syntax' ; +1 if $a = 1 ; EXPECT Found = in conditional, should be == at - line 3. ######## # op.c use warning 'deprecated' ; split ; +no warning 'deprecated' ; +split ; EXPECT Use of implicit split to @_ is deprecated at - line 3. ######## # op.c use warning 'deprecated' ; $a = split ; +no warning 'deprecated' ; +$a = split ; EXPECT Use of implicit split to @_ is deprecated at - line 3. ######## @@ -239,8 +283,65 @@ Useless use of getpwnam in void context at - line 52. Useless use of getpwuid in void context at - line 53. ######## # op.c +no warning 'void' ; close STDIN ; +1 x 3 ; # OP_REPEAT + # OP_GVSV +wantarray ; # OP_WANTARRAY + # OP_GV + # OP_PADSV + # OP_PADAV + # OP_PADHV + # OP_PADANY + # OP_AV2ARYLEN +ref ; # OP_REF +\@a ; # OP_REFGEN +\$a ; # OP_SREFGEN +defined $a ; # OP_DEFINED +hex $a ; # OP_HEX +oct $a ; # OP_OCT +length $a ; # OP_LENGTH +substr $a,1 ; # OP_SUBSTR +vec $a,1,2 ; # OP_VEC +index $a,1,2 ; # OP_INDEX +rindex $a,1,2 ; # OP_RINDEX +sprintf $a ; # OP_SPRINTF +$a[0] ; # OP_AELEM + # OP_AELEMFAST +@a[0] ; # OP_ASLICE +#values %a ; # OP_VALUES +#keys %a ; # OP_KEYS +$a{0} ; # OP_HELEM +@a{0} ; # OP_HSLICE +unpack "a", "a" ; # OP_UNPACK +pack $a,"" ; # OP_PACK +join "" ; # OP_JOIN +(@a)[0,1] ; # OP_LSLICE + # OP_ANONLIST + # OP_ANONHASH +sort(1,2) ; # OP_SORT +reverse(1,2) ; # OP_REVERSE + # OP_RANGE + # OP_FLIP +(1 ..2) ; # OP_FLOP +caller ; # OP_CALLER +fileno STDIN ; # OP_FILENO +eof STDIN ; # OP_EOF +tell STDIN ; # OP_TELL +readlink 1; # OP_READLINK +time ; # OP_TIME +localtime ; # OP_LOCALTIME +gmtime ; # OP_GMTIME +eval { getgrnam 1 }; # OP_GGRNAM +eval { getgrgid 1 }; # OP_GGRGID +eval { getpwnam 1 }; # OP_GPWNAM +eval { getpwuid 1 }; # OP_GPWUID +EXPECT +######## +# op.c use warning 'void' ; for (@{[0]}) { "$_" } # check warning isn't duplicated +no warning 'void' ; +for (@{[0]}) { "$_" } # check warning isn't duplicated EXPECT Useless use of string in void context at - line 3. ######## @@ -257,6 +358,8 @@ EOM } } telldir 1 ; # OP_TELLDIR +no warning 'void' ; +telldir 1 ; # OP_TELLDIR EXPECT Useless use of telldir in void context at - line 13. ######## @@ -273,6 +376,8 @@ EOM } } getppid ; # OP_GETPPID +no warning 'void' ; +getppid ; # OP_GETPPID EXPECT Useless use of getppid in void context at - line 13. ######## @@ -289,6 +394,8 @@ EOM } } getpgrp ; # OP_GETPGRP +no warning 'void' ; +getpgrp ; # OP_GETPGRP EXPECT Useless use of getpgrp in void context at - line 13. ######## @@ -305,6 +412,8 @@ EOM } } times ; # OP_TMS +no warning 'void' ; +times ; # OP_TMS EXPECT Useless use of times in void context at - line 13. ######## @@ -321,6 +430,8 @@ EOM } } getpriority 1,2; # OP_GETPRIORITY +no warning 'void' ; +getpriority 1,2; # OP_GETPRIORITY EXPECT Useless use of getpriority in void context at - line 13. ######## @@ -337,6 +448,8 @@ EOM } } getlogin ; # OP_GETLOGIN +no warning 'void' ; +getlogin ; # OP_GETLOGIN EXPECT Useless use of getlogin in void context at - line 13. ######## @@ -377,6 +490,22 @@ getprotoent ; # OP_GPROTOENT getservbyname 1,2; # OP_GSBYNAME getservbyport 1,2; # OP_GSBYPORT getservent ; # OP_GSERVENT + +no warning 'void' ; +getsockname STDIN ; # OP_GETSOCKNAME +getpeername STDIN ; # OP_GETPEERNAME +gethostbyname 1 ; # OP_GHBYNAME +gethostbyaddr 1,2; # OP_GHBYADDR +gethostent ; # OP_GHOSTENT +getnetbyname 1 ; # OP_GNBYNAME +getnetbyaddr 1,2 ; # OP_GNBYADDR +getnetent ; # OP_GNETENT +getprotobyname 1; # OP_GPBYNAME +getprotobynumber 1; # OP_GPBYNUMBER +getprotoent ; # OP_GPROTOENT +getservbyname 1,2; # OP_GSBYNAME +getservbyport 1,2; # OP_GSBYPORT +getservent ; # OP_GSERVENT INIT { # some functions may not be there, so we exit without running exit; @@ -403,6 +532,11 @@ use warning 'void' ; $a ; # OP_RV2SV @a ; # OP_RV2AV %a ; # OP_RV2HV +no warning 'void' ; +*a ; # OP_RV2GV +$a ; # OP_RV2SV +@a ; # OP_RV2AV +%a ; # OP_RV2HV EXPECT Useless use of a variable in void context at - line 3. Useless use of a variable in void context at - line 4. @@ -413,6 +547,9 @@ Useless use of a variable in void context at - line 6. use warning 'void' ; "abc"; # OP_CONST 7 ; # OP_CONST +no warning 'void' ; +"abc"; # OP_CONST +7 ; # OP_CONST EXPECT Useless use of a constant in void context at - line 3. Useless use of a constant in void context at - line 4. @@ -432,6 +569,22 @@ my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ; %$c =~ /abc/ ; %$c =~ s/a/b/ ; %$c =~ tr/a/b/ ; +{ +no warning 'unsafe' ; +my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ; +@a =~ /abc/ ; +@a =~ s/a/b/ ; +@a =~ tr/a/b/ ; +@$b =~ /abc/ ; +@$b =~ s/a/b/ ; +@$b =~ tr/a/b/ ; +%a =~ /abc/ ; +%a =~ s/a/b/ ; +%a =~ tr/a/b/ ; +%$c =~ /abc/ ; +%$c =~ s/a/b/ ; +%$c =~ tr/a/b/ ; +} EXPECT Applying pattern match to @array will act on scalar(@array) at - line 4. Applying substitution to @array will act on scalar(@array) at - line 5. @@ -446,23 +599,29 @@ Applying character translation to %hash will act on scalar(%hash) at - line 12. Applying pattern match to %hash will act on scalar(%hash) at - line 13. Applying substitution to %hash will act on scalar(%hash) at - line 14. Applying character translation to %hash will act on scalar(%hash) at - line 15. -Execution of - aborted due to compilation errors. +BEGIN not safe after errors--compilation aborted at - line 17. ######## # op.c use warning 'syntax' ; my $a, $b = (1,2); +no warning 'syntax' ; +my $c, $d = (1,2); EXPECT Parentheses missing around "my" list at - line 3. ######## # op.c use warning 'syntax' ; local $a, $b = (1,2); +no warning 'syntax' ; +local $c, $d = (1,2); EXPECT Parentheses missing around "local" list at - line 3. ######## # op.c use warning 'syntax' ; print (ABC || 1) ; +no warning 'syntax' ; +print (ABC || 1) ; EXPECT Probable precedence problem on logical or at - line 3. ######## @@ -473,6 +632,8 @@ Probable precedence problem on logical or at - line 3. use warning 'unsafe' ; open FH, "<abc" ; $x = 1 if $x = <FH> ; +no warning 'unsafe' ; +$x = 1 if $x = <FH> ; EXPECT Value of <HANDLE> construct can be "0"; test with defined() at - line 4. ######## @@ -480,6 +641,8 @@ Value of <HANDLE> construct can be "0"; test with defined() at - line 4. use warning 'unsafe' ; opendir FH, "." ; $x = 1 if $x = readdir FH ; +no warning 'unsafe' ; +$x = 1 if $x = readdir FH ; closedir FH ; EXPECT Value of readdir() operator can be "0"; test with defined() at - line 4. @@ -487,6 +650,8 @@ Value of readdir() operator can be "0"; test with defined() at - line 4. # op.c use warning 'unsafe' ; $x = 1 if $x = <*> ; +no warning 'unsafe' ; +$x = 1 if $x = <*> ; EXPECT Value of glob construct can be "0"; test with defined() at - line 3. ######## @@ -494,12 +659,16 @@ Value of glob construct can be "0"; test with defined() at - line 3. use warning 'unsafe' ; %a = (1,2,3,4) ; $x = 1 if $x = each %a ; +no warning 'unsafe' ; +$x = 1 if $x = each %a ; EXPECT Value of each() operator can be "0"; test with defined() at - line 4. ######## # op.c use warning 'unsafe' ; $x = 1 while $x = <*> and 0 ; +no warning 'unsafe' ; +$x = 1 while $x = <*> and 0 ; EXPECT Value of glob construct can be "0"; test with defined() at - line 3. ######## @@ -507,6 +676,8 @@ Value of glob construct can be "0"; test with defined() at - line 3. use warning 'unsafe' ; opendir FH, "." ; $x = 1 while $x = readdir FH and 0 ; +no warning 'unsafe' ; +$x = 1 while $x = readdir FH and 0 ; closedir FH ; EXPECT Value of readdir() operator can be "0"; test with defined() at - line 4. @@ -515,6 +686,8 @@ Value of readdir() operator can be "0"; test with defined() at - line 4. use warning 'redefine' ; sub fred {} sub fred {} +no warning 'redefine' ; +sub fred {} EXPECT Subroutine fred redefined at - line 4. ######## @@ -522,6 +695,8 @@ Subroutine fred redefined at - line 4. use warning 'redefine' ; sub fred () { 1 } sub fred () { 1 } +no warning 'redefine' ; +sub fred () { 1 } EXPECT Constant subroutine fred redefined at - line 4. ######## @@ -531,18 +706,25 @@ format FRED = . format FRED = . +no warning 'redefine' ; +format FRED = +. EXPECT Format FRED redefined at - line 5. ######## # op.c use warning 'syntax' ; push FRED; +no warning 'syntax' ; +push FRED; EXPECT Array @FRED missing the @ in argument 1 of push() at - line 3. ######## # op.c use warning 'syntax' ; @a = keys FRED ; +no warning 'syntax' ; +@a = keys FRED ; EXPECT Hash %FRED missing the % in argument 1 of keys() at - line 3. ######## @@ -588,3 +770,35 @@ my %h; defined(%h); EXPECT defined(%hash) is deprecated at - line 3. (Maybe you should just omit the defined()?) +######## +# op.c +no warning 'syntax' ; +exec "$^X -e 1" ; +my $a +EXPECT + +######## +# op.c +sub fred(); +sub fred($) {} +EXPECT +Prototype mismatch: sub main::fred () vs ($) at - line 3. +######## +# op.c +$^W = 0 ; +sub fred() ; +sub fred($) {} +{ + no warning 'unsafe' ; + sub Fred() ; + sub Fred($) {} + use warning 'unsafe' ; + sub freD() ; + sub freD($) {} +} +sub FRED() ; +sub FRED($) {} +EXPECT +Prototype mismatch: sub main::fred () vs ($) at - line 4. +Prototype mismatch: sub main::freD () vs ($) at - line 11. +Prototype mismatch: sub main::FRED () vs ($) at - line 14. diff --git a/t/pragma/warn/perl b/t/pragma/warn/perl index 5211990902..25f125e03d 100644 --- a/t/pragma/warn/perl +++ b/t/pragma/warn/perl @@ -3,10 +3,55 @@ gv_check(defstash) Name \"%s::%s\" used only once: possible typo + Mandatory Warnings All TODO + ------------------ + Recompile perl with -DDEBUGGING to use -D switch [moreswitches] + Unbalanced scopes: %ld more ENTERs than LEAVEs [perl_destruct] + Unbalanced saves: %ld more saves than restores [perl_destruct] + Unbalanced tmps: %ld more allocs than frees [perl_destruct] + Unbalanced context: %ld more PUSHes than POPs [perl_destruct] + Unbalanced string table refcount: (%d) for \"%s\" [perl_destruct] + Scalars leaked: %ld [perl_destruct] + __END__ # perl.c +no warning 'once' ; +$x = 3 ; use warning 'once' ; +$z = 3 ; +EXPECT +Name "main::z" used only once: possible typo at - line 5. +######## +-w +# perl.c $x = 3 ; +no warning 'once' ; +$z = 3 EXPECT Name "main::x" used only once: possible typo at - line 3. +######## +# perl.c +BEGIN { $^W =1 ; } +$x = 3 ; +no warning 'once' ; +$z = 3 +EXPECT +Name "main::x" used only once: possible typo at - line 3. +######## +-W +# perl.c +no warning 'once' ; +$x = 3 ; +use warning 'once' ; +$z = 3 ; +EXPECT +Name "main::x" used only once: possible typo at - line 4. +Name "main::z" used only once: possible typo at - line 6. +######## +-X +# perl.c +use warning 'once' ; +$x = 3 ; +EXPECT + diff --git a/t/pragma/warn/perlio b/t/pragma/warn/perlio new file mode 100644 index 0000000000..18c0dfa89f --- /dev/null +++ b/t/pragma/warn/perlio @@ -0,0 +1,10 @@ + perlio.c + + + Mandatory Warnings ALL TODO + ------------------ + Setting cnt to %d + Setting ptr %p > end+1 %p + Setting cnt to %d, ptr implies %d + +__END__ diff --git a/t/pragma/warn/perly b/t/pragma/warn/perly index fd420d3b22..bddc39c716 100644 --- a/t/pragma/warn/perly +++ b/t/pragma/warn/perly @@ -18,6 +18,12 @@ do fred(1) ; $a = "fred" ; do $a() ; do $a(1) ; +no warning 'deprecated' ; +do fred() ; +do fred(1) ; +$a = "fred" ; +do $a() ; +do $a(1) ; EXPECT Use of "do" to call subroutines is deprecated at - line 4. Use of "do" to call subroutines is deprecated at - line 5. diff --git a/t/pragma/warn/pp b/t/pragma/warn/pp index 7a3b28991c..9baf9c14b0 100644 --- a/t/pragma/warn/pp +++ b/t/pragma/warn/pp @@ -25,14 +25,21 @@ Explicit blessing to '' (assuming package main) bless \[], ""; - Constant subroutine %s undefined <<< - Constant subroutine (anonymous) undefined <<< + Constant subroutine %s undefined <<<TODO + Constant subroutine (anonymous) undefined <<<TODO + + Mandatory Warnings + ------------------ + Malformed UTF-8 character __END__ # pp.c use warning 'substr' ; $a = "ab" ; -$a = substr($a, 4,5) +$a = substr($a, 4,5); +no warning 'substr' ; +$a = "ab" ; +$a = substr($a, 4,5); EXPECT substr outside of string at - line 4. ######## @@ -41,6 +48,8 @@ use warning 'substr' ; $a = "ab" ; $b = \$a ; substr($b, 1,1) = "ab" ; +no warning 'substr' ; +substr($b, 1,1) = "ab" ; EXPECT Attempt to use reference as lvalue in substr at - line 5. ######## @@ -53,6 +62,8 @@ EXPECT # pp.c use warning 'unsafe' ; my $a = { 1,2,3}; +no warning 'unsafe' ; +my $b = { 1,2,3}; EXPECT Odd number of elements in hash assignment at - line 3. ######## @@ -60,6 +71,9 @@ Odd number of elements in hash assignment at - line 3. use warning 'unsafe' ; my @a = unpack ("A,A", "22") ; my $a = pack ("A,A", 1,2) ; +no warning 'unsafe' ; +my @b = unpack ("A,A", "22") ; +my $b = pack ("A,A", 1,2) ; EXPECT Invalid type in unpack: ',' at - line 3. Invalid type in pack: ',' at - line 4. @@ -67,7 +81,9 @@ Invalid type in pack: ',' at - line 4. # pp.c use warning 'uninitialized' ; my $a = undef ; -my $b = $$a +my $b = $$a; +no warning 'uninitialized' ; +my $c = $$a; EXPECT Use of uninitialized value at - line 4. ######## @@ -75,11 +91,35 @@ Use of uninitialized value at - line 4. use warning 'unsafe' ; sub foo { my $a = "a"; return $a . $a++ . $a++ } my $a = pack("p", &foo) ; +no warning 'unsafe' ; +my $b = pack("p", &foo) ; EXPECT Attempt to pack pointer to temporary value at - line 4. ######## # pp.c use warning 'unsafe' ; bless \[], "" ; +no warning 'unsafe' ; +bless \[], "" ; EXPECT Explicit blessing to '' (assuming package main) at - line 3. +######## +# pp.c +use utf8 ; +$_ = "\x80 \xff" ; +reverse ; +EXPECT +Malformed UTF-8 character at - line 4. +######## +# pp.c +use warning 'utf8' ; +use utf8 ; +$_ = "\x80 \xff" ; +reverse ; +no warning 'utf8' ; +$_ = "\x80 \xff" ; +reverse ; +EXPECT +\x80 will produce malformed UTF-8 character; use \x{80} for that at - line 4. +\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 4. +Malformed UTF-8 character at - line 5. diff --git a/t/pragma/warn/pp_ctl b/t/pragma/warn/pp_ctl index 5a1c2338ed..4d6d8ca2af 100644 --- a/t/pragma/warn/pp_ctl +++ b/t/pragma/warn/pp_ctl @@ -71,6 +71,16 @@ Not enough format arguments at - line 5. 1 ######## # pp_ctl.c +no warning 'syntax' ; +format = +@<<< @<<< +1 +. +write ; +EXPECT +1 +######## +# pp_ctl.c use warning 'unsafe' ; $_ = "abc" ; @@ -78,6 +88,11 @@ while ($i ++ == 0) { s/ab/last/e ; } +no warning 'unsafe' ; +while ($i ++ == 0) +{ + s/ab/last/e ; +} EXPECT Exiting substitution via last at - line 7. ######## @@ -85,12 +100,20 @@ Exiting substitution via last at - line 7. use warning 'unsafe' ; sub fred { last } { fred() } +no warning 'unsafe' ; +sub joe { last } +{ joe() } EXPECT Exiting subroutine via last at - line 3. ######## # pp_ctl.c -use warning 'unsafe' ; -{ eval "last;" } +{ + eval "use warning 'unsafe' ; last;" +} +print STDERR $@ ; +{ + eval "no warning 'unsafe' ;last;" +} print STDERR $@ ; EXPECT Exiting eval via last at (eval 1) line 1. @@ -99,6 +122,8 @@ Exiting eval via last at (eval 1) line 1. use warning 'unsafe' ; @a = (1,2) ; @b = sort { last } @a ; +no warning 'unsafe' ; +@b = sort { last } @a ; EXPECT Exiting pseudo-block via last at - line 4. Can't "last" outside a block at - line 4. @@ -111,6 +136,11 @@ while ($i ++ == 0) { s/ab/last fred/e ; } +no warning 'unsafe' ; +while ($i ++ == 0) +{ + s/ab/last fred/e ; +} EXPECT Exiting substitution via last at - line 7. ######## @@ -118,12 +148,18 @@ Exiting substitution via last at - line 7. use warning 'unsafe' ; sub fred { last joe } joe: { fred() } +no warning 'unsafe' ; +sub Fred { last Joe } +Joe: { Fred() } EXPECT Exiting subroutine via last at - line 3. ######## # pp_ctl.c -use warning 'unsafe' ; -joe: { eval "last joe;" } +joe: +{ eval "use warning 'unsafe' ; last joe;" } +print STDERR $@ ; +Joe: +{ eval "no warning 'unsafe' ; last Joe;" } print STDERR $@ ; EXPECT Exiting eval via last at (eval 1) line 1. @@ -132,6 +168,8 @@ Exiting eval via last at (eval 1) line 1. use warning 'unsafe' ; @a = (1,2) ; fred: @b = sort { last fred } @a ; +no warning 'unsafe' ; +Fred: @b = sort { last Fred } @a ; EXPECT Exiting pseudo-block via last at - line 4. Label not found for "last fred" at - line 4. @@ -149,6 +187,18 @@ EXPECT Deep recursion on subroutine "main::fred" at - line 6. ######## # pp_ctl.c +no warning 'recursion' ; +BEGIN { warn "PREFIX\n" ;} +sub fred +{ + goto &fred() if $a++ < 200 +} + +goto &fred() +EXPECT +Can't find label +######## +# pp_ctl.c use warning 'unsafe' ; package Foo; DESTROY { die "@{$_[0]} foo bar" } @@ -157,3 +207,12 @@ DESTROY { die "@{$_[0]} foo bar" } EXPECT (in cleanup) A foo bar at - line 4. (in cleanup) B foo bar at - line 4. +######## +# pp_ctl.c +no warning 'unsafe' ; +package Foo; +DESTROY { die "@{$_[0]} foo bar" } +{ bless ['A'], 'Foo' for 1..10 } +{ bless ['B'], 'Foo' for 1..10 } +EXPECT + diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot index 817c0c89d6..60490bcd6a 100644 --- a/t/pragma/warn/pp_hot +++ b/t/pragma/warn/pp_hot @@ -37,7 +37,9 @@ __END__ # pp_hot.c use warning 'unopened' ; $f = $a = "abc" ; -print $f $a +print $f $a; +no warning 'unopened' ; +print $f $a; EXPECT Filehandle main::abc never opened at - line 4. ######## @@ -50,6 +52,8 @@ open(FOO, ">&STDOUT") and print <FOO>; print getc(STDERR); print getc(FOO); read(FOO,$_,1); +no warning '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. @@ -63,38 +67,50 @@ Filehandle main::FOO opened only for output at - line 9. use warning 'closed' ; close STDIN ; print STDIN "anc"; +no warning 'closed' ; +print STDIN "anc"; EXPECT print on closed filehandle main::STDIN at - line 4. ######## # pp_hot.c use warning 'uninitialized' ; my $a = undef ; -my @b = @$a +my @b = @$a; +no warning 'uninitialized' ; +my @c = @$a; EXPECT Use of uninitialized value at - line 4. ######## # pp_hot.c use warning 'uninitialized' ; my $a = undef ; -my %b = %$a +my %b = %$a; +no warning 'uninitialized' ; +my %c = %$a; EXPECT Use of uninitialized value at - line 4. ######## # pp_hot.c use warning 'unsafe' ; my %X ; %X = (1,2,3) ; +no warning 'unsafe' ; +my %Y ; %Y = (1,2,3) ; EXPECT Odd number of elements in hash assignment at - line 3. ######## # pp_hot.c use warning 'unsafe' ; my %X ; %X = [1 .. 3] ; +no warning 'unsafe' ; +my %Y ; %Y = [1 .. 3] ; EXPECT Reference found where even-sized list expected at - line 3. ######## # pp_hot.c use warning 'closed' ; close STDIN ; $a = <STDIN> ; +no warning 'closed' ; +$a = <STDIN> ; EXPECT Read on closed filehandle main::STDIN at - line 3. ######## @@ -114,6 +130,21 @@ EXPECT ok ######## # pp_hot.c +no warning '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 use warning 'recursion' ; $b = sub { @@ -123,3 +154,14 @@ $b = sub &$b ; EXPECT Deep recursion on anonymous subroutine at - line 5. +######## +# pp_hot.c +no warning 'recursion' ; +$b = sub +{ + &$b if $a++ < 200 +} ; + +&$b ; +EXPECT + diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys index 82d1501147..bf64a940e1 100644 --- a/t/pragma/warn/pp_sys +++ b/t/pragma/warn/pp_sys @@ -82,6 +82,9 @@ use warning 'untie' ; sub TIESCALAR { bless [] } ; $b = tie $a, 'main'; untie $a ; +no warning 'untie' ; +$c = tie $d, 'main'; +untie $d ; EXPECT untie attempted while 1 inner references still exist at - line 5. ######## @@ -90,6 +93,8 @@ use warning 'io' ; format STDIN = . write STDIN; +no warning 'io' ; +write STDIN; EXPECT Filehandle main::STDIN opened only for input at - line 5. ######## @@ -99,6 +104,8 @@ format STDIN = . close STDIN; write STDIN; +no warning 'closed' ; +write STDIN; EXPECT Write on closed filehandle main::STDIN at - line 6. ######## @@ -115,26 +122,34 @@ $= = 1 ; $- =1 ; open STDOUT, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ; write ; +no warning 'io' ; +write ; EXPECT page overflow at - line 13. ######## # pp_sys.c use warning 'unopened' ; $a = "abc"; -printf $a "fred" +printf $a "fred"; +no warning 'unopened' ; +printf $a "fred"; EXPECT Filehandle main::abc never opened at - line 4. ######## # pp_sys.c use warning 'closed' ; close STDIN ; -printf STDIN "fred" +printf STDIN "fred"; +no warning 'closed' ; +printf STDIN "fred"; EXPECT printf on closed filehandle main::STDIN at - line 4. ######## # pp_sys.c use warning 'io' ; -printf STDIN "fred" +printf STDIN "fred"; +no warning 'io' ; +printf STDIN "fred"; EXPECT Filehandle main::STDIN opened only for input at - line 3. ######## @@ -142,6 +157,8 @@ Filehandle main::STDIN opened only for input at - line 3. use warning 'closed' ; close STDIN; syswrite STDIN, "fred", 1; +no warning 'closed' ; +syswrite STDIN, "fred", 1; EXPECT Syswrite on closed filehandle at - line 4. ######## @@ -176,6 +193,17 @@ setsockopt STDIN, 1,2,3; getsockopt STDIN, 1,2; getsockname STDIN; getpeername STDIN; +no warning 'io' ; +send STDIN, "fred", 1; +bind STDIN, "fred" ; +connect STDIN, "fred" ; +listen STDIN, 2; +accept STDIN, "fred" ; +shutdown STDIN, 0; +setsockopt STDIN, 1,2,3; +getsockopt STDIN, 1,2; +getsockname STDIN; +getpeername STDIN; EXPECT Send on closed socket at - line 22. bind() on closed fd at - line 23. @@ -191,6 +219,8 @@ get{sock, peer}name() on closed fd at - line 31. # pp_sys.c use warning 'newline' ; stat "abc\ndef"; +no warning 'newline' ; +stat "abc\ndef"; EXPECT Unsuccessful stat on filename containing newline at - line 3. ######## @@ -198,11 +228,15 @@ Unsuccessful stat on filename containing newline at - line 3. use warning 'unopened' ; close STDIN ; -T STDIN ; +no warning 'unopened' ; +-T STDIN ; EXPECT Test on unopened file <STDIN> at - line 4. ######## # pp_sys.c use warning 'newline' ; -T "abc\ndef" ; +no warning 'newline' ; +-T "abc\ndef" ; EXPECT Unsuccessful open on filename containing newline at - line 3. diff --git a/t/pragma/warn/regcomp b/t/pragma/warn/regcomp index 52a163a2f5..4b2f7ff2ba 100644 --- a/t/pragma/warn/regcomp +++ b/t/pragma/warn/regcomp @@ -19,6 +19,8 @@ __END__ use warning 'unsafe' ; my $a = "ABC123" ; $a =~ /(?=a)*/ ; +no warning 'unsafe' ; +$a =~ /(?=a)*/ ; EXPECT (?=a)* matches null string many times at - line 4. ######## @@ -26,6 +28,8 @@ EXPECT use warning 'unsafe' ; $_ = "" ; /(?=a)?/; +no warning 'unsafe' ; +/(?=a)?/; EXPECT Strange *+?{} on zero-length expression at - line 4. ######## @@ -35,6 +39,10 @@ $_ = "" ; /[a[:xyz:]b]/; /[a[.xyz.]b]/; /[a[=xyz=]b]/; +no warning 'unsafe' ; +/[a[:xyz:]b]/; +/[a[.xyz.]b]/; +/[a[=xyz=]b]/; EXPECT Character class syntax [: :] is reserved for future extensions at - line 4. Character class syntax [. .] is reserved for future extensions at - line 5. @@ -47,6 +55,10 @@ $_ = "" ; /[a[:xyz:]b]/; /[a[.xyz.]b]/; /[a[=xyz=]b]/; +no warning 'unsafe' ; +/[a[:xyz:]b]/; +/[a[.xyz.]b]/; +/[a[=xyz=]b]/; EXPECT Character class syntax [: :] is reserved for future extensions at - line 5. Character class syntax [. .] is reserved for future extensions at - line 6. diff --git a/t/pragma/warn/regexec b/t/pragma/warn/regexec index 6d4ec320e7..ce4eac7083 100644 --- a/t/pragma/warn/regexec +++ b/t/pragma/warn/regexec @@ -42,6 +42,32 @@ Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9. ######## # regexec.c print("SKIPPED\n# most systems run into stacksize limits\n"),exit; +no warning 'unsafe' ; +$SIG{__WARN__} = sub{local ($m) = shift; + $m =~ s/\(\d+\)/(*MASKED*)/; + print STDERR $m}; +$_ = 'a' x (2**15+1); +/^()(a\1)*$/ ; +# +# If this test fails with a segmentation violation or similar, +# you may have to increase the default stacksize limit in your +# shell. You may need superuser privileges. +# +# Under the sh, ksh, zsh: +# $ ulimit -s +# 8192 +# $ ulimit -s 16000 +# +# Under the csh: +# % limit stacksize +# stacksize 8192 kbytes +# % limit stacksize 16000 +# +EXPECT + +######## +# regexec.c +print("SKIPPED\n# most systems run into stacksize limits\n"),exit; use warning 'unsafe' ; $SIG{__WARN__} = sub{local ($m) = shift; $m =~ s/\(\d+\)/(*MASKED*)/; @@ -65,3 +91,29 @@ $_ = 'a' x (2**15+1); # EXPECT Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9. +######## +# regexec.c +print("SKIPPED\n# most systems run into stacksize limits\n"),exit; +no warning 'unsafe' ; +$SIG{__WARN__} = sub{local ($m) = shift; + $m =~ s/\(\d+\)/(*MASKED*)/; + print STDERR $m}; +$_ = 'a' x (2**15+1); +/^()(a\1)*?$/ ; +# +# If this test fails with a segmentation violation or similar, +# you may have to increase the default stacksize limit in your +# shell. You may need superuser privileges. +# +# Under the sh, ksh, zsh: +# $ ulimit -s +# 8192 +# $ ulimit -s 16000 +# +# Under the csh: +# % limit stacksize +# stacksize 8192 kbytes +# % limit stacksize 16000 +# +EXPECT + diff --git a/t/pragma/warn/run b/t/pragma/warn/run new file mode 100644 index 0000000000..7a4be20e70 --- /dev/null +++ b/t/pragma/warn/run @@ -0,0 +1,8 @@ + run.c + + + Mandatory Warnings ALL TODO + ------------------ + NULL OP IN RUN + +__END__ diff --git a/t/pragma/warn/sv b/t/pragma/warn/sv index f3c530f884..0421192104 100644 --- a/t/pragma/warn/sv +++ b/t/pragma/warn/sv @@ -1,4 +1,4 @@ - sv.c AOK + sv.c warn(warn_uninit); @@ -32,12 +32,27 @@ Undefined value assigned to typeglob + Mandatory Warnings + ------------------ + Malformed UTF-8 character [sv_pos_b2u] + my $a = rindex "a\xff bc ", "bc" ; + + Mandatory Warnings TODO + ------------------ + Attempt to free non-arena SV: 0x%lx [del_sv] + Reference miscount in sv_replace() [sv_replace] + Attempt to free unreferenced scalar [sv_free] + Attempt to free temp prematurely: SV 0x%lx [sv_free] + semi-panic: attempt to dup freed string [newSVsv] + __END__ # sv.c use integer ; use warning 'uninitialized' ; $x = 1 + $a[0] ; # a +no warning 'uninitialized' ; +$x = 1 + $b[0] ; # a EXPECT Use of uninitialized value at - line 4. ######## @@ -51,6 +66,8 @@ tie $A, 'fred' ; use integer ; use warning 'uninitialized' ; $A *= 2 ; +no warning 'uninitialized' ; +$A *= 2 ; EXPECT Use of uninitialized value at - line 10. ######## @@ -58,6 +75,8 @@ Use of uninitialized value at - line 10. use integer ; use warning 'uninitialized' ; my $x *= 2 ; #b +no warning 'uninitialized' ; +my $y *= 2 ; #b EXPECT Use of uninitialized value at - line 4. ######## @@ -71,25 +90,35 @@ tie $A, 'fred' ; use warning 'uninitialized' ; $B = 0 ; $B |= $A ; +no warning 'uninitialized' ; +$B = 0 ; +$B |= $A ; EXPECT Use of uninitialized value at - line 10. ######## # sv.c use warning 'uninitialized' ; my $Y = 1 ; -my $x = 1 | $a[$Y] +my $x = 1 | $a[$Y] ; +no warning 'uninitialized' ; +my $Y = 1 ; +$x = 1 | $b[$Y] ; EXPECT Use of uninitialized value at - line 4. ######## # sv.c use warning 'uninitialized' ; my $x *= 1 ; # d +no warning 'uninitialized' ; +my $y *= 1 ; # d EXPECT Use of uninitialized value at - line 3. ######## # sv.c use warning 'uninitialized' ; $x = 1 + $a[0] ; # e +no warning 'uninitialized' ; +$x = 1 + $b[0] ; # e EXPECT Use of uninitialized value at - line 3. ######## @@ -102,24 +131,32 @@ package main ; tie $A, 'fred' ; use warning 'uninitialized' ; $A *= 2 ; +no warning 'uninitialized' ; +$A *= 2 ; EXPECT Use of uninitialized value at - line 9. ######## # sv.c use warning 'uninitialized' ; $x = $y + 1 ; # f +no warning 'uninitialized' ; +$x = $z + 1 ; # f EXPECT Use of uninitialized value at - line 3. ######## # sv.c use warning 'uninitialized' ; $x = chop undef ; # g +no warning 'uninitialized' ; +$x = chop undef ; # g EXPECT Modification of a read-only value attempted at - line 3. ######## # sv.c use warning 'uninitialized' ; $x = chop $y ; # h +no warning 'uninitialized' ; +$x = chop $z ; # h EXPECT Use of uninitialized value at - line 3. ######## @@ -133,6 +170,9 @@ tie $A, 'fred' ; use warning 'uninitialized' ; $B = "" ; $B .= $A ; +no warning 'uninitialized' ; +$C = "" ; +$C .= $A ; EXPECT Use of uninitialized value at - line 10. ######## @@ -141,13 +181,17 @@ use warning 'numeric' ; sub TIESCALAR{bless[]} ; sub FETCH {"def"} ; tie $a,"main" ; -my $b = 1 + $a +my $b = 1 + $a; +no warning 'numeric' ; +my $c = 1 + $a; EXPECT Argument "def" isn't numeric in add at - line 6. ######## # sv.c use warning 'numeric' ; my $x = 1 + "def" ; +no warning 'numeric' ; +my $z = 1 + "def" ; EXPECT Argument "def" isn't numeric in add at - line 3. ######## @@ -155,6 +199,8 @@ Argument "def" isn't numeric in add at - line 3. use warning 'numeric' ; my $a = "def" ; my $x = 1 + $a ; +no warning 'numeric' ; +my $y = 1 + $a ; EXPECT Argument "def" isn't numeric in add at - line 4. ######## @@ -162,12 +208,16 @@ Argument "def" isn't numeric in add at - line 4. use warning 'numeric' ; use integer ; my $a = "def" ; my $x = 1 + $a ; +no warning 'numeric' ; +my $z = 1 + $a ; EXPECT Argument "def" isn't numeric in i_add at - line 4. ######## # sv.c use warning 'numeric' ; my $x = 1 & "def" ; +no warning 'numeric' ; +my $z = 1 & "def" ; EXPECT Argument "def" isn't numeric in bit_and at - line 3. ######## @@ -176,6 +226,9 @@ use warning 'redefine' ; sub fred {} sub joe {} *fred = \&joe ; +no warning 'redefine' ; +sub jim {} +*jim = \&joe ; EXPECT Subroutine fred redefined at - line 5. ######## @@ -188,6 +241,13 @@ printf F "%" ; $a = sprintf "%" ; printf F "%\x02" ; $a = sprintf "%\x02" ; +no warning 'printf' ; +printf F "%q\n" ; +$a = sprintf "%q" ; +printf F "%" ; +$a = sprintf "%" ; +printf F "%\x02" ; +$a = sprintf "%\x02" ; EXPECT Invalid conversion in sprintf: "%q" at - line 5. Invalid conversion in sprintf: end of string at - line 7. @@ -199,5 +259,22 @@ Invalid conversion in printf: "%\002" at - line 8. # sv.c use warning 'unsafe' ; *a = undef ; +no warning 'unsafe' ; +*b = undef ; EXPECT Undefined value assigned to typeglob at - line 3. +######## +# sv.c +use utf8 ; +$^W =0 ; +{ + use warning 'utf8' ; + my $a = rindex "a\xff bc ", "bc" ; + no warning 'utf8' ; + $a = rindex "a\xff bc ", "bc" ; +} +my $a = rindex "a\xff bc ", "bc" ; +EXPECT +\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 6. +Malformed UTF-8 character at - line 6. +Malformed UTF-8 character at - line 10. diff --git a/t/pragma/warn/taint b/t/pragma/warn/taint index 40fadd0913..17ab0423c6 100644 --- a/t/pragma/warn/taint +++ b/t/pragma/warn/taint @@ -1,25 +1,49 @@ - taint.c TODO + taint.c AOK - Insecure %s%s while running setuid - Insecure %s%s while running setgid Insecure %s%s while running with -T switch - - Insecure directory in %s%s while running setuid - Insecure directory in %s%s while running setgid - Insecure directory in %s%s while running with -T switch - - - __END__ +-T +--FILE-- abc +def +--FILE-- # taint.c -use warning 'misc' ; - +open(FH, "<abc") ; +$a = <FH> ; +close FH ; +chdir $a ; +print "xxx\n" ; EXPECT - +Insecure dependency in chdir while running with -T switch at - line 5. ######## +-TU +--FILE-- abc +def +--FILE-- # taint.c -use warning 'misc' ; - +open(FH, "<abc") ; +$a = <FH> ; +close FH ; +chdir $a ; +print "xxx\n" ; EXPECT - +xxx +######## +-TU +--FILE-- abc +def +--FILE-- +# taint.c +open(FH, "<abc") ; +$a = <FH> ; +close FH ; +use warning 'taint' ; +chdir $a ; +print "xxx\n" ; +no warning 'taint' ; +chdir $a ; +print "yyy\n" ; +EXPECT +Insecure dependency in chdir while running with -T switch at - line 6. +xxx +yyy diff --git a/t/pragma/warn/toke b/t/pragma/warn/toke index da6c0dc9ae..72c1e2fddc 100644 --- a/t/pragma/warn/toke +++ b/t/pragma/warn/toke @@ -97,6 +97,21 @@ toke.c AOK use utf8 ; $_ = "\xffe" + Mandatory Warnings + ------------------ + Use of "%s" without parentheses is ambiguous [check_uni] + rand + 4 + + Ambiguous use of -%s resolved as -&%s() [yylex] + sub fred {} ; - fred ; + + Precedence problem: open %.*s should be open(%.*s) [yylex] + open FOO || die; + + Operator or semicolon missing before %c%s [yylex] + Ambiguous use of %c resolved as operator %c + *foo *foo + __END__ # toke.c use warning 'deprecated' ; @@ -106,6 +121,13 @@ use warning 'deprecated' ; 1 if $a LT $b ; 1 if $a GE $b ; 1 if $a LE $b ; +no warning 'deprecated' ; +1 if $a EQ $b ; +1 if $a NE $b ; +1 if $a GT $b ; +1 if $a LT $b ; +1 if $a GE $b ; +1 if $a LE $b ; EXPECT Use of EQ is deprecated at - line 3. Use of NE is deprecated at - line 4. @@ -120,24 +142,31 @@ format STDOUT = @<<< @||| @>>> @>>> $a $b "abc" 'def' . -($a, $b) = (1,2,3); -write; +no warning 'deprecated' ; +format STDOUT = +@<<< @||| @>>> @>>> +$a $b "abc" 'def' +. EXPECT Use of comma-less variable list is deprecated at - line 5. Use of comma-less variable list is deprecated at - line 5. Use of comma-less variable list is deprecated at - line 5. -1 2 abc def ######## # toke.c use warning 'deprecated' ; $a = <<; +no warning 'deprecated' ; +$a = <<; + EXPECT Use of bare << to mean <<"" is deprecated at - line 3. ######## # toke.c use warning 'syntax' ; s/(abc)/\1/; +no warning 'syntax' ; +s/(abc)/\1/; EXPECT \1 better written as $1 at - line 3. ######## @@ -145,6 +174,9 @@ EXPECT use warning 'semicolon' ; $a = 1 &time ; +no warning 'semicolon' ; +$a = 1 +&time ; EXPECT Semicolon seems to be missing at - line 3. ######## @@ -180,14 +212,40 @@ Reversed <= operator at - line 15. Unterminated <> operator at - line 15. ######## # toke.c +BEGIN { + # Scalars leaked: due to syntax errors + $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; +} +no warning 'syntax' ; +my $a =+ 2 ; +$a =- 2 ; +$a =* 2 ; +$a =% 2 ; +$a =& 2 ; +$a =. 2 ; +$a =^ 2 ; +$a =| 2 ; +$a =< 2 ; +$a =/ 2 ; +EXPECT +syntax error at - line 12, near "=." +syntax error at - line 13, near "=^" +syntax error at - line 14, near "=|" +Unterminated <> operator at - line 15. +######## +# toke.c use warning 'syntax' ; my $a = $a[1,2] ; +no warning 'syntax' ; +my $a = $a[1,2] ; EXPECT Multidimensional syntax $a[1,2] not supported at - line 3. ######## # toke.c use warning 'syntax' ; sub fred {} ; $SIG{TERM} = fred; +no warning 'syntax' ; +$SIG{TERM} = fred; EXPECT You need to quote "fred" at - line 3. ######## @@ -195,6 +253,9 @@ You need to quote "fred" at - line 3. use warning 'syntax' ; @a[3] = 2; @a{3} = 2; +no warning 'syntax' ; +@a[3] = 2; +@a{3} = 2; EXPECT Scalar value @a[3] better written as $a[3] at - line 3. Scalar value @a{3} better written as $a{3} at - line 4. @@ -203,36 +264,49 @@ Scalar value @a{3} better written as $a{3} at - line 4. use warning 'syntax' ; $_ = "ab" ; s/(ab)/\1/e; +no warning 'syntax' ; +$_ = "ab" ; +s/(ab)/\1/e; EXPECT Can't use \1 to mean $1 in expression at - line 4. ######## # toke.c use warning 'reserved' ; $a = abc; +no warning 'reserved' ; +$a = abc; EXPECT Unquoted string "abc" may clash with future reserved word at - line 3. ######## # toke.c use warning 'octal' ; chmod 3; +no warning 'octal' ; +chmod 3; EXPECT chmod: mode argument is missing initial 0 at - line 3, at end of line ######## # toke.c use warning 'syntax' ; @a = qw(a, b, c) ; +no warning 'syntax' ; +@a = qw(a, b, c) ; EXPECT Possible attempt to separate words with commas at - line 3. ######## # toke.c use warning 'syntax' ; @a = qw(a b #) ; +no warning 'syntax' ; +@a = qw(a b #) ; EXPECT Possible attempt to put comments in qw() list at - line 3. ######## # toke.c use warning 'octal' ; umask 3; +no warning 'octal' ; +umask 3; EXPECT umask: argument is missing initial 0 at - line 3, at end of line ######## @@ -243,20 +317,40 @@ EXPECT print (...) interpreted as function at - line 3. ######## # toke.c +no warning 'syntax' ; +print ("") +EXPECT + +######## +# toke.c use warning 'syntax' ; printf ("") EXPECT printf (...) interpreted as function at - line 3. ######## # toke.c +no warning 'syntax' ; +printf ("") +EXPECT + +######## +# toke.c use warning 'syntax' ; sort ("") EXPECT sort (...) interpreted as function at - line 3. ######## # toke.c +no warning 'syntax' ; +sort ("") +EXPECT + +######## +# toke.c use warning 'ambiguous' ; $a = ${time[2]}; +no warning 'ambiguous' ; +$a = ${time[2]}; EXPECT Ambiguous use of ${time[...]} resolved to $time[...] at - line 3. ######## @@ -267,8 +361,16 @@ EXPECT Ambiguous use of ${time{...}} resolved to $time{...} at - line 3. ######## # toke.c +no warning 'ambiguous' ; +$a = ${time{2}}; +EXPECT + +######## +# toke.c use warning 'ambiguous' ; $a = ${time} ; +no warning 'ambiguous' ; +$a = ${time} ; EXPECT Ambiguous use of ${time} resolved to $time at - line 3. ######## @@ -276,6 +378,8 @@ Ambiguous use of ${time} resolved to $time at - line 3. use warning 'ambiguous' ; sub fred {} $a = ${fred} ; +no warning 'ambiguous' ; +$a = ${fred} ; EXPECT Ambiguous use of ${fred} resolved to $fred at - line 4. ######## @@ -283,6 +387,9 @@ Ambiguous use of ${fred} resolved to $fred at - line 4. use warning 'syntax' ; $a = 1_2; $a = 1_2345_6; +no warning 'syntax' ; +$a = 1_2; +$a = 1_2345_6; EXPECT Misplaced _ in number at - line 3. Misplaced _ in number at - line 4. @@ -292,13 +399,18 @@ Misplaced _ in number at - line 4. use warning 'unsafe' ; #line 25 "bar" $a = FRED:: ; +no warning 'unsafe' ; +#line 25 "bar" +$a = FRED:: ; EXPECT Bareword "FRED::" refers to nonexistent package at bar line 25. ######## # toke.c use warning 'ambiguous' ; sub time {} -my $a = time() +my $a = time() ; +no warning 'ambiguous' ; +my $b = time() ; EXPECT Ambiguous call resolved as CORE::time(), qualify as such or use & at - line 4. ######## @@ -314,8 +426,101 @@ EXPECT Use of \x{} without utf8 declaration at foo line 30. ######## # toke.c +no warning 'utf8' ; +eval <<'EOE'; +{ +#line 30 "foo" + $_ = " \x{123} " ; +} +EOE +EXPECT + +######## +# toke.c use warning 'utf8' ; use utf8 ; $_ = " \xffe " ; +no warning 'utf8' ; +$_ = " \xffe " ; EXPECT \xff will produce malformed UTF-8 character; use \x{ff} for that at - line 4. +######## +# toke.c +my $a = rand + 4 ; +EXPECT +Warning: Use of "rand" without parens is ambiguous at - line 2. +######## +# toke.c +$^W = 0 ; +my $a = rand + 4 ; +{ + no warning 'ambiguous' ; + $a = rand + 4 ; + use warning 'ambiguous' ; + $a = rand + 4 ; +} +$a = rand + 4 ; +EXPECT +Warning: Use of "rand" without parens is ambiguous at - line 3. +Warning: Use of "rand" without parens is ambiguous at - line 8. +Warning: Use of "rand" without parens is ambiguous at - line 10. +######## +# toke.c +sub fred {}; +-fred ; +EXPECT +Ambiguous use of -fred resolved as -&fred() at - line 3. +######## +# toke.c +$^W = 0 ; +sub fred {} ; +-fred ; +{ + no warning 'ambiguous' ; + -fred ; + use warning 'ambiguous' ; + -fred ; +} +-fred ; +EXPECT +Ambiguous use of -fred resolved as -&fred() at - line 4. +Ambiguous use of -fred resolved as -&fred() at - line 9. +Ambiguous use of -fred resolved as -&fred() at - line 11. +######## +# toke.c +open FOO || time; +EXPECT +Precedence problem: open FOO should be open(FOO) at - line 2. +######## +# toke.c +$^W = 0 ; +open FOO || time; +{ + no warning 'ambiguous' ; + open FOO || time; + use warning 'ambiguous' ; + open FOO || time; +} +open FOO || time; +EXPECT +Precedence problem: open FOO should be open(FOO) at - line 3. +Precedence problem: open FOO should be open(FOO) at - line 8. +Precedence problem: open FOO should be open(FOO) at - line 10. +######## +# toke.c +$^W = 0 ; +*foo *foo ; +{ + no warning 'ambiguous' ; + *foo *foo ; + use warning 'ambiguous' ; + *foo *foo ; +} +*foo *foo ; +EXPECT +Operator or semicolon missing before *foo at - line 3. +Ambiguous use of * resolved as operator * at - line 3. +Operator or semicolon missing before *foo at - line 8. +Ambiguous use of * resolved as operator * at - line 8. +Operator or semicolon missing before *foo at - line 10. +Ambiguous use of * resolved as operator * at - line 10. diff --git a/t/pragma/warn/universal b/t/pragma/warn/universal index e2814e11c4..37e77195ca 100644 --- a/t/pragma/warn/universal +++ b/t/pragma/warn/universal @@ -1,4 +1,4 @@ - universal.c + universal.c TODO Can't locate package %s for @%s::ISA diff --git a/t/pragma/warn/utf8 b/t/pragma/warn/utf8 new file mode 100644 index 0000000000..380d53bbcc --- /dev/null +++ b/t/pragma/warn/utf8 @@ -0,0 +1,56 @@ + + utf8.c AOK + + All Mandatory warnings + + [utf8_to_uv] + Malformed UTF-8 character + my $a = ord "\x80" ; + + Malformed UTF-8 character + my $a = ord "\xf080" ; + + [utf16_to_utf8] + Malformed UTF-16 surrogate + <<<<<< Add a test when somethig actually calls utf16_to_utf8 + +__END__ +# utf8.c +use utf8 ; +my $a = ord "\x80" ; +EXPECT +Malformed UTF-8 character at - line 3. +######## +# utf8.c +use utf8 ; +my $a = ord "\x80" ; +{ + use warning 'utf8' ; + my $a = ord "\x80" ; + no warning 'utf8' ; + my $a = ord "\x80" ; +} +EXPECT +Malformed UTF-8 character at - line 3. +\x80 will produce malformed UTF-8 character; use \x{80} for that at - line 6. +Malformed UTF-8 character at - line 6. +######## +# utf8.c +use utf8 ; +my $a = ord "\xf080" ; +EXPECT +Malformed UTF-8 character at - line 3. +######## +# utf8.c +use utf8 ; +my $a = ord "\xf080" ; +{ + use warning 'utf8' ; + my $a = ord "\xf080" ; + no warning 'utf8' ; + my $a = ord "\xf080" ; +} +EXPECT +Malformed UTF-8 character at - line 3. +\xf0 will produce malformed UTF-8 character; use \x{f0} for that at - line 6. +Malformed UTF-8 character at - line 6. diff --git a/t/pragma/warn/util b/t/pragma/warn/util index d58f4b70fa..bd29f7b254 100644 --- a/t/pragma/warn/util +++ b/t/pragma/warn/util @@ -9,21 +9,74 @@ Illegal binary digit ignored my $a = oct "0b9" ; + + Mandatory Warnings + ------------------ + Integer overflow in binary number + Integer overflow in octal number + Integer overflow in hex number + __END__ # util.c use warning 'octal' ; my $a = oct "029" ; +no warning 'octal' ; +my $a = oct "029" ; EXPECT Illegal octal digit '9' ignored at - line 3. ######## # util.c use warning 'unsafe' ; *a = hex "0xv9" ; +no warning 'unsafe' ; +*a = hex "0xv9" ; EXPECT Illegal hex digit 'v' ignored at - line 3. ######## # util.c use warning 'unsafe' ; *a = oct "0b9" ; +no warning 'unsafe' ; +*a = oct "0b9" ; EXPECT Illegal binary digit '9' ignored at - line 3. +######## +# util.c +$^W =1 ; +{ + use warning 'unsafe' ; + my $a = oct "0b111111111111111111111111111111111" ; + no warning 'unsafe' ; + $a = oct "0b111111111111111111111111111111111" ; +} +my $a = oct "0b111111111111111111111111111111111" ; +EXPECT +Integer overflow in binary number at - line 5. +Integer overflow in binary number at - line 9. +######## +# util.c +$^W =1 ; +{ + use warning 'unsafe' ; + my $a = oct "777777777777777777777777777777777777" ; + no warning 'unsafe' ; + $a = oct "777777777777777777777777777777777777" ; +} +my $a = oct "777777777777777777777777777777777777" ; +EXPECT +Integer overflow in octal number at - line 5. +Integer overflow in octal number at - line 9. +######## +# util.c +$^W =1 ; +{ + use warning 'unsafe' ; + my $a = hex "ffffffffffffffffffffffffffffffff" ; + no warning 'unsafe' ; + $a = hex "ffffffffffffffffffffffffffffffff" ; +} +my $a = hex "ffffffffffffffffffffffffffffffff" ; +EXPECT +Integer overflow in hex number at - line 5. +Integer overflow in hex number at - line 9. + diff --git a/t/pragma/warning.t b/t/pragma/warning.t index 7914121ae8..73e4c8d1a8 100755 --- a/t/pragma/warning.t +++ b/t/pragma/warning.t @@ -79,7 +79,7 @@ for (@prgs){ `MCR $^X $switch $tmpfile` : $Is_MSWin32 ? `.\\perl -I../lib $switch $tmpfile 2>&1` : - `./perl $switch $tmpfile 2>&1`; + `./perl -I../lib $switch $tmpfile 2>&1`; my $status = $?; $results =~ s/\n+$//; # allow expected output to be written as if $prog is on STDIN |