diff options
Diffstat (limited to 'contrib/perl5/t/pragma/warn')
33 files changed, 5601 insertions, 0 deletions
diff --git a/contrib/perl5/t/pragma/warn/1global b/contrib/perl5/t/pragma/warn/1global new file mode 100644 index 0000000..0af8022 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/1global @@ -0,0 +1,189 @@ +Check existing $^W functionality + + +__END__ + +# warnable code, warnings disabled +$a =+ 3 ; +EXPECT + +######## +-w +# warnable code, warnings enabled via command line switch +$a =+ 3 ; +EXPECT +Reversed += operator at - line 3. +Name "main::a" used only once: possible typo at - line 3. +######## +#! perl -w +# warnable code, warnings enabled via #! line +$a =+ 3 ; +EXPECT +Reversed += operator at - line 3. +Name "main::a" used only once: possible typo at - line 3. +######## + +# warnable code, warnings enabled via compile time $^W +BEGIN { $^W = 1 } +$a =+ 3 ; +EXPECT +Reversed += operator at - line 4. +Name "main::a" used only once: possible typo at - line 4. +######## + +# compile-time warnable code, warnings enabled via runtime $^W +# so no warning printed. +$^W = 1 ; +$a =+ 3 ; +EXPECT + +######## + +# warnable code, warnings enabled via runtime $^W +$^W = 1 ; +my $b ; chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 4. +######## + +# warnings enabled at compile time, disabled at run time +BEGIN { $^W = 1 } +$^W = 0 ; +my $b ; chop $b ; +EXPECT + +######## + +# warnings disabled at compile time, enabled at run time +BEGIN { $^W = 0 } +$^W = 1 ; +my $b ; chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 5. +######## +-w +--FILE-- abcd +my $b ; chop $b ; +1 ; +--FILE-- +require "./abcd"; +EXPECT +Use of uninitialized value in scalar chop at ./abcd line 1. +######## + +--FILE-- abcd +my $b ; chop $b ; +1 ; +--FILE-- +#! perl -w +require "./abcd"; +EXPECT +Use of uninitialized value in scalar chop at ./abcd line 1. +######## + +--FILE-- abcd +my $b ; chop $b ; +1 ; +--FILE-- +$^W =1 ; +require "./abcd"; +EXPECT +Use of uninitialized value in scalar chop at ./abcd line 1. +######## + +--FILE-- abcd +$^W = 0; +my $b ; chop $b ; +1 ; +--FILE-- +$^W =1 ; +require "./abcd"; +EXPECT + +######## + +--FILE-- abcd +$^W = 1; +1 ; +--FILE-- +$^W =0 ; +require "./abcd"; +my $b ; chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 3. +######## + +$^W = 1; +eval 'my $b ; chop $b ;' ; +print $@ ; +EXPECT +Use of uninitialized value in scalar chop at (eval 1) line 1. +######## + +eval '$^W = 1;' ; +print $@ ; +my $b ; chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 4. +######## + +eval {$^W = 1;} ; +print $@ ; +my $b ; chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 4. +######## + +{ + local ($^W) = 1; +} +my $b ; chop $b ; +EXPECT + +######## + +my $a ; chop $a ; +{ + local ($^W) = 1; + my $b ; chop $b ; +} +my $c ; chop $c ; +EXPECT +Use of uninitialized value in scalar chop at - line 5. +######## +-w +-e undef +EXPECT +Use of uninitialized value in -e at - line 2. +######## + +$^W = 1 + 2 ; +EXPECT + +######## + +$^W = $a ; +EXPECT + +######## + +sub fred {} +$^W = fred() ; +EXPECT + +######## + +sub fred { my $b ; chop $b ;} +{ local $^W = 0 ; + fred() ; +} +EXPECT + +######## + +sub fred { my $b ; chop $b ;} +{ local $^W = 1 ; + fred() ; +} +EXPECT +Use of uninitialized value in scalar chop at - line 2. diff --git a/contrib/perl5/t/pragma/warn/2use b/contrib/perl5/t/pragma/warn/2use new file mode 100644 index 0000000..60a60c3 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/2use @@ -0,0 +1,308 @@ +Check lexical warnings functionality + +TODO + check that the warning hierarchy works. + +__END__ + +# check illegal category is caught +use warnings 'this-should-never-be-a-warning-category' ; +EXPECT +unknown warnings category 'this-should-never-be-a-warning-category' at - line 3 +BEGIN failed--compilation aborted at - line 3. +######## + +# Check compile time scope of pragma +use warnings 'deprecated' ; +{ + no warnings ; + 1 if $a EQ $b ; +} +1 if $a EQ $b ; +EXPECT +Use of EQ is deprecated at - line 8. +######## + +# Check compile time scope of pragma +no warnings; +{ + use warnings 'deprecated' ; + 1 if $a EQ $b ; +} +1 if $a EQ $b ; +EXPECT +Use of EQ is deprecated at - line 6. +######## + +# Check runtime scope of pragma +use warnings 'uninitialized' ; +{ + no warnings ; + my $b ; chop $b ; +} +my $b ; chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 8. +######## + +# Check runtime scope of pragma +no warnings ; +{ + use warnings 'uninitialized' ; + my $b ; chop $b ; +} +my $b ; chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check runtime scope of pragma +no warnings ; +{ + use warnings 'uninitialized' ; + $a = sub { my $b ; chop $b ; } +} +&$a ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +use warnings 'deprecated' ; +1 if $a EQ $b ; +EXPECT +Use of EQ is deprecated at - line 3. +######## + +--FILE-- abc +1 if $a EQ $b ; +1; +--FILE-- +use warnings 'deprecated' ; +require "./abc"; +EXPECT + +######## + +--FILE-- abc +use warnings 'deprecated' ; +1; +--FILE-- +require "./abc"; +1 if $a EQ $b ; +EXPECT + +######## + +--FILE-- abc +use warnings 'deprecated' ; +1 if $a EQ $b ; +1; +--FILE-- +use warnings 'uninitialized' ; +require "./abc"; +my $a ; chop $a ; +EXPECT +Use of EQ is deprecated at ./abc line 2. +Use of uninitialized value in scalar chop at - line 3. +######## + +--FILE-- abc.pm +use warnings 'deprecated' ; +1 if $a EQ $b ; +1; +--FILE-- +use warnings 'uninitialized' ; +use abc; +my $a ; chop $a ; +EXPECT +Use of EQ is deprecated at abc.pm line 2. +Use of uninitialized value in scalar chop at - line 3. +######## + +# Check scope of pragma with eval +no warnings ; +eval { + my $b ; chop $b ; +}; print STDERR $@ ; +my $b ; chop $b ; +EXPECT + +######## + +# Check scope of pragma with eval +no warnings ; +eval { + use warnings 'uninitialized' ; + my $b ; chop $b ; +}; print STDERR $@ ; +my $b ; chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check scope of pragma with eval +use warnings 'uninitialized' ; +eval { + 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. +######## + +# Check scope of pragma with eval +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 8. +######## + +# Check scope of pragma with eval +no warnings ; +eval { + 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' ; + 1 if $a EQ $b ; +}; print STDERR $@ ; +1 if $a EQ $b ; +EXPECT +Use of EQ is deprecated at - line 6. +######## + +# Check scope of pragma with eval +use warnings 'deprecated' ; +eval { + 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. +######## + +# Check scope of pragma with eval +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 8. +######## + +# Check scope of pragma with eval +no warnings ; +eval ' + my $b ; chop $b ; +'; print STDERR $@ ; +my $b ; chop $b ; +EXPECT + +######## + +# Check scope of pragma with eval +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 +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 7. +######## + +# Check scope of pragma with eval +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 8. +######## + +# Check scope of pragma with eval +no warnings ; +eval ' + 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' ; + 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 ' + 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 (eval 1) line 2. +######## + +# Check scope of pragma with eval +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 8. +######## + +# Check the additive nature of the pragma +1 if $a EQ $b ; +my $a ; chop $a ; +use warnings 'deprecated' ; +1 if $a EQ $b ; +my $b ; chop $b ; +use warnings 'uninitialized' ; +my $c ; chop $c ; +no warnings 'deprecated' ; +1 if $a EQ $b ; +EXPECT +Use of EQ is deprecated at - line 6. +Use of uninitialized value in scalar chop at - line 9. +Use of uninitialized value in string eq at - line 11. +Use of uninitialized value in string eq at - line 11. diff --git a/contrib/perl5/t/pragma/warn/3both b/contrib/perl5/t/pragma/warn/3both new file mode 100644 index 0000000..132b99b --- /dev/null +++ b/contrib/perl5/t/pragma/warn/3both @@ -0,0 +1,197 @@ +Check interaction of $^W and lexical + +__END__ + +# Check interaction of $^W and use warnings +sub fred { + use warnings ; + my $b ; + chop $b ; +} +{ local $^W = 0 ; + fred() ; +} + +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check interaction of $^W and use warnings +sub fred { + use warnings ; + my $b ; + chop $b ; +} +{ $^W = 0 ; + fred() ; +} + +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check interaction of $^W and use warnings +sub fred { + no warnings ; + my $b ; + chop $b ; +} +{ local $^W = 1 ; + fred() ; +} + +EXPECT + +######## + +# Check interaction of $^W and use warnings +sub fred { + no warnings ; + my $b ; + chop $b ; +} +{ $^W = 1 ; + fred() ; +} + +EXPECT + +######## + +# Check interaction of $^W and use warnings +use warnings ; +$^W = 1 ; +my $b ; +chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check interaction of $^W and use warnings +$^W = 1 ; +use warnings ; +my $b ; +chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check interaction of $^W and use warnings +$^W = 1 ; +no warnings ; +my $b ; +chop $b ; +EXPECT + +######## + +# Check interaction of $^W and use warnings +no warnings ; +$^W = 1 ; +my $b ; +chop $b ; +EXPECT + +######## +-w +# Check interaction of $^W and use warnings +no warnings ; +my $b ; +chop $b ; +EXPECT + +######## +-w +# Check interaction of $^W and use warnings +use warnings ; +my $b ; +chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 5. +######## + +# Check interaction of $^W and use warnings +sub fred { + use warnings ; + my $b ; + chop $b ; +} +BEGIN { $^W = 0 } +fred() ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check interaction of $^W and use warnings +sub fred { + no warnings ; + my $b ; + chop $b ; +} +BEGIN { $^W = 1 } +fred() ; + +EXPECT + +######## + +# Check interaction of $^W and use warnings +use warnings ; +BEGIN { $^W = 1 } +my $b ; +chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check interaction of $^W and use warnings +BEGIN { $^W = 1 } +use warnings ; +my $b ; +chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 6. +######## + +# Check interaction of $^W and use warnings +BEGIN { $^W = 1 } +no warnings ; +my $b ; +chop $b ; +EXPECT + +######## + +# Check interaction of $^W and use warnings +no warnings ; +BEGIN { $^W = 1 } +my $b ; +chop $b ; +EXPECT + +######## + +# Check interaction of $^W and use warnings +BEGIN { $^W = 1 } +{ + no warnings ; + my $b ; + chop $b ; +} +my $b ; +chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 10. +######## + +# Check interaction of $^W and use warnings +BEGIN { $^W = 0 } +{ + use warnings ; + my $b ; + chop $b ; +} +my $b ; +chop $b ; +EXPECT +Use of uninitialized value in scalar chop at - line 7. diff --git a/contrib/perl5/t/pragma/warn/4lint b/contrib/perl5/t/pragma/warn/4lint new file mode 100644 index 0000000..db54f31 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/4lint @@ -0,0 +1,112 @@ +Check lint + +__END__ +-W +# lint: check compile time $^W is zapped +BEGIN { $^W = 0 ;} +$a = $b = 1 ; +$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. +######## +-W +# lint: check runtime $^W is zapped +$^W = 0 ; +close STDIN ; print STDIN "abc" ; +EXPECT +print() on closed filehandle main::STDIN at - line 4. +######## +-W +# lint: check runtime $^W is zapped +{ + $^W = 0 ; + close STDIN ; print STDIN "abc" ; +} +EXPECT +print() on closed filehandle main::STDIN at - line 5. +######## +-W +# lint: check "no warnings" is zapped +no warnings ; +$a = $b = 1 ; +$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. +######## +-W +# lint: check "no warnings" is zapped +{ + no warnings ; + close STDIN ; print STDIN "abc" ; +} +EXPECT +print() on closed filehandle main::STDIN at - line 5. +######## +-Ww +# lint: check combination of -w and -W +{ + $^W = 0 ; + close STDIN ; print STDIN "abc" ; +} +EXPECT +print() on closed filehandle main::STDIN at - line 5. +######## +-W +--FILE-- abc.pm +no warnings 'deprecated' ; +my ($a, $b) = (0,0); +1 if $a EQ $b ; +1; +--FILE-- +no warnings 'uninitialized' ; +use abc; +my $a ; chop $a ; +EXPECT +Use of EQ is deprecated at abc.pm line 3. +Use of uninitialized value in scalar chop at - line 3. +######## +-W +--FILE-- abc +no warnings 'deprecated' ; +my ($a, $b) = (0,0); +1 if $a EQ $b ; +1; +--FILE-- +no warnings 'uninitialized' ; +require "./abc"; +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 +--FILE-- abc.pm +BEGIN {$^W = 0} +my ($a, $b) = (0,0); +1 if $a EQ $b ; +1; +--FILE-- +$^W = 0 ; +use abc; +my $a ; chop $a ; +EXPECT +Use of EQ is deprecated at abc.pm line 3. +Use of uninitialized value in scalar chop at - line 3. +######## +-W +--FILE-- abc +BEGIN {$^W = 0} +my ($a, $b) = (0,0); +1 if $a EQ $b ; +1; +--FILE-- +$^W = 0 ; +require "./abc"; +my $a ; chop $a ; +EXPECT +Use of EQ is deprecated at ./abc line 3. +Use of uninitialized value in scalar chop at - line 3. diff --git a/contrib/perl5/t/pragma/warn/5nolint b/contrib/perl5/t/pragma/warn/5nolint new file mode 100644 index 0000000..994190a --- /dev/null +++ b/contrib/perl5/t/pragma/warn/5nolint @@ -0,0 +1,96 @@ +Check anti-lint + +__END__ +-X +# nolint: check compile time $^W is zapped +BEGIN { $^W = 1 ;} +$a = $b = 1 ; +$a = 1 if $a EQ $b ; +close STDIN ; print STDIN "abc" ; +EXPECT +######## +-X +# nolint: check runtime $^W is zapped +$^W = 1 ; +close STDIN ; print STDIN "abc" ; +EXPECT +######## +-X +# nolint: check runtime $^W is zapped +{ + $^W = 1 ; + close STDIN ; print STDIN "abc" ; +} +EXPECT +######## +-X +# nolint: check "no warnings" is zapped +use warnings ; +$a = $b = 1 ; +$a = 1 if $a EQ $b ; +close STDIN ; print STDIN "abc" ; +EXPECT +######## +-X +# nolint: check "no warnings" is zapped +{ + use warnings ; + close STDIN ; print STDIN "abc" ; +} +EXPECT +######## +-Xw +# nolint: check combination of -w and -X +{ + $^W = 1 ; + close STDIN ; print STDIN "abc" ; +} +EXPECT +######## +-X +--FILE-- abc.pm +use warnings 'deprecated' ; +my ($a, $b) = (0,0); +1 if $a EQ $b ; +1; +--FILE-- +use warnings 'uninitialized' ; +use abc; +my $a ; chop $a ; +EXPECT +######## +-X +--FILE-- abc +use warnings 'deprecated' ; +my ($a, $b) = (0,0); +1 if $a EQ $b ; +1; +--FILE-- +use warnings 'uninitialized' ; +require "./abc"; +my $a ; chop $a ; +EXPECT +######## +-X +--FILE-- abc.pm +BEGIN {$^W = 1} +my ($a, $b) = (0,0); +1 if $a EQ $b ; +1; +--FILE-- +$^W = 1 ; +use abc; +my $a ; chop $a ; +EXPECT +######## +-X +--FILE-- abc +BEGIN {$^W = 1} +my ($a, $b) = (0,0); +1 if $a EQ $b ; +1; +--FILE-- +$^W = 1 ; +require "./abc"; +my $a ; chop $a ; +EXPECT diff --git a/contrib/perl5/t/pragma/warn/6default b/contrib/perl5/t/pragma/warn/6default new file mode 100644 index 0000000..dd3d182 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/6default @@ -0,0 +1,53 @@ +Check default warnings + +__END__ +# default warnings 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 warnings should be displayed +no warnings ; +my $a = oct "7777777777777777777777777777777777778" ; +EXPECT +######## +# all warnings should be displayed +use warnings ; +my $a = oct "7777777777777777777777777777777777778" ; +EXPECT +Integer overflow in octal number at - line 3. +Illegal octal digit '8' ignored at - line 3. +Octal number > 037777777777 non-portable at - line 3. +######## +# check scope +use warnings ; +my $a = oct "7777777777777777777777777777777777778" ; +{ + no warnings ; + my $a = oct "7777777777777777777777777777777777778" ; +} +my $c = oct "7777777777777777777777777777777777778" ; +EXPECT +Integer overflow in octal number at - line 3. +Illegal octal digit '8' ignored at - line 3. +Octal number > 037777777777 non-portable at - line 3. +Integer overflow in octal number at - line 8. +Illegal octal digit '8' ignored at - line 8. +Octal number > 037777777777 non-portable at - line 8. +######## +# all warnings should be displayed +use warnings ; +my $a = oct "0xfffffffffffffffffg" ; +EXPECT +Integer overflow in hexadecimal number at - line 3. +Illegal hexadecimal digit 'g' ignored at - line 3. +Hexadecimal number > 0xffffffff non-portable at - line 3. +######## +# all warnings should be displayed +use warnings ; +my $a = oct "0b111111111111111111111111111111111111111111111111111111111111111112"; +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. diff --git a/contrib/perl5/t/pragma/warn/7fatal b/contrib/perl5/t/pragma/warn/7fatal new file mode 100644 index 0000000..943bb06f --- /dev/null +++ b/contrib/perl5/t/pragma/warn/7fatal @@ -0,0 +1,242 @@ +Check FATAL functionality + +__END__ + +# Check compile time warning +use warnings FATAL => 'deprecated' ; +{ + 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' ; +{ + 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' ; + $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; +--FILE-- +use warnings FATAL => 'deprecated' ; +require "./abc"; +EXPECT + +######## + +--FILE-- abc +use warnings FATAL => 'deprecated' ; +1; +--FILE-- +require "./abc"; +1 if $a EQ $b ; +EXPECT + +######## + +--FILE-- abc +use warnings 'deprecated' ; +1 if $a EQ $b ; +1; +--FILE-- +use warnings FATAL => 'uninitialized' ; +require "./abc"; +my $a ; chop $a ; +print STDERR "The End.\n" ; +EXPECT +Use of EQ is deprecated at ./abc line 2. +Use of uninitialized value in scalar chop at - line 3. +######## + +--FILE-- abc.pm +use warnings 'deprecated' ; +1 if $a EQ $b ; +1; +--FILE-- +use warnings FATAL => 'uninitialized' ; +use abc; +my $a ; chop $a ; +print STDERR "The End.\n" ; +EXPECT +Use of EQ is deprecated at abc.pm line 2. +Use of uninitialized value in scalar chop at - line 3. +######## + +# Check scope of pragma with eval +no warnings ; +eval { + use warnings FATAL => 'uninitialized' ; + my $b ; chop $b ; +}; print STDERR "-- $@" ; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +-- Use of uninitialized value in scalar chop at - line 6. +The End. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'uninitialized' ; +eval { + my $b ; chop $b ; +}; print STDERR "-- $@" ; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +-- Use of uninitialized value in scalar chop at - line 5. +Use of uninitialized value in scalar chop at - line 7. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'uninitialized' ; +eval { + no warnings ; + my $b ; chop $b ; +}; print STDERR $@ ; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value in scalar chop at - line 8. +######## + +# Check scope of pragma with eval +no warnings ; +eval { + use warnings FATAL => 'deprecated' ; + 1 if $a EQ $b ; +}; print STDERR "-- $@" ; +1 if $a EQ $b ; +print STDERR "The End.\n" ; +EXPECT +Use of EQ is deprecated at - line 6. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'deprecated' ; +eval { + 1 if $a EQ $b ; +}; print STDERR "-- $@" ; +1 if $a EQ $b ; +print STDERR "The End.\n" ; +EXPECT +Use of EQ is deprecated at - line 5. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'deprecated' ; +eval { + no warnings ; + 1 if $a EQ $b ; +}; print STDERR $@ ; +1 if $a EQ $b ; +print STDERR "The End.\n" ; +EXPECT +Use of EQ is deprecated at - line 8. +######## + +# Check scope of pragma with eval +no warnings ; +eval { + use warnings FATAL => 'deprecated' ; +}; print STDERR $@ ; +1 if $a EQ $b ; +print STDERR "The End.\n" ; +EXPECT +The End. +######## + +# Check scope of pragma with eval +no warnings ; +eval q[ + use warnings FATAL => 'uninitialized' ; + my $b ; chop $b ; +]; print STDERR "-- $@"; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +-- Use of uninitialized value in scalar chop at (eval 1) line 3. +The End. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'uninitialized' ; +eval ' + my $b ; chop $b ; +'; print STDERR "-- $@" ; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +-- Use of uninitialized value in scalar chop at (eval 1) line 2. +Use of uninitialized value in scalar chop at - line 7. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'uninitialized' ; +eval ' + no warnings ; + my $b ; chop $b ; +'; print STDERR $@ ; +my $b ; chop $b ; +print STDERR "The End.\n" ; +EXPECT +Use of uninitialized value in scalar chop at - line 8. +######## + +# Check scope of pragma with eval +no warnings ; +eval q[ + use warnings FATAL => 'deprecated' ; + 1 if $a EQ $b ; +]; print STDERR "-- $@"; +1 if $a EQ $b ; +print STDERR "The End.\n" ; +EXPECT +-- Use of EQ is deprecated at (eval 1) line 3. +The End. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'deprecated' ; +eval ' + 1 if $a EQ $b ; +'; print STDERR "-- $@"; +print STDERR "The End.\n" ; +EXPECT +-- Use of EQ is deprecated at (eval 1) line 2. +The End. +######## + +# Check scope of pragma with eval +use warnings FATAL => 'deprecated' ; +eval ' + no warnings ; + 1 if $a EQ $b ; +'; print STDERR "-- $@"; +1 if $a EQ $b ; +print STDERR "The End.\n" ; +EXPECT +Use of EQ is deprecated at - line 8. diff --git a/contrib/perl5/t/pragma/warn/8signal b/contrib/perl5/t/pragma/warn/8signal new file mode 100644 index 0000000..d480f19 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/8signal @@ -0,0 +1,18 @@ +Check interaction of __WARN__, __DIE__ & lexical Warnings + +TODO + +__END__ +# 8signal +BEGIN { $| = 1; $SIG{__WARN__} = sub { print "WARN -- @_" } } +BEGIN { $SIG{__DIE__} = sub { print "DIE -- @_" } } +1 if 1 EQ 2 ; +use warnings qw(deprecated) ; +1 if 1 EQ 2 ; +use warnings FATAL => qw(deprecated) ; +1 if 1 EQ 2 ; +print "The End.\n" ; +EXPECT +WARN -- Use of EQ is deprecated at - line 6. +DIE -- Use of EQ is deprecated at - line 8. +Use of EQ is deprecated at - line 8. diff --git a/contrib/perl5/t/pragma/warn/9enabled b/contrib/perl5/t/pragma/warn/9enabled new file mode 100755 index 0000000..7facf99 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/9enabled @@ -0,0 +1,819 @@ +Check warnings::enabled & warnings::warn + +__END__ + +--FILE-- abc.pm +package abc ; +use warnings "io" ; +print "ok1\n" if ! warnings::enabled('all') ; +print "ok2\n" if ! warnings::enabled("io") ; +1; +--FILE-- +no warnings; +use abc ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +print "ok1\n" if !warnings::enabled('all') ; +print "ok2\n" if warnings::enabled("syntax") ; +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'syntax' ; +print "ok1\n" if warnings::enabled('io') ; +print "ok2\n" if ! warnings::enabled("syntax") ; +1; +--FILE-- +use warnings 'io' ; +use abc ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc +no warnings ; +print "ok1\n" if !warnings::enabled('all') ; +print "ok2\n" if warnings::enabled("syntax") ; +1; +--FILE-- +use warnings 'syntax' ; +require "abc" ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc +use warnings 'syntax' ; +print "ok1\n" if ! warnings::enabled('all') ; +print "ok2\n" if ! warnings::enabled("syntax") ; +print "ok3\n" if warnings::enabled("io") ; +1; +--FILE-- +use warnings 'io' ; +require "abc" ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +sub check { + print "ok1\n" if !warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +abc::check() ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +sub check { + print "ok1\n" if ! warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if ! warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc +package abc ; +no warnings ; +sub check { + print "ok1\n" if !warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; +} +1; +--FILE-- +use warnings 'syntax' ; +require "abc" ; +abc::check() ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc +package abc ; +use warnings 'io' ; +sub check { + print "ok1\n" if ! warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if ! warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +require "abc" ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings "io" ; +print "ok1\n" if ! warnings::enabled('all') ; +print "ok2\n" if ! warnings::enabled("io") ; +1; +--FILE-- def.pm +no warnings; +use abc ; +1; +--FILE-- +use warnings; +use def ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +print "ok1\n" if ! warnings::enabled('all') ; +print "ok2\n" if warnings::enabled("syntax") ; +print "ok3\n" if !warnings::enabled("io") ; +1; +--FILE-- def.pm +use warnings 'syntax' ; +print "ok4\n" if !warnings::enabled('all') ; +print "ok5\n" if warnings::enabled("io") ; +use abc ; +1; +--FILE-- +use warnings 'io' ; +use def ; +EXPECT +ok1 +ok2 +ok3 +ok4 +ok5 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +sub check { + print "ok1\n" if !warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +eval { abc::check() ; }; +print $@ ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +sub check { + print "ok1\n" if ! warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if ! warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +eval { abc::check() ; } ; +print $@ ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc +package abc ; +no warnings ; +sub check { + print "ok1\n" if !warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; +} +1; +--FILE-- +use warnings 'syntax' ; +require "abc" ; +eval { abc::check() ; } ; +print $@ ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc +package abc ; +use warnings 'io' ; +sub check { + print "ok1\n" if !warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +require "abc" ; +eval { use warnings 'io' ; abc::check() ; }; +abc::check() ; +print $@ ; +EXPECT +ok1 +ok2 +ok3 +ok1 +ok2 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +sub check { + print "ok1\n" if ! warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if ! warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +sub fred { abc::check() } +fred() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +sub check { + print "ok1\n" if ! warnings::enabled('all') ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +sub fred { no warnings ; abc::check() } +fred() ; +EXPECT +ok1 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'misc' ; +sub check { + print "ok1\n" if ! warnings::enabled('all') ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if warnings::enabled("io") ; + print "ok4\n" if ! warnings::enabled("misc") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +sub fred { use warnings 'io' ; abc::check() } +fred() ; +EXPECT +ok1 +ok2 +ok3 +ok4 +######## + +# check warnings::warn +use warnings ; +eval { warnings::warn() } ; +print $@ ; +eval { warnings::warn("fred", "joe") } ; +print $@ ; +EXPECT +Usage: warnings::warn([category,] 'message') at - line 4 +unknown warnings category 'fred' at - line 6 + require 0 called at - line 6 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'misc' ; +sub check { warnings::warn("io", "hello") } +1; +--FILE-- +use warnings "io" ; +use abc; +abc::check() ; +EXPECT +hello at - line 3 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'misc' ; +sub check { warnings::warn("misc", "hello") } +1; +--FILE-- +use warnings "io" ; +use abc; +abc::check() ; +EXPECT +hello at - line 3 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'misc' ; +sub check { warnings::warn("io", "hello") } +1; +--FILE-- +use warnings qw( FATAL deprecated ) ; +use abc; +eval { abc::check() ; } ; +print "[[$@]]\n"; +EXPECT +hello at - line 3 +[[]] +######## + +--FILE-- abc.pm +package abc ; +use warnings 'misc' ; +sub check { warnings::warn("io", "hello") } +1; +--FILE-- +use warnings qw( FATAL io ) ; +use abc; +eval { abc::check() ; } ; +print "[[$@]]\n"; +EXPECT +[[hello at - line 3 +]] +######## +-W +--FILE-- abc.pm +package abc ; +use warnings "io" ; +print "ok1\n" if warnings::enabled("io") ; +print "ok2\n" if warnings::enabled("all") ; +1; +--FILE-- +no warnings; +use abc ; +EXPECT +ok1 +ok2 +######## +-X +--FILE-- abc.pm +package abc ; +use warnings "io" ; +print "ok1\n" if !warnings::enabled("io") ; +print "ok2\n" if !warnings::enabled("all") ; +1; +--FILE-- +use warnings; +use abc ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc.pm +package abc ; +no warnings ; +sub check { + print "ok\n" if ! warnings::enabled() ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +abc::check() ; +EXPECT +package 'abc' not registered for warnings at - line 3 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +use warnings::register ; +sub check { + print "ok1\n" if warnings::enabled ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if !warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +use warnings 'abc' ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if !warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +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("syntax") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +use warnings 'abc' ; +eval { abc::check() ; }; +print $@ ; +EXPECT +ok1 +ok2 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +use warnings::register ; +sub check { + print "ok1\n" if !warnings::enabled ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if !warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +eval { abc::check() ; } ; +print $@ ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +use warnings::register ; +sub check { + print "ok1\n" if warnings::enabled ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if !warnings::enabled("io") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +use warnings 'abc' ; +sub fred { abc::check() } +fred() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'io' ; +use warnings::register ; +sub check { + print "ok1\n" if ! warnings::enabled ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +sub fred { no warnings ; abc::check() } +fred() ; +EXPECT +ok1 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'misc' ; +use warnings::register; +sub check { + print "ok1\n" if warnings::enabled ; + print "ok2\n" if warnings::enabled("syntax") ; + print "ok3\n" if warnings::enabled("io") ; + print "ok4\n" if ! warnings::enabled("misc") ; +} +1; +--FILE-- +use warnings 'syntax' ; +use abc ; +use warnings 'abc' ; +sub fred { use warnings 'io' ; abc::check() } +fred() ; +EXPECT +ok1 +ok2 +ok3 +ok4 +######## + +--FILE-- abc.pm +package abc ; +use warnings 'misc' ; +use warnings::register; +sub check { warnings::warn("hello") } +1; +--FILE-- +use abc; +use warnings "abc" ; +abc::check() ; +EXPECT +hello at - line 3 +######## + +--FILE-- abc.pm +package abc ; +use warnings::register; +sub check { warnings::warn("hello") } +1; +--FILE-- +use abc; +abc::check() ; +EXPECT +hello at - line 2 +######## + +--FILE-- abc.pm +package abc ; +use warnings::register ; +sub check { warnings::warn("hello") } +1; +--FILE-- +use abc; +use warnings qw( FATAL deprecated ) ; +eval { abc::check() ; } ; +print "[[$@]]\n"; +EXPECT +hello at - line 3 +[[]] +######## + +--FILE-- abc.pm +package abc ; +use warnings::register ; +sub check { warnings::warn("hello") } +1; +--FILE-- +use abc; +use warnings qw( FATAL abc ) ; +eval { abc::check() ; } ; +print "[[$@]]\n"; +EXPECT +[[hello at - line 3 +]] +######## +-W +--FILE-- abc.pm +package abc ; +use warnings "io" ; +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-- +no warnings; +use abc ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## +-X +--FILE-- abc.pm +package abc ; +use warnings "io" ; +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-- +no warnings; +use abc ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings "io" ; +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 warnings 'all'; +use abc ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings "io" ; +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 ; +no warnings ; +abc::check() ; +EXPECT +ok1 +ok2 +ok3 +######## + +--FILE-- abc.pm +package abc ; +use warnings "io" ; +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 ; +use warnings "io" ; +use warnings::register ; +sub check { + print "abc self" . (warnings::enabled() ? "" : " not") . " enabled\n" ; + print "abc def" . (warnings::enabled('def') ? "" : " not") . " enabled\n" ; + print "abc all" . (warnings::enabled('all') ? "" : " not") . " enabled\n" ; +} +1; +--FILE-- def.pm +package def ; +use warnings "io" ; +use warnings::register ; +sub check { + print "def self" . (warnings::enabled() ? "" : " not") . " enabled\n" ; + print "def abc" . (warnings::enabled('abc') ? "" : " not") . " enabled\n" ; + print "def all" . (warnings::enabled('all') ? "" : " not") . " enabled\n" ; +} +1; +--FILE-- +use abc ; +use def ; +use warnings 'abc'; +abc::check() ; +def::check() ; +no warnings 'abc' ; +use warnings 'def' ; +abc::check() ; +def::check() ; +use warnings 'abc' ; +use warnings 'def' ; +abc::check() ; +def::check() ; +no warnings 'abc' ; +no warnings 'def' ; +abc::check() ; +def::check() ; +use warnings; +abc::check() ; +def::check() ; +no warnings 'abc' ; +abc::check() ; +def::check() ; +EXPECT +abc self enabled +abc def not enabled +abc all not enabled +def self not enabled +def abc enabled +def all not enabled +abc self not enabled +abc def enabled +abc all not enabled +def self enabled +def abc not enabled +def all not enabled +abc self enabled +abc def enabled +abc all not enabled +def self enabled +def abc enabled +def all not enabled +abc self not enabled +abc def not enabled +abc all not enabled +def self not enabled +def abc not enabled +def all not enabled +abc self enabled +abc def enabled +abc all enabled +def self enabled +def abc enabled +def all enabled +abc self not enabled +abc def enabled +abc all not enabled +def self enabled +def abc not enabled +def all not enabled diff --git a/contrib/perl5/t/pragma/warn/av b/contrib/perl5/t/pragma/warn/av new file mode 100644 index 0000000..79bd3b76 --- /dev/null +++ b/contrib/perl5/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/contrib/perl5/t/pragma/warn/doio b/contrib/perl5/t/pragma/warn/doio new file mode 100644 index 0000000..bd40972 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/doio @@ -0,0 +1,191 @@ + doio.c + + Can't open bidirectional pipe [Perl_do_open9] + open(F, "| true |"); + + Missing command in piped open [Perl_do_open9] + open(F, "| "); + + Missing command in piped open [Perl_do_open9] + open(F, " |"); + + warn(warn_nl, "open"); [Perl_do_open9] + open(F, "true\ncd") + + Close on unopened file <%s> [Perl_do_close] <<TODO + $a = "fred";close("$a") + + tell() on unopened file [Perl_do_tell] + $a = "fred";$a = tell($a) + + seek() on unopened file [Perl_do_seek] + $a = "fred";$a = seek($a,1,1) + + sysseek() on unopened file [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] + close STDIN ; -x STDIN ; + + warn(warn_nl, "stat"); [Perl_my_stat] + stat "ab\ncd" + + warn(warn_nl, "lstat"); [Perl_my_lstat] + lstat "ab\ncd" + + Can't exec \"%s\": %s [Perl_do_aexec5] + + Can't exec \"%s\": %s [Perl_do_exec3] + + Filehandle %s opened only for output [Perl_do_eof] + my $a = eof STDOUT + + Mandatory Warnings ALL TODO + ------------------ + Can't do inplace edit: %s is not a regular file [Perl_nextargv] + edit a directory + + Can't do inplace edit: %s would not be unique [Perl_nextargv] + Can't rename %s to %s: %s, skipping file [Perl_nextargv] + Can't rename %s to %s: %s, skipping file [Perl_nextargv] + Can't remove %s: %s, skipping file [Perl_nextargv] + Can't do inplace edit on %s: %s [Perl_nextargv] + + +__END__ +# doio.c [Perl_do_open9] +use warnings 'io' ; +open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|"); +close(F); +no warnings 'io' ; +open(G, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|"); +close(G); +EXPECT +Can't open bidirectional pipe at - line 3. +######## +# doio.c [Perl_do_open9] +use warnings 'io' ; +open(F, "| "); +no warnings 'io' ; +open(G, "| "); +EXPECT +Missing command in piped open at - line 3. +######## +# doio.c [Perl_do_open9] +use warnings 'io' ; +open(F, " |"); +no warnings 'io' ; +open(G, " |"); +EXPECT +Missing command in piped open at - line 3. +######## +# doio.c [Perl_do_open9] +use warnings 'io' ; +open(F, "<true\ncd"); +no warnings 'io' ; +open(G, "<true\ncd"); +EXPECT +Unsuccessful open on filename containing newline at - line 3. +######## +# doio.c [Perl_do_close] <<TODO +use warnings 'unopened' ; +close "fred" ; +no warnings 'unopened' ; +close "joe" ; +EXPECT +Close on unopened file <fred> at - line 3. +######## +# doio.c [Perl_do_tell Perl_do_seek Perl_do_sysseek Perl_my_stat] +use warnings 'io' ; +close STDIN ; +tell(STDIN); +$a = seek(STDIN,1,1); +$a = sysseek(STDIN,1,1); +-x STDIN ; +no warnings '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. +sysseek() on unopened file at - line 6. +Stat on unopened file <STDIN> at - line 7. +######## +# doio.c [Perl_do_print] +use warnings 'uninitialized' ; +print $a ; +no warnings 'uninitialized' ; +print $b ; +EXPECT +Use of uninitialized value in print at - line 3. +######## +# doio.c [Perl_my_stat Perl_my_lstat] +use warnings 'io' ; +stat "ab\ncd"; +lstat "ab\ncd"; +no warnings '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. +######## +# doio.c [Perl_do_aexec5] +use warnings 'io' ; +exec "lskdjfalksdjfdjfkls","" ; +no warnings 'io' ; +exec "lskdjfalksdjfdjfkls","" ; +EXPECT +OPTION regex +Can't exec "lskdjfalksdjfdjfkls": .+ +######## +# doio.c [Perl_do_exec3] +use warnings 'io' ; +exec "lskdjfalksdjfdjfkls", "abc" ; +no warnings 'io' ; +exec "lskdjfalksdjfdjfkls", "abc" ; +EXPECT +OPTION regex +Can't exec "lskdjfalksdjfdjfkls(:? abc)?": .+ +######## +# doio.c [Perl_nextargv] +$^W = 0 ; +my $filename = "./temp.dir" ; +mkdir $filename, 0777 + or die "Cannot create directory $filename: $!\n" ; +{ + local (@ARGV) = ($filename) ; + local ($^I) = "" ; + my $x = <> ; +} +{ + no warnings 'inplace' ; + local (@ARGV) = ($filename) ; + local ($^I) = "" ; + my $x = <> ; +} +{ + use warnings 'inplace' ; + local (@ARGV) = ($filename) ; + local ($^I) = "" ; + my $x = <> ; +} +rmdir $filename ; +EXPECT +Can't do inplace edit: ./temp.dir is not a regular file at - line 9. +Can't do inplace edit: ./temp.dir is not a regular file at - line 21. + +######## +# doio.c [Perl_do_eof] +use warnings 'io' ; +my $a = eof STDOUT ; +no warnings 'io' ; +$a = eof STDOUT ; +EXPECT +Filehandle main::STDOUT opened only for output at - line 3. diff --git a/contrib/perl5/t/pragma/warn/doop b/contrib/perl5/t/pragma/warn/doop new file mode 100644 index 0000000..5803b44 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/doop @@ -0,0 +1,6 @@ +# doop.c +use utf8 ; +$_ = "\x80 \xff" ; +chop ; +EXPECT +######## diff --git a/contrib/perl5/t/pragma/warn/gv b/contrib/perl5/t/pragma/warn/gv new file mode 100644 index 0000000..5ed4eca --- /dev/null +++ b/contrib/perl5/t/pragma/warn/gv @@ -0,0 +1,54 @@ + gv.c AOK + + Can't locate package %s for @%s::ISA + @ISA = qw(Fred); joe() + + Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated + sub Other::AUTOLOAD { 1 } sub Other::fred {} + @ISA = qw(Other) ; + fred() ; + + Use of $# is deprecated + Use of $* is deprecated + + $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 warnings 'misc' ; +@ISA = qw(Fred); joe() +EXPECT +Can't locate package Fred for @main::ISA at - line 3. +Undefined subroutine &main::joe called at - line 3. +######## +# gv.c +no warnings '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 warnings 'deprecated' ; +fred() ; +EXPECT +Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5. +######## +# gv.c +use warnings 'deprecated' ; +$a = ${"#"}; +$a = ${"*"}; +no warnings 'deprecated' ; +$a = ${"#"}; +$a = ${"*"}; +EXPECT +Use of $# is deprecated at - line 3. +Use of $* is deprecated at - line 4. diff --git a/contrib/perl5/t/pragma/warn/hv b/contrib/perl5/t/pragma/warn/hv new file mode 100644 index 0000000..c9eec02 --- /dev/null +++ b/contrib/perl5/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/contrib/perl5/t/pragma/warn/malloc b/contrib/perl5/t/pragma/warn/malloc new file mode 100644 index 0000000..2f8b096 --- /dev/null +++ b/contrib/perl5/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/contrib/perl5/t/pragma/warn/mg b/contrib/perl5/t/pragma/warn/mg new file mode 100644 index 0000000..a8f9dbc --- /dev/null +++ b/contrib/perl5/t/pragma/warn/mg @@ -0,0 +1,44 @@ + mg.c AOK + + No such signal: SIG%s + $SIG{FRED} = sub {} + + 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 +use warnings 'signal' ; +$SIG{FRED} = sub {}; +EXPECT +No such signal: SIGFRED at - line 3. +######## +# mg.c +no warnings 'signal' ; +$SIG{FRED} = sub {}; +EXPECT + +######## +# mg.c +use warnings 'signal' ; +if ($^O eq 'MSWin32' || $^O eq 'VMS') { + print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit; +} +$|=1; +$SIG{"INT"} = "fred"; kill "INT",$$; +EXPECT +SIGINT handler "fred" not defined. +######## +# mg.c +no warnings '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/contrib/perl5/t/pragma/warn/op b/contrib/perl5/t/pragma/warn/op new file mode 100644 index 0000000..1a79b4a --- /dev/null +++ b/contrib/perl5/t/pragma/warn/op @@ -0,0 +1,861 @@ + op.c AOK + + "my" variable %s masks earlier declaration in same scope + my $x; + my $x ; + + Variable "%s" may be unavailable + sub x { + my $x; + sub y { + $x + } + } + + Variable "%s" will not stay shared + sub x { + my $x; + sub y { + sub { $x } + } + } + + Found = in conditional, should be == + 1 if $a = 1 ; + + Use of implicit split to @_ is deprecated + split ; + + Use of implicit split to @_ is deprecated + $a = split ; + + Useless use of time in void context + Useless use of a variable in void context + Useless use of a constant in void context + time ; + $a ; + "abc" + + Applying %s to %s will act on scalar(%s) + 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/ ; + + + Parentheses missing around "my" list at -e line 1. + my $a, $b = (1,2); + + Parentheses missing around "local" list at -e line 1. + local $a, $b = (1,2); + + Bareword found in conditional at -e line 1. + use warnings 'bareword'; my $x = print(ABC || 1); + + Value of %s may be \"0\"; use \"defined\" + $x = 1 if $x = <FH> ; + $x = 1 while $x = <FH> ; + + Subroutine fred redefined at -e line 1. + sub fred{1;} sub fred{1;} + + Constant subroutine %s redefined + sub fred() {1;} sub fred() {1;} + + Format FRED redefined at /tmp/x line 5. + format FRED = + . + format FRED = + . + + Array @%s missing the @ in argument %d of %s() + push fred ; + + Hash %%%s missing the %% in argument %d of %s() + keys joe ; + + Statement unlikely to be reached + (Maybe you meant system() when you said exec()? + exec "true" ; my $a + + defined(@array) is deprecated + (Maybe you should just omit the defined()?) + my @a ; defined @a ; + defined (@a = (1,2,3)) ; + + defined(%hash) is deprecated + (Maybe you should just omit the defined()?) + my %h ; defined %h ; + + /---/ should probably be written as "---" + join(/---/, @foo); + + %s() called too early to check prototype [Perl_peep] + fred() ; sub fred ($$) {} + + + 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 warnings 'misc' ; +my $x ; +my $x ; +no warnings 'misc' ; +my $x ; +EXPECT +"my" variable $x masks earlier declaration in same scope at - line 4. +######## +# op.c +use warnings 'closure' ; +sub x { + my $x; + sub y { + $x + } + } +EXPECT +Variable "$x" will not stay shared at - line 7. +######## +# op.c +no warnings 'closure' ; +sub x { + my $x; + sub y { + $x + } + } +EXPECT + +######## +# op.c +use warnings 'closure' ; +sub x { + my $x; + sub y { + sub { $x } + } + } +EXPECT +Variable "$x" may be unavailable at - line 6. +######## +# op.c +no warnings 'closure' ; +sub x { + my $x; + sub y { + sub { $x } + } + } +EXPECT + +######## +# op.c +use warnings 'syntax' ; +1 if $a = 1 ; +no warnings 'syntax' ; +1 if $a = 1 ; +EXPECT +Found = in conditional, should be == at - line 3. +######## +# op.c +use warnings 'deprecated' ; +split ; +no warnings 'deprecated' ; +split ; +EXPECT +Use of implicit split to @_ is deprecated at - line 3. +######## +# op.c +use warnings 'deprecated' ; +$a = split ; +no warnings 'deprecated' ; +$a = split ; +EXPECT +Use of implicit split to @_ is deprecated at - line 3. +######## +# op.c +use warnings '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 +Useless use of repeat (x) in void context at - line 3. +Useless use of wantarray in void context at - line 5. +Useless use of reference-type operator in void context at - line 12. +Useless use of reference constructor in void context at - line 13. +Useless use of single ref constructor in void context at - line 14. +Useless use of defined operator in void context at - line 15. +Useless use of hex in void context at - line 16. +Useless use of oct in void context at - line 17. +Useless use of length in void context at - line 18. +Useless use of substr in void context at - line 19. +Useless use of vec in void context at - line 20. +Useless use of index in void context at - line 21. +Useless use of rindex in void context at - line 22. +Useless use of sprintf in void context at - line 23. +Useless use of array element in void context at - line 24. +Useless use of array slice in void context at - line 26. +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 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. +Useless use of range (or flop) in void context at - line 41. +Useless use of caller in void context at - line 42. +Useless use of fileno in void context at - line 43. +Useless use of eof in void context at - line 44. +Useless use of tell in void context at - line 45. +Useless use of readlink in void context at - line 46. +Useless use of time in void context at - line 47. +Useless use of localtime in void context at - line 48. +Useless use of gmtime in void context at - line 49. +Useless use of getgrnam in void context at - line 50. +Useless use of getgrgid in void context at - line 51. +Useless use of getpwnam in void context at - line 52. +Useless use of getpwuid in void context at - line 53. +######## +# op.c +no warnings '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 warnings 'void' ; +for (@{[0]}) { "$_" } # check warning isn't duplicated +no warnings 'void' ; +for (@{[0]}) { "$_" } # check warning isn't duplicated +EXPECT +Useless use of string in void context at - line 3. +######## +# op.c +use warnings 'void' ; +use Config ; +BEGIN { + if ( ! $Config{d_telldir}) { + print <<EOM ; +SKIPPED +# telldir not present +EOM + exit + } +} +telldir 1 ; # OP_TELLDIR +no warnings 'void' ; +telldir 1 ; # OP_TELLDIR +EXPECT +Useless use of telldir in void context at - line 13. +######## +# op.c +use warnings 'void' ; +use Config ; +BEGIN { + if ( ! $Config{d_getppid}) { + print <<EOM ; +SKIPPED +# getppid not present +EOM + exit + } +} +getppid ; # OP_GETPPID +no warnings 'void' ; +getppid ; # OP_GETPPID +EXPECT +Useless use of getppid in void context at - line 13. +######## +# op.c +use warnings 'void' ; +use Config ; +BEGIN { + if ( ! $Config{d_getpgrp}) { + print <<EOM ; +SKIPPED +# getpgrp not present +EOM + exit + } +} +getpgrp ; # OP_GETPGRP +no warnings 'void' ; +getpgrp ; # OP_GETPGRP +EXPECT +Useless use of getpgrp in void context at - line 13. +######## +# op.c +use warnings 'void' ; +use Config ; +BEGIN { + if ( ! $Config{d_times}) { + print <<EOM ; +SKIPPED +# times not present +EOM + exit + } +} +times ; # OP_TMS +no warnings 'void' ; +times ; # OP_TMS +EXPECT +Useless use of times in void context at - line 13. +######## +# op.c +use warnings 'void' ; +use Config ; +BEGIN { + if ( ! $Config{d_getprior} or $^O eq 'os2') { # Locks before fixpak22 + print <<EOM ; +SKIPPED +# getpriority not present +EOM + exit + } +} +getpriority 1,2; # OP_GETPRIORITY +no warnings 'void' ; +getpriority 1,2; # OP_GETPRIORITY +EXPECT +Useless use of getpriority in void context at - line 13. +######## +# op.c +use warnings 'void' ; +use Config ; +BEGIN { + if ( ! $Config{d_getlogin}) { + print <<EOM ; +SKIPPED +# getlogin not present +EOM + exit + } +} +getlogin ; # OP_GETLOGIN +no warnings 'void' ; +getlogin ; # OP_GETLOGIN +EXPECT +Useless use of getlogin in void context at - line 13. +######## +# op.c +use warnings 'void' ; +use Config ; BEGIN { +if ( ! $Config{d_socket}) { + print <<EOM ; +SKIPPED +# getsockname not present +# getpeername not present +# gethostbyname not present +# gethostbyaddr not present +# gethostent not present +# getnetbyname not present +# getnetbyaddr not present +# getnetent not present +# getprotobyname not present +# getprotobynumber not present +# getprotoent not present +# getservbyname not present +# getservbyport not present +# getservent not present +EOM + exit +} } +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 + +no warnings '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; +} +EXPECT +Useless use of getsockname in void context at - line 24. +Useless use of getpeername in void context at - line 25. +Useless use of gethostbyname in void context at - line 26. +Useless use of gethostbyaddr in void context at - line 27. +Useless use of gethostent in void context at - line 28. +Useless use of getnetbyname in void context at - line 29. +Useless use of getnetbyaddr in void context at - line 30. +Useless use of getnetent in void context at - line 31. +Useless use of getprotobyname in void context at - line 32. +Useless use of getprotobynumber in void context at - line 33. +Useless use of getprotoent in void context at - line 34. +Useless use of getservbyname in void context at - line 35. +Useless use of getservbyport in void context at - line 36. +Useless use of getservent in void context at - line 37. +######## +# op.c +use warnings 'void' ; +*a ; # OP_RV2GV +$a ; # OP_RV2SV +@a ; # OP_RV2AV +%a ; # OP_RV2HV +no warnings '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. +Useless use of a variable in void context at - line 5. +Useless use of a variable in void context at - line 6. +######## +# op.c +use warnings 'void' ; +"abc"; # OP_CONST +7 ; # OP_CONST +no warnings '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. +######## +# 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/ ; +@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/ ; +{ +no warnings 'misc' ; +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 (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. +Applying transliteration (tr///) to @array will act on scalar(@array) at - line 10. +Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 11. +Applying substitution (s///) to %hash will act on scalar(%hash) at - line 12. +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. +BEGIN not safe after errors--compilation aborted at - line 18. +######## +# op.c +use warnings 'syntax' ; +my $a, $b = (1,2); +no warnings 'syntax' ; +my $c, $d = (1,2); +EXPECT +Parentheses missing around "my" list at - line 3. +######## +# op.c +use warnings 'syntax' ; +local $a, $b = (1,2); +no warnings 'syntax' ; +local $c, $d = (1,2); +EXPECT +Parentheses missing around "local" list at - line 3. +######## +# op.c +use warnings 'bareword' ; +print (ABC || 1) ; +no warnings 'bareword' ; +print (ABC || 1) ; +EXPECT +Bareword found in conditional at - line 3. +######## +--FILE-- abc + +--FILE-- +# op.c +use warnings 'misc' ; +open FH, "<abc" ; +$x = 1 if $x = <FH> ; +no warnings 'misc' ; +$x = 1 if $x = <FH> ; +EXPECT +Value of <HANDLE> construct can be "0"; test with defined() at - line 4. +######## +# op.c +use warnings 'misc' ; +opendir FH, "." ; +$x = 1 if $x = readdir FH ; +no warnings 'misc' ; +$x = 1 if $x = readdir FH ; +closedir FH ; +EXPECT +Value of readdir() operator can be "0"; test with defined() at - line 4. +######## +# op.c +use warnings 'misc' ; +$x = 1 if $x = <*> ; +no warnings 'misc' ; +$x = 1 if $x = <*> ; +EXPECT +Value of glob construct can be "0"; test with defined() at - line 3. +######## +# op.c +use warnings 'misc' ; +%a = (1,2,3,4) ; +$x = 1 if $x = each %a ; +no warnings 'misc' ; +$x = 1 if $x = each %a ; +EXPECT +Value of each() operator can be "0"; test with defined() at - line 4. +######## +# op.c +use warnings 'misc' ; +$x = 1 while $x = <*> and 0 ; +no warnings 'misc' ; +$x = 1 while $x = <*> and 0 ; +EXPECT +Value of glob construct can be "0"; test with defined() at - line 3. +######## +# op.c +use warnings 'misc' ; +opendir FH, "." ; +$x = 1 while $x = readdir FH and 0 ; +no warnings 'misc' ; +$x = 1 while $x = readdir FH and 0 ; +closedir FH ; +EXPECT +Value of readdir() operator can be "0"; test with defined() at - line 4. +######## +# op.c +use warnings 'redefine' ; +sub fred {} +sub fred {} +no warnings 'redefine' ; +sub fred {} +EXPECT +Subroutine fred redefined at - line 4. +######## +# op.c +use warnings 'redefine' ; +sub fred () { 1 } +sub fred () { 1 } +no warnings 'redefine' ; +sub fred () { 1 } +EXPECT +Constant subroutine fred redefined at - line 4. +######## +# op.c +use warnings 'redefine' ; +format FRED = +. +format FRED = +. +no warnings 'redefine' ; +format FRED = +. +EXPECT +Format FRED redefined at - line 5. +######## +# op.c +use warnings 'deprecated' ; +push FRED; +no warnings 'deprecated' ; +push FRED; +EXPECT +Array @FRED missing the @ in argument 1 of push() at - line 3. +######## +# op.c +use warnings 'deprecated' ; +@a = keys FRED ; +no warnings 'deprecated' ; +@a = keys FRED ; +EXPECT +Hash %FRED missing the % in argument 1 of keys() at - line 3. +######## +# op.c +use warnings 'syntax' ; +exec "$^X -e 1" ; +my $a +EXPECT +Statement unlikely to be reached at - line 4. + (Maybe you meant system() when you said exec()?) +######## +# op.c +use warnings 'deprecated' ; +my @a; defined(@a); +EXPECT +defined(@array) is deprecated at - line 3. + (Maybe you should just omit the defined()?) +######## +# op.c +use warnings 'deprecated' ; +defined(@a = (1,2,3)); +EXPECT +defined(@array) is deprecated at - line 3. + (Maybe you should just omit the defined()?) +######## +# op.c +use warnings 'deprecated' ; +my %h; defined(%h); +EXPECT +defined(%hash) is deprecated at - line 3. + (Maybe you should just omit the defined()?) +######## +# op.c +no warnings '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 warnings 'prototype' ; + sub Fred() ; + sub Fred($) {} + use warnings 'prototype' ; + 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. +######## +# op.c +use warnings 'syntax' ; +join /---/, 'x', 'y', 'z'; +EXPECT +/---/ should probably be written as "---" at - line 3. +######## +# op.c [Perl_peep] +use warnings 'prototype' ; +fred() ; +sub fred ($$) {} +no warnings 'prototype' ; +joe() ; +sub joe ($$) {} +EXPECT +main::fred() called too early to check prototype at - line 3. +######## +# op.c [Perl_newATTRSUB] +--FILE-- abc.pm +use warnings 'void' ; +BEGIN { $| = 1; print "in begin\n"; } +CHECK { print "in check\n"; } +INIT { print "in init\n"; } +END { print "in end\n"; } +print "in mainline\n"; +1; +--FILE-- +use abc; +delete $INC{"abc.pm"}; +require abc; +do "abc.pm"; +EXPECT +in begin +in mainline +in check +in init +in begin +Too late to run CHECK block at abc.pm line 3. +Too late to run INIT block at abc.pm line 4. +in mainline +in begin +Too late to run CHECK block at abc.pm line 3. +Too late to run INIT block at abc.pm line 4. +in mainline +in end +in end +in end +######## +# op.c [Perl_newATTRSUB] +--FILE-- abc.pm +no warnings 'void' ; +BEGIN { $| = 1; print "in begin\n"; } +CHECK { print "in check\n"; } +INIT { print "in init\n"; } +END { print "in end\n"; } +print "in mainline\n"; +1; +--FILE-- +require abc; +do "abc.pm"; +EXPECT +in begin +in mainline +in begin +in mainline +in end +in end diff --git a/contrib/perl5/t/pragma/warn/perl b/contrib/perl5/t/pragma/warn/perl new file mode 100644 index 0000000..4580749 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/perl @@ -0,0 +1,57 @@ + perl.c AOK + + 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 warnings 'once' ; +$x = 3 ; +use warnings 'once' ; +$z = 3 ; +EXPECT +Name "main::z" used only once: possible typo at - line 5. +######## +-w +# perl.c +$x = 3 ; +no warnings 'once' ; +$z = 3 +EXPECT +Name "main::x" used only once: possible typo at - line 3. +######## +# perl.c +BEGIN { $^W =1 ; } +$x = 3 ; +no warnings 'once' ; +$z = 3 +EXPECT +Name "main::x" used only once: possible typo at - line 3. +######## +-W +# perl.c +no warnings 'once' ; +$x = 3 ; +use warnings '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 warnings 'once' ; +$x = 3 ; +EXPECT + diff --git a/contrib/perl5/t/pragma/warn/perlio b/contrib/perl5/t/pragma/warn/perlio new file mode 100644 index 0000000..18c0dfa --- /dev/null +++ b/contrib/perl5/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/contrib/perl5/t/pragma/warn/perly b/contrib/perl5/t/pragma/warn/perly new file mode 100644 index 0000000..afc5dcc --- /dev/null +++ b/contrib/perl5/t/pragma/warn/perly @@ -0,0 +1,31 @@ + perly.y AOK + + dep() => deprecate("\"do\" to call subroutines") + Use of "do" to call subroutines is deprecated + + sub fred {} do fred() + sub fred {} do fred(1) + sub fred {} $a = "fred" ; do $a() + sub fred {} $a = "fred" ; do $a(1) + + +__END__ +# perly.y +use warnings 'deprecated' ; +sub fred {} +do fred() ; +do fred(1) ; +$a = "fred" ; +do $a() ; +do $a(1) ; +no warnings '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. +Use of "do" to call subroutines is deprecated at - line 7. +Use of "do" to call subroutines is deprecated at - line 8. diff --git a/contrib/perl5/t/pragma/warn/pp b/contrib/perl5/t/pragma/warn/pp new file mode 100644 index 0000000..8f42ba6 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/pp @@ -0,0 +1,110 @@ + pp.c TODO + + substr outside of string + $a = "ab" ; $b = substr($a, 4,5) ; + + Attempt to use reference as lvalue in substr + $a = "ab" ; $b = \$a ; substr($b, 1,1) = $b + + uninitialized in pp_rv2gv() + my *b = *{ undef()} + + uninitialized in pp_rv2sv() + my $a = undef ; my $b = $$a + + Odd number of elements in hash list + my $a = { 1,2,3 } ; + + Invalid type in unpack: '%c + my $A = pack ("A,A", 1,2) ; + my @A = unpack ("A,A", "22") ; + + Attempt to pack pointer to temporary value + pack("p", "abc") ; + + Explicit blessing to '' (assuming package main) + bless \[], ""; + + Constant subroutine %s undefined <<<TODO + Constant subroutine (anonymous) undefined <<<TODO + +__END__ +# pp.c +use warnings 'substr' ; +$a = "ab" ; +$b = substr($a, 4,5) ; +no warnings 'substr' ; +$a = "ab" ; +$b = substr($a, 4,5) ; +EXPECT +substr outside of string at - line 4. +######## +# pp.c +use warnings 'substr' ; +$a = "ab" ; +$b = \$a ; +substr($b, 1,1) = "ab" ; +no warnings 'substr' ; +substr($b, 1,1) = "ab" ; +EXPECT +Attempt to use reference as lvalue in substr at - line 5. +######## +# pp.c +use warnings 'uninitialized' ; +# TODO +EXPECT + +######## +# pp.c +use warnings 'misc' ; +my $a = { 1,2,3}; +no warnings 'misc' ; +my $b = { 1,2,3}; +EXPECT +Odd number of elements in hash assignment at - line 3. +######## +# pp.c +use warnings 'pack' ; +use warnings 'unpack' ; +my @a = unpack ("A,A", "22") ; +my $a = pack ("A,A", 1,2) ; +no warnings 'pack' ; +no warnings 'unpack' ; +my @b = unpack ("A,A", "22") ; +my $b = pack ("A,A", 1,2) ; +EXPECT +Invalid type in unpack: ',' at - line 4. +Invalid type in pack: ',' at - line 5. +######## +# pp.c +use warnings 'uninitialized' ; +my $a = undef ; +my $b = $$a; +no warnings 'uninitialized' ; +my $c = $$a; +EXPECT +Use of uninitialized value in scalar dereference at - line 4. +######## +# pp.c +use warnings 'pack' ; +sub foo { my $a = "a"; return $a . $a++ . $a++ } +my $a = pack("p", &foo) ; +no warnings 'pack' ; +my $b = pack("p", &foo) ; +EXPECT +Attempt to pack pointer to temporary value at - line 4. +######## +# pp.c +use warnings 'misc' ; +bless \[], "" ; +no warnings 'misc' ; +bless \[], "" ; +EXPECT +Explicit blessing to '' (assuming package main) at - line 3. +######## +# pp.c +use utf8 ; +$_ = "\x80 \xff" ; +reverse ; +EXPECT +######## diff --git a/contrib/perl5/t/pragma/warn/pp_ctl b/contrib/perl5/t/pragma/warn/pp_ctl new file mode 100644 index 0000000..0deccd3 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/pp_ctl @@ -0,0 +1,217 @@ + pp_ctl.c AOK + + Not enough format arguments + format STDOUT = + @<<< @<<< + $a + . + write; + + + Exiting substitution via %s + $_ = "abc" ; + while ($i ++ == 0) + { + s/ab/last/e ; + } + + Exiting subroutine via %s + sub fred { last } + { fred() } + + Exiting eval via %s + { eval "last" } + + Exiting pseudo-block via %s + @a = (1,2) ; @b = sort { last } @a ; + + Exiting substitution via %s + $_ = "abc" ; + last fred: + while ($i ++ == 0) + { + s/ab/last fred/e ; + } + + + Exiting subroutine via %s + sub fred { last joe } + joe: { fred() } + + Exiting eval via %s + fred: { eval "last fred" } + + Exiting pseudo-block via %s + @a = (1,2) ; fred: @b = sort { last fred } @a ; + + + Deep recursion on subroutine \"%s\" + sub fred + { + fred() if $a++ < 200 + } + + fred() + + (in cleanup) foo bar + package Foo; + DESTROY { die "foo bar" } + { bless [], 'Foo' for 1..10 } + +__END__ +# pp_ctl.c +use warnings 'syntax' ; +format STDOUT = +@<<< @<<< +1 +. +write; +EXPECT +Not enough format arguments at - line 5. +1 +######## +# pp_ctl.c +no warnings 'syntax' ; +format = +@<<< @<<< +1 +. +write ; +EXPECT +1 +######## +# pp_ctl.c +use warnings 'exiting' ; +$_ = "abc" ; + +while ($i ++ == 0) +{ + s/ab/last/e ; +} +no warnings 'exiting' ; +while ($i ++ == 0) +{ + s/ab/last/e ; +} +EXPECT +Exiting substitution via last at - line 7. +######## +# pp_ctl.c +use warnings 'exiting' ; +sub fred { last } +{ fred() } +no warnings 'exiting' ; +sub joe { last } +{ joe() } +EXPECT +Exiting subroutine via last at - line 3. +######## +# pp_ctl.c +{ + eval "use warnings 'exiting' ; last;" +} +print STDERR $@ ; +{ + eval "no warnings 'exiting' ;last;" +} +print STDERR $@ ; +EXPECT +Exiting eval via last at (eval 1) line 1. +######## +# pp_ctl.c +use warnings 'exiting' ; +@a = (1,2) ; +@b = sort { last } @a ; +no warnings 'exiting' ; +@b = sort { last } @a ; +EXPECT +Exiting pseudo-block via last at - line 4. +Can't "last" outside a loop block at - line 4. +######## +# pp_ctl.c +use warnings 'exiting' ; +$_ = "abc" ; +fred: +while ($i ++ == 0) +{ + s/ab/last fred/e ; +} +no warnings 'exiting' ; +while ($i ++ == 0) +{ + s/ab/last fred/e ; +} +EXPECT +Exiting substitution via last at - line 7. +######## +# pp_ctl.c +use warnings 'exiting' ; +sub fred { last joe } +joe: { fred() } +no warnings 'exiting' ; +sub Fred { last Joe } +Joe: { Fred() } +EXPECT +Exiting subroutine via last at - line 3. +######## +# pp_ctl.c +joe: +{ eval "use warnings 'exiting' ; last joe;" } +print STDERR $@ ; +Joe: +{ eval "no warnings 'exiting' ; last Joe;" } +print STDERR $@ ; +EXPECT +Exiting eval via last at (eval 1) line 1. +######## +# pp_ctl.c +use warnings 'exiting' ; +@a = (1,2) ; +fred: @b = sort { last fred } @a ; +no warnings 'exiting' ; +Fred: @b = sort { last Fred } @a ; +EXPECT +Exiting pseudo-block via last at - line 4. +Label not found for "last fred" at - line 4. +######## +# pp_ctl.c +use warnings 'recursion' ; +BEGIN { warn "PREFIX\n" ;} +sub fred +{ + fred() if $a++ < 200 +} + +fred() +EXPECT +Deep recursion on subroutine "main::fred" at - line 6. +######## +# pp_ctl.c +no warnings 'recursion' ; +BEGIN { warn "PREFIX\n" ;} +sub fred +{ + fred() if $a++ < 200 +} + +fred() +EXPECT +######## +# pp_ctl.c +use warnings 'misc' ; +package Foo; +DESTROY { die "@{$_[0]} foo bar" } +{ bless ['A'], 'Foo' for 1..10 } +{ bless ['B'], 'Foo' for 1..10 } +EXPECT + (in cleanup) A foo bar at - line 4. + (in cleanup) B foo bar at - line 4. +######## +# pp_ctl.c +no warnings 'misc' ; +package Foo; +DESTROY { die "@{$_[0]} foo bar" } +{ bless ['A'], 'Foo' for 1..10 } +{ bless ['B'], 'Foo' for 1..10 } +EXPECT + diff --git a/contrib/perl5/t/pragma/warn/pp_hot b/contrib/perl5/t/pragma/warn/pp_hot new file mode 100644 index 0000000..2759057 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/pp_hot @@ -0,0 +1,226 @@ + pp_hot.c + + Filehandle %s never opened [pp_print] + $f = $a = "abc" ; print $f $a + + Filehandle %s opened only for input [pp_print] + print STDIN "abc" ; + + Filehandle %s opened only for output [pp_print] + print <STDOUT> ; + + print() on closed filehandle %s [pp_print] + close STDIN ; print STDIN "abc" ; + + uninitialized [pp_rv2av] + my $a = undef ; my @b = @$a + + uninitialized [pp_rv2hv] + my $a = undef ; my %b = %$a + + Odd number of elements in hash list [pp_aassign] + %X = (1,2,3) ; + + Reference found where even-sized list expected [pp_aassign] + $X = [ 1 ..3 ]; + + Filehandle %s opened only for output [Perl_do_readline] + open (FH, ">./xcv") ; + my $a = <FH> ; + + glob failed (can't start child: %s) [Perl_do_readline] <<TODO + + readline() on closed filehandle %s [Perl_do_readline] + close STDIN ; $a = <STDIN>; + + glob failed (child exited with status %d%s) [Perl_do_readline] <<TODO + + Deep recursion on subroutine \"%s\" [Perl_sub_crush_depth] + sub fred { fred() if $a++ < 200} fred() + + Deep recursion on anonymous subroutine [Perl_sub_crush_depth] + $a = sub { &$a if $a++ < 200} &$a + + Possible Y2K bug: about to append an integer to '19' [pp_concat] + $x = "19$yy\n"; + +__END__ +# pp_hot.c [pp_print] +use warnings 'unopened' ; +$f = $a = "abc" ; +print $f $a; +no warnings 'unopened' ; +print $f $a; +EXPECT +Filehandle main::abc never opened at - line 4. +######## +# pp_hot.c [pp_print] +use warnings 'io' ; +print STDIN "anc"; +print <STDOUT>; +print <STDERR>; +open(FOO, ">&STDOUT") and print <FOO>; +print getc(STDERR); +print getc(FOO); +#################################################################### +# The next test is known to fail on some systems (Linux+old glibc, # +# old *BSDs, and NeXT, among others. # +# We skip it for now (on the grounds that it is "just" a warning). # +#################################################################### +#read(FOO,$_,1); +no warnings 'io' ; +print STDIN "anc"; +EXPECT +Filehandle main::STDIN opened only for input at - line 3. +Filehandle main::STDOUT opened only for output at - line 4. +Filehandle main::STDERR opened only for output at - line 5. +Filehandle main::FOO opened only for output at - line 6. +Filehandle main::STDERR opened only for output at - line 7. +Filehandle main::FOO opened only for output at - line 8. +######## +# pp_hot.c [pp_print] +use warnings 'closed' ; +close STDIN ; +print STDIN "anc"; +opendir STDIN, "."; +print STDIN "anc"; +closedir STDIN; +no warnings 'closed' ; +print STDIN "anc"; +opendir STDIN, "."; +print STDIN "anc"; +EXPECT +print() on closed filehandle main::STDIN at - line 4. +print() on closed filehandle main::STDIN at - line 6. + (Are you trying to call print() on dirhandle main::STDIN?) +######## +# pp_hot.c [pp_rv2av] +use warnings 'uninitialized' ; +my $a = undef ; +my @b = @$a; +no warnings 'uninitialized' ; +my @c = @$a; +EXPECT +Use of uninitialized value in array dereference at - line 4. +######## +# pp_hot.c [pp_rv2hv] +use warnings 'uninitialized' ; +my $a = undef ; +my %b = %$a; +no warnings 'uninitialized' ; +my %c = %$a; +EXPECT +Use of uninitialized value in hash dereference at - line 4. +######## +# pp_hot.c [pp_aassign] +use warnings 'misc' ; +my %X ; %X = (1,2,3) ; +no warnings 'misc' ; +my %Y ; %Y = (1,2,3) ; +EXPECT +Odd number of elements in hash assignment at - line 3. +######## +# pp_hot.c [pp_aassign] +use warnings 'misc' ; +my %X ; %X = [1 .. 3] ; +no warnings 'misc' ; +my %Y ; %Y = [1 .. 3] ; +EXPECT +Reference found where even-sized list expected at - line 3. +######## +# pp_hot.c [Perl_do_readline] +use warnings 'closed' ; +close STDIN ; $a = <STDIN> ; +opendir STDIN, "." ; $a = <STDIN> ; +closedir STDIN; +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?) +######## +# pp_hot.c [Perl_do_readline] +use warnings 'io' ; +my $file = "./xcv" ; unlink $file ; +open (FH, ">./xcv") ; +my $a = <FH> ; +no warnings 'io' ; +$a = <FH> ; +unlink $file ; +EXPECT +Filehandle main::FH opened only for output at - line 5. +######## +# pp_hot.c [Perl_sub_crush_depth] +use warnings 'recursion' ; +sub fred +{ + fred() if $a++ < 200 +} +{ + local $SIG{__WARN__} = sub { + die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/ + }; + fred(); +} +EXPECT +ok +######## +# pp_hot.c [Perl_sub_crush_depth] +no warnings 'recursion' ; +sub fred +{ + fred() if $a++ < 200 +} +{ + local $SIG{__WARN__} = sub { + die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/ + }; + fred(); +} +EXPECT + +######## +# pp_hot.c [Perl_sub_crush_depth] +use warnings 'recursion' ; +$b = sub +{ + &$b if $a++ < 200 +} ; + +&$b ; +EXPECT +Deep recursion on anonymous subroutine at - line 5. +######## +# pp_hot.c [Perl_sub_crush_depth] +no warnings 'recursion' ; +$b = sub +{ + &$b if $a++ < 200 +} ; + +&$b ; +EXPECT +######## +# pp_hot.c [pp_concat] +use warnings 'y2k'; +use Config; +BEGIN { + unless ($Config{ccflags} =~ /Y2KWARN/) { + print "SKIPPED\n# perl not built with -DPERL_Y2KWARN"; + exit 0; + } +} +my $x; +my $yy = 78; +$x = "19$yy\n"; +$x = "19" . $yy . "\n"; +$x = "319$yy\n"; +$x = "319" . $yy . "\n"; +no warnings 'y2k'; +$x = "19$yy\n"; +$x = "19" . $yy . "\n"; +EXPECT +Possible Y2K bug: about to append an integer to '19' at - line 12. +Possible Y2K bug: about to append an integer to '19' at - line 13. diff --git a/contrib/perl5/t/pragma/warn/pp_sys b/contrib/perl5/t/pragma/warn/pp_sys new file mode 100644 index 0000000..7c38727 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/pp_sys @@ -0,0 +1,354 @@ + pp_sys.c AOK + + untie attempted while %d inner references still exist [pp_untie] + sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ; + + Filehandle %s opened only for input [pp_leavewrite] + format STDIN = + . + write STDIN; + + write() on closed filehandle %s [pp_leavewrite] + format STDIN = + . + close STDIN; + write STDIN ; + + page overflow [pp_leavewrite] + + Filehandle %s never opened [pp_prtf] + $a = "abc"; printf $a "fred" + + Filehandle %s opened only for input [pp_prtf] + $a = "abc"; + printf $a "fred" + + printf() on closed filehandle %s [pp_prtf] + close STDIN ; + printf STDIN "fred" + + syswrite() on closed filehandle %s [pp_send] + close STDIN; + syswrite STDIN, "fred", 1; + + send() on closed socket %s [pp_send] + close STDIN; + send STDIN, "fred", 1 + + bind() on closed socket %s [pp_bind] + close STDIN; + bind STDIN, "fred" ; + + + connect() on closed socket %s [pp_connect] + close STDIN; + connect STDIN, "fred" ; + + listen() on closed socket %s [pp_listen] + close STDIN; + listen STDIN, 2; + + accept() on closed socket %s [pp_accept] + close STDIN; + accept "fred", STDIN ; + + shutdown() on closed socket %s [pp_shutdown] + close STDIN; + shutdown STDIN, 0; + + setsockopt() on closed socket %s [pp_ssockopt] + getsockopt() on closed socket %s [pp_ssockopt] + close STDIN; + setsockopt STDIN, 1,2,3; + getsockopt STDIN, 1,2; + + getsockname() on closed socket %s [pp_getpeername] + getpeername() on closed socket %s [pp_getpeername] + close STDIN; + getsockname STDIN; + getpeername STDIN; + + flock() on closed socket %s [pp_flock] + close STDIN; + flock STDIN, 8; + + warn(warn_nl, "stat"); [pp_stat] + + Test on unopened file <%s> + close STDIN ; -T STDIN ; + + warn(warn_nl, "open"); [pp_fttext] + -T "abc\ndef" ; + + Filehandle %s opened only for output [pp_sysread] + my $file = "./xcv" ; + open(F, ">$file") ; + my $a = sysread(F, $a,10) ; + + + +__END__ +# pp_sys.c [pp_untie] +use warnings 'untie' ; +sub TIESCALAR { bless [] } ; +$b = tie $a, 'main'; +untie $a ; +no warnings 'untie' ; +$c = tie $d, 'main'; +untie $d ; +EXPECT +untie attempted while 1 inner references still exist at - line 5. +######## +# pp_sys.c [pp_leavewrite] +use warnings 'io' ; +format STDIN = +. +write STDIN; +no warnings 'io' ; +write STDIN; +EXPECT +Filehandle main::STDIN opened only for input at - line 5. +######## +# pp_sys.c [pp_leavewrite] +use warnings 'closed' ; +format STDIN = +. +close STDIN; +write STDIN; +opendir STDIN, "."; +write STDIN; +closedir STDIN; +no warnings 'closed' ; +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?) +######## +# pp_sys.c [pp_leavewrite] +use warnings 'io' ; +format STDOUT_TOP = +abc +. +format STDOUT = +def +ghi +. +$= = 1 ; +$- =1 ; +open STDOUT, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ; +write ; +no warnings 'io' ; +write ; +EXPECT +page overflow at - line 13. +######## +# pp_sys.c [pp_prtf] +use warnings 'unopened' ; +$a = "abc"; +printf $a "fred"; +no warnings 'unopened' ; +printf $a "fred"; +EXPECT +Filehandle main::abc never opened at - line 4. +######## +# pp_sys.c [pp_prtf] +use warnings 'closed' ; +close STDIN ; +printf STDIN "fred"; +opendir STDIN, "."; +printf STDIN "fred"; +closedir STDIN; +no warnings 'closed' ; +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?) +######## +# pp_sys.c [pp_prtf] +use warnings 'io' ; +printf STDIN "fred"; +no warnings 'io' ; +printf STDIN "fred"; +EXPECT +Filehandle main::STDIN opened only for input at - line 3. +######## +# pp_sys.c [pp_send] +use warnings 'closed' ; +close STDIN; +syswrite STDIN, "fred", 1; +opendir STDIN, "."; +syswrite STDIN, "fred", 1; +closedir STDIN; +no warnings 'closed' ; +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?) +######## +# pp_sys.c [pp_flock] +use Config; +BEGIN { + if ( $^O eq 'VMS' and ! $Config{d_flock}) { + print <<EOM ; +SKIPPED +# flock not present +EOM + exit ; + } +} +use warnings 'closed' ; +close STDIN; +flock STDIN, 8; +opendir STDIN, "."; +flock STDIN, 8; +no warnings 'closed' ; +flock STDIN, 8; +opendir STDIN, "."; +flock STDIN, 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?) +######## +# pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername] +use warnings 'io' ; +use Config; +BEGIN { + if ( $^O ne 'VMS' and ! $Config{d_socket}) { + print <<EOM ; +SKIPPED +# send not present +# bind not present +# connect not present +# accept not present +# shutdown not present +# setsockopt not present +# getsockopt not present +# getsockname not present +# getpeername not present +EOM + exit ; + } +} +close STDIN; +send STDIN, "fred", 1; +bind STDIN, "fred" ; +connect STDIN, "fred" ; +listen STDIN, 2; +accept "fred", STDIN; +shutdown STDIN, 0; +setsockopt STDIN, 1,2,3; +getsockopt STDIN, 1,2; +getsockname STDIN; +getpeername STDIN; +opendir STDIN, "."; +send STDIN, "fred", 1; +bind STDIN, "fred" ; +connect STDIN, "fred" ; +listen STDIN, 2; +accept "fred", STDIN; +shutdown STDIN, 0; +setsockopt STDIN, 1,2,3; +getsockopt STDIN, 1,2; +getsockname STDIN; +getpeername STDIN; +closedir STDIN; +no warnings '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; +opendir STDIN, "."; +send STDIN, "fred", 1; +bind STDIN, "fred" ; +connect STDIN, "fred" ; +listen STDIN, 2; +accept "fred", STDIN; +shutdown STDIN, 0; +setsockopt STDIN, 1,2,3; +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?) +######## +# pp_sys.c [pp_stat] +use warnings 'newline' ; +stat "abc\ndef"; +no warnings 'newline' ; +stat "abc\ndef"; +EXPECT +Unsuccessful stat on filename containing newline at - line 3. +######## +# pp_sys.c [pp_fttext] +use warnings 'unopened' ; +close STDIN ; +-T STDIN ; +no warnings 'unopened' ; +-T STDIN ; +EXPECT +Test on unopened file <STDIN> at - line 4. +######## +# pp_sys.c [pp_fttext] +use warnings 'newline' ; +-T "abc\ndef" ; +no warnings 'newline' ; +-T "abc\ndef" ; +EXPECT +Unsuccessful open on filename containing newline at - line 3. +######## +# pp_sys.c [pp_sysread] +use warnings 'io' ; +my $file = "./xcv" ; +open(F, ">$file") ; +my $a = sysread(F, $a,10) ; +no warnings 'io' ; +my $a = sysread(F, $a,10) ; +close F ; +unlink $file ; +EXPECT +Filehandle main::F opened only for output at - line 5. diff --git a/contrib/perl5/t/pragma/warn/regcomp b/contrib/perl5/t/pragma/warn/regcomp new file mode 100644 index 0000000..5d0c291 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/regcomp @@ -0,0 +1,165 @@ + regcomp.c AOK + + Strange *+?{} on zero-length expression [S_study_chunk] + /(?=a)?/ + + %.*s matches null string many times [S_regpiece] + $a = "ABC123" ; $a =~ /(?=a)*/' + + /%.127s/: Unrecognized escape \\%c passed through [S_regatom] + $x = '\m' ; /$x/ + + 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] + + /%.127s/: false [] range \"%*.*s\" in regexp [S_regclassutf8] + + /%.127s/: Unrecognized escape \\%c in character class passed through" [S_regclass] + + /%.127s/: Unrecognized escape \\%c in character class passed through" [S_regclassutf8] + +__END__ +# regcomp.c [S_regpiece] +use warnings 'regexp' ; +my $a = "ABC123" ; +$a =~ /(?=a)*/ ; +no warnings 'regexp' ; +$a =~ /(?=a)*/ ; +EXPECT +(?=a)* matches null string many times at - line 4. +######## +# regcomp.c [S_study_chunk] +use warnings 'regexp' ; +$_ = "" ; +/(?=a)?/; +no warnings 'regexp' ; +/(?=a)?/; +EXPECT +Strange *+?{} on zero-length expression at - line 4. +######## +# regcomp.c [S_regatom] +$x = '\m' ; +use warnings 'regexp' ; +$a =~ /a$x/ ; +no warnings 'regexp' ; +$a =~ /a$x/ ; +EXPECT +/a\m/: Unrecognized escape \m passed through 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:]/; +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. +######## +# regcomp.c [S_regclass] +$_ = ""; +use warnings 'regexp' ; +/[a-b]/; +/[a-\d]/; +/[\d-b]/; +/[\s-\d]/; +/[\d-\s]/; +/[a-[:digit:]]/; +/[[:digit:]-b]/; +/[[:alpha:]-[:digit:]]/; +/[[:digit:]-[:alpha:]]/; +no warnings 'regexp' ; +/[a-b]/; +/[a-\d]/; +/[\d-b]/; +/[\s-\d]/; +/[\d-\s]/; +/[a-[:digit:]]/; +/[[:digit:]-b]/; +/[[: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. +######## +# regcomp.c [S_regclassutf8] +BEGIN { + if (ord("\t") == 5) { + print "SKIPPED\n# ebcdic regular expression ranges differ."; + exit 0; + } +} +use utf8; +$_ = ""; +use warnings 'regexp' ; +/[a-b]/; +/[a-\d]/; +/[\d-b]/; +/[\s-\d]/; +/[\d-\s]/; +/[a-[:digit:]]/; +/[[:digit:]-b]/; +/[[:alpha:]-[:digit:]]/; +/[[:digit:]-[:alpha:]]/; +no warnings 'regexp' ; +/[a-b]/; +/[a-\d]/; +/[\d-b]/; +/[\s-\d]/; +/[\d-\s]/; +/[a-[:digit:]]/; +/[[:digit:]-b]/; +/[[: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. +######## +# regcomp.c [S_regclass S_regclassutf8] +use warnings 'regexp' ; +$a =~ /[a\zb]/ ; +no warnings 'regexp' ; +$a =~ /[a\zb]/ ; +EXPECT +/[a\zb]/: Unrecognized escape \z in character class passed through at - line 3. diff --git a/contrib/perl5/t/pragma/warn/regexec b/contrib/perl5/t/pragma/warn/regexec new file mode 100644 index 0000000..73696df --- /dev/null +++ b/contrib/perl5/t/pragma/warn/regexec @@ -0,0 +1,119 @@ + regexec.c + + This test generates "bad free" warnings when run under + PERL_DESTRUCT_LEVEL. This file merely serves as a placeholder + for investigation. + + Complex regular subexpression recursion limit (%d) exceeded + + $_ = 'a' x (2**15+1); /^()(a\1)*$/ ; + Complex regular subexpression recursion limit (%d) exceeded + + $_ = 'a' x (2**15+1); /^()(a\1)*?$/ ; + + (The actual value substituted for %d is masked in the tests so that + REG_INFTY configuration variable value does not affect outcome.) +__END__ +# regexec.c +print("SKIPPED\n# most systems run into stacksize limits\n"),exit; +use warnings 'regexp' ; +$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 +Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9. +######## +# regexec.c +print("SKIPPED\n# most systems run into stacksize limits\n"),exit; +no warnings 'regexp' ; +$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 warnings 'regexp' ; +$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 +Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9. +######## +# regexec.c +print("SKIPPED\n# most systems run into stacksize limits\n"),exit; +no warnings 'regexp' ; +$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/contrib/perl5/t/pragma/warn/run b/contrib/perl5/t/pragma/warn/run new file mode 100644 index 0000000..7a4be20 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/run @@ -0,0 +1,8 @@ + run.c + + + Mandatory Warnings ALL TODO + ------------------ + NULL OP IN RUN + +__END__ diff --git a/contrib/perl5/t/pragma/warn/sv b/contrib/perl5/t/pragma/warn/sv new file mode 100644 index 0000000..758137f --- /dev/null +++ b/contrib/perl5/t/pragma/warn/sv @@ -0,0 +1,303 @@ + sv.c + + warn(warn_uninit); + + warn(warn_uninit); + + warn(warn_uninit); + + warn(warn_uninit); + + not_a_number(sv); + + not_a_number(sv); + + warn(warn_uninit); + + not_a_number(sv); + + warn(warn_uninit); + + not_a_number(sv); + + not_a_number(sv); + + warn(warn_uninit); + + warn(warn_uninit); + + Subroutine %s redefined + + Invalid conversion in %s: + + Undefined value assigned to typeglob + + Possible Y2K bug: %d format string following '19' + + Reference is already weak [Perl_sv_rvweaken] <<TODO + + Mandatory Warnings + ------------------ + Malformed UTF-8 character [sv_pos_b2u] (not tested: difficult to produce + with perl now) + + 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 warnings 'uninitialized' ; +$x = 1 + $a[0] ; # a +no warnings 'uninitialized' ; +$x = 1 + $b[0] ; # a +EXPECT +Use of uninitialized value in integer addition (+) at - line 4. +######## +# sv.c (sv_2iv) +package fred ; +sub TIESCALAR { my $x ; bless \$x} +sub FETCH { return undef } +sub STORE { return 1 } +package main ; +tie $A, 'fred' ; +use integer ; +use warnings 'uninitialized' ; +$A *= 2 ; +no warnings 'uninitialized' ; +$A *= 2 ; +EXPECT +Use of uninitialized value in integer multiplication (*) at - line 10. +######## +# sv.c +use integer ; +use warnings 'uninitialized' ; +my $x *= 2 ; #b +no warnings 'uninitialized' ; +my $y *= 2 ; #b +EXPECT +Use of uninitialized value in integer multiplication (*) at - line 4. +######## +# sv.c (sv_2uv) +package fred ; +sub TIESCALAR { my $x ; bless \$x} +sub FETCH { return undef } +sub STORE { return 1 } +package main ; +tie $A, 'fred' ; +use warnings 'uninitialized' ; +$B = 0 ; +$B |= $A ; +no warnings 'uninitialized' ; +$B = 0 ; +$B |= $A ; +EXPECT +Use of uninitialized value in bitwise or (|) at - line 10. +######## +# sv.c +use warnings 'uninitialized' ; +my $Y = 1 ; +my $x = 1 | $a[$Y] ; +no warnings 'uninitialized' ; +my $Y = 1 ; +$x = 1 | $b[$Y] ; +EXPECT +Use of uninitialized value in bitwise or (|) at - line 4. +######## +# sv.c +use warnings 'uninitialized' ; +my $x *= 1 ; # d +no warnings 'uninitialized' ; +my $y *= 1 ; # d +EXPECT +Use of uninitialized value in multiplication (*) at - line 3. +######## +# sv.c +use warnings 'uninitialized' ; +$x = 1 + $a[0] ; # e +no warnings 'uninitialized' ; +$x = 1 + $b[0] ; # e +EXPECT +Use of uninitialized value in addition (+) at - line 3. +######## +# sv.c (sv_2nv) +package fred ; +sub TIESCALAR { my $x ; bless \$x} +sub FETCH { return undef } +sub STORE { return 1 } +package main ; +tie $A, 'fred' ; +use warnings 'uninitialized' ; +$A *= 2 ; +no warnings 'uninitialized' ; +$A *= 2 ; +EXPECT +Use of uninitialized value in multiplication (*) at - line 9. +######## +# sv.c +use warnings 'uninitialized' ; +$x = $y + 1 ; # f +no warnings 'uninitialized' ; +$x = $z + 1 ; # f +EXPECT +Use of uninitialized value in addition (+) at - line 3. +######## +# sv.c +use warnings 'uninitialized' ; +$x = chop undef ; # g +no warnings 'uninitialized' ; +$x = chop undef ; # g +EXPECT +Modification of a read-only value attempted at - line 3. +######## +# sv.c +use warnings 'uninitialized' ; +$x = chop $y ; # h +no warnings 'uninitialized' ; +$x = chop $z ; # h +EXPECT +Use of uninitialized value in scalar chop at - line 3. +######## +# sv.c (sv_2pv) +package fred ; +sub TIESCALAR { my $x ; bless \$x} +sub FETCH { return undef } +sub STORE { return 1 } +package main ; +tie $A, 'fred' ; +use warnings 'uninitialized' ; +$B = "" ; +$B .= $A ; +no warnings 'uninitialized' ; +$C = "" ; +$C .= $A ; +EXPECT +Use of uninitialized value in concatenation (.) at - line 10. +######## +# sv.c +use warnings 'numeric' ; +sub TIESCALAR{bless[]} ; +sub FETCH {"def"} ; +tie $a,"main" ; +my $b = 1 + $a; +no warnings 'numeric' ; +my $c = 1 + $a; +EXPECT +Argument "def" isn't numeric in addition (+) at - line 6. +######## +# sv.c +use warnings 'numeric' ; +my $x = 1 + "def" ; +no warnings 'numeric' ; +my $z = 1 + "def" ; +EXPECT +Argument "def" isn't numeric in addition (+) at - line 3. +######## +# sv.c +use warnings 'numeric' ; +my $a = "def" ; +my $x = 1 + $a ; +no warnings 'numeric' ; +my $y = 1 + $a ; +EXPECT +Argument "def" isn't numeric in addition (+) at - line 4. +######## +# sv.c +use warnings 'numeric' ; use integer ; +my $a = "def" ; +my $x = 1 + $a ; +no warnings 'numeric' ; +my $z = 1 + $a ; +EXPECT +Argument "def" isn't numeric in integer addition (+) at - line 4. +######## +# sv.c +use warnings 'numeric' ; +my $x = 1 & "def" ; +no warnings 'numeric' ; +my $z = 1 & "def" ; +EXPECT +Argument "def" isn't numeric in bitwise and (&) at - line 3. +######## +# sv.c +use warnings 'redefine' ; +sub fred {} +sub joe {} +*fred = \&joe ; +no warnings 'redefine' ; +sub jim {} +*jim = \&joe ; +EXPECT +Subroutine fred redefined at - line 5. +######## +# sv.c +use warnings 'printf' ; +open F, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ; +printf F "%z\n" ; +my $a = sprintf "%z" ; +printf F "%" ; +$a = sprintf "%" ; +printf F "%\x02" ; +$a = sprintf "%\x02" ; +no warnings 'printf' ; +printf F "%z\n" ; +$a = sprintf "%z" ; +printf F "%" ; +$a = sprintf "%" ; +printf F "%\x02" ; +$a = sprintf "%\x02" ; +EXPECT +Invalid conversion in sprintf: "%z" at - line 5. +Invalid conversion in sprintf: end of string at - line 7. +Invalid conversion in sprintf: "%\002" at - line 9. +Invalid conversion in printf: "%z" at - line 4. +Invalid conversion in printf: end of string at - line 6. +Invalid conversion in printf: "%\002" at - line 8. +######## +# sv.c +use warnings 'misc' ; +*a = undef ; +no warnings 'misc' ; +*b = undef ; +EXPECT +Undefined value assigned to typeglob at - line 3. +######## +# sv.c +use warnings 'y2k'; +use Config; +BEGIN { + unless ($Config{ccflags} =~ /Y2KWARN/) { + print "SKIPPED\n# perl not built with -DPERL_Y2KWARN"; + exit 0; + } + $|=1; +} +my $x; +my $yy = 78; +$x = printf "19%02d\n", $yy; +$x = sprintf "#19%02d\n", $yy; +$x = printf " 19%02d\n", 78; +$x = sprintf "19%02d\n", 78; +$x = printf "319%02d\n", $yy; +$x = sprintf "319%02d\n", $yy; +no warnings 'y2k'; +$x = printf "19%02d\n", $yy; +$x = sprintf "19%02d\n", $yy; +$x = printf "19%02d\n", 78; +$x = sprintf "19%02d\n", 78; +EXPECT +Possible Y2K bug: %d format string following '19' at - line 16. +Possible Y2K bug: %d format string following '19' at - line 13. +1978 +Possible Y2K bug: %d format string following '19' at - line 14. +Possible Y2K bug: %d format string following '19' at - line 15. + 1978 +31978 +1978 +1978 diff --git a/contrib/perl5/t/pragma/warn/taint b/contrib/perl5/t/pragma/warn/taint new file mode 100644 index 0000000..fd6deed --- /dev/null +++ b/contrib/perl5/t/pragma/warn/taint @@ -0,0 +1,49 @@ + taint.c AOK + + Insecure %s%s while running with -T switch + +__END__ +-T +--FILE-- abc +def +--FILE-- +# taint.c +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 +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 warnings 'taint' ; +chdir $a ; +print "xxx\n" ; +no warnings 'taint' ; +chdir $a ; +print "yyy\n" ; +EXPECT +Insecure dependency in chdir while running with -T switch at - line 6. +xxx +yyy diff --git a/contrib/perl5/t/pragma/warn/toke b/contrib/perl5/t/pragma/warn/toke new file mode 100644 index 0000000..cfdea78 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/toke @@ -0,0 +1,583 @@ +toke.c AOK + + we seem to have lost a few ambiguous warnings!! + + + 1 if $a EQ $b ; + 1 if $a NE $b ; + 1 if $a LT $b ; + 1 if $a GT $b ; + 1 if $a GE $b ; + 1 if $a LE $b ; + $a = <<; + Use of comma-less variable list is deprecated + (called 3 times via depcom) + + \1 better written as $1 + use warnings 'syntax' ; + s/(abc)/\1/; + + warn(warn_nosemi) + Semicolon seems to be missing + $a = 1 + &time ; + + + Reversed %c= operator + my $a =+ 2 ; + $a =- 2 ; + $a =* 2 ; + $a =% 2 ; + $a =& 2 ; + $a =. 2 ; + $a =^ 2 ; + $a =| 2 ; + $a =< 2 ; + $a =/ 2 ; + + Multidimensional syntax %.*s not supported + my $a = $a[1,2] ; + + You need to quote \"%s\"" + sub fred {} ; $SIG{TERM} = fred; + + Scalar value %.*s better written as $%.*s" + @a[3] = 2; + @a{3} = 2; + + Can't use \\%c to mean $%c in expression + $_ = "ab" ; s/(ab)/\1/e; + + Unquoted string "abc" may clash with future reserved word at - line 3. + warn(warn_reserved + $a = abc; + + chmod() mode argument is missing initial 0 + chmod 3; + + Possible attempt to separate words with commas + @a = qw(a, b, c) ; + + Possible attempt to put comments in qw() list + @a = qw(a b # c) ; + + umask: argument is missing initial 0 + umask 3; + + %s (...) interpreted as function + print ("") + printf ("") + sort ("") + + Ambiguous use of %c{%s%s} resolved to %c%s%s + $a = ${time[2]} + $a = ${time{2}} + + + Ambiguous use of %c{%s} resolved to %c%s + $a = ${time} + sub fred {} $a = ${fred} + + Misplaced _ in number + $a = 1_2; + $a = 1_2345_6; + + Bareword \"%s\" refers to nonexistent package + $a = FRED:: ; + + Ambiguous call resolved as CORE::%s(), qualify as such or use & + sub time {} + my $a = time() + + Unrecognized escape \\%c passed through + $a = "\m" ; + + %s number > %s non-portable + my $a = 0b011111111111111111111111111111110 ; + $a = 0b011111111111111111111111111111111 ; + $a = 0b111111111111111111111111111111111 ; + $a = 0x0fffffffe ; + $a = 0x0ffffffff ; + $a = 0x1ffffffff ; + $a = 0037777777776 ; + $a = 0037777777777 ; + $a = 0047777777777 ; + + Integer overflow in binary number + my $a = 0b011111111111111111111111111111110 ; + $a = 0b011111111111111111111111111111111 ; + $a = 0b111111111111111111111111111111111 ; + $a = 0x0fffffffe ; + $a = 0x0ffffffff ; + $a = 0x1ffffffff ; + $a = 0037777777776 ; + $a = 0037777777777 ; + $a = 0047777777777 ; + + 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 warnings '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 ; +no warnings '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. +Use of GT is deprecated at - line 5. +Use of LT is deprecated at - line 6. +Use of GE is deprecated at - line 7. +Use of LE is deprecated at - line 8. +######## +# toke.c +use warnings 'deprecated' ; +format STDOUT = +@<<< @||| @>>> @>>> +$a $b "abc" 'def' +. +no warnings '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. +######## +# toke.c +use warnings 'deprecated' ; +$a = <<; + +no warnings 'deprecated' ; +$a = <<; + +EXPECT +Use of bare << to mean <<"" is deprecated at - line 3. +######## +# toke.c +use warnings 'syntax' ; +s/(abc)/\1/; +no warnings 'syntax' ; +s/(abc)/\1/; +EXPECT +\1 better written as $1 at - line 3. +######## +# toke.c +use warnings 'semicolon' ; +$a = 1 +&time ; +no warnings 'semicolon' ; +$a = 1 +&time ; +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 ; +$a =* 2 ; +$a =% 2 ; +$a =& 2 ; +$a =. 2 ; +$a =^ 2 ; +$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; +} +no warnings '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 warnings 'syntax' ; +my $a = $a[1,2] ; +no warnings 'syntax' ; +my $a = $a[1,2] ; +EXPECT +Multidimensional syntax $a[1,2] not supported at - line 3. +######## +# toke.c +use warnings 'syntax' ; +sub fred {} ; $SIG{TERM} = fred; +no warnings 'syntax' ; +$SIG{TERM} = fred; +EXPECT +You need to quote "fred" at - line 3. +######## +# toke.c +use warnings 'syntax' ; +@a[3] = 2; +@a{3} = 2; +no warnings '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. +######## +# toke.c +use warnings 'syntax' ; +$_ = "ab" ; +s/(ab)/\1/e; +no warnings 'syntax' ; +$_ = "ab" ; +s/(ab)/\1/e; +EXPECT +Can't use \1 to mean $1 in expression at - line 4. +######## +# toke.c +use warnings 'reserved' ; +$a = abc; +no warnings 'reserved' ; +$a = abc; +EXPECT +Unquoted string "abc" may clash with future reserved word at - line 3. +######## +# toke.c +use warnings 'chmod' ; +chmod 3; +no warnings 'chmod' ; +chmod 3; +EXPECT +chmod() mode argument is missing initial 0 at - line 3. +######## +# toke.c +use warnings 'qw' ; +@a = qw(a, b, c) ; +no warnings 'qw' ; +@a = qw(a, b, c) ; +EXPECT +Possible attempt to separate words with commas at - line 3. +######## +# toke.c +use warnings 'qw' ; +@a = qw(a b #) ; +no warnings 'qw' ; +@a = qw(a b #) ; +EXPECT +Possible attempt to put comments in qw() list at - line 3. +######## +# toke.c +use warnings 'umask' ; +umask 3; +no warnings 'umask' ; +umask 3; +EXPECT +umask: argument is missing initial 0 at - line 3. +######## +# toke.c +use warnings 'syntax' ; +print ("") +EXPECT +print (...) interpreted as function at - line 3. +######## +# toke.c +no warnings 'syntax' ; +print ("") +EXPECT + +######## +# toke.c +use warnings 'syntax' ; +printf ("") +EXPECT +printf (...) interpreted as function at - line 3. +######## +# toke.c +no warnings 'syntax' ; +printf ("") +EXPECT + +######## +# toke.c +use warnings 'syntax' ; +sort ("") +EXPECT +sort (...) interpreted as function at - line 3. +######## +# toke.c +no warnings 'syntax' ; +sort ("") +EXPECT + +######## +# toke.c +use warnings 'ambiguous' ; +$a = ${time[2]}; +no warnings 'ambiguous' ; +$a = ${time[2]}; +EXPECT +Ambiguous use of ${time[...]} resolved to $time[...] at - line 3. +######## +# toke.c +use warnings 'ambiguous' ; +$a = ${time{2}}; +EXPECT +Ambiguous use of ${time{...}} resolved to $time{...} at - line 3. +######## +# toke.c +no warnings 'ambiguous' ; +$a = ${time{2}}; +EXPECT + +######## +# toke.c +use warnings 'ambiguous' ; +$a = ${time} ; +no warnings 'ambiguous' ; +$a = ${time} ; +EXPECT +Ambiguous use of ${time} resolved to $time at - line 3. +######## +# toke.c +use warnings 'ambiguous' ; +sub fred {} +$a = ${fred} ; +no warnings 'ambiguous' ; +$a = ${fred} ; +EXPECT +Ambiguous use of ${fred} resolved to $fred at - line 4. +######## +# toke.c +use warnings 'syntax' ; +$a = 1_2; +$a = 1_2345_6; +no warnings 'syntax' ; +$a = 1_2; +$a = 1_2345_6; +EXPECT +Misplaced _ in number at - line 3. +Misplaced _ in number at - line 4. +Misplaced _ in number at - line 4. +######## +# toke.c +use warnings 'bareword' ; +#line 25 "bar" +$a = FRED:: ; +no warnings 'bareword' ; +#line 25 "bar" +$a = FRED:: ; +EXPECT +Bareword "FRED::" refers to nonexistent package at bar line 25. +######## +# toke.c +use warnings 'ambiguous' ; +sub time {} +my $a = time() ; +no warnings 'ambiguous' ; +my $b = time() ; +EXPECT +Ambiguous call resolved as CORE::time(), qualify as such or use & at - line 4. +######## +# toke.c +use warnings ; +eval <<'EOE'; +{ +#line 30 "foo" + $_ = " \x{123} " ; +} +EOE +EXPECT + +######## +# 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 warnings 'ambiguous' ; + $a = rand + 4 ; + use warnings '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 warnings 'ambiguous' ; + -fred ; + use warnings '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 warnings 'precedence' ; + open FOO || time; + use warnings 'precedence' ; + 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 warnings 'ambiguous' ; + *foo *foo ; + use warnings '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. +######## +# toke.c +use warnings 'misc' ; +my $a = "\m" ; +no warnings 'misc' ; +$a = "\m" ; +EXPECT +Unrecognized escape \m passed through at - line 3. +######## +# toke.c +use warnings 'portable' ; +my $a = 0b011111111111111111111111111111110 ; + $a = 0b011111111111111111111111111111111 ; + $a = 0b111111111111111111111111111111111 ; + $a = 0x0fffffffe ; + $a = 0x0ffffffff ; + $a = 0x1ffffffff ; + $a = 0037777777776 ; + $a = 0037777777777 ; + $a = 0047777777777 ; +no warnings 'portable' ; + $a = 0b011111111111111111111111111111110 ; + $a = 0b011111111111111111111111111111111 ; + $a = 0b111111111111111111111111111111111 ; + $a = 0x0fffffffe ; + $a = 0x0ffffffff ; + $a = 0x1ffffffff ; + $a = 0037777777776 ; + $a = 0037777777777 ; + $a = 0047777777777 ; +EXPECT +Binary number > 0b11111111111111111111111111111111 non-portable at - line 5. +Hexadecimal number > 0xffffffff non-portable at - line 8. +Octal number > 037777777777 non-portable at - line 11. +######## +# toke.c +use warnings 'overflow' ; +my $a = 0b011111111111111111111111111111110 ; + $a = 0b011111111111111111111111111111111 ; + $a = 0b10000000000000000000000000000000000000000000000000000000000000000 ; + $a = 0x0fffffffe ; + $a = 0x0ffffffff ; + $a = 0x10000000000000000 ; + $a = 0037777777776 ; + $a = 0037777777777 ; + $a = 002000000000000000000000; +no warnings 'overflow' ; + $a = 0b011111111111111111111111111111110 ; + $a = 0b011111111111111111111111111111111 ; + $a = 0b10000000000000000000000000000000000000000000000000000000000000000 ; + $a = 0x0fffffffe ; + $a = 0x0ffffffff ; + $a = 0x10000000000000000 ; + $a = 0037777777776 ; + $a = 0037777777777 ; + $a = 002000000000000000000000; +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. diff --git a/contrib/perl5/t/pragma/warn/universal b/contrib/perl5/t/pragma/warn/universal new file mode 100644 index 0000000..6dbb1be --- /dev/null +++ b/contrib/perl5/t/pragma/warn/universal @@ -0,0 +1,16 @@ + universal.c AOK + + Can't locate package %s for @%s::ISA [S_isa_lookup] + + + +__END__ +# universal.c [S_isa_lookup] +use warnings 'misc' ; +@ISA = qw(Joe) ; +my $a = bless [] ; +UNIVERSAL::isa $a, Jim ; +EXPECT +Can't locate package Joe for @main::ISA at - line 5. +Can't locate package Joe for @main::ISA. +Can't locate package Joe for @main::ISA. diff --git a/contrib/perl5/t/pragma/warn/utf8 b/contrib/perl5/t/pragma/warn/utf8 new file mode 100644 index 0000000..6a2fe54 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/utf8 @@ -0,0 +1,29 @@ + + utf8.c AOK + + [utf8_to_uv] + Malformed UTF-8 character + my $a = ord "\x80" ; + + Malformed UTF-8 character + my $a = ord "\xf080" ; + <<<<<< this warning can't be easily triggered from perl anymore + + [utf16_to_utf8] + Malformed UTF-16 surrogate + <<<<<< Add a test when somethig actually calls utf16_to_utf8 + +__END__ +# utf8.c [utf8_to_uv] -W +use utf8 ; +my $a = "snøstorm" ; +{ + no warnings 'utf8' ; + my $a = "snøstorm"; + use warnings 'utf8' ; + my $a = "snøstorm"; +} +EXPECT +Malformed UTF-8 character at - line 3. +Malformed UTF-8 character at - line 8. +######## diff --git a/contrib/perl5/t/pragma/warn/util b/contrib/perl5/t/pragma/warn/util new file mode 100644 index 0000000..e82d6a6 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/util @@ -0,0 +1,108 @@ + util.c AOK + + Illegal octal digit ignored + my $a = oct "029" ; + + Illegal hex digit ignored + my $a = hex "0xv9" ; + + Illegal binary digit ignored + my $a = oct "0b9" ; + + Integer overflow in binary number + my $a = oct "0b111111111111111111111111111111111111111111" ; + Binary number > 0b11111111111111111111111111111111 non-portable + $a = oct "0b111111111111111111111111111111111" ; + Integer overflow in octal number + my $a = oct "077777777777777777777777777777" ; + Octal number > 037777777777 non-portable + $a = oct "0047777777777" ; + Integer overflow in hexadecimal number + my $a = hex "0xffffffffffffffffffff" ; + Hexadecimal number > 0xffffffff non-portable + $a = hex "0x1ffffffff" ; + +__END__ +# util.c +use warnings 'digit' ; +my $a = oct "029" ; +no warnings 'digit' ; +$a = oct "029" ; +EXPECT +Illegal octal digit '9' ignored at - line 3. +######## +# util.c +use warnings 'digit' ; +my $a = hex "0xv9" ; +no warnings 'digit' ; +$a = hex "0xv9" ; +EXPECT +Illegal hexadecimal digit 'v' ignored at - line 3. +######## +# util.c +use warnings 'digit' ; +my $a = oct "0b9" ; +no warnings 'digit' ; +$a = oct "0b9" ; +EXPECT +Illegal binary digit '9' ignored at - line 3. +######## +# util.c +use warnings 'overflow' ; +my $a = oct "0b11111111111111111111111111111111111111111111111111111111111111111"; +no warnings 'overflow' ; +$a = oct "0b11111111111111111111111111111111111111111111111111111111111111111"; +EXPECT +Integer overflow in binary number at - line 3. +######## +# util.c +use warnings 'overflow' ; +my $a = hex "0xffffffffffffffffffff" ; +no warnings 'overflow' ; +$a = hex "0xffffffffffffffffffff" ; +EXPECT +Integer overflow in hexadecimal number at - line 3. +######## +# util.c +use warnings 'overflow' ; +my $a = oct "077777777777777777777777777777" ; +no warnings 'overflow' ; +$a = oct "077777777777777777777777777777" ; +EXPECT +Integer overflow in octal number at - line 3. +######## +# util.c +use warnings 'portable' ; +my $a = oct "0b011111111111111111111111111111110" ; + $a = oct "0b011111111111111111111111111111111" ; + $a = oct "0b111111111111111111111111111111111" ; +no warnings 'portable' ; + $a = oct "0b011111111111111111111111111111110" ; + $a = oct "0b011111111111111111111111111111111" ; + $a = oct "0b111111111111111111111111111111111" ; +EXPECT +Binary number > 0b11111111111111111111111111111111 non-portable at - line 5. +######## +# util.c +use warnings 'portable' ; +my $a = hex "0x0fffffffe" ; + $a = hex "0x0ffffffff" ; + $a = hex "0x1ffffffff" ; +no warnings 'portable' ; + $a = hex "0x0fffffffe" ; + $a = hex "0x0ffffffff" ; + $a = hex "0x1ffffffff" ; +EXPECT +Hexadecimal number > 0xffffffff non-portable at - line 5. +######## +# util.c +use warnings 'portable' ; +my $a = oct "0037777777776" ; + $a = oct "0037777777777" ; + $a = oct "0047777777777" ; +no warnings 'portable' ; + $a = oct "0037777777776" ; + $a = oct "0037777777777" ; + $a = oct "0047777777777" ; +EXPECT +Octal number > 037777777777 non-portable at - line 5. |
