From b37043115f92ac73bfe3a2939d40e00a12f9f215 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Wed, 23 Sep 1998 06:24:49 +0000 Subject: rename t/pragma/warn-* to t/pragma/warn/*, be 8.3-friendly p4raw-id: //depot/perl@1820 --- t/pragma/warn-1global | 186 ----------------- t/pragma/warn-2use | 291 -------------------------- t/pragma/warn-3both | 66 ------ t/pragma/warn-4lint | 112 ---------- t/pragma/warn-5nolint | 96 --------- t/pragma/warn-doio | 94 --------- t/pragma/warn-gv | 40 ---- t/pragma/warn-mg | 25 --- t/pragma/warn-op | 539 ------------------------------------------------ t/pragma/warn-perl | 12 -- t/pragma/warn-perly | 25 --- t/pragma/warn-pp | 85 -------- t/pragma/warn-pp_ctl | 145 ------------- t/pragma/warn-pp_hot | 107 ---------- t/pragma/warn-pp_sys | 208 ------------------- t/pragma/warn-regcomp | 53 ----- t/pragma/warn-regexec | 57 ----- t/pragma/warn-sv | 203 ------------------ t/pragma/warn-taint | 25 --- t/pragma/warn-toke | 315 ---------------------------- t/pragma/warn-universal | 11 - t/pragma/warn-util | 21 -- t/pragma/warn/1global | 186 +++++++++++++++++ t/pragma/warn/2use | 291 ++++++++++++++++++++++++++ t/pragma/warn/3both | 66 ++++++ t/pragma/warn/4lint | 112 ++++++++++ t/pragma/warn/5nolint | 96 +++++++++ t/pragma/warn/doio | 94 +++++++++ t/pragma/warn/gv | 40 ++++ t/pragma/warn/mg | 25 +++ t/pragma/warn/op | 539 ++++++++++++++++++++++++++++++++++++++++++++++++ t/pragma/warn/perl | 12 ++ t/pragma/warn/perly | 25 +++ t/pragma/warn/pp | 85 ++++++++ t/pragma/warn/pp_ctl | 145 +++++++++++++ t/pragma/warn/pp_hot | 107 ++++++++++ t/pragma/warn/pp_sys | 208 +++++++++++++++++++ t/pragma/warn/regcomp | 53 +++++ t/pragma/warn/regexec | 57 +++++ t/pragma/warn/sv | 203 ++++++++++++++++++ t/pragma/warn/taint | 25 +++ t/pragma/warn/toke | 315 ++++++++++++++++++++++++++++ t/pragma/warn/universal | 11 + t/pragma/warn/util | 21 ++ t/pragma/warning.t | 4 +- 45 files changed, 2718 insertions(+), 2718 deletions(-) delete mode 100644 t/pragma/warn-1global delete mode 100644 t/pragma/warn-2use delete mode 100644 t/pragma/warn-3both delete mode 100644 t/pragma/warn-4lint delete mode 100644 t/pragma/warn-5nolint delete mode 100644 t/pragma/warn-doio delete mode 100644 t/pragma/warn-gv delete mode 100644 t/pragma/warn-mg delete mode 100644 t/pragma/warn-op delete mode 100644 t/pragma/warn-perl delete mode 100644 t/pragma/warn-perly delete mode 100644 t/pragma/warn-pp delete mode 100644 t/pragma/warn-pp_ctl delete mode 100644 t/pragma/warn-pp_hot delete mode 100644 t/pragma/warn-pp_sys delete mode 100644 t/pragma/warn-regcomp delete mode 100644 t/pragma/warn-regexec delete mode 100644 t/pragma/warn-sv delete mode 100644 t/pragma/warn-taint delete mode 100644 t/pragma/warn-toke delete mode 100644 t/pragma/warn-universal delete mode 100644 t/pragma/warn-util create mode 100644 t/pragma/warn/1global create mode 100644 t/pragma/warn/2use create mode 100644 t/pragma/warn/3both create mode 100644 t/pragma/warn/4lint create mode 100644 t/pragma/warn/5nolint create mode 100644 t/pragma/warn/doio create mode 100644 t/pragma/warn/gv create mode 100644 t/pragma/warn/mg create mode 100644 t/pragma/warn/op create mode 100644 t/pragma/warn/perl create mode 100644 t/pragma/warn/perly create mode 100644 t/pragma/warn/pp create mode 100644 t/pragma/warn/pp_ctl create mode 100644 t/pragma/warn/pp_hot create mode 100644 t/pragma/warn/pp_sys create mode 100644 t/pragma/warn/regcomp create mode 100644 t/pragma/warn/regexec create mode 100644 t/pragma/warn/sv create mode 100644 t/pragma/warn/taint create mode 100644 t/pragma/warn/toke create mode 100644 t/pragma/warn/universal create mode 100644 t/pragma/warn/util (limited to 't/pragma') diff --git a/t/pragma/warn-1global b/t/pragma/warn-1global deleted file mode 100644 index dca47e92ce..0000000000 --- a/t/pragma/warn-1global +++ /dev/null @@ -1,186 +0,0 @@ -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. -######## -#! perl -w -# warnable code, warnings enabled via #! line -$a =+ 3 ; -EXPECT -Reversed += operator at - line 3. -######## - -# warnable code, warnings enabled via compile time $^W -BEGIN { $^W = 1 } -$a =+ 3 ; -EXPECT -Reversed += operator 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 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 at - line 5. -######## --w ---FILE-- abcd -my $b ; chop $b ; -1 ; ---FILE-- -require "./abcd"; -EXPECT -Use of uninitialized value at ./abcd line 1. -######## - ---FILE-- abcd -my $b ; chop $b ; -1 ; ---FILE-- -#! perl -w -require "./abcd"; -EXPECT -Use of uninitialized value at ./abcd line 1. -######## - ---FILE-- abcd -my $b ; chop $b ; -1 ; ---FILE-- -$^W =1 ; -require "./abcd"; -EXPECT -Use of uninitialized value 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 at - line 3. -######## - -$^W = 1; -eval 'my $b ; chop $b ;' ; -print $@ ; -EXPECT -Use of uninitialized value at (eval 1) line 1. -######## - -eval '$^W = 1;' ; -print $@ ; -my $b ; chop $b ; -EXPECT -Use of uninitialized value at - line 4. -######## - -eval {$^W = 1;} ; -print $@ ; -my $b ; chop $b ; -EXPECT -Use of uninitialized value 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 at - line 5. -######## --w --e undef -EXPECT -Use of uninitialized value 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 at - line 2. diff --git a/t/pragma/warn-2use b/t/pragma/warn-2use deleted file mode 100644 index 764a843192..0000000000 --- a/t/pragma/warn-2use +++ /dev/null @@ -1,291 +0,0 @@ -Check lexical warning functionality - -TODO - check that the warning hierarchy works. - -__END__ - -# check illegal category is caught -use warning 'blah' ; -EXPECT -unknown warning category 'blah' at - line 3 -BEGIN failed--compilation aborted at - line 3. -######## - -# Check compile time scope of pragma -use warning 'deprecated' ; -{ - no warning ; - 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 warning; -{ - use warning '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 warning 'uninitialized' ; -{ - no warning ; - my $b ; chop $b ; -} -my $b ; chop $b ; -EXPECT -Use of uninitialized value at - line 8. -######## - -# Check runtime scope of pragma -no warning ; -{ - use warning 'uninitialized' ; - my $b ; chop $b ; -} -my $b ; chop $b ; -EXPECT -Use of uninitialized value at - line 6. -######## - -# Check runtime scope of pragma -no warning ; -{ - use warning 'uninitialized' ; - $a = sub { my $b ; chop $b ; } -} -&$a ; -EXPECT -Use of uninitialized value at - line 6. -######## - -use warning '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 warning 'deprecated' ; -require "./abc"; -EXPECT - -######## - ---FILE-- abc -use warning 'deprecated' ; -1; ---FILE-- -require "./abc"; -1 if $a EQ $b ; -EXPECT - -######## - ---FILE-- abc -use warning 'deprecated' ; -1 if $a EQ $b ; -1; ---FILE-- -use warning 'uninitialized' ; -require "./abc"; -my $a ; chop $a ; -EXPECT -Use of EQ is deprecated at ./abc line 2. -Use of uninitialized value at - line 3. -######## - ---FILE-- abc.pm -use warning 'deprecated' ; -1 if $a EQ $b ; -1; ---FILE-- -use warning 'uninitialized' ; -use abc; -my $a ; chop $a ; -EXPECT -Use of EQ is deprecated at abc.pm line 2. -Use of uninitialized value at - line 3. -######## - -# Check scope of pragma with eval -no warning ; -eval { - my $b ; chop $b ; -}; print STDERR $@ ; -my $b ; chop $b ; -EXPECT - -######## - -# Check scope of pragma with eval -no warning ; -eval { - use warning 'uninitialized' ; - my $b ; chop $b ; -}; print STDERR $@ ; -my $b ; chop $b ; -EXPECT -Use of uninitialized value at - line 6. -######## - -# Check scope of pragma with eval -use warning 'uninitialized' ; -eval { - my $b ; chop $b ; -}; print STDERR $@ ; -my $b ; chop $b ; -EXPECT -Use of uninitialized value at - line 5. -Use of uninitialized value at - line 7. -######## - -# Check scope of pragma with eval -use warning 'uninitialized' ; -eval { - no warning ; - my $b ; chop $b ; -}; print STDERR $@ ; -my $b ; chop $b ; -EXPECT -Use of uninitialized value at - line 8. -######## - -# Check scope of pragma with eval -no warning ; -eval { - 1 if $a EQ $b ; -}; print STDERR $@ ; -1 if $a EQ $b ; -EXPECT - -######## - -# Check scope of pragma with eval -no warning ; -eval { - use warning '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 warning '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 warning 'deprecated' ; -eval { - no warning ; - 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 warning ; -eval ' - my $b ; chop $b ; -'; print STDERR $@ ; -my $b ; chop $b ; -EXPECT - -######## - -# Check scope of pragma with eval -no warning ; -eval q[ - use warning 'uninitialized' ; - my $b ; chop $b ; -]; print STDERR $@; -my $b ; chop $b ; -EXPECT -Use of uninitialized value at (eval 1) line 3. -######## - -# Check scope of pragma with eval -use warning 'uninitialized' ; -eval ' - my $b ; chop $b ; -'; print STDERR $@ ; -my $b ; chop $b ; -EXPECT -Use of uninitialized value at (eval 1) line 2. -Use of uninitialized value at - line 7. -######## - -# Check scope of pragma with eval -use warning 'uninitialized' ; -eval ' - no warning ; - my $b ; chop $b ; -'; print STDERR $@ ; -my $b ; chop $b ; -EXPECT -Use of uninitialized value at - line 8. -######## - -# Check scope of pragma with eval -no warning ; -eval ' - 1 if $a EQ $b ; -'; print STDERR $@ ; -1 if $a EQ $b ; -EXPECT - -######## - -# Check scope of pragma with eval -no warning ; -eval q[ - use warning '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 warning '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 warning 'deprecated' ; -eval ' - no warning ; - 1 if $a EQ $b ; -'; print STDERR $@; -1 if $a EQ $b ; -EXPECT -Use of EQ is deprecated at - line 8. diff --git a/t/pragma/warn-3both b/t/pragma/warn-3both deleted file mode 100644 index 7c3260126b..0000000000 --- a/t/pragma/warn-3both +++ /dev/null @@ -1,66 +0,0 @@ -Check interaction of $^W and lexical - -__END__ - -# Check interaction of $^W and use warning -sub fred { - use warning ; - my $b ; - chop $b ; -} -{ local $^W = 0 ; - fred() ; -} - -EXPECT -Use of uninitialized value at - line 6. -######## - -# Check interaction of $^W and use warning -sub fred { - no warning ; - my $b ; - chop $b ; -} -{ local $^W = 1 ; - fred() ; -} - -EXPECT -Use of uninitialized value at - line 6. -######## - -# Check interaction of $^W and use warning -use warning ; -$^W = 1 ; -my $b ; -chop $b ; -EXPECT -Use of uninitialized value at - line 6. -######## - -# Check interaction of $^W and use warning -$^W = 1 ; -use warning ; -my $b ; -chop $b ; -EXPECT -Use of uninitialized value at - line 6. -######## - -# Check interaction of $^W and use warning -$^W = 1 ; -no warning ; -my $b ; -chop $b ; -EXPECT -Use of uninitialized value at - line 6. -######## - -# Check interaction of $^W and use warning -no warning ; -$^W = 1 ; -my $b ; -chop $b ; -EXPECT -Use of uninitialized value at - line 6. diff --git a/t/pragma/warn-4lint b/t/pragma/warn-4lint deleted file mode 100644 index 87cd7dc967..0000000000 --- a/t/pragma/warn-4lint +++ /dev/null @@ -1,112 +0,0 @@ -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 warning" is zapped -no warning ; -$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 warning" is zapped -{ - no warning ; - 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 warning 'deprecated' ; -my ($a, $b) = (0,0); -1 if $a EQ $b ; -1; ---FILE-- -no warning 'uninitialized' ; -use abc; -my $a ; chop $a ; -EXPECT -Use of EQ is deprecated at abc.pm line 3. -Use of uninitialized value at - line 3. -######## --W ---FILE-- abc -no warning 'deprecated' ; -my ($a, $b) = (0,0); -1 if $a EQ $b ; -1; ---FILE-- -no warning 'uninitialized' ; -require "./abc"; -my $a ; chop $a ; -EXPECT -Use of EQ is deprecated at ./abc line 3. -Use of uninitialized value 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 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 at - line 3. diff --git a/t/pragma/warn-5nolint b/t/pragma/warn-5nolint deleted file mode 100644 index 979423e87e..0000000000 --- a/t/pragma/warn-5nolint +++ /dev/null @@ -1,96 +0,0 @@ -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 warning" is zapped -use warning ; -$a = $b = 1 ; -$a = 1 if $a EQ $b ; -close STDIN ; print STDIN "abc" ; -EXPECT -######## --X -# nolint: check "no warning" is zapped -{ - use warning ; - 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 warning 'deprecated' ; -my ($a, $b) = (0,0); -1 if $a EQ $b ; -1; ---FILE-- -use warning 'uninitialized' ; -use abc; -my $a ; chop $a ; -EXPECT -######## --X ---FILE-- abc -use warning 'deprecated' ; -my ($a, $b) = (0,0); -1 if $a EQ $b ; -1; ---FILE-- -use warning '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/t/pragma/warn-doio b/t/pragma/warn-doio deleted file mode 100644 index af14f42272..0000000000 --- a/t/pragma/warn-doio +++ /dev/null @@ -1,94 +0,0 @@ - doio.c AOK - - Can't do bidirectional pipe - open(F, "| true |"); - - warn(warn_nl, "open"); - open(F, "true\ncd") - - Close on unopened file <%s> - $a = "fred";close($a) - - tell() on unopened file - $a = "fred";$a = tell($a) - - seek() on unopened file - $a = "fred";$a = seek($a,1,1) - - sysseek() on unopened file - $a = "fred";$a = seek($a,1,1) - - warn(warn_uninit); - print $a ; - - Stat on unopened file <%s> - close STDIN ; -x STDIN ; - - warn(warn_nl, "stat"); - stat "ab\ncd" - - warn(warn_nl, "lstat"); - lstat "ab\ncd" - - Can't exec \"%s\": %s - - Can't exec \"%s\": %s - - -__END__ -# doio.c -use warning 'io' ; -open(F, "|$^X -e 1|") -EXPECT -Can't do bidirectional pipe at - line 3. -######## -# doio.c -use warning 'io' ; -open(F, " at - line 7. -######## -# doio.c -use warning 'uninitialized' ; -print $a ; -EXPECT -Use of uninitialized value at - line 3. -######## -# doio.c -use warning 'io' ; - -EXPECT - -######## -# doio.c -use warning 'io' ; -stat "ab\ncd"; -lstat "ab\ncd"; -EXPECT -Unsuccessful stat on filename containing newline at - line 3. -Unsuccessful stat on filename containing newline at - line 4. -######## -# doio.c -use warning 'io' ; -exec "lskdjfalksdjfdjfkls","" ; -EXPECT -Can't exec "lskdjfalksdjfdjfkls": No such file or directory at - line 3. -######## -# doio.c -use warning 'io' ; -exec "lskdjfalksdjfdjfkls", "abc" ; -EXPECT -Can't exec "lskdjfalksdjfdjfkls": No such file or directory at - line 3. diff --git a/t/pragma/warn-gv b/t/pragma/warn-gv deleted file mode 100644 index bd442b97d6..0000000000 --- a/t/pragma/warn-gv +++ /dev/null @@ -1,40 +0,0 @@ - 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 = ${"*"} ; - - -__END__ -# gv.c -use warning '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 -sub Other::AUTOLOAD { 1 } sub Other::fred {} -@ISA = qw(Other) ; -use warning 'deprecated' ; -fred() ; -EXPECT -Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5. -######## -# gv.c -use warning 'deprecated' ; -$a = ${"#"}; -$a = ${"*"}; -EXPECT -Use of $# is deprecated at - line 3. -Use of $* is deprecated at - line 4. diff --git a/t/pragma/warn-mg b/t/pragma/warn-mg deleted file mode 100644 index 44e7634952..0000000000 --- a/t/pragma/warn-mg +++ /dev/null @@ -1,25 +0,0 @@ - mg.c AOK - - No such signal: SIG%s - $SIG{FRED} = sub {} - - SIG%s handler \"%s\" not defined. - $SIG{"INT"} = "ok3"; kill "INT",$$; - - -__END__ -# mg.c -use warning 'signal' ; -$SIG{FRED} = sub {}; -EXPECT -No such signal: SIGFRED at - line 3. -######## -# mg.c -use warning 'signal' ; -if ($^O eq 'MSWin32') { - print "SKIPPED\n# win32, can't kill() to raise()\n"; exit; -} -$|=1; -$SIG{"INT"} = "fred"; kill "INT",$$; -EXPECT -SIGINT handler "fred" not defined. diff --git a/t/pragma/warn-op b/t/pragma/warn-op deleted file mode 100644 index d0886edf58..0000000000 --- a/t/pragma/warn-op +++ /dev/null @@ -1,539 +0,0 @@ - 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/ ; - - - Parens missing around "my" list at -e line 1. - my $a, $b = (1,2); - - Parens missing around "local" list at -e line 1. - local $a, $b = (1,2); - - Probable precedence problem on logical or at -e line 1. - use warning 'syntax'; my $x = print(ABC || 1); - - Value of %s may be \"0\"; use \"defined\" - $x = 1 if $x = ; - $x = 1 while $x = ; - - 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 - - -__END__ -# op.c -use warning 'unsafe' ; -my $x ; -my $x ; -EXPECT -"my" variable $x masks earlier declaration in same scope at - line 4. -######## -# op.c -use warning 'unsafe' ; -sub x { - my $x; - sub y { - $x - } - } -EXPECT -Variable "$x" will not stay shared at - line 7. -######## -# op.c -use warning 'unsafe' ; -sub x { - my $x; - sub y { - sub { $x } - } - } -EXPECT -Variable "$x" may be unavailable at - line 6. -######## -# op.c -use warning 'syntax' ; -1 if $a = 1 ; -EXPECT -Found = in conditional, should be == at - line 3. -######## -# op.c -use warning 'deprecated' ; -split ; -EXPECT -Use of implicit split to @_ is deprecated at - line 3. -######## -# op.c -use warning 'deprecated' ; -$a = split ; -EXPECT -Use of implicit split to @_ is deprecated at - line 3. -######## -# op.c -use warning 'void' ; close STDIN ; -1 x 3 ; # OP_REPEAT - # OP_GVSV -wantarray ; # OP_WANTARRAY - # OP_GV - # OP_PADSV - # OP_PADAV - # OP_PADHV - # OP_PADANY - # OP_AV2ARYLEN -ref ; # OP_REF -\@a ; # OP_REFGEN -\$a ; # OP_SREFGEN -defined $a ; # OP_DEFINED -hex $a ; # OP_HEX -oct $a ; # OP_OCT -length $a ; # OP_LENGTH -substr $a,1 ; # OP_SUBSTR -vec $a,1,2 ; # OP_VEC -index $a,1,2 ; # OP_INDEX -rindex $a,1,2 ; # OP_RINDEX -sprintf $a ; # OP_SPRINTF -$a[0] ; # OP_AELEM - # OP_AELEMFAST -@a[0] ; # OP_ASLICE -#values %a ; # OP_VALUES -#keys %a ; # OP_KEYS -$a{0} ; # OP_HELEM -@a{0} ; # OP_HSLICE -unpack "a", "a" ; # OP_UNPACK -pack $a,"" ; # OP_PACK -join "" ; # OP_JOIN -(@a)[0,1] ; # OP_LSLICE - # OP_ANONLIST - # OP_ANONHASH -sort(1,2) ; # OP_SORT -reverse(1,2) ; # OP_REVERSE - # OP_RANGE - # OP_FLIP -(1 ..2) ; # OP_FLOP -caller ; # OP_CALLER -fileno STDIN ; # OP_FILENO -eof STDIN ; # OP_EOF -tell STDIN ; # OP_TELL -readlink 1; # OP_READLINK -time ; # OP_TIME -localtime ; # OP_LOCALTIME -gmtime ; # OP_GMTIME -eval { getgrnam 1 }; # OP_GGRNAM -eval { getgrgid 1 }; # OP_GGRGID -eval { getpwnam 1 }; # OP_GPWNAM -eval { getpwuid 1 }; # OP_GPWUID -EXPECT -Useless use of repeat 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 scalar 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 elem 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 -use warning 'void' ; -use Config ; -BEGIN { - if ( ! $Config{d_telldir}) { - print < ; -EXPECT -Value of construct can be "0"; test with defined() at - line 4. -######## -# op.c -use warning 'unsafe' ; -opendir FH, "." ; -$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 warning 'unsafe' ; -$x = 1 if $x = <*> ; -EXPECT -Value of glob construct can be "0"; test with defined() at - line 3. -######## -# op.c -use warning 'unsafe' ; -%a = (1,2,3,4) ; -$x = 1 if $x = each %a ; -EXPECT -Value of each() operator can be "0"; test with defined() at - line 4. -######## -# op.c -use warning 'unsafe' ; -$x = 1 while $x = <*> and 0 ; -EXPECT -Value of glob construct can be "0"; test with defined() at - line 3. -######## -# op.c -use warning 'unsafe' ; -opendir FH, "." ; -$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 warning 'redefine' ; -sub fred {} -sub fred {} -EXPECT -Subroutine fred redefined at - line 4. -######## -# op.c -use warning 'redefine' ; -sub fred () { 1 } -sub fred () { 1 } -EXPECT -Constant subroutine fred redefined at - line 4. -######## -# op.c -use warning 'redefine' ; -format FRED = -. -format FRED = -. -EXPECT -Format FRED redefined at - line 5. -######## -# op.c -use warning 'syntax' ; -push FRED; -EXPECT -Array @FRED missing the @ in argument 1 of push() at - line 3. -######## -# op.c -use warning 'syntax' ; -@a = keys FRED ; -EXPECT -Hash %FRED missing the % in argument 1 of keys() at - line 3. -######## -# op.c -use warning 'syntax' ; -exec "$^X -e 1" ; -my $a -EXPECT -Statement unlikely to be reached at - line 4. -(Maybe you meant system() when you said exec()?) diff --git a/t/pragma/warn-perl b/t/pragma/warn-perl deleted file mode 100644 index 5211990902..0000000000 --- a/t/pragma/warn-perl +++ /dev/null @@ -1,12 +0,0 @@ - perl.c AOK - - gv_check(defstash) - Name \"%s::%s\" used only once: possible typo - - -__END__ -# perl.c -use warning 'once' ; -$x = 3 ; -EXPECT -Name "main::x" used only once: possible typo at - line 3. diff --git a/t/pragma/warn-perly b/t/pragma/warn-perly deleted file mode 100644 index fd420d3b22..0000000000 --- a/t/pragma/warn-perly +++ /dev/null @@ -1,25 +0,0 @@ - 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 warning 'deprecated' ; -sub fred {} -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/t/pragma/warn-pp b/t/pragma/warn-pp deleted file mode 100644 index 7a3b28991c..0000000000 --- a/t/pragma/warn-pp +++ /dev/null @@ -1,85 +0,0 @@ - pp.c TODO - - substr outside of string - $a = "ab" ; $a = 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 <<< - Constant subroutine (anonymous) undefined <<< - -__END__ -# pp.c -use warning 'substr' ; -$a = "ab" ; -$a = substr($a, 4,5) -EXPECT -substr outside of string at - line 4. -######## -# pp.c -use warning 'substr' ; -$a = "ab" ; -$b = \$a ; -substr($b, 1,1) = "ab" ; -EXPECT -Attempt to use reference as lvalue in substr at - line 5. -######## -# pp.c -use warning 'uninitialized' ; -# TODO -EXPECT - -######## -# pp.c -use warning 'unsafe' ; -my $a = { 1,2,3}; -EXPECT -Odd number of elements in hash assignment at - line 3. -######## -# pp.c -use warning 'unsafe' ; -my @a = unpack ("A,A", "22") ; -my $a = pack ("A,A", 1,2) ; -EXPECT -Invalid type in unpack: ',' at - line 3. -Invalid type in pack: ',' at - line 4. -######## -# pp.c -use warning 'uninitialized' ; -my $a = undef ; -my $b = $$a -EXPECT -Use of uninitialized value at - line 4. -######## -# pp.c -use warning 'unsafe' ; -sub foo { my $a = "a"; return $a . $a++ . $a++ } -my $a = pack("p", &foo) ; -EXPECT -Attempt to pack pointer to temporary value at - line 4. -######## -# pp.c -use warning 'unsafe' ; -bless \[], "" ; -EXPECT -Explicit blessing to '' (assuming package main) at - line 3. diff --git a/t/pragma/warn-pp_ctl b/t/pragma/warn-pp_ctl deleted file mode 100644 index e017d8a0a8..0000000000 --- a/t/pragma/warn-pp_ctl +++ /dev/null @@ -1,145 +0,0 @@ - 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 - { - goto &fred() if $a++ < 200 - } - - goto &fred() - - -__END__ -# pp_ctl.c -use warning 'syntax' ; -format STDOUT = -@<<< @<<< -1 -. -write; -EXPECT -Not enough format arguments at - line 5. -1 -######## -# pp_ctl.c -use warning 'unsafe' ; -$_ = "abc" ; - -while ($i ++ == 0) -{ - s/ab/last/e ; -} -EXPECT -Exiting substitution via last at - line 7. -######## -# pp_ctl.c -use warning 'unsafe' ; -sub fred { last } -{ fred() } -EXPECT -Exiting subroutine via last at - line 3. -######## -# pp_ctl.c -use warning 'unsafe' ; -{ eval "last" } -print STDERR $@ ; -EXPECT -Exiting eval via last at (eval 1) line 1. -######## -# pp_ctl.c -use warning 'unsafe' ; -@a = (1,2) ; -@b = sort { last } @a ; -EXPECT -Exiting pseudo-block via last at - line 4. -Can't "last" outside a block at - line 4. -######## -# pp_ctl.c -use warning 'unsafe' ; -$_ = "abc" ; -fred: -while ($i ++ == 0) -{ - s/ab/last fred/e ; -} -EXPECT -Exiting substitution via last at - line 7. -######## -# pp_ctl.c -use warning 'unsafe' ; -sub fred { last joe } -joe: { fred() } -EXPECT -Exiting subroutine via last at - line 3. -######## -# pp_ctl.c -use warning 'unsafe' ; -joe: { eval "last joe" } -print STDERR $@ ; -EXPECT -Exiting eval via last at (eval 1) line 2. -######## -# pp_ctl.c -use warning 'unsafe' ; -@a = (1,2) ; -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 warning 'recursion' ; -BEGIN { warn "PREFIX\n" ;} -sub fred -{ - goto &fred() if $a++ < 200 -} - -goto &fred() -EXPECT -Deep recursion on subroutine "main::fred" at - line 6. diff --git a/t/pragma/warn-pp_hot b/t/pragma/warn-pp_hot deleted file mode 100644 index ab180949e7..0000000000 --- a/t/pragma/warn-pp_hot +++ /dev/null @@ -1,107 +0,0 @@ - pp_hot.c AOK - - Filehandle %s never opened - $f = $a = "abc" ; print $f $a - - Filehandle %s opened only for input - print STDIN "abc" ; - - - print on closed filehandle %s - close STDIN ; print STDIN "abc" ; - - uninitialized - my $a = undef ; my @b = @$a - - uninitialized - my $a = undef ; my %b = %$a - - Odd number of elements in hash list - %X = (1,2,3) ; - - Reference found where even-sized list expected - $X = [ 1 ..3 ]; - - Read on closed filehandle <%s> - close STDIN ; $a = ; - - Deep recursion on subroutine \"%s\" - sub fred { fred() if $a++ < 200} fred() - - Deep recursion on anonymous subroutine - $a = sub { &$a if $a++ < 200} &$a - -__END__ -# pp_hot.c -use warning 'unopened' ; -$f = $a = "abc" ; -print $f $a -EXPECT -Filehandle main::abc never opened at - line 4. -######## -# pp_hot.c -use warning 'io' ; -print STDIN "anc"; -EXPECT -Filehandle main::STDIN opened only for input at - line 3. -######## -# pp_hot.c -use warning 'closed' ; -close STDIN ; -print STDIN "anc"; -EXPECT -print on closed filehandle main::STDIN at - line 4. -######## -# pp_hot.c -use warning 'uninitialized' ; -my $a = undef ; -my @b = @$a -EXPECT -Use of uninitialized value at - line 4. -######## -# pp_hot.c -use warning 'uninitialized' ; -my $a = undef ; -my %b = %$a -EXPECT -Use of uninitialized value at - line 4. -######## -# pp_hot.c -use warning 'unsafe' ; -my %X ; %X = (1,2,3) ; -EXPECT -Odd number of elements in hash assignment at - line 3. -######## -# pp_hot.c -use warning 'unsafe' ; -my %X ; %X = [1 .. 3] ; -EXPECT -Reference found where even-sized list expected at - line 3. -######## -# pp_hot.c -use warning 'closed' ; -close STDIN ; $a = ; -EXPECT -Read on closed filehandle at - line 3. -######## -# pp_hot.c -use warning 'recursion' ; -sub fred -{ - fred() if $a++ < 200 -} - -fred() -EXPECT -Deep recursion on subroutine "main::fred" at - line 5. -######## -# pp_hot.c -use warning 'recursion' ; -$b = sub -{ - &$b if $a++ < 200 -} ; - -&$b ; -EXPECT -Deep recursion on anonymous subroutine at - line 5. diff --git a/t/pragma/warn-pp_sys b/t/pragma/warn-pp_sys deleted file mode 100644 index 7588827744..0000000000 --- a/t/pragma/warn-pp_sys +++ /dev/null @@ -1,208 +0,0 @@ - pp_sys.c AOK - - untie attempted while %d inner references still exist - sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ; - - Filehandle only opened for input - format STDIN = - . - write STDIN; - - Write on closed filehandle - format STDIN = - . - close STDIN; - write STDIN ; - - page overflow - - Filehandle %s never opened - $a = "abc"; printf $a "fred" - - Filehandle %s opened only for input - $a = "abc"; - printf $a "fred" - - printf on closed filehandle %s - close STDIN ; - printf STDIN "fred" - - Syswrite on closed filehandle - close STDIN; - syswrite STDIN, "fred", 1; - - Send on closed socket - close STDIN; - send STDIN, "fred", 1 - - bind() on closed fd - close STDIN; - bind STDIN, "fred" ; - - - connect() on closed fd - close STDIN; - connect STDIN, "fred" ; - - listen() on closed fd - close STDIN; - listen STDIN, 2; - - accept() on closed fd - close STDIN; - accept STDIN, "fred" ; - - shutdown() on closed fd - close STDIN; - shutdown STDIN, 0; - - [gs]etsockopt() on closed fd - close STDIN; - setsockopt STDIN, 1,2,3; - getsockopt STDIN, 1,2; - - get{sock, peer}name() on closed fd - close STDIN; - getsockname STDIN; - getpeername STDIN; - - warn(warn_nl, "stat"); - - Test on unopened file <%s> - close STDIN ; -T STDIN ; - - warn(warn_nl, "open"); - -T "abc\ndef" ; - - - -__END__ -# pp_sys.c -use warning 'untie' ; -sub TIESCALAR { bless [] } ; -$b = tie $a, 'main'; -untie $a ; -EXPECT -untie attempted while 1 inner references still exist at - line 5. -######## -# pp_sys.c -use warning 'io' ; -format STDIN = -. -write STDIN; -EXPECT -Filehandle only opened for input at - line 5. -######## -# pp_sys.c -use warning 'closed' ; -format STDIN = -. -close STDIN; -write STDIN; -EXPECT -Write on closed filehandle at - line 6. -######## -# pp_sys.c -use warning 'io' ; -format STDOUT_TOP = -abc -. -format STDOUT = -def -ghi -. -$= = 1 ; -$- =1 ; -open STDOUT, ">/dev/null" ; -write ; -EXPECT -page overflow at - line 13. -######## -# pp_sys.c -use warning 'unopened' ; -$a = "abc"; -printf $a "fred" -EXPECT -Filehandle main::abc never opened at - line 4. -######## -# pp_sys.c -use warning 'closed' ; -close STDIN ; -printf STDIN "fred" -EXPECT -printf on closed filehandle main::STDIN at - line 4. -######## -# pp_sys.c -use warning 'io' ; -printf STDIN "fred" -EXPECT -Filehandle main::STDIN opened only for input at - line 3. -######## -# pp_sys.c -use warning 'closed' ; -close STDIN; -syswrite STDIN, "fred", 1; -EXPECT -Syswrite on closed filehandle at - line 4. -######## -# pp_sys.c -use warning 'io' ; -use Config; -BEGIN { - if ( $^O ne 'VMS' and ! $Config{d_socket}) { - print < at - line 4. -######## -# pp_sys.c -use warning 'newline' ; --T "abc\ndef" ; -EXPECT -Unsuccessful open on filename containing newline at - line 3. diff --git a/t/pragma/warn-regcomp b/t/pragma/warn-regcomp deleted file mode 100644 index 52a163a2f5..0000000000 --- a/t/pragma/warn-regcomp +++ /dev/null @@ -1,53 +0,0 @@ - regcomp.c AOK - - %.*s matches null string many times - - $a = "ABC123" ; $a =~ /(?=a)*/' - - Strange *+?{} on zero-length expression - - /(?=a)?/ - - Character class syntax [: :] is reserved for future extensions - /[a[:xyz:]b]/ - - Character class syntax [. .] is reserved for future extensions - Character class syntax [= =] is reserved for future extensions - -__END__ -# regcomp.c -use warning 'unsafe' ; -my $a = "ABC123" ; -$a =~ /(?=a)*/ ; -EXPECT -(?=a)* matches null string many times at - line 4. -######## -# regcomp.c -use warning 'unsafe' ; -$_ = "" ; -/(?=a)?/; -EXPECT -Strange *+?{} on zero-length expression at - line 4. -######## -# regcomp.c -use warning 'unsafe' ; -$_ = "" ; -/[a[:xyz:]b]/; -/[a[.xyz.]b]/; -/[a[=xyz=]b]/; -EXPECT -Character class syntax [: :] is reserved for future extensions at - line 4. -Character class syntax [. .] is reserved for future extensions at - line 5. -Character class syntax [= =] is reserved for future extensions at - line 6. -######## -# regcomp.c -use warning 'unsafe' ; -# use utf8 ; # Note this line should be uncommented when utf8 gets fixed. -$_ = "" ; -/[a[:xyz:]b]/; -/[a[.xyz.]b]/; -/[a[=xyz=]b]/; -EXPECT -Character class syntax [: :] is reserved for future extensions at - line 5. -Character class syntax [. .] is reserved for future extensions at - line 6. -Character class syntax [= =] is reserved for future extensions at - line 7. diff --git a/t/pragma/warn-regexec b/t/pragma/warn-regexec deleted file mode 100644 index 158a7538ae..0000000000 --- a/t/pragma/warn-regexec +++ /dev/null @@ -1,57 +0,0 @@ - regexec.c - - count exceeded %d - - $_ = 'a' x (2**15+1); /^()(a\1)*$/ ; - count exceeded %d - - $_ = 'a' x (2**15+1); /^()(a\1)*?$/ ; - -__END__ -# regexec.c -use warning 'unsafe' ; -print("SKIPPED\n# win32 can't increase stacksize in shell\n"),exit - if $^O eq 'MSWin32'; -$_ = '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 (32766) exceeded at - line 6. -######## -# regexec.c -use warning 'unsafe' ; -print("SKIPPED\n# win32 can't increase stacksize in shell\n"),exit - if $^O eq 'MSWin32'; -$_ = '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 (32766) exceeded at - line 6. diff --git a/t/pragma/warn-sv b/t/pragma/warn-sv deleted file mode 100644 index 0f1d83c2e5..0000000000 --- a/t/pragma/warn-sv +++ /dev/null @@ -1,203 +0,0 @@ - sv.c AOK - - 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 - - -__END__ -# sv.c -use integer ; -use warning 'uninitialized' ; -$x = 1 + $a[0] ; # a -EXPECT -Use of uninitialized value 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 warning 'uninitialized' ; -$A *= 2 ; -EXPECT -Use of uninitialized value at - line 10. -######## -# sv.c -use integer ; -use warning 'uninitialized' ; -my $x *= 2 ; #b -EXPECT -Use of uninitialized value 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 warning 'uninitialized' ; -$B = 0 ; -$B |= $A ; -EXPECT -Use of uninitialized value at - line 10. -######## -# sv.c -use warning 'uninitialized' ; -my $Y = 1 ; -my $x = 1 | $a[$Y] -EXPECT -Use of uninitialized value at - line 4. -######## -# sv.c -use warning 'uninitialized' ; -my $x *= 1 ; # d -EXPECT -Use of uninitialized value at - line 3. -######## -# sv.c -use warning 'uninitialized' ; -$x = 1 + $a[0] ; # e -EXPECT -Use of uninitialized value 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 warning 'uninitialized' ; -$A *= 2 ; -EXPECT -Use of uninitialized value at - line 9. -######## -# sv.c -use warning 'uninitialized' ; -$x = $y + 1 ; # f -EXPECT -Use of uninitialized value at - line 3. -######## -# sv.c -use warning 'uninitialized' ; -$x = chop undef ; # g -EXPECT -Use of uninitialized value at - line 3. -######## -# sv.c -use warning 'uninitialized' ; -$x = chop $y ; # h -EXPECT -Use of uninitialized value 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 warning 'uninitialized' ; -$B = "" ; -$B .= $A ; -EXPECT -Use of uninitialized value at - line 10. -######## -# sv.c -use warning 'numeric' ; -sub TIESCALAR{bless[]} ; -sub FETCH {"def"} ; -tie $a,"main" ; -my $b = 1 + $a -EXPECT -Argument "def" isn't numeric in add at - line 6. -######## -# sv.c -use warning 'numeric' ; -my $x = 1 + "def" ; -EXPECT -Argument "def" isn't numeric in add at - line 3. -######## -# sv.c -use warning 'numeric' ; -my $a = "def" ; -my $x = 1 + $a ; -EXPECT -Argument "def" isn't numeric in add at - line 4. -######## -# sv.c -use warning 'numeric' ; use integer ; -my $a = "def" ; -my $x = 1 + $a ; -EXPECT -Argument "def" isn't numeric in i_add at - line 4. -######## -# sv.c -use warning 'numeric' ; -my $x = 1 & "def" ; -EXPECT -Argument "def" isn't numeric in bit_and at - line 3. -######## -# sv.c -use warning 'redefine' ; -sub fred {} -sub joe {} -*fred = \&joe ; -EXPECT -Subroutine fred redefined at - line 5. -######## -# sv.c -use warning 'printf' ; -open F, ">/dev/null" ; -printf F "%q\n" ; -my $a = sprintf "%q" ; -printf F "%" ; -$a = sprintf "%" ; -printf F "%\x02" ; -$a = sprintf "%\x02" ; -EXPECT -Invalid conversion in sprintf: "%q" at - line 5. -Invalid conversion in sprintf: end of string at - line 7. -Invalid conversion in sprintf: "%\002" at - line 9. -Invalid conversion in printf: "%q" at - line 4. -Invalid conversion in printf: end of string at - line 6. -Invalid conversion in printf: "%\002" at - line 8. -######## -# sv.c -use warning 'unsafe' ; -*a = undef ; -EXPECT -Undefined value assigned to typeglob at - line 3. diff --git a/t/pragma/warn-taint b/t/pragma/warn-taint deleted file mode 100644 index 40fadd0913..0000000000 --- a/t/pragma/warn-taint +++ /dev/null @@ -1,25 +0,0 @@ - taint.c TODO - - Insecure %s%s while running setuid - Insecure %s%s while running setgid - Insecure %s%s while running with -T switch - - - Insecure directory in %s%s while running setuid - Insecure directory in %s%s while running setgid - Insecure directory in %s%s while running with -T switch - - - -__END__ -# taint.c -use warning 'misc' ; - -EXPECT - -######## -# taint.c -use warning 'misc' ; - -EXPECT - diff --git a/t/pragma/warn-toke b/t/pragma/warn-toke deleted file mode 100644 index 6cc4a500a4..0000000000 --- a/t/pragma/warn-toke +++ /dev/null @@ -1,315 +0,0 @@ -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 warning '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() - - Use of \\x{} without utf8 declaration - $_ = " \x{123} " ; - - - \x%.*s will produce malformed UTF-8 character; use \x{%.*s} for that - use utf8 ; - $_ = "\xffe" - -__END__ -# toke.c -use warning 'deprecated' ; -1 if $a EQ $b ; -1 if $a NE $b ; -1 if $a GT $b ; -1 if $a LT $b ; -1 if $a GE $b ; -1 if $a LE $b ; -EXPECT -Use of EQ is deprecated at - line 3. -Use of NE is deprecated at - line 4. -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 warning 'deprecated' ; -format STDOUT = -@<<< @||| @>>> @>>> -$a $b "abc" 'def' -. -($a, $b) = (1,2,3); -write; -EXPECT -Use of comma-less variable list is deprecated at - line 5. -Use of comma-less variable list is deprecated at - line 5. -Use of comma-less variable list is deprecated at - line 5. -1 2 abc def -######## -# toke.c -use warning 'deprecated' ; -$a = <<; - -EXPECT -Use of bare << to mean <<"" is deprecated at - line 3. -######## -# toke.c -use warning 'syntax' ; -s/(abc)/\1/; -EXPECT -\1 better written as $1 at - line 3. -######## -# toke.c -use warning '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 warning '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 -use warning 'syntax' ; -my $a = $a[1,2] ; -EXPECT -Multidimensional syntax $a[1,2] not supported at - line 3. -######## -# toke.c -use warning 'syntax' ; -sub fred {} ; $SIG{TERM} = fred; -EXPECT -You need to quote "fred" at - line 3. -######## -# toke.c -use warning 'syntax' ; -@a[3] = 2; -@a{3} = 2; -EXPECT -Scalar value @a[3] better written as $a[3] at - line 3. -Scalar value @a{3} better written as $a{3} at - line 4. -######## -# toke.c -use warning 'syntax' ; -$_ = "ab" ; -s/(ab)/\1/e; -EXPECT -Can't use \1 to mean $1 in expression at - line 4. -######## -# toke.c -use warning 'reserved' ; -$a = abc; -EXPECT -Unquoted string "abc" may clash with future reserved word at - line 3. -######## -# toke.c -use warning 'octal' ; -chmod 3; -EXPECT -chmod: mode argument is missing initial 0 at - line 3, at end of line -######## -# toke.c -use warning 'syntax' ; -@a = qw(a, b, c) ; -EXPECT -Possible attempt to separate words with commas at - line 3. -######## -# toke.c -use warning 'syntax' ; -@a = qw(a b #) ; -EXPECT -Possible attempt to put comments in qw() list at - line 3. -######## -# toke.c -use warning 'octal' ; -umask 3; -EXPECT -umask: argument is missing initial 0 at - line 3, at end of line -######## -# toke.c -use warning 'syntax' ; -print ("") -EXPECT -print (...) interpreted as function at - line 3. -######## -# toke.c -use warning 'syntax' ; -printf ("") -EXPECT -printf (...) interpreted as function at - line 3. -######## -# toke.c -use warning 'syntax' ; -sort ("") -EXPECT -sort (...) interpreted as function at - line 3. -######## -# toke.c -use warning 'ambiguous' ; -$a = ${time[2]}; -EXPECT -Ambiguous use of ${time[...]} resolved to $time[...] at - line 3. -######## -# toke.c -use warning 'ambiguous' ; -$a = ${time{2}}; -EXPECT -Ambiguous use of ${time{...}} resolved to $time{...} at - line 3. -######## -# toke.c -use warning 'ambiguous' ; -$a = ${time} ; -EXPECT -Ambiguous use of ${time} resolved to $time at - line 3. -######## -# toke.c -use warning 'ambiguous' ; -sub fred {} -$a = ${fred} ; -EXPECT -Ambiguous use of ${fred} resolved to $fred at - line 4. -######## -# toke.c -use warning '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 warning 'unsafe' ; -$a = FRED:: ; -EXPECT -Bareword "FRED::" refers to nonexistent package at - line 3. -######## -# toke.c -use warning 'ambiguous' ; -sub time {} -my $a = time() -EXPECT -Ambiguous call resolved as CORE::time(), qualify as such or use & at - line 4. -######## -# toke.c -use warning 'utf8' ; -$_ = " \x{123} " ; -EXPECT -Use of \x{} without utf8 declaration at - line 3. -######## -# toke.c -use warning 'utf8' ; -use utf8 ; -$_ = " \xffe " ; -EXPECT -\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 4. diff --git a/t/pragma/warn-universal b/t/pragma/warn-universal deleted file mode 100644 index e2814e11c4..0000000000 --- a/t/pragma/warn-universal +++ /dev/null @@ -1,11 +0,0 @@ - universal.c - - Can't locate package %s for @%s::ISA - - -__END__ -# universal.c -use warning 'misc' ; - -EXPECT - diff --git a/t/pragma/warn-util b/t/pragma/warn-util deleted file mode 100644 index 649a2929ce..0000000000 --- a/t/pragma/warn-util +++ /dev/null @@ -1,21 +0,0 @@ - util.c AOK - - Illegal octal digit ignored - my $a = oct "029" ; - - Illegal hex digit ignored - my $a = hex "0xv9" ; - - -__END__ -# util.c -use warning 'octal' ; -my $a = oct "029" ; -EXPECT -Illegal octal digit ignored at - line 3. -######## -# util.c -use warning 'unsafe' ; -*a = hex "0xv9" ; -EXPECT -Illegal hex digit ignored at - line 3. diff --git a/t/pragma/warn/1global b/t/pragma/warn/1global new file mode 100644 index 0000000000..dca47e92ce --- /dev/null +++ b/t/pragma/warn/1global @@ -0,0 +1,186 @@ +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. +######## +#! perl -w +# warnable code, warnings enabled via #! line +$a =+ 3 ; +EXPECT +Reversed += operator at - line 3. +######## + +# warnable code, warnings enabled via compile time $^W +BEGIN { $^W = 1 } +$a =+ 3 ; +EXPECT +Reversed += operator 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 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 at - line 5. +######## +-w +--FILE-- abcd +my $b ; chop $b ; +1 ; +--FILE-- +require "./abcd"; +EXPECT +Use of uninitialized value at ./abcd line 1. +######## + +--FILE-- abcd +my $b ; chop $b ; +1 ; +--FILE-- +#! perl -w +require "./abcd"; +EXPECT +Use of uninitialized value at ./abcd line 1. +######## + +--FILE-- abcd +my $b ; chop $b ; +1 ; +--FILE-- +$^W =1 ; +require "./abcd"; +EXPECT +Use of uninitialized value 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 at - line 3. +######## + +$^W = 1; +eval 'my $b ; chop $b ;' ; +print $@ ; +EXPECT +Use of uninitialized value at (eval 1) line 1. +######## + +eval '$^W = 1;' ; +print $@ ; +my $b ; chop $b ; +EXPECT +Use of uninitialized value at - line 4. +######## + +eval {$^W = 1;} ; +print $@ ; +my $b ; chop $b ; +EXPECT +Use of uninitialized value 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 at - line 5. +######## +-w +-e undef +EXPECT +Use of uninitialized value 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 at - line 2. diff --git a/t/pragma/warn/2use b/t/pragma/warn/2use new file mode 100644 index 0000000000..764a843192 --- /dev/null +++ b/t/pragma/warn/2use @@ -0,0 +1,291 @@ +Check lexical warning functionality + +TODO + check that the warning hierarchy works. + +__END__ + +# check illegal category is caught +use warning 'blah' ; +EXPECT +unknown warning category 'blah' at - line 3 +BEGIN failed--compilation aborted at - line 3. +######## + +# Check compile time scope of pragma +use warning 'deprecated' ; +{ + no warning ; + 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 warning; +{ + use warning '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 warning 'uninitialized' ; +{ + no warning ; + my $b ; chop $b ; +} +my $b ; chop $b ; +EXPECT +Use of uninitialized value at - line 8. +######## + +# Check runtime scope of pragma +no warning ; +{ + use warning 'uninitialized' ; + my $b ; chop $b ; +} +my $b ; chop $b ; +EXPECT +Use of uninitialized value at - line 6. +######## + +# Check runtime scope of pragma +no warning ; +{ + use warning 'uninitialized' ; + $a = sub { my $b ; chop $b ; } +} +&$a ; +EXPECT +Use of uninitialized value at - line 6. +######## + +use warning '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 warning 'deprecated' ; +require "./abc"; +EXPECT + +######## + +--FILE-- abc +use warning 'deprecated' ; +1; +--FILE-- +require "./abc"; +1 if $a EQ $b ; +EXPECT + +######## + +--FILE-- abc +use warning 'deprecated' ; +1 if $a EQ $b ; +1; +--FILE-- +use warning 'uninitialized' ; +require "./abc"; +my $a ; chop $a ; +EXPECT +Use of EQ is deprecated at ./abc line 2. +Use of uninitialized value at - line 3. +######## + +--FILE-- abc.pm +use warning 'deprecated' ; +1 if $a EQ $b ; +1; +--FILE-- +use warning 'uninitialized' ; +use abc; +my $a ; chop $a ; +EXPECT +Use of EQ is deprecated at abc.pm line 2. +Use of uninitialized value at - line 3. +######## + +# Check scope of pragma with eval +no warning ; +eval { + my $b ; chop $b ; +}; print STDERR $@ ; +my $b ; chop $b ; +EXPECT + +######## + +# Check scope of pragma with eval +no warning ; +eval { + use warning 'uninitialized' ; + my $b ; chop $b ; +}; print STDERR $@ ; +my $b ; chop $b ; +EXPECT +Use of uninitialized value at - line 6. +######## + +# Check scope of pragma with eval +use warning 'uninitialized' ; +eval { + my $b ; chop $b ; +}; print STDERR $@ ; +my $b ; chop $b ; +EXPECT +Use of uninitialized value at - line 5. +Use of uninitialized value at - line 7. +######## + +# Check scope of pragma with eval +use warning 'uninitialized' ; +eval { + no warning ; + my $b ; chop $b ; +}; print STDERR $@ ; +my $b ; chop $b ; +EXPECT +Use of uninitialized value at - line 8. +######## + +# Check scope of pragma with eval +no warning ; +eval { + 1 if $a EQ $b ; +}; print STDERR $@ ; +1 if $a EQ $b ; +EXPECT + +######## + +# Check scope of pragma with eval +no warning ; +eval { + use warning '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 warning '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 warning 'deprecated' ; +eval { + no warning ; + 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 warning ; +eval ' + my $b ; chop $b ; +'; print STDERR $@ ; +my $b ; chop $b ; +EXPECT + +######## + +# Check scope of pragma with eval +no warning ; +eval q[ + use warning 'uninitialized' ; + my $b ; chop $b ; +]; print STDERR $@; +my $b ; chop $b ; +EXPECT +Use of uninitialized value at (eval 1) line 3. +######## + +# Check scope of pragma with eval +use warning 'uninitialized' ; +eval ' + my $b ; chop $b ; +'; print STDERR $@ ; +my $b ; chop $b ; +EXPECT +Use of uninitialized value at (eval 1) line 2. +Use of uninitialized value at - line 7. +######## + +# Check scope of pragma with eval +use warning 'uninitialized' ; +eval ' + no warning ; + my $b ; chop $b ; +'; print STDERR $@ ; +my $b ; chop $b ; +EXPECT +Use of uninitialized value at - line 8. +######## + +# Check scope of pragma with eval +no warning ; +eval ' + 1 if $a EQ $b ; +'; print STDERR $@ ; +1 if $a EQ $b ; +EXPECT + +######## + +# Check scope of pragma with eval +no warning ; +eval q[ + use warning '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 warning '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 warning 'deprecated' ; +eval ' + no warning ; + 1 if $a EQ $b ; +'; print STDERR $@; +1 if $a EQ $b ; +EXPECT +Use of EQ is deprecated at - line 8. diff --git a/t/pragma/warn/3both b/t/pragma/warn/3both new file mode 100644 index 0000000000..7c3260126b --- /dev/null +++ b/t/pragma/warn/3both @@ -0,0 +1,66 @@ +Check interaction of $^W and lexical + +__END__ + +# Check interaction of $^W and use warning +sub fred { + use warning ; + my $b ; + chop $b ; +} +{ local $^W = 0 ; + fred() ; +} + +EXPECT +Use of uninitialized value at - line 6. +######## + +# Check interaction of $^W and use warning +sub fred { + no warning ; + my $b ; + chop $b ; +} +{ local $^W = 1 ; + fred() ; +} + +EXPECT +Use of uninitialized value at - line 6. +######## + +# Check interaction of $^W and use warning +use warning ; +$^W = 1 ; +my $b ; +chop $b ; +EXPECT +Use of uninitialized value at - line 6. +######## + +# Check interaction of $^W and use warning +$^W = 1 ; +use warning ; +my $b ; +chop $b ; +EXPECT +Use of uninitialized value at - line 6. +######## + +# Check interaction of $^W and use warning +$^W = 1 ; +no warning ; +my $b ; +chop $b ; +EXPECT +Use of uninitialized value at - line 6. +######## + +# Check interaction of $^W and use warning +no warning ; +$^W = 1 ; +my $b ; +chop $b ; +EXPECT +Use of uninitialized value at - line 6. diff --git a/t/pragma/warn/4lint b/t/pragma/warn/4lint new file mode 100644 index 0000000000..87cd7dc967 --- /dev/null +++ b/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 warning" is zapped +no warning ; +$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 warning" is zapped +{ + no warning ; + 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 warning 'deprecated' ; +my ($a, $b) = (0,0); +1 if $a EQ $b ; +1; +--FILE-- +no warning 'uninitialized' ; +use abc; +my $a ; chop $a ; +EXPECT +Use of EQ is deprecated at abc.pm line 3. +Use of uninitialized value at - line 3. +######## +-W +--FILE-- abc +no warning 'deprecated' ; +my ($a, $b) = (0,0); +1 if $a EQ $b ; +1; +--FILE-- +no warning 'uninitialized' ; +require "./abc"; +my $a ; chop $a ; +EXPECT +Use of EQ is deprecated at ./abc line 3. +Use of uninitialized value 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 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 at - line 3. diff --git a/t/pragma/warn/5nolint b/t/pragma/warn/5nolint new file mode 100644 index 0000000000..979423e87e --- /dev/null +++ b/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 warning" is zapped +use warning ; +$a = $b = 1 ; +$a = 1 if $a EQ $b ; +close STDIN ; print STDIN "abc" ; +EXPECT +######## +-X +# nolint: check "no warning" is zapped +{ + use warning ; + 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 warning 'deprecated' ; +my ($a, $b) = (0,0); +1 if $a EQ $b ; +1; +--FILE-- +use warning 'uninitialized' ; +use abc; +my $a ; chop $a ; +EXPECT +######## +-X +--FILE-- abc +use warning 'deprecated' ; +my ($a, $b) = (0,0); +1 if $a EQ $b ; +1; +--FILE-- +use warning '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/t/pragma/warn/doio b/t/pragma/warn/doio new file mode 100644 index 0000000000..af14f42272 --- /dev/null +++ b/t/pragma/warn/doio @@ -0,0 +1,94 @@ + doio.c AOK + + Can't do bidirectional pipe + open(F, "| true |"); + + warn(warn_nl, "open"); + open(F, "true\ncd") + + Close on unopened file <%s> + $a = "fred";close($a) + + tell() on unopened file + $a = "fred";$a = tell($a) + + seek() on unopened file + $a = "fred";$a = seek($a,1,1) + + sysseek() on unopened file + $a = "fred";$a = seek($a,1,1) + + warn(warn_uninit); + print $a ; + + Stat on unopened file <%s> + close STDIN ; -x STDIN ; + + warn(warn_nl, "stat"); + stat "ab\ncd" + + warn(warn_nl, "lstat"); + lstat "ab\ncd" + + Can't exec \"%s\": %s + + Can't exec \"%s\": %s + + +__END__ +# doio.c +use warning 'io' ; +open(F, "|$^X -e 1|") +EXPECT +Can't do bidirectional pipe at - line 3. +######## +# doio.c +use warning 'io' ; +open(F, " at - line 7. +######## +# doio.c +use warning 'uninitialized' ; +print $a ; +EXPECT +Use of uninitialized value at - line 3. +######## +# doio.c +use warning 'io' ; + +EXPECT + +######## +# doio.c +use warning 'io' ; +stat "ab\ncd"; +lstat "ab\ncd"; +EXPECT +Unsuccessful stat on filename containing newline at - line 3. +Unsuccessful stat on filename containing newline at - line 4. +######## +# doio.c +use warning 'io' ; +exec "lskdjfalksdjfdjfkls","" ; +EXPECT +Can't exec "lskdjfalksdjfdjfkls": No such file or directory at - line 3. +######## +# doio.c +use warning 'io' ; +exec "lskdjfalksdjfdjfkls", "abc" ; +EXPECT +Can't exec "lskdjfalksdjfdjfkls": No such file or directory at - line 3. diff --git a/t/pragma/warn/gv b/t/pragma/warn/gv new file mode 100644 index 0000000000..bd442b97d6 --- /dev/null +++ b/t/pragma/warn/gv @@ -0,0 +1,40 @@ + 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 = ${"*"} ; + + +__END__ +# gv.c +use warning '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 +sub Other::AUTOLOAD { 1 } sub Other::fred {} +@ISA = qw(Other) ; +use warning 'deprecated' ; +fred() ; +EXPECT +Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5. +######## +# gv.c +use warning 'deprecated' ; +$a = ${"#"}; +$a = ${"*"}; +EXPECT +Use of $# is deprecated at - line 3. +Use of $* is deprecated at - line 4. diff --git a/t/pragma/warn/mg b/t/pragma/warn/mg new file mode 100644 index 0000000000..44e7634952 --- /dev/null +++ b/t/pragma/warn/mg @@ -0,0 +1,25 @@ + mg.c AOK + + No such signal: SIG%s + $SIG{FRED} = sub {} + + SIG%s handler \"%s\" not defined. + $SIG{"INT"} = "ok3"; kill "INT",$$; + + +__END__ +# mg.c +use warning 'signal' ; +$SIG{FRED} = sub {}; +EXPECT +No such signal: SIGFRED at - line 3. +######## +# mg.c +use warning 'signal' ; +if ($^O eq 'MSWin32') { + print "SKIPPED\n# win32, can't kill() to raise()\n"; exit; +} +$|=1; +$SIG{"INT"} = "fred"; kill "INT",$$; +EXPECT +SIGINT handler "fred" not defined. diff --git a/t/pragma/warn/op b/t/pragma/warn/op new file mode 100644 index 0000000000..d0886edf58 --- /dev/null +++ b/t/pragma/warn/op @@ -0,0 +1,539 @@ + 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/ ; + + + Parens missing around "my" list at -e line 1. + my $a, $b = (1,2); + + Parens missing around "local" list at -e line 1. + local $a, $b = (1,2); + + Probable precedence problem on logical or at -e line 1. + use warning 'syntax'; my $x = print(ABC || 1); + + Value of %s may be \"0\"; use \"defined\" + $x = 1 if $x = ; + $x = 1 while $x = ; + + 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 + + +__END__ +# op.c +use warning 'unsafe' ; +my $x ; +my $x ; +EXPECT +"my" variable $x masks earlier declaration in same scope at - line 4. +######## +# op.c +use warning 'unsafe' ; +sub x { + my $x; + sub y { + $x + } + } +EXPECT +Variable "$x" will not stay shared at - line 7. +######## +# op.c +use warning 'unsafe' ; +sub x { + my $x; + sub y { + sub { $x } + } + } +EXPECT +Variable "$x" may be unavailable at - line 6. +######## +# op.c +use warning 'syntax' ; +1 if $a = 1 ; +EXPECT +Found = in conditional, should be == at - line 3. +######## +# op.c +use warning 'deprecated' ; +split ; +EXPECT +Use of implicit split to @_ is deprecated at - line 3. +######## +# op.c +use warning 'deprecated' ; +$a = split ; +EXPECT +Use of implicit split to @_ is deprecated at - line 3. +######## +# op.c +use warning 'void' ; close STDIN ; +1 x 3 ; # OP_REPEAT + # OP_GVSV +wantarray ; # OP_WANTARRAY + # OP_GV + # OP_PADSV + # OP_PADAV + # OP_PADHV + # OP_PADANY + # OP_AV2ARYLEN +ref ; # OP_REF +\@a ; # OP_REFGEN +\$a ; # OP_SREFGEN +defined $a ; # OP_DEFINED +hex $a ; # OP_HEX +oct $a ; # OP_OCT +length $a ; # OP_LENGTH +substr $a,1 ; # OP_SUBSTR +vec $a,1,2 ; # OP_VEC +index $a,1,2 ; # OP_INDEX +rindex $a,1,2 ; # OP_RINDEX +sprintf $a ; # OP_SPRINTF +$a[0] ; # OP_AELEM + # OP_AELEMFAST +@a[0] ; # OP_ASLICE +#values %a ; # OP_VALUES +#keys %a ; # OP_KEYS +$a{0} ; # OP_HELEM +@a{0} ; # OP_HSLICE +unpack "a", "a" ; # OP_UNPACK +pack $a,"" ; # OP_PACK +join "" ; # OP_JOIN +(@a)[0,1] ; # OP_LSLICE + # OP_ANONLIST + # OP_ANONHASH +sort(1,2) ; # OP_SORT +reverse(1,2) ; # OP_REVERSE + # OP_RANGE + # OP_FLIP +(1 ..2) ; # OP_FLOP +caller ; # OP_CALLER +fileno STDIN ; # OP_FILENO +eof STDIN ; # OP_EOF +tell STDIN ; # OP_TELL +readlink 1; # OP_READLINK +time ; # OP_TIME +localtime ; # OP_LOCALTIME +gmtime ; # OP_GMTIME +eval { getgrnam 1 }; # OP_GGRNAM +eval { getgrgid 1 }; # OP_GGRGID +eval { getpwnam 1 }; # OP_GPWNAM +eval { getpwuid 1 }; # OP_GPWUID +EXPECT +Useless use of repeat 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 scalar 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 elem 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 +use warning 'void' ; +use Config ; +BEGIN { + if ( ! $Config{d_telldir}) { + print < ; +EXPECT +Value of construct can be "0"; test with defined() at - line 4. +######## +# op.c +use warning 'unsafe' ; +opendir FH, "." ; +$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 warning 'unsafe' ; +$x = 1 if $x = <*> ; +EXPECT +Value of glob construct can be "0"; test with defined() at - line 3. +######## +# op.c +use warning 'unsafe' ; +%a = (1,2,3,4) ; +$x = 1 if $x = each %a ; +EXPECT +Value of each() operator can be "0"; test with defined() at - line 4. +######## +# op.c +use warning 'unsafe' ; +$x = 1 while $x = <*> and 0 ; +EXPECT +Value of glob construct can be "0"; test with defined() at - line 3. +######## +# op.c +use warning 'unsafe' ; +opendir FH, "." ; +$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 warning 'redefine' ; +sub fred {} +sub fred {} +EXPECT +Subroutine fred redefined at - line 4. +######## +# op.c +use warning 'redefine' ; +sub fred () { 1 } +sub fred () { 1 } +EXPECT +Constant subroutine fred redefined at - line 4. +######## +# op.c +use warning 'redefine' ; +format FRED = +. +format FRED = +. +EXPECT +Format FRED redefined at - line 5. +######## +# op.c +use warning 'syntax' ; +push FRED; +EXPECT +Array @FRED missing the @ in argument 1 of push() at - line 3. +######## +# op.c +use warning 'syntax' ; +@a = keys FRED ; +EXPECT +Hash %FRED missing the % in argument 1 of keys() at - line 3. +######## +# op.c +use warning 'syntax' ; +exec "$^X -e 1" ; +my $a +EXPECT +Statement unlikely to be reached at - line 4. +(Maybe you meant system() when you said exec()?) diff --git a/t/pragma/warn/perl b/t/pragma/warn/perl new file mode 100644 index 0000000000..5211990902 --- /dev/null +++ b/t/pragma/warn/perl @@ -0,0 +1,12 @@ + perl.c AOK + + gv_check(defstash) + Name \"%s::%s\" used only once: possible typo + + +__END__ +# perl.c +use warning 'once' ; +$x = 3 ; +EXPECT +Name "main::x" used only once: possible typo at - line 3. diff --git a/t/pragma/warn/perly b/t/pragma/warn/perly new file mode 100644 index 0000000000..fd420d3b22 --- /dev/null +++ b/t/pragma/warn/perly @@ -0,0 +1,25 @@ + 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 warning 'deprecated' ; +sub fred {} +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/t/pragma/warn/pp b/t/pragma/warn/pp new file mode 100644 index 0000000000..7a3b28991c --- /dev/null +++ b/t/pragma/warn/pp @@ -0,0 +1,85 @@ + pp.c TODO + + substr outside of string + $a = "ab" ; $a = 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 <<< + Constant subroutine (anonymous) undefined <<< + +__END__ +# pp.c +use warning 'substr' ; +$a = "ab" ; +$a = substr($a, 4,5) +EXPECT +substr outside of string at - line 4. +######## +# pp.c +use warning 'substr' ; +$a = "ab" ; +$b = \$a ; +substr($b, 1,1) = "ab" ; +EXPECT +Attempt to use reference as lvalue in substr at - line 5. +######## +# pp.c +use warning 'uninitialized' ; +# TODO +EXPECT + +######## +# pp.c +use warning 'unsafe' ; +my $a = { 1,2,3}; +EXPECT +Odd number of elements in hash assignment at - line 3. +######## +# pp.c +use warning 'unsafe' ; +my @a = unpack ("A,A", "22") ; +my $a = pack ("A,A", 1,2) ; +EXPECT +Invalid type in unpack: ',' at - line 3. +Invalid type in pack: ',' at - line 4. +######## +# pp.c +use warning 'uninitialized' ; +my $a = undef ; +my $b = $$a +EXPECT +Use of uninitialized value at - line 4. +######## +# pp.c +use warning 'unsafe' ; +sub foo { my $a = "a"; return $a . $a++ . $a++ } +my $a = pack("p", &foo) ; +EXPECT +Attempt to pack pointer to temporary value at - line 4. +######## +# pp.c +use warning 'unsafe' ; +bless \[], "" ; +EXPECT +Explicit blessing to '' (assuming package main) at - line 3. diff --git a/t/pragma/warn/pp_ctl b/t/pragma/warn/pp_ctl new file mode 100644 index 0000000000..e017d8a0a8 --- /dev/null +++ b/t/pragma/warn/pp_ctl @@ -0,0 +1,145 @@ + 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 + { + goto &fred() if $a++ < 200 + } + + goto &fred() + + +__END__ +# pp_ctl.c +use warning 'syntax' ; +format STDOUT = +@<<< @<<< +1 +. +write; +EXPECT +Not enough format arguments at - line 5. +1 +######## +# pp_ctl.c +use warning 'unsafe' ; +$_ = "abc" ; + +while ($i ++ == 0) +{ + s/ab/last/e ; +} +EXPECT +Exiting substitution via last at - line 7. +######## +# pp_ctl.c +use warning 'unsafe' ; +sub fred { last } +{ fred() } +EXPECT +Exiting subroutine via last at - line 3. +######## +# pp_ctl.c +use warning 'unsafe' ; +{ eval "last" } +print STDERR $@ ; +EXPECT +Exiting eval via last at (eval 1) line 1. +######## +# pp_ctl.c +use warning 'unsafe' ; +@a = (1,2) ; +@b = sort { last } @a ; +EXPECT +Exiting pseudo-block via last at - line 4. +Can't "last" outside a block at - line 4. +######## +# pp_ctl.c +use warning 'unsafe' ; +$_ = "abc" ; +fred: +while ($i ++ == 0) +{ + s/ab/last fred/e ; +} +EXPECT +Exiting substitution via last at - line 7. +######## +# pp_ctl.c +use warning 'unsafe' ; +sub fred { last joe } +joe: { fred() } +EXPECT +Exiting subroutine via last at - line 3. +######## +# pp_ctl.c +use warning 'unsafe' ; +joe: { eval "last joe" } +print STDERR $@ ; +EXPECT +Exiting eval via last at (eval 1) line 2. +######## +# pp_ctl.c +use warning 'unsafe' ; +@a = (1,2) ; +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 warning 'recursion' ; +BEGIN { warn "PREFIX\n" ;} +sub fred +{ + goto &fred() if $a++ < 200 +} + +goto &fred() +EXPECT +Deep recursion on subroutine "main::fred" at - line 6. diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot new file mode 100644 index 0000000000..ab180949e7 --- /dev/null +++ b/t/pragma/warn/pp_hot @@ -0,0 +1,107 @@ + pp_hot.c AOK + + Filehandle %s never opened + $f = $a = "abc" ; print $f $a + + Filehandle %s opened only for input + print STDIN "abc" ; + + + print on closed filehandle %s + close STDIN ; print STDIN "abc" ; + + uninitialized + my $a = undef ; my @b = @$a + + uninitialized + my $a = undef ; my %b = %$a + + Odd number of elements in hash list + %X = (1,2,3) ; + + Reference found where even-sized list expected + $X = [ 1 ..3 ]; + + Read on closed filehandle <%s> + close STDIN ; $a = ; + + Deep recursion on subroutine \"%s\" + sub fred { fred() if $a++ < 200} fred() + + Deep recursion on anonymous subroutine + $a = sub { &$a if $a++ < 200} &$a + +__END__ +# pp_hot.c +use warning 'unopened' ; +$f = $a = "abc" ; +print $f $a +EXPECT +Filehandle main::abc never opened at - line 4. +######## +# pp_hot.c +use warning 'io' ; +print STDIN "anc"; +EXPECT +Filehandle main::STDIN opened only for input at - line 3. +######## +# pp_hot.c +use warning 'closed' ; +close STDIN ; +print STDIN "anc"; +EXPECT +print on closed filehandle main::STDIN at - line 4. +######## +# pp_hot.c +use warning 'uninitialized' ; +my $a = undef ; +my @b = @$a +EXPECT +Use of uninitialized value at - line 4. +######## +# pp_hot.c +use warning 'uninitialized' ; +my $a = undef ; +my %b = %$a +EXPECT +Use of uninitialized value at - line 4. +######## +# pp_hot.c +use warning 'unsafe' ; +my %X ; %X = (1,2,3) ; +EXPECT +Odd number of elements in hash assignment at - line 3. +######## +# pp_hot.c +use warning 'unsafe' ; +my %X ; %X = [1 .. 3] ; +EXPECT +Reference found where even-sized list expected at - line 3. +######## +# pp_hot.c +use warning 'closed' ; +close STDIN ; $a = ; +EXPECT +Read on closed filehandle at - line 3. +######## +# pp_hot.c +use warning 'recursion' ; +sub fred +{ + fred() if $a++ < 200 +} + +fred() +EXPECT +Deep recursion on subroutine "main::fred" at - line 5. +######## +# pp_hot.c +use warning 'recursion' ; +$b = sub +{ + &$b if $a++ < 200 +} ; + +&$b ; +EXPECT +Deep recursion on anonymous subroutine at - line 5. diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys new file mode 100644 index 0000000000..7588827744 --- /dev/null +++ b/t/pragma/warn/pp_sys @@ -0,0 +1,208 @@ + pp_sys.c AOK + + untie attempted while %d inner references still exist + sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ; + + Filehandle only opened for input + format STDIN = + . + write STDIN; + + Write on closed filehandle + format STDIN = + . + close STDIN; + write STDIN ; + + page overflow + + Filehandle %s never opened + $a = "abc"; printf $a "fred" + + Filehandle %s opened only for input + $a = "abc"; + printf $a "fred" + + printf on closed filehandle %s + close STDIN ; + printf STDIN "fred" + + Syswrite on closed filehandle + close STDIN; + syswrite STDIN, "fred", 1; + + Send on closed socket + close STDIN; + send STDIN, "fred", 1 + + bind() on closed fd + close STDIN; + bind STDIN, "fred" ; + + + connect() on closed fd + close STDIN; + connect STDIN, "fred" ; + + listen() on closed fd + close STDIN; + listen STDIN, 2; + + accept() on closed fd + close STDIN; + accept STDIN, "fred" ; + + shutdown() on closed fd + close STDIN; + shutdown STDIN, 0; + + [gs]etsockopt() on closed fd + close STDIN; + setsockopt STDIN, 1,2,3; + getsockopt STDIN, 1,2; + + get{sock, peer}name() on closed fd + close STDIN; + getsockname STDIN; + getpeername STDIN; + + warn(warn_nl, "stat"); + + Test on unopened file <%s> + close STDIN ; -T STDIN ; + + warn(warn_nl, "open"); + -T "abc\ndef" ; + + + +__END__ +# pp_sys.c +use warning 'untie' ; +sub TIESCALAR { bless [] } ; +$b = tie $a, 'main'; +untie $a ; +EXPECT +untie attempted while 1 inner references still exist at - line 5. +######## +# pp_sys.c +use warning 'io' ; +format STDIN = +. +write STDIN; +EXPECT +Filehandle only opened for input at - line 5. +######## +# pp_sys.c +use warning 'closed' ; +format STDIN = +. +close STDIN; +write STDIN; +EXPECT +Write on closed filehandle at - line 6. +######## +# pp_sys.c +use warning 'io' ; +format STDOUT_TOP = +abc +. +format STDOUT = +def +ghi +. +$= = 1 ; +$- =1 ; +open STDOUT, ">/dev/null" ; +write ; +EXPECT +page overflow at - line 13. +######## +# pp_sys.c +use warning 'unopened' ; +$a = "abc"; +printf $a "fred" +EXPECT +Filehandle main::abc never opened at - line 4. +######## +# pp_sys.c +use warning 'closed' ; +close STDIN ; +printf STDIN "fred" +EXPECT +printf on closed filehandle main::STDIN at - line 4. +######## +# pp_sys.c +use warning 'io' ; +printf STDIN "fred" +EXPECT +Filehandle main::STDIN opened only for input at - line 3. +######## +# pp_sys.c +use warning 'closed' ; +close STDIN; +syswrite STDIN, "fred", 1; +EXPECT +Syswrite on closed filehandle at - line 4. +######## +# pp_sys.c +use warning 'io' ; +use Config; +BEGIN { + if ( $^O ne 'VMS' and ! $Config{d_socket}) { + print < at - line 4. +######## +# pp_sys.c +use warning 'newline' ; +-T "abc\ndef" ; +EXPECT +Unsuccessful open on filename containing newline at - line 3. diff --git a/t/pragma/warn/regcomp b/t/pragma/warn/regcomp new file mode 100644 index 0000000000..52a163a2f5 --- /dev/null +++ b/t/pragma/warn/regcomp @@ -0,0 +1,53 @@ + regcomp.c AOK + + %.*s matches null string many times + + $a = "ABC123" ; $a =~ /(?=a)*/' + + Strange *+?{} on zero-length expression + + /(?=a)?/ + + Character class syntax [: :] is reserved for future extensions + /[a[:xyz:]b]/ + + Character class syntax [. .] is reserved for future extensions + Character class syntax [= =] is reserved for future extensions + +__END__ +# regcomp.c +use warning 'unsafe' ; +my $a = "ABC123" ; +$a =~ /(?=a)*/ ; +EXPECT +(?=a)* matches null string many times at - line 4. +######## +# regcomp.c +use warning 'unsafe' ; +$_ = "" ; +/(?=a)?/; +EXPECT +Strange *+?{} on zero-length expression at - line 4. +######## +# regcomp.c +use warning 'unsafe' ; +$_ = "" ; +/[a[:xyz:]b]/; +/[a[.xyz.]b]/; +/[a[=xyz=]b]/; +EXPECT +Character class syntax [: :] is reserved for future extensions at - line 4. +Character class syntax [. .] is reserved for future extensions at - line 5. +Character class syntax [= =] is reserved for future extensions at - line 6. +######## +# regcomp.c +use warning 'unsafe' ; +# use utf8 ; # Note this line should be uncommented when utf8 gets fixed. +$_ = "" ; +/[a[:xyz:]b]/; +/[a[.xyz.]b]/; +/[a[=xyz=]b]/; +EXPECT +Character class syntax [: :] is reserved for future extensions at - line 5. +Character class syntax [. .] is reserved for future extensions at - line 6. +Character class syntax [= =] is reserved for future extensions at - line 7. diff --git a/t/pragma/warn/regexec b/t/pragma/warn/regexec new file mode 100644 index 0000000000..158a7538ae --- /dev/null +++ b/t/pragma/warn/regexec @@ -0,0 +1,57 @@ + regexec.c + + count exceeded %d + + $_ = 'a' x (2**15+1); /^()(a\1)*$/ ; + count exceeded %d + + $_ = 'a' x (2**15+1); /^()(a\1)*?$/ ; + +__END__ +# regexec.c +use warning 'unsafe' ; +print("SKIPPED\n# win32 can't increase stacksize in shell\n"),exit + if $^O eq 'MSWin32'; +$_ = '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 (32766) exceeded at - line 6. +######## +# regexec.c +use warning 'unsafe' ; +print("SKIPPED\n# win32 can't increase stacksize in shell\n"),exit + if $^O eq 'MSWin32'; +$_ = '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 (32766) exceeded at - line 6. diff --git a/t/pragma/warn/sv b/t/pragma/warn/sv new file mode 100644 index 0000000000..0f1d83c2e5 --- /dev/null +++ b/t/pragma/warn/sv @@ -0,0 +1,203 @@ + sv.c AOK + + 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 + + +__END__ +# sv.c +use integer ; +use warning 'uninitialized' ; +$x = 1 + $a[0] ; # a +EXPECT +Use of uninitialized value 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 warning 'uninitialized' ; +$A *= 2 ; +EXPECT +Use of uninitialized value at - line 10. +######## +# sv.c +use integer ; +use warning 'uninitialized' ; +my $x *= 2 ; #b +EXPECT +Use of uninitialized value 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 warning 'uninitialized' ; +$B = 0 ; +$B |= $A ; +EXPECT +Use of uninitialized value at - line 10. +######## +# sv.c +use warning 'uninitialized' ; +my $Y = 1 ; +my $x = 1 | $a[$Y] +EXPECT +Use of uninitialized value at - line 4. +######## +# sv.c +use warning 'uninitialized' ; +my $x *= 1 ; # d +EXPECT +Use of uninitialized value at - line 3. +######## +# sv.c +use warning 'uninitialized' ; +$x = 1 + $a[0] ; # e +EXPECT +Use of uninitialized value 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 warning 'uninitialized' ; +$A *= 2 ; +EXPECT +Use of uninitialized value at - line 9. +######## +# sv.c +use warning 'uninitialized' ; +$x = $y + 1 ; # f +EXPECT +Use of uninitialized value at - line 3. +######## +# sv.c +use warning 'uninitialized' ; +$x = chop undef ; # g +EXPECT +Use of uninitialized value at - line 3. +######## +# sv.c +use warning 'uninitialized' ; +$x = chop $y ; # h +EXPECT +Use of uninitialized value 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 warning 'uninitialized' ; +$B = "" ; +$B .= $A ; +EXPECT +Use of uninitialized value at - line 10. +######## +# sv.c +use warning 'numeric' ; +sub TIESCALAR{bless[]} ; +sub FETCH {"def"} ; +tie $a,"main" ; +my $b = 1 + $a +EXPECT +Argument "def" isn't numeric in add at - line 6. +######## +# sv.c +use warning 'numeric' ; +my $x = 1 + "def" ; +EXPECT +Argument "def" isn't numeric in add at - line 3. +######## +# sv.c +use warning 'numeric' ; +my $a = "def" ; +my $x = 1 + $a ; +EXPECT +Argument "def" isn't numeric in add at - line 4. +######## +# sv.c +use warning 'numeric' ; use integer ; +my $a = "def" ; +my $x = 1 + $a ; +EXPECT +Argument "def" isn't numeric in i_add at - line 4. +######## +# sv.c +use warning 'numeric' ; +my $x = 1 & "def" ; +EXPECT +Argument "def" isn't numeric in bit_and at - line 3. +######## +# sv.c +use warning 'redefine' ; +sub fred {} +sub joe {} +*fred = \&joe ; +EXPECT +Subroutine fred redefined at - line 5. +######## +# sv.c +use warning 'printf' ; +open F, ">/dev/null" ; +printf F "%q\n" ; +my $a = sprintf "%q" ; +printf F "%" ; +$a = sprintf "%" ; +printf F "%\x02" ; +$a = sprintf "%\x02" ; +EXPECT +Invalid conversion in sprintf: "%q" at - line 5. +Invalid conversion in sprintf: end of string at - line 7. +Invalid conversion in sprintf: "%\002" at - line 9. +Invalid conversion in printf: "%q" at - line 4. +Invalid conversion in printf: end of string at - line 6. +Invalid conversion in printf: "%\002" at - line 8. +######## +# sv.c +use warning 'unsafe' ; +*a = undef ; +EXPECT +Undefined value assigned to typeglob at - line 3. diff --git a/t/pragma/warn/taint b/t/pragma/warn/taint new file mode 100644 index 0000000000..40fadd0913 --- /dev/null +++ b/t/pragma/warn/taint @@ -0,0 +1,25 @@ + taint.c TODO + + Insecure %s%s while running setuid + Insecure %s%s while running setgid + Insecure %s%s while running with -T switch + + + Insecure directory in %s%s while running setuid + Insecure directory in %s%s while running setgid + Insecure directory in %s%s while running with -T switch + + + +__END__ +# taint.c +use warning 'misc' ; + +EXPECT + +######## +# taint.c +use warning 'misc' ; + +EXPECT + diff --git a/t/pragma/warn/toke b/t/pragma/warn/toke new file mode 100644 index 0000000000..6cc4a500a4 --- /dev/null +++ b/t/pragma/warn/toke @@ -0,0 +1,315 @@ +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 warning '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() + + Use of \\x{} without utf8 declaration + $_ = " \x{123} " ; + + + \x%.*s will produce malformed UTF-8 character; use \x{%.*s} for that + use utf8 ; + $_ = "\xffe" + +__END__ +# toke.c +use warning 'deprecated' ; +1 if $a EQ $b ; +1 if $a NE $b ; +1 if $a GT $b ; +1 if $a LT $b ; +1 if $a GE $b ; +1 if $a LE $b ; +EXPECT +Use of EQ is deprecated at - line 3. +Use of NE is deprecated at - line 4. +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 warning 'deprecated' ; +format STDOUT = +@<<< @||| @>>> @>>> +$a $b "abc" 'def' +. +($a, $b) = (1,2,3); +write; +EXPECT +Use of comma-less variable list is deprecated at - line 5. +Use of comma-less variable list is deprecated at - line 5. +Use of comma-less variable list is deprecated at - line 5. +1 2 abc def +######## +# toke.c +use warning 'deprecated' ; +$a = <<; + +EXPECT +Use of bare << to mean <<"" is deprecated at - line 3. +######## +# toke.c +use warning 'syntax' ; +s/(abc)/\1/; +EXPECT +\1 better written as $1 at - line 3. +######## +# toke.c +use warning '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 warning '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 +use warning 'syntax' ; +my $a = $a[1,2] ; +EXPECT +Multidimensional syntax $a[1,2] not supported at - line 3. +######## +# toke.c +use warning 'syntax' ; +sub fred {} ; $SIG{TERM} = fred; +EXPECT +You need to quote "fred" at - line 3. +######## +# toke.c +use warning 'syntax' ; +@a[3] = 2; +@a{3} = 2; +EXPECT +Scalar value @a[3] better written as $a[3] at - line 3. +Scalar value @a{3} better written as $a{3} at - line 4. +######## +# toke.c +use warning 'syntax' ; +$_ = "ab" ; +s/(ab)/\1/e; +EXPECT +Can't use \1 to mean $1 in expression at - line 4. +######## +# toke.c +use warning 'reserved' ; +$a = abc; +EXPECT +Unquoted string "abc" may clash with future reserved word at - line 3. +######## +# toke.c +use warning 'octal' ; +chmod 3; +EXPECT +chmod: mode argument is missing initial 0 at - line 3, at end of line +######## +# toke.c +use warning 'syntax' ; +@a = qw(a, b, c) ; +EXPECT +Possible attempt to separate words with commas at - line 3. +######## +# toke.c +use warning 'syntax' ; +@a = qw(a b #) ; +EXPECT +Possible attempt to put comments in qw() list at - line 3. +######## +# toke.c +use warning 'octal' ; +umask 3; +EXPECT +umask: argument is missing initial 0 at - line 3, at end of line +######## +# toke.c +use warning 'syntax' ; +print ("") +EXPECT +print (...) interpreted as function at - line 3. +######## +# toke.c +use warning 'syntax' ; +printf ("") +EXPECT +printf (...) interpreted as function at - line 3. +######## +# toke.c +use warning 'syntax' ; +sort ("") +EXPECT +sort (...) interpreted as function at - line 3. +######## +# toke.c +use warning 'ambiguous' ; +$a = ${time[2]}; +EXPECT +Ambiguous use of ${time[...]} resolved to $time[...] at - line 3. +######## +# toke.c +use warning 'ambiguous' ; +$a = ${time{2}}; +EXPECT +Ambiguous use of ${time{...}} resolved to $time{...} at - line 3. +######## +# toke.c +use warning 'ambiguous' ; +$a = ${time} ; +EXPECT +Ambiguous use of ${time} resolved to $time at - line 3. +######## +# toke.c +use warning 'ambiguous' ; +sub fred {} +$a = ${fred} ; +EXPECT +Ambiguous use of ${fred} resolved to $fred at - line 4. +######## +# toke.c +use warning '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 warning 'unsafe' ; +$a = FRED:: ; +EXPECT +Bareword "FRED::" refers to nonexistent package at - line 3. +######## +# toke.c +use warning 'ambiguous' ; +sub time {} +my $a = time() +EXPECT +Ambiguous call resolved as CORE::time(), qualify as such or use & at - line 4. +######## +# toke.c +use warning 'utf8' ; +$_ = " \x{123} " ; +EXPECT +Use of \x{} without utf8 declaration at - line 3. +######## +# toke.c +use warning 'utf8' ; +use utf8 ; +$_ = " \xffe " ; +EXPECT +\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 4. diff --git a/t/pragma/warn/universal b/t/pragma/warn/universal new file mode 100644 index 0000000000..e2814e11c4 --- /dev/null +++ b/t/pragma/warn/universal @@ -0,0 +1,11 @@ + universal.c + + Can't locate package %s for @%s::ISA + + +__END__ +# universal.c +use warning 'misc' ; + +EXPECT + diff --git a/t/pragma/warn/util b/t/pragma/warn/util new file mode 100644 index 0000000000..649a2929ce --- /dev/null +++ b/t/pragma/warn/util @@ -0,0 +1,21 @@ + util.c AOK + + Illegal octal digit ignored + my $a = oct "029" ; + + Illegal hex digit ignored + my $a = hex "0xv9" ; + + +__END__ +# util.c +use warning 'octal' ; +my $a = oct "029" ; +EXPECT +Illegal octal digit ignored at - line 3. +######## +# util.c +use warning 'unsafe' ; +*a = hex "0xv9" ; +EXPECT +Illegal hex digit ignored at - line 3. diff --git a/t/pragma/warning.t b/t/pragma/warning.t index 9440bc3438..89ffff789a 100755 --- a/t/pragma/warning.t +++ b/t/pragma/warning.t @@ -19,9 +19,9 @@ my @prgs = () ; my @w_files = () ; if (@ARGV) - { print "ARGV = [@ARGV]\n" ; @w_files = map { s#^#./pragma/warn-#; $_ } @ARGV } + { print "ARGV = [@ARGV]\n" ; @w_files = map { s#^#./pragma/warn/#; $_ } @ARGV } else - { @w_files = sort glob("pragma/warn-*") } + { @w_files = sort glob("pragma/warn/*") } foreach (@w_files) { -- cgit v1.2.1