diff options
Diffstat (limited to 'contrib/perl5/t/pragma/warn')
| -rw-r--r-- | contrib/perl5/t/pragma/warn/2use | 212 | ||||
| -rw-r--r-- | contrib/perl5/t/pragma/warn/3both | 69 | ||||
| -rw-r--r-- | contrib/perl5/t/pragma/warn/4lint | 116 | ||||
| -rw-r--r-- | contrib/perl5/t/pragma/warn/5nolint | 108 | ||||
| -rw-r--r-- | contrib/perl5/t/pragma/warn/6default | 68 | ||||
| -rw-r--r-- | contrib/perl5/t/pragma/warn/7fatal | 70 | ||||
| -rwxr-xr-x | contrib/perl5/t/pragma/warn/9enabled | 347 | ||||
| -rw-r--r-- | contrib/perl5/t/pragma/warn/doio | 40 | ||||
| -rw-r--r-- | contrib/perl5/t/pragma/warn/op | 17 | ||||
| -rw-r--r-- | contrib/perl5/t/pragma/warn/perl | 15 | ||||
| -rw-r--r-- | contrib/perl5/t/pragma/warn/pp_ctl | 15 | ||||
| -rw-r--r-- | contrib/perl5/t/pragma/warn/pp_hot | 34 | ||||
| -rw-r--r-- | contrib/perl5/t/pragma/warn/pp_sys | 137 | ||||
| -rw-r--r-- | contrib/perl5/t/pragma/warn/regcomp | 92 | ||||
| -rw-r--r-- | contrib/perl5/t/pragma/warn/sv | 2 | ||||
| -rw-r--r-- | contrib/perl5/t/pragma/warn/toke | 62 | ||||
| -rw-r--r-- | contrib/perl5/t/pragma/warn/utf8 | 10 |
17 files changed, 1162 insertions, 252 deletions
diff --git a/contrib/perl5/t/pragma/warn/2use b/contrib/perl5/t/pragma/warn/2use index 60a60c3..b489d62 100644 --- a/contrib/perl5/t/pragma/warn/2use +++ b/contrib/perl5/t/pragma/warn/2use @@ -120,175 +120,223 @@ Use of uninitialized value in scalar chop at - line 3. ######## # Check scope of pragma with eval -no warnings ; -eval { +use warnings; +{ + no warnings ; + eval { + my $b ; chop $b ; + }; print STDERR $@ ; my $b ; chop $b ; -}; print STDERR $@ ; -my $b ; chop $b ; +} EXPECT ######## # Check scope of pragma with eval -no warnings ; -eval { - use warnings 'uninitialized' ; +use warnings; +{ + no warnings ; + eval { + use warnings 'uninitialized' ; + my $b ; chop $b ; + }; print STDERR $@ ; my $b ; chop $b ; -}; print STDERR $@ ; -my $b ; chop $b ; +} EXPECT -Use of uninitialized value in scalar chop at - line 6. +Use of uninitialized value in scalar chop at - line 8. ######## # Check scope of pragma with eval -use warnings 'uninitialized' ; -eval { +no warnings; +{ + use warnings 'uninitialized' ; + eval { + my $b ; chop $b ; + }; print STDERR $@ ; my $b ; chop $b ; -}; print STDERR $@ ; -my $b ; chop $b ; +} EXPECT -Use of uninitialized value in scalar chop at - line 5. Use of uninitialized value in scalar chop at - line 7. +Use of uninitialized value in scalar chop at - line 9. ######## # Check scope of pragma with eval -use warnings 'uninitialized' ; -eval { - no warnings ; +no warnings; +{ + use warnings 'uninitialized' ; + eval { + no warnings ; + my $b ; chop $b ; + }; print STDERR $@ ; my $b ; chop $b ; -}; print STDERR $@ ; -my $b ; chop $b ; +} EXPECT -Use of uninitialized value in scalar chop at - line 8. +Use of uninitialized value in scalar chop at - line 10. ######## # Check scope of pragma with eval -no warnings ; -eval { +use warnings; +{ + no warnings ; + eval { + 1 if $a EQ $b ; + }; print STDERR $@ ; 1 if $a EQ $b ; -}; print STDERR $@ ; -1 if $a EQ $b ; +} EXPECT ######## # Check scope of pragma with eval -no warnings ; -eval { - use warnings 'deprecated' ; +use warnings; +{ + no warnings ; + eval { + use warnings 'deprecated' ; + 1 if $a EQ $b ; + }; print STDERR $@ ; 1 if $a EQ $b ; -}; print STDERR $@ ; -1 if $a EQ $b ; +} EXPECT -Use of EQ is deprecated at - line 6. +Use of EQ is deprecated at - line 8. ######## # Check scope of pragma with eval -use warnings 'deprecated' ; -eval { +no warnings; +{ + use warnings 'deprecated' ; + eval { + 1 if $a EQ $b ; + }; print STDERR $@ ; 1 if $a EQ $b ; -}; print STDERR $@ ; -1 if $a EQ $b ; +} EXPECT -Use of EQ is deprecated at - line 5. Use of EQ is deprecated at - line 7. +Use of EQ is deprecated at - line 9. ######## # Check scope of pragma with eval -use warnings 'deprecated' ; -eval { - no warnings ; +no warnings; +{ + use warnings 'deprecated' ; + eval { + no warnings ; + 1 if $a EQ $b ; + }; print STDERR $@ ; 1 if $a EQ $b ; -}; print STDERR $@ ; -1 if $a EQ $b ; +} EXPECT -Use of EQ is deprecated at - line 8. +Use of EQ is deprecated at - line 10. ######## # Check scope of pragma with eval -no warnings ; -eval ' +use warnings; +{ + no warnings ; + eval ' + my $b ; chop $b ; + '; print STDERR $@ ; my $b ; chop $b ; -'; print STDERR $@ ; -my $b ; chop $b ; +} EXPECT ######## # Check scope of pragma with eval -no warnings ; -eval q[ - use warnings 'uninitialized' ; +use warnings; +{ + no warnings ; + eval q[ + use warnings 'uninitialized' ; + my $b ; chop $b ; + ]; print STDERR $@; my $b ; chop $b ; -]; print STDERR $@; -my $b ; chop $b ; +} EXPECT Use of uninitialized value in scalar chop at (eval 1) line 3. ######## # Check scope of pragma with eval -use warnings 'uninitialized' ; -eval ' +no warnings; +{ + use warnings 'uninitialized' ; + eval ' + my $b ; chop $b ; + '; print STDERR $@ ; my $b ; chop $b ; -'; print STDERR $@ ; -my $b ; chop $b ; +} EXPECT Use of uninitialized value in scalar chop at (eval 1) line 2. -Use of uninitialized value in scalar chop at - line 7. +Use of uninitialized value in scalar chop at - line 9. ######## # Check scope of pragma with eval -use warnings 'uninitialized' ; -eval ' - no warnings ; +no warnings; +{ + use warnings 'uninitialized' ; + eval ' + no warnings ; + my $b ; chop $b ; + '; print STDERR $@ ; my $b ; chop $b ; -'; print STDERR $@ ; -my $b ; chop $b ; +} EXPECT -Use of uninitialized value in scalar chop at - line 8. +Use of uninitialized value in scalar chop at - line 10. ######## # Check scope of pragma with eval -no warnings ; -eval ' +use warnings; +{ + no warnings ; + eval ' + 1 if $a EQ $b ; + '; print STDERR $@ ; 1 if $a EQ $b ; -'; print STDERR $@ ; -1 if $a EQ $b ; +} EXPECT ######## # Check scope of pragma with eval -no warnings ; -eval q[ - use warnings 'deprecated' ; +use warnings; +{ + no warnings ; + eval q[ + use warnings 'deprecated' ; + 1 if $a EQ $b ; + ]; print STDERR $@; 1 if $a EQ $b ; -]; print STDERR $@; -1 if $a EQ $b ; +} EXPECT Use of EQ is deprecated at (eval 1) line 3. ######## # Check scope of pragma with eval -use warnings 'deprecated' ; -eval ' +no warnings; +{ + use warnings 'deprecated' ; + eval ' + 1 if $a EQ $b ; + '; print STDERR $@; 1 if $a EQ $b ; -'; print STDERR $@; -1 if $a EQ $b ; +} EXPECT -Use of EQ is deprecated at - line 7. +Use of EQ is deprecated at - line 9. Use of EQ is deprecated at (eval 1) line 2. ######## # Check scope of pragma with eval -use warnings 'deprecated' ; -eval ' - no warnings ; +no warnings; +{ + use warnings 'deprecated' ; + eval ' + no warnings ; + 1 if $a EQ $b ; + '; print STDERR $@; 1 if $a EQ $b ; -'; print STDERR $@; -1 if $a EQ $b ; +} EXPECT -Use of EQ is deprecated at - line 8. +Use of EQ is deprecated at - line 10. ######## # Check the additive nature of the pragma diff --git a/contrib/perl5/t/pragma/warn/3both b/contrib/perl5/t/pragma/warn/3both index 132b99b..335e1b2 100644 --- a/contrib/perl5/t/pragma/warn/3both +++ b/contrib/perl5/t/pragma/warn/3both @@ -195,3 +195,72 @@ my $b ; chop $b ; EXPECT Use of uninitialized value in scalar chop at - line 7. +######## + +# Check scope of pragma with eval +BEGIN { $^W = 1 } +{ + no warnings ; + eval ' + my $b ; chop $b ; + '; print STDERR $@ ; + my $b ; chop $b ; +} +EXPECT + +######## + +# Check scope of pragma with eval +BEGIN { $^W = 1 } +use warnings; +{ + no warnings ; + eval q[ + use warnings 'uninitialized' ; + my $b ; chop $b ; + ]; print STDERR $@; + my $b ; chop $b ; +} +EXPECT +Use of uninitialized value in scalar chop at (eval 1) line 3. +######## + +# Check scope of pragma with eval +BEGIN { $^W = 0 } +{ + use warnings 'uninitialized' ; + eval ' + my $b ; chop $b ; + '; print STDERR $@ ; + my $b ; chop $b ; +} +EXPECT +Use of uninitialized value in scalar chop at (eval 1) line 2. +Use of uninitialized value in scalar chop at - line 9. +######## + +# Check scope of pragma with eval +BEGIN { $^W = 0 } +{ + use warnings 'uninitialized' ; + eval ' + no warnings ; + my $b ; chop $b ; + '; print STDERR $@ ; + my $b ; chop $b ; +} +EXPECT +Use of uninitialized value in scalar chop at - line 10. +######## + +# Check scope of pragma with eval +BEGIN { $^W = 1 } +{ + no warnings ; + eval ' + 1 if $a EQ $b ; + '; print STDERR $@ ; + 1 if $a EQ $b ; +} +EXPECT + diff --git a/contrib/perl5/t/pragma/warn/4lint b/contrib/perl5/t/pragma/warn/4lint index db54f31..b2fa75f 100644 --- a/contrib/perl5/t/pragma/warn/4lint +++ b/contrib/perl5/t/pragma/warn/4lint @@ -9,14 +9,14 @@ $a = 1 if $a EQ $b ; close STDIN ; print STDIN "abc" ; EXPECT Use of EQ is deprecated at - line 5. -print() on closed filehandle main::STDIN at - line 6. +print() on closed filehandle STDIN at - line 6. ######## -W # lint: check runtime $^W is zapped $^W = 0 ; close STDIN ; print STDIN "abc" ; EXPECT -print() on closed filehandle main::STDIN at - line 4. +print() on closed filehandle STDIN at - line 4. ######## -W # lint: check runtime $^W is zapped @@ -25,7 +25,7 @@ print() on closed filehandle main::STDIN at - line 4. close STDIN ; print STDIN "abc" ; } EXPECT -print() on closed filehandle main::STDIN at - line 5. +print() on closed filehandle STDIN at - line 5. ######## -W # lint: check "no warnings" is zapped @@ -35,7 +35,7 @@ $a = 1 if $a EQ $b ; close STDIN ; print STDIN "abc" ; EXPECT Use of EQ is deprecated at - line 5. -print() on closed filehandle main::STDIN at - line 6. +print() on closed filehandle STDIN at - line 6. ######## -W # lint: check "no warnings" is zapped @@ -44,7 +44,7 @@ print() on closed filehandle main::STDIN at - line 6. close STDIN ; print STDIN "abc" ; } EXPECT -print() on closed filehandle main::STDIN at - line 5. +print() on closed filehandle STDIN at - line 5. ######## -Ww # lint: check combination of -w and -W @@ -53,7 +53,7 @@ print() on closed filehandle main::STDIN at - line 5. close STDIN ; print STDIN "abc" ; } EXPECT -print() on closed filehandle main::STDIN at - line 5. +print() on closed filehandle STDIN at - line 5. ######## -W --FILE-- abc.pm @@ -110,3 +110,107 @@ my $a ; chop $a ; EXPECT Use of EQ is deprecated at ./abc line 3. Use of uninitialized value in scalar chop at - line 3. +######## +-W +# Check scope of pragma with eval +{ + no warnings ; + eval ' + my $b ; chop $b ; + '; print STDERR $@ ; + my $b ; chop $b ; +} +EXPECT +Use of uninitialized value in scalar chop at (eval 1) line 2. +Use of uninitialized value in scalar chop at - line 8. +######## +-W +# Check scope of pragma with eval +use warnings; +{ + no warnings ; + eval q[ + use warnings 'uninitialized' ; + my $b ; chop $b ; + ]; print STDERR $@; + my $b ; chop $b ; +} +EXPECT +Use of uninitialized value in scalar chop at (eval 1) line 3. +Use of uninitialized value in scalar chop at - line 10. +######## +-W +# Check scope of pragma with eval +no warnings; +{ + use warnings 'uninitialized' ; + eval ' + my $b ; chop $b ; + '; print STDERR $@ ; + my $b ; chop $b ; +} +EXPECT +Use of uninitialized value in scalar chop at (eval 1) line 2. +Use of uninitialized value in scalar chop at - line 9. +######## +-W +# Check scope of pragma with eval +no warnings; +{ + use warnings 'uninitialized' ; + eval ' + no warnings ; + my $b ; chop $b ; + '; print STDERR $@ ; + my $b ; chop $b ; +} +EXPECT +Use of uninitialized value in scalar chop at (eval 1) line 3. +Use of uninitialized value in scalar chop at - line 10. +######## +-W +# Check scope of pragma with eval +use warnings; +{ + my $a = "1"; my $b = "2"; + no warnings ; + eval q[ + use warnings 'deprecated' ; + 1 if $a EQ $b ; + ]; print STDERR $@; + 1 if $a EQ $b ; +} +EXPECT +Use of EQ is deprecated at - line 11. +Use of EQ is deprecated at (eval 1) line 3. +######## +-W +# Check scope of pragma with eval +no warnings; +{ + my $a = "1"; my $b = "2"; + use warnings 'deprecated' ; + eval ' + 1 if $a EQ $b ; + '; print STDERR $@; + 1 if $a EQ $b ; +} +EXPECT +Use of EQ is deprecated at - line 10. +Use of EQ is deprecated at (eval 1) line 2. +######## +-W +# Check scope of pragma with eval +no warnings; +{ + my $a = "1"; my $b = "2"; + use warnings 'deprecated' ; + eval ' + no warnings ; + 1 if $a EQ $b ; + '; print STDERR $@; + 1 if $a EQ $b ; +} +EXPECT +Use of EQ is deprecated at - line 11. +Use of EQ is deprecated at (eval 1) line 3. diff --git a/contrib/perl5/t/pragma/warn/5nolint b/contrib/perl5/t/pragma/warn/5nolint index 994190a..2459968 100644 --- a/contrib/perl5/t/pragma/warn/5nolint +++ b/contrib/perl5/t/pragma/warn/5nolint @@ -94,3 +94,111 @@ $^W = 1 ; require "./abc"; my $a ; chop $a ; EXPECT +######## +-X +# Check scope of pragma with eval +use warnings; +{ + no warnings ; + eval ' + my $b ; chop $b ; + '; print STDERR $@ ; + my $b ; chop $b ; +} +EXPECT + +######## +-X +# Check scope of pragma with eval +use warnings; +{ + no warnings ; + eval q[ + use warnings 'uninitialized' ; + my $b ; chop $b ; + ]; print STDERR $@; + my $b ; chop $b ; +} +EXPECT + +######## +-X +# Check scope of pragma with eval +no warnings; +{ + use warnings 'uninitialized' ; + eval ' + my $b ; chop $b ; + '; print STDERR $@ ; + my $b ; chop $b ; +} +EXPECT + +######## +-X +# Check scope of pragma with eval +no warnings; +{ + use warnings 'uninitialized' ; + eval ' + no warnings ; + my $b ; chop $b ; + '; print STDERR $@ ; + my $b ; chop $b ; +} +EXPECT + +######## +-X +# Check scope of pragma with eval +use warnings; +{ + no warnings ; + eval ' + 1 if $a EQ $b ; + '; print STDERR $@ ; + 1 if $a EQ $b ; +} +EXPECT + +######## +-X +# Check scope of pragma with eval +use warnings; +{ + no warnings ; + eval q[ + use warnings 'deprecated' ; + 1 if $a EQ $b ; + ]; print STDERR $@; + 1 if $a EQ $b ; +} +EXPECT + +######## +-X +# Check scope of pragma with eval +no warnings; +{ + use warnings 'deprecated' ; + eval ' + 1 if $a EQ $b ; + '; print STDERR $@; + 1 if $a EQ $b ; +} +EXPECT + +######## +-X +# Check scope of pragma with eval +no warnings; +{ + use warnings 'deprecated' ; + eval ' + no warnings ; + 1 if $a EQ $b ; + '; print STDERR $@; + 1 if $a EQ $b ; +} +EXPECT + diff --git a/contrib/perl5/t/pragma/warn/6default b/contrib/perl5/t/pragma/warn/6default index dd3d182..a8aafee 100644 --- a/contrib/perl5/t/pragma/warn/6default +++ b/contrib/perl5/t/pragma/warn/6default @@ -51,3 +51,71 @@ EXPECT Integer overflow in binary number at - line 3. Illegal binary digit '2' ignored at - line 3. Binary number > 0b11111111111111111111111111111111 non-portable at - line 3. +######## + +# Check scope of pragma with eval +use warnings; +{ + no warnings ; + eval ' + my $a = oct "0xfffffffffffffffffg" ; + '; print STDERR $@ ; + my $a = oct "0xfffffffffffffffffg" ; +} +EXPECT + +######## + +# Check scope of pragma with eval +use warnings; +{ + no warnings ; + eval q[ + use warnings ; + my $a = oct "0xfffffffffffffffffg" ; + ]; print STDERR $@; + my $a = oct "0xfffffffffffffffffg" ; +} +EXPECT +Integer overflow in hexadecimal number at (eval 1) line 3. +Illegal hexadecimal digit 'g' ignored at (eval 1) line 3. +Hexadecimal number > 0xffffffff non-portable at (eval 1) line 3. +######## + +# Check scope of pragma with eval +no warnings; +{ + use warnings ; + eval ' + my $a = oct "0xfffffffffffffffffg" ; + '; print STDERR $@ ; +} +EXPECT +Integer overflow in hexadecimal number at (eval 1) line 2. +Illegal hexadecimal digit 'g' ignored at (eval 1) line 2. +Hexadecimal number > 0xffffffff non-portable at (eval 1) line 2. +######## + +# Check scope of pragma with eval +no warnings; +{ + use warnings; + eval ' + no warnings ; + my $a = oct "0xfffffffffffffffffg" ; + '; print STDERR $@ ; +} +EXPECT + +######## + +# Check scope of pragma with eval +no warnings; +{ + use warnings 'deprecated' ; + eval ' + my $a = oct "0xfffffffffffffffffg" ; + '; print STDERR $@; +} +EXPECT + diff --git a/contrib/perl5/t/pragma/warn/7fatal b/contrib/perl5/t/pragma/warn/7fatal index 943bb06f..ed585c2 100644 --- a/contrib/perl5/t/pragma/warn/7fatal +++ b/contrib/perl5/t/pragma/warn/7fatal @@ -14,6 +14,18 @@ EXPECT Use of EQ is deprecated at - line 8. ######## +# Check compile time warning +use warnings FATAL => 'all' ; +{ + no warnings ; + 1 if $a EQ $b ; +} +1 if $a EQ $b ; +print STDERR "The End.\n" ; +EXPECT +Use of EQ is deprecated at - line 8. +######## + # Check runtime scope of pragma use warnings FATAL => 'uninitialized' ; { @@ -27,6 +39,18 @@ Use of uninitialized value in scalar chop at - line 8. ######## # Check runtime scope of pragma +use warnings FATAL => 'all' ; +{ + no warnings ; + my $b ; chop $b ; +} +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value in scalar chop at - line 8. +######## + +# Check runtime scope of pragma no warnings ; { use warnings FATAL => 'uninitialized' ; @@ -38,6 +62,18 @@ EXPECT Use of uninitialized value in scalar chop at - line 6. ######## +# Check runtime scope of pragma +no warnings ; +{ + use warnings FATAL => 'all' ; + $a = sub { my $b ; chop $b ; } +} +&$a ; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + --FILE-- abc 1 if $a EQ $b ; 1; @@ -240,3 +276,37 @@ eval ' print STDERR "The End.\n" ; EXPECT Use of EQ is deprecated at - line 8. +######## + +use warnings 'void' ; + +time ; + +{ + use warnings FATAL => qw(void) ; + length "abc" ; +} + +join "", 1,2,3 ; + +print "done\n" ; +EXPECT +Useless use of time in void context at - line 4. +Useless use of length in void context at - line 8. +######## + +use warnings ; + +time ; + +{ + use warnings FATAL => qw(void) ; + length "abc" ; +} + +join "", 1,2,3 ; + +print "done\n" ; +EXPECT +Useless use of time in void context at - line 4. +Useless use of length in void context at - line 8. diff --git a/contrib/perl5/t/pragma/warn/9enabled b/contrib/perl5/t/pragma/warn/9enabled index 7facf99..f5579b2 100755 --- a/contrib/perl5/t/pragma/warn/9enabled +++ b/contrib/perl5/t/pragma/warn/9enabled @@ -332,7 +332,17 @@ print $@ ; EXPECT Usage: warnings::warn([category,] 'message') at - line 4 unknown warnings category 'fred' at - line 6 - require 0 called at - line 6 +######## + +# check warnings::warnif +use warnings ; +eval { warnings::warnif() } ; +print $@ ; +eval { warnings::warnif("fred", "joe") } ; +print $@ ; +EXPECT +Usage: warnings::warnif([category,] 'message') at - line 4 +unknown warnings category 'fred' at - line 6 ######## --FILE-- abc.pm @@ -373,6 +383,7 @@ eval { abc::check() ; } ; print "[[$@]]\n"; EXPECT hello at - line 3 + eval {...} called at - line 3 [[]] ######## @@ -388,6 +399,7 @@ eval { abc::check() ; } ; print "[[$@]]\n"; EXPECT [[hello at - line 3 + eval {...} called at - line 3 ]] ######## -W @@ -431,7 +443,37 @@ use warnings 'syntax' ; use abc ; abc::check() ; EXPECT -package 'abc' not registered for warnings at - line 3 +package 'abc' not registered for warnings at abc.pm line 4 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +sub check { + warnings::warn("fred") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +abc::check() ; +EXPECT +package 'abc' not registered for warnings at abc.pm line 4 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +sub check { + warnings::warnif("fred") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +abc::check() ; +EXPECT +package 'abc' not registered for warnings at abc.pm line 4 ######## --FILE-- abc.pm @@ -617,6 +659,7 @@ eval { abc::check() ; } ; print "[[$@]]\n"; EXPECT hello at - line 3 + eval {...} called at - line 3 [[]] ######## @@ -632,6 +675,7 @@ eval { abc::check() ; } ; print "[[$@]]\n"; EXPECT [[hello at - line 3 + eval {...} called at - line 3 ]] ######## -W @@ -723,6 +767,10 @@ sub check { print "ok1\n" if !warnings::enabled() ; print "ok2\n" if !warnings::enabled("io") ; print "ok3\n" if !warnings::enabled("all") ; + warnings::warnif("my message 1") ; + warnings::warnif('abc', "my message 2") ; + warnings::warnif('io', "my message 3") ; + warnings::warnif('all', "my message 4") ; } 1; --FILE-- @@ -817,3 +865,298 @@ abc all not enabled def self enabled def abc not enabled def all not enabled +######## +-w +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if warnings::enabled() ; + print "ok2\n" if warnings::enabled("io") ; + print "ok3\n" if warnings::enabled("all") ; +} +1; +--FILE-- +use abc ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## +-w +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; +} +1; +--FILE-- +use abc ; +use warnings 'abc'; +no warnings ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; + warnings::warnif("my message 1") ; + warnings::warnif('abc', "my message 2") ; + warnings::warnif('io', "my message 3") ; + warnings::warnif('all', "my message 4") ; +} +1; +--FILE-- +use abc ; +use warnings 'abc'; +no warnings ; +BEGIN { $^W = 1 ; } +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; +} +1; +--FILE-- +use abc ; +use warnings 'abc'; +no warnings ; +$^W = 1 ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +$| = 1; +package abc ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; + print "ok4\n" if warnings::enabled("abc") ; + warnings::warn("my message 1") ; + warnings::warnif("my message 2") ; + warnings::warnif('abc', "my message 3") ; + warnings::warnif('io', "my message 4") ; + warnings::warnif('all', "my message 5") ; +} +sub in2 { no warnings ; check() } +sub in1 { no warnings ; in2() } +1; +--FILE-- +use abc ; +use warnings 'abc'; +abc::in1() ; +EXPECT +ok1 +ok2 +ok3 +ok4 +my message 1 at - line 3 +my message 2 at - line 3 +my message 3 at - line 3 +######## + +--FILE-- def.pm +package def ; +no warnings ; +use warnings::register ; +sub check { + print "ok1\n" if warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; + print "ok4\n" if warnings::enabled("def") ; + warnings::warn("my message 1") ; + warnings::warnif("my message 2") ; + warnings::warnif('def', "my message 3") ; + warnings::warnif('io', "my message 4") ; + warnings::warnif('all', "my message 5") ; +} +sub in2 { no warnings ; check() } +sub in1 { no warnings ; in2() } +1; +--FILE-- abc.pm +$| = 1; +package abc ; +use def ; +use warnings 'def'; +sub in1 { def::in1() ; } +1; +--FILE-- +use abc ; +no warnings; +abc::in1() ; +EXPECT +ok1 +ok2 +ok3 +ok4 +my message 1 at abc.pm line 5 + abc::in1() called at - line 3 +my message 2 at abc.pm line 5 + abc::in1() called at - line 3 +my message 3 at abc.pm line 5 + abc::in1() called at - line 3 +######## + +--FILE-- def.pm +$| = 1; +package def ; +no warnings ; +use warnings::register ; +require Exporter; +@ISA = qw( Exporter ) ; +@EXPORT = qw( in1 ) ; +sub check { + print "ok1\n" if warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; + print "ok4\n" if warnings::enabled("abc") ; + print "ok5\n" if !warnings::enabled("def") ; + warnings::warn("my message 1") ; + warnings::warnif("my message 2") ; + warnings::warnif('abc', "my message 3") ; + warnings::warnif('def', "my message 4") ; + warnings::warnif('io', "my message 5") ; + warnings::warnif('all', "my message 6") ; +} +sub in2 { no warnings ; check() } +sub in1 { no warnings ; in2() } +1; +--FILE-- abc.pm +package abc ; +use warnings::register ; +use def ; +#@ISA = qw(def) ; +1; +--FILE-- +use abc ; +no warnings; +use warnings 'abc'; +abc::in1() ; +EXPECT +ok2 +ok3 +ok4 +ok5 +my message 1 at - line 4 +my message 3 at - line 4 +######## + +--FILE-- def.pm +package def ; +no warnings ; +use warnings::register ; + +sub new +{ + my $class = shift ; + bless [], $class ; +} + +sub check +{ + my $self = shift ; + print "ok1\n" if !warnings::enabled() ; + print "ok2\n" if !warnings::enabled("io") ; + print "ok3\n" if !warnings::enabled("all") ; + print "ok4\n" if warnings::enabled("abc") ; + print "ok5\n" if !warnings::enabled("def") ; + print "ok6\n" if warnings::enabled($self) ; + + warnings::warn("my message 1") ; + warnings::warn($self, "my message 2") ; + + warnings::warnif("my message 3") ; + warnings::warnif('abc', "my message 4") ; + warnings::warnif('def', "my message 5") ; + warnings::warnif('io', "my message 6") ; + warnings::warnif('all', "my message 7") ; + warnings::warnif($self, "my message 8") ; +} +sub in2 +{ + no warnings ; + my $self = shift ; + $self->check() ; +} +sub in1 +{ + no warnings ; + my $self = shift ; + $self->in2(); +} +1; +--FILE-- abc.pm +$| = 1; +package abc ; +use warnings::register ; +use def ; +@ISA = qw(def) ; +sub new +{ + my $class = shift ; + bless [], $class ; +} + +1; +--FILE-- +use abc ; +no warnings; +use warnings 'abc'; +$a = new abc ; +$a->in1() ; +print "**\n"; +$b = new def ; +$b->in1() ; +EXPECT +ok1 +ok2 +ok3 +ok4 +ok5 +ok6 +my message 1 at - line 5 +my message 2 at - line 5 +my message 4 at - line 5 +my message 8 at - line 5 +** +ok1 +ok2 +ok3 +ok4 +ok5 +my message 1 at - line 8 +my message 2 at - line 8 +my message 4 at - line 8 diff --git a/contrib/perl5/t/pragma/warn/doio b/contrib/perl5/t/pragma/warn/doio index bd40972..2a357e2 100644 --- a/contrib/perl5/t/pragma/warn/doio +++ b/contrib/perl5/t/pragma/warn/doio @@ -12,22 +12,22 @@ warn(warn_nl, "open"); [Perl_do_open9] open(F, "true\ncd") - Close on unopened file <%s> [Perl_do_close] <<TODO + close() on unopened filehandle %s [Perl_do_close] $a = "fred";close("$a") - tell() on unopened file [Perl_do_tell] + tell() on closed filehandle [Perl_do_tell] $a = "fred";$a = tell($a) - seek() on unopened file [Perl_do_seek] + seek() on closed filehandle [Perl_do_seek] $a = "fred";$a = seek($a,1,1) - sysseek() on unopened file [Perl_do_sysseek] + sysseek() on closed filehandle [Perl_do_sysseek] $a = "fred";$a = seek($a,1,1) warn(warn_uninit); [Perl_do_print] print $a ; - Stat on unopened file <%s> [Perl_my_stat] + -x on closed filehandle %s [Perl_my_stat] close STDIN ; -x STDIN ; warn(warn_nl, "stat"); [Perl_my_stat] @@ -96,7 +96,7 @@ close "fred" ; no warnings 'unopened' ; close "joe" ; EXPECT -Close on unopened file <fred> at - line 3. +close() on unopened filehandle fred at - line 3. ######## # doio.c [Perl_do_tell Perl_do_seek Perl_do_sysseek Perl_my_stat] use warnings 'io' ; @@ -105,17 +105,35 @@ tell(STDIN); $a = seek(STDIN,1,1); $a = sysseek(STDIN,1,1); -x STDIN ; +stat(STDIN) ; +$a = "fred"; +tell($a); +seek($a,1,1); +sysseek($a,1,1); +-x $a; # ok +stat($a); # ok no warnings 'io' ; close STDIN ; tell(STDIN); $a = seek(STDIN,1,1); $a = sysseek(STDIN,1,1); -x STDIN ; +stat(STDIN) ; +$a = "fred"; +tell($a); +seek($a,1,1); +sysseek($a,1,1); +-x $a; +stat($a); EXPECT -tell() on unopened file at - line 4. -seek() on unopened file at - line 5. -sysseek() on unopened file at - line 6. -Stat on unopened file <STDIN> at - line 7. +tell() on closed filehandle STDIN at - line 4. +seek() on closed filehandle STDIN at - line 5. +sysseek() on closed filehandle STDIN at - line 6. +-x on closed filehandle STDIN at - line 7. +stat() on closed filehandle STDIN at - line 8. +tell() on unopened filehandle at - line 10. +seek() on unopened filehandle at - line 11. +sysseek() on unopened filehandle at - line 12. ######## # doio.c [Perl_do_print] use warnings 'uninitialized' ; @@ -188,4 +206,4 @@ my $a = eof STDOUT ; no warnings 'io' ; $a = eof STDOUT ; EXPECT -Filehandle main::STDOUT opened only for output at - line 3. +Filehandle STDOUT opened only for output at - line 3. diff --git a/contrib/perl5/t/pragma/warn/op b/contrib/perl5/t/pragma/warn/op index 1a79b4a..1f41a98 100644 --- a/contrib/perl5/t/pragma/warn/op +++ b/contrib/perl5/t/pragma/warn/op @@ -150,6 +150,17 @@ EXPECT # op.c use warnings 'closure' ; sub x { + our $x; + sub y { + $x + } + } +EXPECT + +######## +# op.c +use warnings 'closure' ; +sub x { my $x; sub y { sub { $x } @@ -267,7 +278,7 @@ Useless use of hash element in void context at - line 29. Useless use of hash slice in void context at - line 30. Useless use of unpack in void context at - line 31. Useless use of pack in void context at - line 32. -Useless use of join in void context at - line 33. +Useless use of join or string in void context at - line 33. Useless use of list slice in void context at - line 34. Useless use of sort in void context at - line 37. Useless use of reverse in void context at - line 38. @@ -558,7 +569,7 @@ Useless use of a constant in void context at - line 3. Useless use of a constant in void context at - line 4. ######## # op.c -BEGIN{ $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; } # known scalar leak +# use warnings 'misc' ; my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ; @a =~ /abc/ ; @@ -592,7 +603,6 @@ my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ; EXPECT Applying pattern match (m//) to @array will act on scalar(@array) at - line 5. Applying substitution (s///) to @array will act on scalar(@array) at - line 6. -Can't modify private array in substitution (s///) at - line 6, near "s/a/b/ ;" Applying transliteration (tr///) to @array will act on scalar(@array) at - line 7. Applying pattern match (m//) to @array will act on scalar(@array) at - line 8. Applying substitution (s///) to @array will act on scalar(@array) at - line 9. @@ -603,6 +613,7 @@ Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 13 Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 14. Applying substitution (s///) to %hash will act on scalar(%hash) at - line 15. Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 16. +Can't modify private array in substitution (s///) at - line 6, near "s/a/b/ ;" BEGIN not safe after errors--compilation aborted at - line 18. ######## # op.c diff --git a/contrib/perl5/t/pragma/warn/perl b/contrib/perl5/t/pragma/warn/perl index 4580749..b4a00ba 100644 --- a/contrib/perl5/t/pragma/warn/perl +++ b/contrib/perl5/t/pragma/warn/perl @@ -54,4 +54,19 @@ Name "main::z" used only once: possible typo at - line 6. use warnings 'once' ; $x = 3 ; EXPECT +######## +# perl.c +{ use warnings 'once' ; $x = 3 ; } +$y = 3 ; +EXPECT +Name "main::x" used only once: possible typo at - line 3. +######## + +# perl.c +$z = 3 ; +BEGIN { $^W = 1 } +{ no warnings 'once' ; $x = 3 ; } +$y = 3 ; +EXPECT +Name "main::y" used only once: possible typo at - line 6. diff --git a/contrib/perl5/t/pragma/warn/pp_ctl b/contrib/perl5/t/pragma/warn/pp_ctl index 0deccd3..ac01f27 100644 --- a/contrib/perl5/t/pragma/warn/pp_ctl +++ b/contrib/perl5/t/pragma/warn/pp_ctl @@ -214,4 +214,17 @@ DESTROY { die "@{$_[0]} foo bar" } { bless ['A'], 'Foo' for 1..10 } { bless ['B'], 'Foo' for 1..10 } EXPECT - +######## +# pp_ctl.c +use warnings; +eval 'print $foo'; +EXPECT +Use of uninitialized value in print at (eval 1) line 1. +######## +# pp_ctl.c +use warnings; +{ + no warnings; + eval 'print $foo'; +} +EXPECT diff --git a/contrib/perl5/t/pragma/warn/pp_hot b/contrib/perl5/t/pragma/warn/pp_hot index 2759057..698255c 100644 --- a/contrib/perl5/t/pragma/warn/pp_hot +++ b/contrib/perl5/t/pragma/warn/pp_hot @@ -1,6 +1,6 @@ pp_hot.c - Filehandle %s never opened [pp_print] + print() on unopened filehandle abc [pp_print] $f = $a = "abc" ; print $f $a Filehandle %s opened only for input [pp_print] @@ -33,6 +33,9 @@ readline() on closed filehandle %s [Perl_do_readline] close STDIN ; $a = <STDIN>; + readline() on closed filehandle %s [Perl_do_readline] + readline(NONESUCH); + glob failed (child exited with status %d%s) [Perl_do_readline] <<TODO Deep recursion on subroutine \"%s\" [Perl_sub_crush_depth] @@ -52,7 +55,7 @@ print $f $a; no warnings 'unopened' ; print $f $a; EXPECT -Filehandle main::abc never opened at - line 4. +print() on unopened filehandle abc at - line 4. ######## # pp_hot.c [pp_print] use warnings 'io' ; @@ -71,12 +74,12 @@ print getc(FOO); 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 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_print] use warnings 'closed' ; @@ -90,9 +93,9 @@ print STDIN "anc"; opendir STDIN, "."; print STDIN "anc"; EXPECT -print() on closed filehandle main::STDIN at - line 4. -print() on closed filehandle main::STDIN at - line 6. - (Are you trying to call print() on dirhandle main::STDIN?) +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_rv2av] use warnings 'uninitialized' ; @@ -137,9 +140,9 @@ no warnings 'closed' ; opendir STDIN, "." ; $a = <STDIN> ; $a = <STDIN> ; EXPECT -readline() on closed filehandle main::STDIN at - line 3. -readline() on closed filehandle main::STDIN at - line 4. - (Are you trying to call readline() on dirhandle main::STDIN?) +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' ; @@ -148,9 +151,10 @@ open (FH, ">./xcv") ; my $a = <FH> ; no warnings 'io' ; $a = <FH> ; +close (FH) ; unlink $file ; EXPECT -Filehandle main::FH opened only for output at - line 5. +Filehandle FH opened only for output at - line 5. ######## # pp_hot.c [Perl_sub_crush_depth] use warnings 'recursion' ; diff --git a/contrib/perl5/t/pragma/warn/pp_sys b/contrib/perl5/t/pragma/warn/pp_sys index 7c38727..68518e2 100644 --- a/contrib/perl5/t/pragma/warn/pp_sys +++ b/contrib/perl5/t/pragma/warn/pp_sys @@ -16,7 +16,7 @@ page overflow [pp_leavewrite] - Filehandle %s never opened [pp_prtf] + printf() on unopened filehandle abc [pp_prtf] $a = "abc"; printf $a "fred" Filehandle %s opened only for input [pp_prtf] @@ -69,13 +69,16 @@ getpeername STDIN; flock() on closed socket %s [pp_flock] + flock() on closed socket [pp_flock] close STDIN; flock STDIN, 8; + flock $a, 8; warn(warn_nl, "stat"); [pp_stat] - Test on unopened file <%s> - close STDIN ; -T STDIN ; + -T on closed filehandle %s + stat() on closed filehandle %s + close STDIN ; -T STDIN ; stat(STDIN) ; warn(warn_nl, "open"); [pp_fttext] -T "abc\ndef" ; @@ -107,7 +110,7 @@ write STDIN; no warnings 'io' ; write STDIN; EXPECT -Filehandle main::STDIN opened only for input at - line 5. +Filehandle STDIN opened only for input at - line 5. ######## # pp_sys.c [pp_leavewrite] use warnings 'closed' ; @@ -123,9 +126,9 @@ write STDIN; opendir STDIN, "."; write STDIN; EXPECT -write() on closed filehandle main::STDIN at - line 6. -write() on closed filehandle main::STDIN at - line 8. - (Are you trying to call write() on dirhandle main::STDIN?) +write() on closed filehandle STDIN at - line 6. +write() on closed filehandle STDIN at - line 8. + (Are you trying to call write() on dirhandle STDIN?) ######## # pp_sys.c [pp_leavewrite] use warnings 'io' ; @@ -152,7 +155,7 @@ printf $a "fred"; no warnings 'unopened' ; printf $a "fred"; EXPECT -Filehandle main::abc never opened at - line 4. +printf() on unopened filehandle abc at - line 4. ######## # pp_sys.c [pp_prtf] use warnings 'closed' ; @@ -166,9 +169,9 @@ printf STDIN "fred"; opendir STDIN, "."; printf STDIN "fred"; EXPECT -printf() on closed filehandle main::STDIN at - line 4. -printf() on closed filehandle main::STDIN at - line 6. - (Are you trying to call printf() on dirhandle main::STDIN?) +printf() on closed filehandle STDIN at - line 4. +printf() on closed filehandle STDIN at - line 6. + (Are you trying to call printf() on dirhandle STDIN?) ######## # pp_sys.c [pp_prtf] use warnings 'io' ; @@ -176,7 +179,7 @@ printf STDIN "fred"; no warnings 'io' ; printf STDIN "fred"; EXPECT -Filehandle main::STDIN opened only for input at - line 3. +Filehandle STDIN opened only for input at - line 3. ######## # pp_sys.c [pp_send] use warnings 'closed' ; @@ -190,14 +193,16 @@ syswrite STDIN, "fred", 1; opendir STDIN, "."; syswrite STDIN, "fred", 1; EXPECT -syswrite() on closed filehandle main::STDIN at - line 4. -syswrite() on closed filehandle main::STDIN at - line 6. - (Are you trying to call syswrite() on dirhandle main::STDIN?) +syswrite() on closed filehandle STDIN at - line 4. +syswrite() on closed filehandle STDIN at - line 6. + (Are you trying to call syswrite() on dirhandle STDIN?) ######## # pp_sys.c [pp_flock] use Config; BEGIN { - if ( $^O eq 'VMS' and ! $Config{d_flock}) { + if ( !$Config{d_flock} && + !$Config{d_fcntl_can_lock} && + !$Config{d_lockf} ) { print <<EOM ; SKIPPED # flock not present @@ -205,19 +210,25 @@ EOM exit ; } } -use warnings 'closed' ; +use warnings qw(unopened closed); close STDIN; flock STDIN, 8; opendir STDIN, "."; flock STDIN, 8; -no warnings 'closed' ; +flock FOO, 8; +flock $a, 8; +no warnings qw(unopened closed); flock STDIN, 8; opendir STDIN, "."; flock STDIN, 8; +flock FOO, 8; +flock $a, 8; EXPECT -flock() on closed filehandle main::STDIN at - line 14. -flock() on closed filehandle main::STDIN at - line 16. - (Are you trying to call flock() on dirhandle main::STDIN?) +flock() on closed filehandle STDIN at - line 16. +flock() on closed filehandle STDIN at - line 18. + (Are you trying to call flock() on dirhandle STDIN?) +flock() on unopened filehandle FOO at - line 19. +flock() on unopened filehandle at - line 20. ######## # pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername] use warnings 'io' ; @@ -285,36 +296,36 @@ getsockopt STDIN, 1,2; getsockname STDIN; getpeername STDIN; EXPECT -send() on closed socket main::STDIN at - line 22. -bind() on closed socket main::STDIN at - line 23. -connect() on closed socket main::STDIN at - line 24. -listen() on closed socket main::STDIN at - line 25. -accept() on closed socket main::STDIN at - line 26. -shutdown() on closed socket main::STDIN at - line 27. -setsockopt() on closed socket main::STDIN at - line 28. -getsockopt() on closed socket main::STDIN at - line 29. -getsockname() on closed socket main::STDIN at - line 30. -getpeername() on closed socket main::STDIN at - line 31. -send() on closed socket main::STDIN at - line 33. - (Are you trying to call send() on dirhandle main::STDIN?) -bind() on closed socket main::STDIN at - line 34. - (Are you trying to call bind() on dirhandle main::STDIN?) -connect() on closed socket main::STDIN at - line 35. - (Are you trying to call connect() on dirhandle main::STDIN?) -listen() on closed socket main::STDIN at - line 36. - (Are you trying to call listen() on dirhandle main::STDIN?) -accept() on closed socket main::STDIN at - line 37. - (Are you trying to call accept() on dirhandle main::STDIN?) -shutdown() on closed socket main::STDIN at - line 38. - (Are you trying to call shutdown() on dirhandle main::STDIN?) -setsockopt() on closed socket main::STDIN at - line 39. - (Are you trying to call setsockopt() on dirhandle main::STDIN?) -getsockopt() on closed socket main::STDIN at - line 40. - (Are you trying to call getsockopt() on dirhandle main::STDIN?) -getsockname() on closed socket main::STDIN at - line 41. - (Are you trying to call getsockname() on dirhandle main::STDIN?) -getpeername() on closed socket main::STDIN at - line 42. - (Are you trying to call getpeername() on dirhandle main::STDIN?) +send() on closed socket STDIN at - line 22. +bind() on closed socket STDIN at - line 23. +connect() on closed socket STDIN at - line 24. +listen() on closed socket STDIN at - line 25. +accept() on closed socket STDIN at - line 26. +shutdown() on closed socket STDIN at - line 27. +setsockopt() on closed socket STDIN at - line 28. +getsockopt() on closed socket STDIN at - line 29. +getsockname() on closed socket STDIN at - line 30. +getpeername() on closed socket STDIN at - line 31. +send() on closed socket STDIN at - line 33. + (Are you trying to call send() on dirhandle STDIN?) +bind() on closed socket STDIN at - line 34. + (Are you trying to call bind() on dirhandle STDIN?) +connect() on closed socket STDIN at - line 35. + (Are you trying to call connect() on dirhandle STDIN?) +listen() on closed socket STDIN at - line 36. + (Are you trying to call listen() on dirhandle STDIN?) +accept() on closed socket STDIN at - line 37. + (Are you trying to call accept() on dirhandle STDIN?) +shutdown() on closed socket STDIN at - line 38. + (Are you trying to call shutdown() on dirhandle STDIN?) +setsockopt() on closed socket STDIN at - line 39. + (Are you trying to call setsockopt() on dirhandle STDIN?) +getsockopt() on closed socket STDIN at - line 40. + (Are you trying to call getsockopt() on dirhandle STDIN?) +getsockname() on closed socket STDIN at - line 41. + (Are you trying to call getsockname() on dirhandle STDIN?) +getpeername() on closed socket STDIN at - line 42. + (Are you trying to call getpeername() on dirhandle STDIN?) ######## # pp_sys.c [pp_stat] use warnings 'newline' ; @@ -325,13 +336,22 @@ EXPECT Unsuccessful stat on filename containing newline at - line 3. ######## # pp_sys.c [pp_fttext] -use warnings 'unopened' ; +use warnings qw(unopened closed) ; close STDIN ; -T STDIN ; -no warnings 'unopened' ; +stat(STDIN) ; +-T HOCUS; +stat(POCUS); +no warnings qw(unopened closed) ; -T STDIN ; +stat(STDIN); +-T HOCUS; +stat(POCUS); EXPECT -Test on unopened file <STDIN> at - line 4. +-T on closed filehandle STDIN at - line 4. +stat() on closed filehandle STDIN at - line 5. +-T on unopened filehandle HOCUS at - line 6. +stat() on unopened filehandle POCUS at - line 7. ######## # pp_sys.c [pp_fttext] use warnings 'newline' ; @@ -343,6 +363,13 @@ Unsuccessful open on filename containing newline at - line 3. ######## # pp_sys.c [pp_sysread] use warnings 'io' ; +if ($^O eq 'dos') { + print <<EOM ; +SKIPPED +# skipped on dos +EOM + exit ; +} my $file = "./xcv" ; open(F, ">$file") ; my $a = sysread(F, $a,10) ; @@ -351,4 +378,4 @@ my $a = sysread(F, $a,10) ; close F ; unlink $file ; EXPECT -Filehandle main::F opened only for output at - line 5. +Filehandle F opened only for output at - line 12. diff --git a/contrib/perl5/t/pragma/warn/regcomp b/contrib/perl5/t/pragma/warn/regcomp index 5d0c291..8b86b50 100644 --- a/contrib/perl5/t/pragma/warn/regcomp +++ b/contrib/perl5/t/pragma/warn/regcomp @@ -11,10 +11,6 @@ Character class [:%.*s:] unknown [S_regpposixcc] - Character class syntax [. .] is reserved for future extensions [S_regpposixcc] - - Character class syntax [= =] is reserved for future extensions [S_checkposixcc] - Character class syntax [%c %c] belongs inside character classes [S_checkposixcc] /%.127s/: false [] range \"%*.*s\" in regexp [S_regclass] @@ -33,7 +29,7 @@ $a =~ /(?=a)*/ ; no warnings 'regexp' ; $a =~ /(?=a)*/ ; EXPECT -(?=a)* matches null string many times at - line 4. +(?=a)* matches null string many times before HERE mark in regex m/(?=a)* << HERE / at - line 4. ######## # regcomp.c [S_study_chunk] use warnings 'regexp' ; @@ -42,7 +38,7 @@ $_ = "" ; no warnings 'regexp' ; /(?=a)?/; EXPECT -Strange *+?{} on zero-length expression at - line 4. +Quantifier unexpected on zero-length expression before HERE mark in regex m/(?=a)? << HERE / at - line 4. ######## # regcomp.c [S_regatom] $x = '\m' ; @@ -51,39 +47,44 @@ $a =~ /a$x/ ; no warnings 'regexp' ; $a =~ /a$x/ ; EXPECT -/a\m/: Unrecognized escape \m passed through at - line 4. +Unrecognized escape \m passed through before HERE mark in regex m/a\m << HERE / at - line 4. ######## # regcomp.c [S_regpposixcc S_checkposixcc] -BEGIN { $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3 } +# use warnings 'regexp' ; $_ = "" ; /[:alpha:]/; -/[.bar.]/; -/[=zog=]/; -/[[:alpha:]]/; -/[[.foo.]]/; -/[[=bar=]]/; /[:zog:]/; /[[:zog:]]/; no warnings 'regexp' ; /[:alpha:]/; -/[.foo.]/; -/[=bar=]/; -/[[:alpha:]]/; -/[[.foo.]]/; -/[[=bar=]]/; -/[[:zog:]]/; /[:zog:]/; +/[[:zog:]]/; EXPECT -Character class syntax [: :] belongs inside character classes at - line 5. -Character class syntax [. .] belongs inside character classes at - line 6. -Character class syntax [. .] is reserved for future extensions at - line 6. -Character class syntax [= =] belongs inside character classes at - line 7. -Character class syntax [= =] is reserved for future extensions at - line 7. -Character class syntax [. .] is reserved for future extensions at - line 9. -Character class syntax [= =] is reserved for future extensions at - line 10. -Character class syntax [: :] belongs inside character classes at - line 11. -Character class [:zog:] unknown at - line 12. +POSIX syntax [: :] belongs inside character classes before HERE mark in regex m/[:alpha:] << HERE / at - line 5. +POSIX syntax [: :] belongs inside character classes before HERE mark in regex m/[:zog:] << HERE / at - line 6. +POSIX class [:zog:] unknown before HERE mark in regex m/[[:zog:] << HERE ]/ +######## +# regcomp.c [S_checkposixcc] +# +use warnings 'regexp' ; +$_ = "" ; +/[.zog.]/; +no warnings 'regexp' ; +/[.zog.]/; +EXPECT +POSIX syntax [. .] belongs inside character classes before HERE mark in regex m/[.zog.] << HERE / at - line 5. +POSIX syntax [. .] is reserved for future extensions before HERE mark in regex m/[.zog.] << HERE / +######## +# regcomp.c [S_checkposixcc] +# +use warnings 'regexp' ; +$_ = "" ; +/[[.zog.]]/; +no warnings 'regexp' ; +/[[.zog.]]/; +EXPECT +POSIX syntax [. .] is reserved for future extensions before HERE mark in regex m/[[.zog.] << HERE ]/ ######## # regcomp.c [S_regclass] $_ = ""; @@ -108,14 +109,14 @@ no warnings 'regexp' ; /[[:alpha:]-[:digit:]]/; /[[:digit:]-[:alpha:]]/; EXPECT -/[a-\d]/: false [] range "a-\d" in regexp at - line 5. -/[\d-b]/: false [] range "\d-" in regexp at - line 6. -/[\s-\d]/: false [] range "\s-" in regexp at - line 7. -/[\d-\s]/: false [] range "\d-" in regexp at - line 8. -/[a-[:digit:]]/: false [] range "a-[:digit:]" in regexp at - line 9. -/[[:digit:]-b]/: false [] range "[:digit:]-" in regexp at - line 10. -/[[:alpha:]-[:digit:]]/: false [] range "[:alpha:]-" in regexp at - line 11. -/[[:digit:]-[:alpha:]]/: false [] range "[:digit:]-" in regexp at - line 12. +False [] range "a-\d" before HERE mark in regex m/[a-\d << HERE ]/ at - line 5. +False [] range "\d-" before HERE mark in regex m/[\d- << HERE b]/ at - line 6. +False [] range "\s-" before HERE mark in regex m/[\s- << HERE \d]/ at - line 7. +False [] range "\d-" before HERE mark in regex m/[\d- << HERE \s]/ at - line 8. +False [] range "a-[:digit:]" before HERE mark in regex m/[a-[:digit:] << HERE ]/ at - line 9. +False [] range "[:digit:]-" before HERE mark in regex m/[[:digit:]- << HERE b]/ at - line 10. +False [] range "[:alpha:]-" before HERE mark in regex m/[[:alpha:]- << HERE [:digit:]]/ at - line 11. +False [] range "[:digit:]-" before HERE mark in regex m/[[:digit:]- << HERE [:alpha:]]/ at - line 12. ######## # regcomp.c [S_regclassutf8] BEGIN { @@ -147,14 +148,14 @@ no warnings 'regexp' ; /[[:alpha:]-[:digit:]]/; /[[:digit:]-[:alpha:]]/; EXPECT -/[a-\d]/: false [] range "a-\d" in regexp at - line 12. -/[\d-b]/: false [] range "\d-" in regexp at - line 13. -/[\s-\d]/: false [] range "\s-" in regexp at - line 14. -/[\d-\s]/: false [] range "\d-" in regexp at - line 15. -/[a-[:digit:]]/: false [] range "a-[:digit:]" in regexp at - line 16. -/[[:digit:]-b]/: false [] range "[:digit:]-" in regexp at - line 17. -/[[:alpha:]-[:digit:]]/: false [] range "[:alpha:]-" in regexp at - line 18. -/[[:digit:]-[:alpha:]]/: false [] range "[:digit:]-" in regexp at - line 19. +False [] range "a-\d" before HERE mark in regex m/[a-\d << HERE ]/ at - line 12. +False [] range "\d-" before HERE mark in regex m/[\d- << HERE b]/ at - line 13. +False [] range "\s-" before HERE mark in regex m/[\s- << HERE \d]/ at - line 14. +False [] range "\d-" before HERE mark in regex m/[\d- << HERE \s]/ at - line 15. +False [] range "a-[:digit:]" before HERE mark in regex m/[a-[:digit:] << HERE ]/ at - line 16. +False [] range "[:digit:]-" before HERE mark in regex m/[[:digit:]- << HERE b]/ at - line 17. +False [] range "[:alpha:]-" before HERE mark in regex m/[[:alpha:]- << HERE [:digit:]]/ at - line 18. +False [] range "[:digit:]-" before HERE mark in regex m/[[:digit:]- << HERE [:alpha:]]/ at - line 19. ######## # regcomp.c [S_regclass S_regclassutf8] use warnings 'regexp' ; @@ -162,4 +163,5 @@ $a =~ /[a\zb]/ ; no warnings 'regexp' ; $a =~ /[a\zb]/ ; EXPECT -/[a\zb]/: Unrecognized escape \z in character class passed through at - line 3. +Unrecognized escape \z in character class passed through before HERE mark in regex m/[a\z << HERE b]/ at - line 3. + diff --git a/contrib/perl5/t/pragma/warn/sv b/contrib/perl5/t/pragma/warn/sv index 758137f..2409589 100644 --- a/contrib/perl5/t/pragma/warn/sv +++ b/contrib/perl5/t/pragma/warn/sv @@ -178,7 +178,7 @@ no warnings 'uninitialized' ; $C = "" ; $C .= $A ; EXPECT -Use of uninitialized value in concatenation (.) at - line 10. +Use of uninitialized value in concatenation (.) or string at - line 10. ######## # sv.c use warnings 'numeric' ; diff --git a/contrib/perl5/t/pragma/warn/toke b/contrib/perl5/t/pragma/warn/toke index cfdea78..fa71329 100644 --- a/contrib/perl5/t/pragma/warn/toke +++ b/contrib/perl5/t/pragma/warn/toke @@ -198,10 +198,6 @@ EXPECT Semicolon seems to be missing at - line 3. ######## # toke.c -BEGIN { - # Scalars leaked: due to syntax errors - $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; -} use warnings 'syntax' ; my $a =+ 2 ; $a =- 2 ; @@ -214,25 +210,21 @@ $a =| 2 ; $a =< 2 ; $a =/ 2 ; EXPECT -Reversed += operator at - line 7. -Reversed -= operator at - line 8. -Reversed *= operator at - line 9. -Reversed %= operator at - line 10. -Reversed &= operator at - line 11. -Reversed .= operator at - line 12. -syntax error at - line 12, near "=." -Reversed ^= operator at - line 13. -syntax error at - line 13, near "=^" -Reversed |= operator at - line 14. -syntax error at - line 14, near "=|" -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; -} +Reversed += operator at - line 3. +Reversed -= operator at - line 4. +Reversed *= operator at - line 5. +Reversed %= operator at - line 6. +Reversed &= operator at - line 7. +Reversed .= operator at - line 8. +Reversed ^= operator at - line 9. +Reversed |= operator at - line 10. +Reversed <= operator at - line 11. +syntax error at - line 8, near "=." +syntax error at - line 9, near "=^" +syntax error at - line 10, near "=|" +Unterminated <> operator at - line 11. +######## +# toke.c no warnings 'syntax' ; my $a =+ 2 ; $a =- 2 ; @@ -245,10 +237,10 @@ $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. +syntax error at - line 8, near "=." +syntax error at - line 9, near "=^" +syntax error at - line 10, near "=|" +Unterminated <> operator at - line 11. ######## # toke.c use warnings 'syntax' ; @@ -290,6 +282,9 @@ Can't use \1 to mean $1 in expression at - line 4. # toke.c use warnings 'reserved' ; $a = abc; +$a = { def + +=> 1 }; no warnings 'reserved' ; $a = abc; EXPECT @@ -434,13 +429,14 @@ Ambiguous call resolved as CORE::time(), qualify as such or use & at - line 4. # toke.c use warnings ; eval <<'EOE'; +# line 30 "foo" +warn "yelp"; { -#line 30 "foo" $_ = " \x{123} " ; } EOE EXPECT - +yelp at foo line 30. ######## # toke.c my $a = rand + 4 ; @@ -581,3 +577,11 @@ EXPECT Integer overflow in binary number at - line 5. Integer overflow in hexadecimal number at - line 8. Integer overflow in octal number at - line 11. +######## +# toke.c +use warnings 'ambiguous'; +"@mjd_previously_unused_array"; +no warnings 'ambiguous'; +"@mjd_previously_unused_array"; +EXPECT +Possible unintended interpolation of @mjd_previously_unused_array in string at - line 3. diff --git a/contrib/perl5/t/pragma/warn/utf8 b/contrib/perl5/t/pragma/warn/utf8 index 6a2fe54..9a7dbaf 100644 --- a/contrib/perl5/t/pragma/warn/utf8 +++ b/contrib/perl5/t/pragma/warn/utf8 @@ -15,6 +15,12 @@ __END__ # utf8.c [utf8_to_uv] -W +BEGIN { + if (ord('A') == 193) { + print "SKIPPED\n# ebcdic platforms do not generate Malformed UTF-8 warnings."; + exit 0; + } +} use utf8 ; my $a = "snøstorm" ; { @@ -24,6 +30,6 @@ my $a = "snøstorm" ; my $a = "snøstorm"; } EXPECT -Malformed UTF-8 character at - line 3. -Malformed UTF-8 character at - line 8. +Malformed UTF-8 character (unexpected non-continuation byte 0x73 after start byte 0xf8) at - line 9. +Malformed UTF-8 character (unexpected non-continuation byte 0x73 after start byte 0xf8) at - line 14. ######## |
