diff options
Diffstat (limited to 'gnu/usr.bin/perl/t/lib')
-rw-r--r-- | gnu/usr.bin/perl/t/lib/charnames/alias | 10 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/common.pl | 7 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/croak/op | 40 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/croak/toke | 208 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/feature/bundle | 6 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/h2ph.pht | 4 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/strict/subs | 10 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/warnings/9uninit | 84 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/warnings/doop | 33 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/warnings/mg | 33 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/warnings/op | 208 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/warnings/pp | 12 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/warnings/pp_hot | 2 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/warnings/pp_sys | 99 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/warnings/regcomp | 43 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/warnings/regexec | 4 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/warnings/sv | 13 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/warnings/toke | 303 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/lib/warnings/utf8 | 80 |
19 files changed, 794 insertions, 405 deletions
diff --git a/gnu/usr.bin/perl/t/lib/charnames/alias b/gnu/usr.bin/perl/t/lib/charnames/alias index 33ccff42323..c0b039f1f93 100644 --- a/gnu/usr.bin/perl/t/lib/charnames/alias +++ b/gnu/usr.bin/perl/t/lib/charnames/alias @@ -416,12 +416,6 @@ use utf8; use open qw( :utf8 :std ); use charnames ":alias" => { "NBSP SEPARATED SPACE" => "BLACK SMILING FACE" }; print "ok\n" if "\N{NBSP SEPARATED SPACE}" eq "\x{263B}"; -print "ok\n" if "\N{NBSP SEPARATED SPACE}" eq "\x{263B}"; -no warnings 'deprecated'; -print "ok\n" if "\N{NBSP SEPARATED SPACE}" eq "\x{263B}"; EXPECT -OPTIONS regex -NO-BREAK SPACE in a charnames alias definition is deprecated; marked by <-- HERE in 'NBSP SEPARATED <-- HERE SPACE' at - line \d+. -ok -ok -ok +OPTIONS regex fatal +Invalid character in charnames alias definition; marked by <-- HERE in 'NBSP <-- HERE SEPARATED SPACE' at - line 3 diff --git a/gnu/usr.bin/perl/t/lib/common.pl b/gnu/usr.bin/perl/t/lib/common.pl index 367c676d516..9c7060ff38c 100644 --- a/gnu/usr.bin/perl/t/lib/common.pl +++ b/gnu/usr.bin/perl/t/lib/common.pl @@ -27,7 +27,12 @@ if (@ARGV) { print "ARGV = [@ARGV]\n"; @w_files = map { "./lib/$pragma_name/$_" } @ARGV; } else { - @w_files = sort glob catfile(curdir(), "lib", $pragma_name, "*"); + @w_files = sort grep !/( \.rej | ~ | \ \(Autosaved\)\.txt ) \z/nx, + glob catfile(curdir(), "lib", $pragma_name, "*"); +} + +if ($::IS_EBCDIC) { # Skip Latin1 files + @w_files = grep { $_ !~ / _l1 $/x } @w_files } my ($tests, @prgs) = setup_multiple_progs(@w_files); diff --git a/gnu/usr.bin/perl/t/lib/croak/op b/gnu/usr.bin/perl/t/lib/croak/op index 439878959e9..c11803e3064 100644 --- a/gnu/usr.bin/perl/t/lib/croak/op +++ b/gnu/usr.bin/perl/t/lib/croak/op @@ -69,7 +69,6 @@ No such class field "c" in variable $f of type main at - line 3. use feature 'bitwise'; @a &= 1; EXPECT -The bitwise feature is experimental at - line 2. Can't modify array dereference in numeric bitwise and (&) at - line 2, near "1;" Execution of - aborted due to compilation errors. ######## @@ -77,7 +76,6 @@ Execution of - aborted due to compilation errors. use feature 'bitwise'; @a |= 1; EXPECT -The bitwise feature is experimental at - line 2. Can't modify array dereference in numeric bitwise or (|) at - line 2, near "1;" Execution of - aborted due to compilation errors. ######## @@ -85,7 +83,6 @@ Execution of - aborted due to compilation errors. use feature 'bitwise'; @a ^= 1; EXPECT -The bitwise feature is experimental at - line 2. Can't modify array dereference in numeric bitwise xor (^) at - line 2, near "1;" Execution of - aborted due to compilation errors. ######## @@ -93,7 +90,6 @@ Execution of - aborted due to compilation errors. use feature 'bitwise'; @a &.= 1; EXPECT -The bitwise feature is experimental at - line 2. Can't modify array dereference in string bitwise and (&.) at - line 2, near "1;" Execution of - aborted due to compilation errors. ######## @@ -101,7 +97,6 @@ Execution of - aborted due to compilation errors. use feature 'bitwise'; @a |.= 1; EXPECT -The bitwise feature is experimental at - line 2. Can't modify array dereference in string bitwise or (|.) at - line 2, near "1;" Execution of - aborted due to compilation errors. ######## @@ -109,10 +104,33 @@ Execution of - aborted due to compilation errors. use feature 'bitwise'; @a ^.= 1; EXPECT -The bitwise feature is experimental at - line 2. Can't modify array dereference in string bitwise xor (^.) at - line 2, near "1;" Execution of - aborted due to compilation errors. ######## +# NAME substr %h in scalar assignment +substr(%h,0) = 3; +EXPECT +Can't modify hash dereference in substr at - line 1, near "3;" +Execution of - aborted due to compilation errors. +######## +# NAME substr %h in list assignment +(substr %h,0) = 3; +EXPECT +Can't modify hash dereference in substr at - line 1, near "3;" +Execution of - aborted due to compilation errors. +######## +# NAME vec %h in scalar assignment +vec(%h,1,1) = 3; +EXPECT +Can't modify hash dereference in vec at - line 1, near "3;" +Execution of - aborted due to compilation errors. +######## +# NAME vec %h in list assignment +(vec %h,1,1) = 3; +EXPECT +Can't modify hash dereference in vec at - line 1, near "3;" +Execution of - aborted due to compilation errors. +######## # NAME Can't declare conditional my($a?$b:$c) EXPECT @@ -128,13 +146,13 @@ Execution of - aborted due to compilation errors. # NAME ($_, state $x) = ... ($_, CORE::state $x) = (); EXPECT -Initialization of state variables in list context currently forbidden at - line 1, near ");" +Initialization of state variables in list currently forbidden at - line 1, near ");" Execution of - aborted due to compilation errors. ######## # NAME my $y; ($y, state $x) = ... my $y; ($y, CORE::state $x) = (); EXPECT -Initialization of state variables in list context currently forbidden at - line 1, near ");" +Initialization of state variables in list currently forbidden at - line 1, near ");" Execution of - aborted due to compilation errors. ######## # NAME delete BAD @@ -185,17 +203,17 @@ Execution of - aborted due to compilation errors. # NAME keys BAREWORD @a = keys FRED ; EXPECT -Type of arg 1 to keys must be hash (not constant item) at - line 1, near "FRED ;" +Type of arg 1 to keys must be hash or array (not constant item) at - line 1, near "FRED ;" Execution of - aborted due to compilation errors. ######## # NAME values BAREWORD @a = values FRED ; EXPECT -Type of arg 1 to values must be hash (not constant item) at - line 1, near "FRED ;" +Type of arg 1 to values must be hash or array (not constant item) at - line 1, near "FRED ;" Execution of - aborted due to compilation errors. ######## # NAME each BAREWORD @a = each FRED ; EXPECT -Type of arg 1 to each must be hash (not constant item) at - line 1, near "FRED ;" +Type of arg 1 to each must be hash or array (not constant item) at - line 1, near "FRED ;" Execution of - aborted due to compilation errors. diff --git a/gnu/usr.bin/perl/t/lib/croak/toke b/gnu/usr.bin/perl/t/lib/croak/toke index 18dfa24cc67..1d45a3fdf5e 100644 --- a/gnu/usr.bin/perl/t/lib/croak/toke +++ b/gnu/usr.bin/perl/t/lib/croak/toke @@ -70,6 +70,13 @@ Can't find string terminator "foo" anywhere before EOF at (eval 1) line 1. EXPECT Can't find string terminator "foo" anywhere before EOF at - line 1. ######## +# NAME Unterminated here-doc with non-Latin-1 terminator +BEGIN { binmode STDERR, ":utf8" } +use utf8; +<<옷옷 +EXPECT +Can't find string terminator "옷옷" anywhere before EOF at - line 3. +######## # NAME Unterminated qw// qw/ EXPECT @@ -85,6 +92,25 @@ Can't find string terminator "/" anywhere before EOF at - line 1. EXPECT Can't find string terminator "'" anywhere before EOF at - line 1. ######## +# NAME Unterminated "" +" +EXPECT +Can't find string terminator '"' anywhere before EOF at - line 1. +######## +# NAME Unterminated q// with non-ASCII delimiter, under utf8 +BEGIN { binmode STDERR, ":utf8" } +use utf8; +q« +EXPECT +Can't find string terminator "«" anywhere before EOF at - line 3. +######## +# NAME Unterminated q// with non-Latin-1 delimiter +BEGIN { binmode STDERR, ":utf8" } +use utf8; +q 옷 +EXPECT +Can't find string terminator "옷" anywhere before EOF at - line 3. +######## # NAME /\N{/ /\N{/ EXPECT @@ -99,29 +125,30 @@ Missing $ on loop variable at - line 1. # NAME Missing name in "my sub" use feature 'lexical_subs'; my sub; EXPECT -The lexical_subs feature is experimental at - line 1. Missing name in "my sub" at - line 1. ######## # NAME Missing name in "our sub" use feature 'lexical_subs'; our sub; EXPECT -The lexical_subs feature is experimental at - line 1. Missing name in "our sub" at - line 1. ######## # NAME Missing name in "state sub" -use 5.01; use feature 'lexical_subs'; +use 5.01; state sub; EXPECT -The lexical_subs feature is experimental at - line 2. Missing name in "state sub" at - line 2. ######## +# NAME our sub pack::foo +our sub foo::bar; +EXPECT +No package name allowed for subroutine &foo::bar in "our" at - line 1, near "our sub foo::bar" +Execution of - aborted due to compilation errors. +######## # NAME my sub pack::foo use feature 'lexical_subs', 'state'; my sub foo::bar; state sub foo::bear; EXPECT -The lexical_subs feature is experimental at - line 2. -The lexical_subs feature is experimental at - line 3. "my" subroutine &foo::bar can't be in a package at - line 2, near "my sub foo::bar" "state" subroutine &foo::bear can't be in a package at - line 3, near "state sub foo::bear" Execution of - aborted due to compilation errors. @@ -164,9 +191,16 @@ Execution of - aborted due to compilation errors. # NAME Regexp constant overloading when *^H is undefined use overload; BEGIN { overload::constant qr => sub {}; undef *^H } -/a/, m'a' +/a/ EXPECT Constant(qq) unknown at - line 3, within pattern +Execution of - aborted due to compilation errors. +######## +# NAME Regexp constant overloading when *^H is undefined +use overload; +BEGIN { overload::constant qr => sub {}; undef *^H } +m'a' +EXPECT Constant(q) unknown at - line 3, within pattern Execution of - aborted due to compilation errors. ######## @@ -216,9 +250,16 @@ Execution of - aborted due to compilation errors. # NAME Regexp constant overloading returning undef use overload; BEGIN { overload::constant qr => sub {} } -/a/, m'a' +/a/ EXPECT Constant(qq): Call to &{$^H{qr}} did not return a defined value at - line 3, within pattern +Execution of - aborted due to compilation errors. +######## +# NAME Regexp constant overloading returning undef +use overload; +BEGIN { overload::constant qr => sub {} } +m'a' +EXPECT Constant(q): Call to &{$^H{qr}} did not return a defined value at - line 3, within pattern Execution of - aborted due to compilation errors. ######## @@ -248,6 +289,44 @@ Too many arguments for undef operator at - line 11, near "2)" Constant(q) unknown at - line 12, near ""a"" - has too many errors. ######## +# NAME Bad name after ' (with other helpful messages) +sub has{} +has erdef => ( + isa => 'Int', + is => 'ro, + default => sub { 1 } +); + +has cxxc => ( + isa => 'Int', + is => 'ro', + default => sub { 1 } +); +EXPECT +Bareword found where operator expected at - line 9, near "isa => 'Int" + (Might be a runaway multi-line '' string starting on line 4) + (Do you need to predeclare isa?) +Bad name after Int' at - line 9. +######## +# NAME Bad name after :: (with other helpful messages) +sub has{} +has erdef => ( + isa => 'Int', + is => "ro, + default => sub { 1 } +); + +has cxxc => ( + isa => "Foo::$subpackage", + is => 'ro', + default => sub { 1 } +); +EXPECT +Bareword found where operator expected at - line 9, near "isa => "Foo" + (Might be a runaway multi-line "" string starting on line 4) + (Do you need to predeclare isa?) +Bad name after Foo:: at - line 9. +######## # NAME Unterminated delimiter for here document <<"foo EXPECT @@ -256,49 +335,148 @@ Unterminated delimiter for here document at - line 1. # NAME my (our $x) errors my (our $x); EXPECT -Can't redeclare "our" in "my" at - line 1, at end of line +Can't redeclare "our" in "my" at - line 1, near "(our" Execution of - aborted due to compilation errors. ######## # NAME our (my $x) errors our (my $x); EXPECT -Can't redeclare "my" in "our" at - line 1, at end of line +Can't redeclare "my" in "our" at - line 1, near "(my" Execution of - aborted due to compilation errors. ######## # NAME state (my $x) errors use feature 'state'; state (my $x); EXPECT -Can't redeclare "my" in "state" at - line 2, at end of line +Can't redeclare "my" in "state" at - line 2, near "(my" Execution of - aborted due to compilation errors. ######## # NAME our (state $x) errors use feature 'state'; our (state $x); EXPECT -Can't redeclare "state" in "our" at - line 2, at end of line +Can't redeclare "state" in "our" at - line 2, near "(state" Execution of - aborted due to compilation errors. ######## # NAME my (my $x) errors my (my $x, $y, $z); EXPECT -Can't redeclare "my" in "my" at - line 1, at end of line +Can't redeclare "my" in "my" at - line 1, near "(my" Execution of - aborted due to compilation errors. ######## # NAME our (our $x) errors our ($x, our($y), $z); EXPECT -Can't redeclare "our" in "our" at - line 1, near ", " +Can't redeclare "our" in "our" at - line 1, near ", our" Execution of - aborted due to compilation errors. ######## # NAME state (state $x) errors use feature 'state'; state ($x, $y, state $z); EXPECT -Can't redeclare "state" in "state" at - line 2, near ", " +Can't redeclare "state" in "state" at - line 2, near ", state" Execution of - aborted due to compilation errors. ######## # NAME BEGIN <> [perl #125341] BEGIN <> EXPECT Illegal declaration of subroutine BEGIN at - line 1. +######## +# NAME multiple conflict markers +<<<<<<< yours:sample.txt +my $some_code; +======= +my $some_other_code; +>>>>>>> theirs:sample.txt +EXPECT +Version control conflict marker at - line 1, near "<<<<<<<" +Version control conflict marker at - line 3, near "=======" +Version control conflict marker at - line 5, near ">>>>>>>" +Execution of - aborted due to compilation errors. +######## +# NAME (Might be a runaway multi-line...) with Latin-1 delimiters in utf8 +BEGIN { binmode STDERR, ':utf8' } +use utf8; +q« +« time +EXPECT +syntax error at - line 4, near "« time" + (Might be a runaway multi-line «« string starting on line 3) +Execution of - aborted due to compilation errors. +######## +# NAME (Might be a runaway multi-line...) with non-Latin-1 delimiters +BEGIN { binmode STDERR, ':utf8' } +use utf8; +q ϡ +ϡ time +EXPECT +syntax error at - line 4, near "ϡ time" + (Might be a runaway multi-line ϡϡ string starting on line 3) +Execution of - aborted due to compilation errors. +######## +# NAME tr/// handling of mis-formatted \o characters +# may only fail with ASAN +tr/\o-0//; +EXPECT +Missing braces on \o{} at - line 2, within string +Execution of - aborted due to compilation errors. +######## +# NAME bare << +$a = <<; + +EXPECT +Use of bare << to mean <<"" is forbidden at - line 1. +######## +# NAME bare <<~ +$a = <<~; +EXPECT +Use of bare << to mean <<"" is forbidden at - line 1. +######## +# NAME bare <<~ +$a = <<~ ; + +EXPECT +Use of bare << to mean <<"" is forbidden at - line 1. +######## +# NAME incomplete floating point decimal exponent (#131725) +1e--5 +EXPECT +Bareword found where operator expected at - line 1, near "1e" + (Missing operator before e?) +Number found where operator expected at - line 1, near "--5" + (Missing operator before 5?) +syntax error at - line 1, near "1e" +Execution of - aborted due to compilation errors. +######## +# NAME signature with non-"=" assignop #131777 +use feature 'signatures'; +no warnings 'experimental::signatures'; +sub foo ($a += 1) +EXPECT +Illegal operator following parameter in a subroutine signature at - line 3, near "($a += 1" +syntax error at - line 3, near "($a += 1" +Execution of - aborted due to compilation errors. +######## +# NAME tr/// range with empty \N{} at the start +tr//\N{}-0/; +EXPECT +Unknown charname '' at - line 1, within string +Execution of - aborted due to compilation errors. +######## +# NAME octal fp with non-octal digits after the decimal point +01.1234567p0; +07.8p0; +EXPECT +Bareword found where operator expected at - line 2, near "8p0" + (Missing operator before p0?) +syntax error at - line 2, near "8p0" +Execution of - aborted due to compilation errors. +######## +# NAME binary fp with non-binary digits after the decimal point +0b1.10p0; +0b1.2p0; +EXPECT +Bareword found where operator expected at - line 2, near "2p0" + (Missing operator before p0?) +syntax error at - line 2, near "2p0" +Execution of - aborted due to compilation errors. diff --git a/gnu/usr.bin/perl/t/lib/feature/bundle b/gnu/usr.bin/perl/t/lib/feature/bundle index b9facc0bd69..5eacaff41ba 100644 --- a/gnu/usr.bin/perl/t/lib/feature/bundle +++ b/gnu/usr.bin/perl/t/lib/feature/bundle @@ -92,7 +92,7 @@ print qw[a b c][2], "\n"; use feature ":5.16"; print qw[a b c][2], "\n"; EXPECT -Use of assignment to $[ is deprecated at - line 4. +Use of assignment to $[ is deprecated, and will be fatal in Perl 5.30 at - line 4. b b c @@ -104,7 +104,7 @@ no feature; # resets to :default, thus turns array_base on $[ = 1; print qw[a b c][2], "\n"; EXPECT -Use of assignment to $[ is deprecated at - line 4. +Use of assignment to $[ is deprecated, and will be fatal in Perl 5.30 at - line 4. b ######## # "no feature 'all" @@ -114,7 +114,7 @@ no feature ':all'; # turns array_base (and everything else) off $[ = 1; print qw[a b c][2], "\n"; EXPECT -Use of assignment to $[ is deprecated at - line 2. +Use of assignment to $[ is deprecated, and will be fatal in Perl 5.30 at - line 2. Assigning non-zero to $[ is no longer possible at - line 5. b ######## diff --git a/gnu/usr.bin/perl/t/lib/h2ph.pht b/gnu/usr.bin/perl/t/lib/h2ph.pht index cda8d21051c..f068d6dae46 100644 --- a/gnu/usr.bin/perl/t/lib/h2ph.pht +++ b/gnu/usr.bin/perl/t/lib/h2ph.pht @@ -90,6 +90,10 @@ unless(defined(&_H2PH_H_)) { } eval("sub flim () { 0; }") unless defined(&flim); eval("sub flam () { 1; }") unless defined(&flam); + eval 'sub blli_in_use { + my($blli) = @_; + eval q({ ($blli->{l2_proto}) || ($blli->{l3_proto}); }); + }' unless defined(&blli_in_use); eval 'sub multiline () {"multilinestring";}' unless defined(&multiline); } 1; diff --git a/gnu/usr.bin/perl/t/lib/strict/subs b/gnu/usr.bin/perl/t/lib/strict/subs index 246be0ee9be..a83df015053 100644 --- a/gnu/usr.bin/perl/t/lib/strict/subs +++ b/gnu/usr.bin/perl/t/lib/strict/subs @@ -337,7 +337,7 @@ Execution of - aborted due to compilation errors. ######## -# ID 20020703.002 +# ID 20020703.002 (#10021) use strict; use warnings; my $abc = XYZ ? 1 : 0; @@ -467,3 +467,11 @@ my $v2 = $h->{+CONST_TYPO}; EXPECT Bareword "CONST_TYPO" not allowed while "strict subs" in use at - line 5. Execution of - aborted due to compilation errors. +######## +# NAME constant-folded barewords still trigger stricture +my $x = !BARE1; +use strict 'subs'; +my $y = !BARE2; +EXPECT +Bareword "BARE2" not allowed while "strict subs" in use at - line 3. +Execution of - aborted due to compilation errors. diff --git a/gnu/usr.bin/perl/t/lib/warnings/9uninit b/gnu/usr.bin/perl/t/lib/warnings/9uninit index ef9b4f6d178..774c6ee4326 100644 --- a/gnu/usr.bin/perl/t/lib/warnings/9uninit +++ b/gnu/usr.bin/perl/t/lib/warnings/9uninit @@ -404,15 +404,19 @@ use warnings 'uninitialized'; my ($m1); local $/ =\$m1; +EXPECT +Use of uninitialized value $m1 in scalar assignment at - line 4. +Setting $/ to a reference to zero is forbidden at - line 4. +######## +use warnings 'uninitialized'; + my $x = "abc"; chomp $x; chop $x; my $y; chomp ($x, $y); chop ($x, $y); EXPECT -Use of uninitialized value $m1 in scalar assignment at - line 4. -Use of uninitialized value $m1 in scalar assignment at - line 4. -Setting $/ to a reference to zero as a form of slurp is deprecated, treating as undef at - line 4. -Use of uninitialized value $y in chop at - line 8. +Use of uninitialized value $y in chomp at - line 6. +Use of uninitialized value $y in chop at - line 6. ######## use warnings 'uninitialized'; my ($m1, @ma, %mh); @@ -651,8 +655,8 @@ Use of uninitialized value $m1 in sort at - line 6. Use of uninitialized value $g1 in sort at - line 6. Use of uninitialized value $m1 in sort at - line 7. Use of uninitialized value $g1 in sort at - line 7. -Use of uninitialized value $m1 in sort at - line 7. Use of uninitialized value $g1 in sort at - line 7. +Use of uninitialized value $m1 in sort at - line 7. Use of uninitialized value $a in subtraction (-) at - line 8. Use of uninitialized value $b in subtraction (-) at - line 8. Use of uninitialized value $m1 in sort at - line 9. @@ -668,7 +672,15 @@ Use of uninitialized value in sort at - line 14. Use of uninitialized value in sort at - line 21. Use of uninitialized value in sort at - line 22. ######## -my $nan = sin 9**9**9; +use Config; +unless ($Config{d_double_has_inf} && $Config{d_double_has_nan}) { + print <<EOM ; +SKIPPED +# No inf/nan support +EOM + exit ; +} +my $nan = eval 'sin 9**9**9'; if ($nan == $nan) { print <<EOM ; SKIPPED @@ -681,8 +693,8 @@ use warnings 'uninitialized'; @sort = sort { ($a)[0] <=> $b } 1, $nan; @sort = sort { $a <=> $b } 1, $nan; EXPECT -Use of uninitialized value in sort at - line 11. -Use of uninitialized value in sort at - line 12. +Use of uninitialized value in sort at - line 19. +Use of uninitialized value in sort at - line 20. ######## use warnings 'uninitialized'; my ($m1, $m2, $v); @@ -2138,3 +2150,59 @@ Use of uninitialized value $i in array element at - line 12. Use of uninitialized value $k in hash element at - line 12. Use of uninitialized value $i in array element at - line 13. Use of uninitialized value $k in hash element at - line 13. +######## +# perl #127877 +use warnings 'uninitialized'; +my ($p, $q, $r, $s, $t, $u, $v, $w, $x, $y); +$p = $p . "a"; +$q .= "a"; +$r = $r + 17; +$s += 17; +$t = $t - 17; +$u -= 17; +use integer; +$v = $v + 17; +$w += 17; +$x = $x - 17; +$y -= 17; +EXPECT +Use of uninitialized value $p in concatenation (.) or string at - line 4. +Use of uninitialized value $r in addition (+) at - line 6. +Use of uninitialized value $t in subtraction (-) at - line 8. +Use of uninitialized value $v in integer addition (+) at - line 11. +Use of uninitialized value $x in integer subtraction (-) at - line 13. +######## +# NAME 64-bit array subscripts +# SKIP ? length(pack "p", "") < 8 +use warnings 'uninitialized'; + +# aelem + const +use constant foo => \0; +$SIG{__WARN__} = sub { + print STDERR + $_[0] =~ /\$a\[([^]]+)]/ && $1 == foo + ? "ok\n" + : ("$1 != ",0+foo,"\n") +}; +() = "$a[foo]"; +undef $SIG{__WARN__}; + +# Multideref +() = "$a[140688675223280]"; +EXPECT +ok +Use of uninitialized value $a[140688675223280] in string at - line 15. +######## +# RT #128940 +use warnings 'uninitialized'; +my $x = "" . open my $fh, "<", "no / such / file"; +EXPECT +Use of uninitialized value in concatenation (.) or string at - line 3. +######## +# RT #123910 +# undef's arg being undef doesn't trigger warnings - any warning will be +# from tied/magic vars +use warnings 'uninitialized'; +undef $0; +EXPECT +Use of uninitialized value in undef operator at - line 5. diff --git a/gnu/usr.bin/perl/t/lib/warnings/doop b/gnu/usr.bin/perl/t/lib/warnings/doop index bcc85a365af..09db1467377 100644 --- a/gnu/usr.bin/perl/t/lib/warnings/doop +++ b/gnu/usr.bin/perl/t/lib/warnings/doop @@ -5,33 +5,10 @@ $_ = "\x80 \xff" ; chop ; EXPECT ######## -# NAME deprecation of logical bit operations with above ff code points -$_ = "\xFF" & "\x{100}"; # Above ff second -$_ = "\xFF" | "\x{101}"; -$_ = "\xFF" ^ "\x{102}"; -$_ = "\x{100}" & "\x{FF}"; # Above ff first -$_ = "\x{101}" | "\x{FF}"; -$_ = "\x{102}" ^ "\x{FF}"; -$_ = "\x{100}" & "\x{103}"; # both above ff has just one message raised -$_ = "\x{101}" | "\x{104}"; -$_ = "\x{102}" ^ "\x{105}"; +# NAME vec with above ff code points is deprecated +my $foo = "\x{100}" . "\xff\xfe"; +eval { vec($foo, 1, 8) }; no warnings 'deprecated'; -$_ = "\xFF" & "\x{100}"; -$_ = "\xFF" | "\x{101}"; -$_ = "\xFF" ^ "\x{101}"; -$_ = "\x{100}" & "\x{FF}"; -$_ = "\x{101}" | "\x{FF}"; -$_ = "\x{102}" ^ "\x{FF}"; -$_ = "\x{100}" & "\x{103}"; -$_ = "\x{101}" | "\x{104}"; -$_ = "\x{102}" ^ "\x{105}"; +eval { vec($foo, 1, 8) }; EXPECT -Use of strings with code points over 0xFF as arguments to bitwise and (&) operator is deprecated at - line 1. -Use of strings with code points over 0xFF as arguments to bitwise or (|) operator is deprecated at - line 2. -Use of strings with code points over 0xFF as arguments to bitwise xor (^) operator is deprecated at - line 3. -Use of strings with code points over 0xFF as arguments to bitwise and (&) operator is deprecated at - line 4. -Use of strings with code points over 0xFF as arguments to bitwise or (|) operator is deprecated at - line 5. -Use of strings with code points over 0xFF as arguments to bitwise xor (^) operator is deprecated at - line 6. -Use of strings with code points over 0xFF as arguments to bitwise and (&) operator is deprecated at - line 7. -Use of strings with code points over 0xFF as arguments to bitwise or (|) operator is deprecated at - line 8. -Use of strings with code points over 0xFF as arguments to bitwise xor (^) operator is deprecated at - line 9. +Use of strings with code points over 0xFF as arguments to vec is deprecated. This will be a fatal error in Perl 5.32 at - line 2. diff --git a/gnu/usr.bin/perl/t/lib/warnings/mg b/gnu/usr.bin/perl/t/lib/warnings/mg index 6bd6c3a912f..6c0f3e5ec78 100644 --- a/gnu/usr.bin/perl/t/lib/warnings/mg +++ b/gnu/usr.bin/perl/t/lib/warnings/mg @@ -3,8 +3,6 @@ No such signal: SIG%s $SIG{FRED} = sub {} - Setting $/ to a reference to zero as a form of slurp is deprecated, treating as undef - SIG%s handler \"%s\" not defined. $SIG{"INT"} = "ok3"; kill "INT",$$; @@ -21,24 +19,6 @@ $SIG{FRED} = sub {}; EXPECT ######## --w -# warnable code, warnings enabled via command line switch -$/ = \0; -EXPECT -Setting $/ to a reference to zero as a form of slurp is deprecated, treating as undef at - line 3. -######## --w -# warnable code, warnings enabled via command line switch -$/ = \-1; -EXPECT -Setting $/ to a reference to a negative integer as a form of slurp is deprecated, treating as undef at - line 3. -######## -$/ = \-1; -no warnings 'deprecated'; -$/ = \-1; -EXPECT -Setting $/ to a reference to a negative integer as a form of slurp is deprecated, treating as undef at - line 1. -######## # mg.c use warnings 'signal' ; if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') { @@ -99,16 +79,3 @@ Use of uninitialized value $3 in oct at - line 3. use warnings 'uninitialized'; $ENV{FOO} = undef; # should not warn EXPECT -######## -${^ENCODING} = 42; -{ local ${^ENCODING}; } -${^ENCODING} = undef; -{ local ${^ENCODING} = 37; } -no warnings 'deprecated'; -${^ENCODING} = 42; -{ local ${^ENCODING}; } -${^ENCODING} = undef; -{ local ${^ENCODING} = 37; } -EXPECT -Setting ${^ENCODING} is deprecated at - line 1. -Setting ${^ENCODING} is deprecated at - line 4. diff --git a/gnu/usr.bin/perl/t/lib/warnings/op b/gnu/usr.bin/perl/t/lib/warnings/op index 528639e5a9a..54e2e3de20e 100644 --- a/gnu/usr.bin/perl/t/lib/warnings/op +++ b/gnu/usr.bin/perl/t/lib/warnings/op @@ -87,8 +87,6 @@ Use of /g modifier is meaningless in split - The bitwise feature is experimental [Perl_ck_bitop] - Possible precedence problem on bitwise %c operator [Perl_ck_bitop] Mandatory Warnings @@ -134,6 +132,28 @@ Found = in conditional, should be == at - line 3. Found = in conditional, should be == at - line 4. ######## # op.c +# NAME while with assignment as condition +use warnings 'syntax'; +1 while $a = 0; +while ($a = 0) { + 1; +} +EXPECT +Found = in conditional, should be == at - line 3. +Found = in conditional, should be == at - line 4. +######## +# op.c +# NAME until with assignment as condition +use warnings 'syntax'; +1 until $a = 1; +until ($a = 1) { + 1; +} +EXPECT +Found = in conditional, should be == at - line 3. +Found = in conditional, should be == at - line 4. +######## +# op.c use warnings 'syntax' ; @a[3]; @a{3}; @@ -145,9 +165,13 @@ use warnings 'syntax' ; @a{--$_}; @a[$_]; @a[--$_]; +delete @a[$x]; +delete @a{$x}; no warnings 'syntax' ; @a[3]; @a{3}; +delete @a[$x]; +delete @a{$x}; 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. @@ -159,6 +183,15 @@ Scalar value @a{...} better written as $a{...} at - line 9. Scalar value @a{...} better written as $a{...} at - line 10. Scalar value @a[...] better written as $a[...] at - line 11. Scalar value @a[...] better written as $a[...] at - line 12. +Scalar value @a[...] better written as $a[...] at - line 13. +Scalar value @a{...} better written as $a{...} at - line 14. +######## +# op.c +# [perl #132645] +use warnings 'syntax'; +@inf[3]; +EXPECT +Scalar value @inf[3] better written as $inf[3] at - line 4. ######## # op.c use utf8; @@ -997,15 +1030,11 @@ sub phred { 2 }; state sub jorge { 1 } sub jorge () { 2 } # should *not* produce redef warnings by default EXPECT -The lexical_subs feature is experimental at - line 3. Prototype mismatch: sub fred () vs none at - line 4. Constant subroutine fred redefined at - line 4. -The lexical_subs feature is experimental at - line 5. Prototype mismatch: sub george: none vs () at - line 6. -The lexical_subs feature is experimental at - line 7. Prototype mismatch: sub phred () vs none at - line 8. Constant subroutine phred redefined at - line 8. -The lexical_subs feature is experimental at - line 9. Prototype mismatch: sub jorge: none vs () at - line 10. ######## # op.c @@ -1104,65 +1133,6 @@ Prototype mismatch: sub main::frèd () vs ($) at - line 5. use utf8; use open qw( :utf8 :std ); use warnings; -eval "sub fòò (@\$\0) {}"; -EXPECT -Prototype after '@' for main::fòò : @$\0 at (eval 1) line 1. -Illegal character in prototype for main::fòò : @$\0 at (eval 1) line 1. -######## -# op.c -use utf8; -use open qw( :utf8 :std ); -use warnings; -eval "sub foo (@\0) {}"; -EXPECT -Prototype after '@' for main::foo : @\0 at (eval 1) line 1. -Illegal character in prototype for main::foo : @\0 at (eval 1) line 1. -######## -# op.c -BEGIN { - if (ord('A') == 193) { - print "SKIPPED\n# Different results on EBCDIC"; - exit 0; - } -} -use utf8; -use open qw( :utf8 :std ); -use warnings; -BEGIN { $::{"foo"} = "\@\$\0L\351on" } -BEGIN { eval "sub foo (@\$\0L\x{c3}\x{a9}on) {}"; } -EXPECT -Prototype after '@' for main::foo : @$\x{0}L... at (eval 1) line 1. -Illegal character in prototype for main::foo : @$\x{0}L... at (eval 1) line 1. -######## -# op.c -use utf8; -use open qw( :utf8 :std ); -use warnings; -BEGIN { eval "sub foo (@\0) {}"; } -EXPECT -Prototype after '@' for main::foo : @\0 at (eval 1) line 1. -Illegal character in prototype for main::foo : @\0 at (eval 1) line 1. -######## -# op.c -use warnings; -eval "sub foo (@\xAB) {}"; -EXPECT -Prototype after '@' for main::foo : @\x{ab} at (eval 1) line 1. -Illegal character in prototype for main::foo : @\x{ab} at (eval 1) line 1. -######## -# op.c -use utf8; -use open qw( :utf8 :std ); -use warnings; -BEGIN { eval "sub foo (@\x{30cb}) {}"; } -EXPECT -Prototype after '@' for main::foo : @\x{30cb} at (eval 1) line 1. -Illegal character in prototype for main::foo : @\x{30cb} at (eval 1) line 1. -######## -# op.c -use utf8; -use open qw( :utf8 :std ); -use warnings; BEGIN { $::{"foo"} = "\x{30cb}" } BEGIN { eval "sub foo {}"; } EXPECT @@ -1435,6 +1405,7 @@ END { print "in end\n"; } print "in mainline\n"; 1; --FILE-- +BEGIN { unshift @INC, '.' } require abc; do "abc.pm"; EXPECT @@ -1512,34 +1483,6 @@ $_ |.= $_; $_ &.= $_; $_ ^.= $_; EXPECT -The bitwise feature is experimental at - line 2. -The bitwise feature is experimental at - line 3. -The bitwise feature is experimental at - line 4. -The bitwise feature is experimental at - line 5. -The bitwise feature is experimental at - line 6. -The bitwise feature is experimental at - line 7. -The bitwise feature is experimental at - line 8. -The bitwise feature is experimental at - line 9. -The bitwise feature is experimental at - line 10. -The bitwise feature is experimental at - line 11. -The bitwise feature is experimental at - line 12. -The bitwise feature is experimental at - line 13. -The bitwise feature is experimental at - line 14. -The bitwise feature is experimental at - line 15. -The bitwise feature is experimental at - line 17. -The bitwise feature is experimental at - line 18. -The bitwise feature is experimental at - line 19. -The bitwise feature is experimental at - line 20. -The bitwise feature is experimental at - line 21. -The bitwise feature is experimental at - line 22. -The bitwise feature is experimental at - line 23. -The bitwise feature is experimental at - line 24. -The bitwise feature is experimental at - line 25. -The bitwise feature is experimental at - line 26. -The bitwise feature is experimental at - line 27. -The bitwise feature is experimental at - line 28. -The bitwise feature is experimental at - line 29. -The bitwise feature is experimental at - line 30. ######## # op.c use warnings 'precedence'; @@ -1747,13 +1690,13 @@ if (my $w2) { $a=1 } if ($a && (my $w3 = 1)) {$a = 2} EXPECT -Deprecated use of my() in false conditional at - line 2. -Deprecated use of my() in false conditional at - line 3. -Deprecated use of my() in false conditional at - line 4. -Deprecated use of my() in false conditional at - line 5. -Deprecated use of my() in false conditional at - line 6. -Deprecated use of my() in false conditional at - line 7. -Deprecated use of my() in false conditional at - line 8. +Deprecated use of my() in false conditional. This will be a fatal error in Perl 5.30 at - line 2. +Deprecated use of my() in false conditional. This will be a fatal error in Perl 5.30 at - line 3. +Deprecated use of my() in false conditional. This will be a fatal error in Perl 5.30 at - line 4. +Deprecated use of my() in false conditional. This will be a fatal error in Perl 5.30 at - line 5. +Deprecated use of my() in false conditional. This will be a fatal error in Perl 5.30 at - line 6. +Deprecated use of my() in false conditional. This will be a fatal error in Perl 5.30 at - line 7. +Deprecated use of my() in false conditional. This will be a fatal error in Perl 5.30 at - line 8. ######## # op.c $[ = 1; @@ -1761,14 +1704,15 @@ $[ = 1; use warnings 'deprecated'; $[ = 2; ($[) = 2; +$[ = 0; no warnings 'deprecated'; $[ = 3; ($[) = 3; EXPECT -Use of assignment to $[ is deprecated at - line 2. -Use of assignment to $[ is deprecated at - line 3. -Use of assignment to $[ is deprecated at - line 5. -Use of assignment to $[ is deprecated at - line 6. +Use of assignment to $[ is deprecated, and will be fatal in Perl 5.30 at - line 2. +Use of assignment to $[ is deprecated, and will be fatal in Perl 5.30 at - line 3. +Use of assignment to $[ is deprecated, and will be fatal in Perl 5.30 at - line 5. +Use of assignment to $[ is deprecated, and will be fatal in Perl 5.30 at - line 6. ######## # op.c use warnings 'void'; @@ -2024,6 +1968,17 @@ EXPECT Negative repeat count does nothing at - line 3. Negative repeat count does nothing at - line 4. ######## +use Config; +my $non_ieee_fp = ($Config{doublekind} == 9 || + $Config{doublekind} == 10 || + $Config{doublekind} == 11); +if ($non_ieee_fp) { + print <<EOM ; +SKIPPED +# No inf/nan support +EOM + exit ; +} my $a = "inf" + 0; my $b = -$a; my $c = "nan" + 0; @@ -2037,9 +1992,9 @@ my $y = "y" x $b; my $z = "z" x $c; no warnings 'numeric'; EXPECT -Non-finite repeat count does nothing at - line 5. -Non-finite repeat count does nothing at - line 6. -Non-finite repeat count does nothing at - line 7. +Non-finite repeat count does nothing at - line 16. +Non-finite repeat count does nothing at - line 17. +Non-finite repeat count does nothing at - line 18. ######## # NAME warn on stat @array @foo = ("op/stat.t"); @@ -2057,3 +2012,42 @@ Array passed to stat will be coerced to a scalar (did you want stat $foo[0]?) at Array passed to stat will be coerced to a scalar (did you want stat $bar[0]?) at - line 9. Array passed to stat will be coerced to a scalar at - line 10. +######## +# NAME barewords and conditionals near constant folding +use warnings; +my $x1 = !a || !b; # no "in conditional" warnings +my $x2 = !A || !B; # warning-free, because upper-case won't clash +EXPECT +Unquoted string "a" may clash with future reserved word at - line 2. +Unquoted string "b" may clash with future reserved word at - line 2. +######## +# RT #6870: Odd parsing of do...for... +# This was really more a tokenizer bug, but it manifests as spurious warnings +use warnings; +no warnings 'reserved'; +$a=do xa for ax; +do "xa" for ax; +do xa for ax; +do xa for "ax"; +do xa for sin(1); +do xa for (sin(1)); +do xa for "sin"; +do xa for qq(sin); +do xa for my $a; +do xa for my @a; +EXPECT +######## +# TODO [perl #125493 +use warnings; +$_="3.14159"; +tr/0-9/\x{6F0}-\x{6F9}/; +EXPECT +######## +# Useless use of concatenation should appear for any number of args +use warnings; +($a, $b, $c) = (42)x3; +$a.$b; +$a.$b.$c; +EXPECT +Useless use of concatenation (.) or string in void context at - line 4. +Useless use of concatenation (.) or string in void context at - line 5. diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp b/gnu/usr.bin/perl/t/lib/warnings/pp index 3324ccc5638..d94a480a991 100644 --- a/gnu/usr.bin/perl/t/lib/warnings/pp +++ b/gnu/usr.bin/perl/t/lib/warnings/pp @@ -21,6 +21,8 @@ Constant subroutine (anonymous) undefined $foo = sub () { 3 }; undef &$foo; + Invalid negative number (%s) in chr + __END__ # pp.c use warnings 'substr' ; @@ -129,10 +131,8 @@ $_ = "\x80 \xff" ; reverse ; EXPECT ######## -# NAME deprecation of complement with above ff code points -$_ = ~ "\xff"; -$_ = ~ "\x{100}"; +# NAME chr -1 +use warnings 'utf8'; +my $chr = chr(-1); EXPECT -OPTION regex -Use of strings with code points over 0xFF as arguments to 1's complement \(~\) operator is deprecated at - line \d+. -Use of code point 0xFF+EFF is deprecated; the permissible max is 0x7F+ at - line \d+. +Invalid negative number (-1) in chr at - line 2. diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp_hot b/gnu/usr.bin/perl/t/lib/warnings/pp_hot index 702df088772..e660528b524 100644 --- a/gnu/usr.bin/perl/t/lib/warnings/pp_hot +++ b/gnu/usr.bin/perl/t/lib/warnings/pp_hot @@ -136,7 +136,7 @@ print() on closed filehandle STDIN at - line 6. (Are you trying to call print() on dirhandle STDIN?) ######## # pp_hot.c [pp_print] -# [ID 20020425.012] from Dave Steiner <steiner@bakerst.rutgers.edu> +# [ID 20020425.012 (#9030)] from Dave Steiner <steiner@bakerst.rutgers.edu> # This goes segv on 5.7.3 use warnings 'closed' ; my $fh = *STDOUT{IO}; diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp_sys b/gnu/usr.bin/perl/t/lib/warnings/pp_sys index 63389649a83..90d3cc790d6 100644 --- a/gnu/usr.bin/perl/t/lib/warnings/pp_sys +++ b/gnu/usr.bin/perl/t/lib/warnings/pp_sys @@ -761,65 +761,6 @@ chdir() on closed filehandle BAR at - line 21. chdir() on unopened filehandle $dh at - line 22. chdir() on closed filehandle $fh at - line 23. ######## -# pp_sys.c [pp_open] -use warnings; -opendir FOO, "."; -opendir my $foo, "."; -open FOO, "../harness"; -open $foo, "../harness"; -no warnings qw(io deprecated); -open FOO, "../harness"; -open $foo, "../harness"; -EXPECT -Opening dirhandle FOO also as a file at - line 5. -Opening dirhandle $foo also as a file at - line 6. -######## - -# pp_sys.c [pp_open] -use utf8; -use open qw( :utf8 :std ); -use warnings; -opendir FOO, "."; -opendir $foo, "."; -open FOO, "../harness"; -open $foo, "../harness"; -no warnings qw(io deprecated); -open FOO, "../harness"; -open $foo, "../harness"; -EXPECT -Opening dirhandle FOO also as a file at - line 8. -Opening dirhandle $foo also as a file at - line 9. -######## -# pp_sys.c [pp_open_dir] -use warnings; -open FOO, "../harness"; -open my $foo, "../harness"; -opendir FOO, "."; -opendir $foo, "."; -no warnings qw(io deprecated); -opendir FOO, "."; -opendir $foo, "."; -EXPECT -Opening filehandle FOO also as a directory at - line 5. -Opening filehandle $foo also as a directory at - line 6. -######## - -# pp_sys.c [pp_open_dir] -use utf8; -use open qw( :utf8 :std ); -use warnings; -use warnings; -open FOO, "../harness"; -open $foo, "../harness"; -opendir FOO, "."; -opendir $foo, "."; -no warnings qw(io deprecated); -opendir FOO, "."; -opendir $foo, "."; -EXPECT -Opening filehandle FOO also as a directory at - line 9. -Opening filehandle $foo also as a directory at - line 10. -######## # pp_sys.c [pp_*dir] use Config ; BEGIN { @@ -911,6 +852,14 @@ closedir() attempted on invalid dirhandle $foo at - line 23. ######## # pp_sys.c [pp_gmtime] +use Config; +unless ($Config{d_double_has_nan}) { + print <<EOM ; +SKIPPED +# No nan support +EOM + exit ; +} gmtime("NaN"); localtime("NaN"); use warnings "overflow"; @@ -918,10 +867,10 @@ gmtime("NaN"); localtime("NaN"); EXPECT -gmtime(NaN) too large at - line 6. -gmtime(NaN) failed at - line 6. -localtime(NaN) too large at - line 7. -localtime(NaN) failed at - line 7. +gmtime(NaN) too large at - line 14. +gmtime(NaN) failed at - line 14. +localtime(NaN) too large at - line 15. +localtime(NaN) failed at - line 15. ######## # pp_sys.c [pp_alarm] @@ -942,23 +891,39 @@ EXPECT sleep() with negative argument at - line 2. ######## # NAME sysread() deprecated on :utf8 -use warnings 'deprecated'; open my $fh, "<:raw", "../harness" or die "# $!"; my $buf; sysread $fh, $buf, 10; binmode $fh, ':utf8'; sysread $fh, $buf, 10; +no warnings 'deprecated'; +sysread $fh, $buf, 10; EXPECT -sysread() is deprecated on :utf8 handles at - line 6. +sysread() is deprecated on :utf8 handles. This will be a fatal error in Perl 5.30 at - line 5. ######## # NAME syswrite() deprecated on :utf8 my $file = "syswwarn.tmp"; -use warnings 'deprecated'; open my $fh, ">:raw", $file or die "# $!"; syswrite $fh, 'ABC'; binmode $fh, ':utf8'; syswrite $fh, 'ABC'; +no warnings 'deprecated'; +syswrite $fh, 'ABC'; close $fh; unlink $file; EXPECT -syswrite() is deprecated on :utf8 handles at - line 6. +syswrite() is deprecated on :utf8 handles. This will be a fatal error in Perl 5.30 at - line 5. +######## +# NAME stat on name with \0 +use warnings; +my @x = stat("./\0-"); +my @y = lstat("./\0-"); +-T ".\0-"; +-x ".\0-"; +-l ".\0-"; +EXPECT +Invalid \0 character in pathname for stat: ./\0- at - line 2. +Invalid \0 character in pathname for lstat: ./\0- at - line 3. +Invalid \0 character in pathname for fttext: .\0- at - line 4. +Invalid \0 character in pathname for fteexec: .\0- at - line 5. +Invalid \0 character in pathname for ftlink: .\0- at - line 6. diff --git a/gnu/usr.bin/perl/t/lib/warnings/regcomp b/gnu/usr.bin/perl/t/lib/warnings/regcomp index 367276d0fc8..516de419116 100644 --- a/gnu/usr.bin/perl/t/lib/warnings/regcomp +++ b/gnu/usr.bin/perl/t/lib/warnings/regcomp @@ -83,38 +83,27 @@ EXPECT ]]]]][\ ==> Unmatched [ in regex; marked by <-- HERE in m/]]]]][\ <-- HERE / at - line 2. ######## # NAME [perl #123417] -use warnings 'regexp'; -qr/[\N{}]/; -qr/\N{}/; -no warnings 'regexp'; -qr/[\N{}]/; -qr/\N{}/; -no warnings 'deprecated'; -qr/[\N{}]/; -qr/\N{}/; -EXPECT -Unknown charname '' is deprecated at - line 2. -Ignoring zero length \N{} in character class in regex; marked by <-- HERE in m/[\N{} <-- HERE ]/ at - line 2. -Unknown charname '' is deprecated at - line 3. -Unknown charname '' is deprecated at - line 5. -Unknown charname '' is deprecated at - line 6. -######## -# NAME [perl #123417] # OPTION fatal -use warnings 'regexp'; -no warnings 'experimental::re_strict'; -use re 'strict'; qr/[\N{}]/; EXPECT -Unknown charname '' is deprecated at - line 5. -Zero length \N{} in regex; marked by <-- HERE in m/[\N{} <-- HERE ]/ at - line 5. +Unknown charname '' at - line 2, within pattern +Execution of - aborted due to compilation errors. ######## # NAME [perl #123417] # OPTION fatal -use warnings 'regexp'; -no warnings 'experimental::re_strict'; -use re 'strict'; qr/\N{}/; EXPECT -Unknown charname '' is deprecated at - line 5. -Zero length \N{} in regex; marked by <-- HERE in m/\N{} <-- HERE / at - line 5. +Unknown charname '' at - line 2, within pattern +Execution of - aborted due to compilation errors. +######## +# NAME [perl #131868] +use warnings; +my $qr = qr { + (?(DEFINE) + (?<digit> [0-9]) + (?<digits> (?&digit){4}) + ) + ^(?&digits)$ +}x; +EXPECT +######## diff --git a/gnu/usr.bin/perl/t/lib/warnings/regexec b/gnu/usr.bin/perl/t/lib/warnings/regexec index c370ddc3c77..900dd6ee7f4 100644 --- a/gnu/usr.bin/perl/t/lib/warnings/regexec +++ b/gnu/usr.bin/perl/t/lib/warnings/regexec @@ -260,7 +260,3 @@ setlocale(&POSIX::LC_CTYPE, $utf8_locale); "k" =~ /(?[ \N{KELVIN SIGN} ])/i; ":" =~ /(?[ \: ])/; EXPECT -######## -# NAME perl #132063, read beyond buffer end -"\xff" =~ /(?il)\x{100}|\x{100}/; -EXPECT diff --git a/gnu/usr.bin/perl/t/lib/warnings/sv b/gnu/usr.bin/perl/t/lib/warnings/sv index 5ddd4fe1303..64f624c5edb 100644 --- a/gnu/usr.bin/perl/t/lib/warnings/sv +++ b/gnu/usr.bin/perl/t/lib/warnings/sv @@ -200,7 +200,7 @@ $C .= $A ; EXPECT Use of uninitialized value $A in concatenation (.) or string at - line 10. ######## -# perlbug 20011116.125 +# perlbug 20011116.125 (#7917) use warnings 'uninitialized'; $a = undef; $foo = join '', $a, "\n"; @@ -341,10 +341,13 @@ Invalid conversion in sprintf: "%+2L\003" at - line 19. # sv.c use warnings 'misc' ; *a = undef ; +(*c) = (); no warnings 'misc' ; *b = undef ; +(*d) = (); EXPECT Undefined value assigned to typeglob at - line 3. +Undefined value assigned to typeglob at - line 4. ######## # sv.c use warnings 'numeric' ; @@ -413,3 +416,11 @@ Argument "a_c" isn't numeric in preincrement (++) at - line 5. Argument "(?^:abc)" isn't numeric in preincrement (++) at - line 6. Argument "123x" isn't numeric in preincrement (++) at - line 7. Argument "123e" isn't numeric in preincrement (++) at - line 8. +######## +# RT #128257 This used to SEGV +use warnings; +sub Foo::f {} +undef *Foo::; +*Foo::f =sub {}; +EXPECT +Subroutine f redefined at - line 5. diff --git a/gnu/usr.bin/perl/t/lib/warnings/toke b/gnu/usr.bin/perl/t/lib/warnings/toke index 493c8a222c2..ffa6307c619 100644 --- a/gnu/usr.bin/perl/t/lib/warnings/toke +++ b/gnu/usr.bin/perl/t/lib/warnings/toke @@ -2,10 +2,11 @@ toke.c AOK we seem to have lost a few ambiguous warnings!! - - $a = <<; - Use of comma-less variable list is deprecated - (called 3 times via depcom) + Prototype after '@' for main::foo + sub foo (@$) + + Illegal character in prototype for main::foo + sub foo (x) \1 better written as $1 use warnings 'syntax' ; @@ -53,6 +54,11 @@ toke.c AOK printf ("") sort ("") + Old package separator used in string + "$foo'bar" + "@foo'bar" + "$#foo'bar" + Ambiguous use of %c{%s%s} resolved to %c%s%s $a = ${time[2]} $a = ${time{2}} @@ -125,29 +131,74 @@ toke.c AOK *foo *foo __END__ -# toke.c -format STDOUT = -@<<< @||| @>>> @>>> -$a $b "abc" 'def' -. -no warnings 'deprecated' ; -format STDOUT = -@<<< @||| @>>> @>>> -$a $b "abc" 'def' -. -EXPECT -Use of comma-less variable list is deprecated at - line 4. -Use of comma-less variable list is deprecated at - line 4. -Use of comma-less variable list is deprecated at - line 4. -######## -# toke.c -$a = <<; - -no warnings 'deprecated' ; -$a = <<; - +use utf8; +use open qw( :utf8 :std ); +use warnings; +eval "sub fòò (@\$\0) {}"; EXPECT -Use of bare << to mean <<"" is deprecated at - line 2. +Prototype after '@' for main::fòò : @$\0 at (eval 1) line 1. +Illegal character in prototype for main::fòò : @$\0 at (eval 1) line 1. +######## +use utf8; +use open qw( :utf8 :std ); +use warnings; +eval "sub foo (@\0) {}"; +eval "sub foo2 :prototype(@\0) {}"; +EXPECT +Prototype after '@' for main::foo : @\0 at (eval 1) line 1. +Illegal character in prototype for main::foo : @\0 at (eval 1) line 1. +Prototype after '@' for main::foo2 : @\x{0} at (eval 2) line 1. +Illegal character in prototype for main::foo2 : @\x{0} at (eval 2) line 1. +######## +BEGIN { + if (ord('A') == 193) { + print "SKIPPED\n# Different results on EBCDIC"; + exit 0; + } +} +use utf8; +use open qw( :utf8 :std ); +use warnings; +BEGIN { $::{"foo"} = "\@\$\0L\351on" } +BEGIN { eval "sub foo (@\$\0L\x{c3}\x{a9}on) {}"; } +EXPECT +Prototype after '@' for main::foo : @$\x{0}L... at (eval 1) line 1. +Illegal character in prototype for main::foo : @$\x{0}L... at (eval 1) line 1. +######## +use utf8; +use open qw( :utf8 :std ); +use warnings; +BEGIN { eval "sub foo (@\0) {}"; } +EXPECT +Prototype after '@' for main::foo : @\0 at (eval 1) line 1. +Illegal character in prototype for main::foo : @\0 at (eval 1) line 1. +######## +use warnings; +eval "sub foo (@\xAB) {}"; +EXPECT +Prototype after '@' for main::foo : @\x{ab} at (eval 1) line 1. +Illegal character in prototype for main::foo : @\x{ab} at (eval 1) line 1. +######## +use utf8; +use open qw( :utf8 :std ); +use warnings; +BEGIN { eval "sub foo (@\x{30cb}) {}"; } +EXPECT +Prototype after '@' for main::foo : @\x{30cb} at (eval 1) line 1. +Illegal character in prototype for main::foo : @\x{30cb} at (eval 1) line 1. +######## +use warnings; +sub f ([); +sub f :prototype([) +EXPECT +Missing ']' in prototype for main::f : [ at - line 2. +Missing ']' in prototype for main::f : [ at - line 3. +######## +use warnings; +package bar { sub bar { eval q"sub foo ([)" } } +bar::bar +EXPECT +Missing ']' in prototype for bar::foo : [ at (eval 1) line 1. ######## # toke.c $a =~ m/$foo/eq; @@ -366,6 +417,40 @@ sort ("") EXPECT ######## +use warnings 'syntax'; +@foo::bar = 1..3; +() = "$foo'bar"; +() = "@foo'bar"; +() = "$#foo'bar"; +no warnings 'syntax' ; +() = "$foo'bar"; +() = "@foo'bar"; +() = "$#foo'bar"; +EXPECT +Old package separator used in string at - line 3. + (Did you mean "$foo\'bar" instead?) +Old package separator used in string at - line 4. + (Did you mean "@foo\'bar" instead?) +Old package separator used in string at - line 5. + (Did you mean "$#foo\'bar" instead?) +######## +use warnings 'syntax'; use utf8; +@fooл::barл = 1..3; +() = "$fooл'barл"; +() = "@fooл'barл"; +() = "$#fooл'barл"; +no warnings 'syntax' ; +() = "$fooл'barл"; +() = "@fooл'barл"; +() = "$#fooл'barл"; +EXPECT +Old package separator used in string at - line 3. + (Did you mean "$fooл\'barл" instead?) +Old package separator used in string at - line 4. + (Did you mean "@fooл\'barл" instead?) +Old package separator used in string at - line 5. + (Did you mean "$#fooл\'barл" instead?) +######## # toke.c use warnings 'ambiguous' ; $a = ${time[2]}; @@ -668,6 +753,34 @@ _123 12340000000000 ######## # toke.c +use warnings 'syntax'; +$a = 1_; print "$a\n"; +$a = 01_; print "$a\n"; +$a = 0_; print "$a\n"; +$a = 0x1_; print "$a\n"; +$a = 0x_; print "$a\n"; +$a = 1.2_; print "$a\n"; +$a = 1._2; print "$a\n"; +$a = 1._; print "$a\n"; +EXPECT +Misplaced _ in number at - line 3. +Misplaced _ in number at - line 4. +Misplaced _ in number at - line 5. +Misplaced _ in number at - line 6. +Misplaced _ in number at - line 7. +Misplaced _ in number at - line 8. +Misplaced _ in number at - line 9. +Misplaced _ in number at - line 10. +1 +1 +0 +1 +0 +1.2 +1.2 +1 +######## +# toke.c use warnings 'bareword' ; #line 25 "bar" $a = FRED:: ; @@ -1069,11 +1182,28 @@ Integer overflow in octal number at - line 11. ######## # toke.c BEGIN { $^C = 1; } +dump; +CORE::dump; +EXPECT +dump() better written as CORE::dump(). dump() will no longer be available in Perl 5.30 at - line 3. +- syntax OK +######## +# toke.c +BEGIN { $^C = 1; } +no warnings 'deprecated'; +dump; +CORE::dump; +EXPECT +- syntax OK +######## +# toke.c +BEGIN { $^C = 1; } +no warnings 'deprecated'; use warnings 'misc'; dump; CORE::dump; EXPECT -dump() better written as CORE::dump() at - line 4. +dump() better written as CORE::dump(). dump() will no longer be available in Perl 5.30 at - line 5. - syntax OK ######## # toke.c @@ -1112,6 +1242,11 @@ no warnings 'ambiguous'; EXPECT Possible unintended interpolation of @mjd_previously_unused_ぁrrぁy in string at - line 5. ######## +-w +# toke.c +$_ = "@DB::args"; +EXPECT +######## # toke.c # 20020328 mjd-perl-patch+@plover.com at behest of jfriedl@yahoo.com use warnings 'regexp'; @@ -1208,27 +1343,7 @@ EXPECT !=~ should be !~ at - line 9. ######## # toke.c -our $foo :unique; -sub pam :locked; -sub glipp :locked { -} -sub whack_eth ($) : locked { -} -no warnings 'deprecated'; -our $bar :unique; -sub zapeth :locked; -sub ker_plop :locked { -} -sub swa_a_p ($) : locked { -} -EXPECT -Use of :unique is deprecated at - line 2. -Use of :locked is deprecated at - line 3. -Use of :locked is deprecated at - line 4. -Use of :locked is deprecated at - line 6. -######## -# toke.c -use warnings "syntax"; use feature 'lexical_subs'; +use warnings "syntax"; sub proto_after_array(@$); sub proto_after_arref(\@$); sub proto_after_arref2(\[@$]); @@ -1238,7 +1353,7 @@ sub proto_after_hashref(\%$); sub proto_after_hashref2(\[%$]); sub underscore_last_pos($_); sub underscore2($_;$); -sub underscore_fail($_$); +sub underscore_fail($_$); sub underscore_fail2 : prototype($_$); sub underscore_after_at(@_); our sub hour (@$); my sub migh (@$); @@ -1256,12 +1371,10 @@ EXPECT Prototype after '@' for main::proto_after_array : @$ at - line 3. Prototype after '%' for main::proto_after_hash : %$ at - line 7. Illegal character after '_' in prototype for main::underscore_fail : $_$ at - line 12. +Illegal character after '_' in prototype for main::underscore_fail2 : $_$ at - line 12. Prototype after '@' for main::underscore_after_at : @_ at - line 13. -The lexical_subs feature is experimental at - line 14. Prototype after '@' for hour : @$ at - line 14. -The lexical_subs feature is experimental at - line 15. Prototype after '@' for migh : @$ at - line 15. -The lexical_subs feature is experimental at - line 17. Prototype after '@' for estate : @$ at - line 17. Prototype after '@' for hour : @$ at - line 19. Prototype after '@' for migh : @$ at - line 20. @@ -1509,3 +1622,89 @@ my $v = 𝛃 - 5; EXPECT OPTION regex (Wide character.*\n)?Warning: Use of "𝛃" without parentheses is ambiguous +######## +# RT #4346 Case 1: Warnings for print (...) +# TODO RT #4346: Warnings for print(...) are inconsistent +use warnings; +print ("((\n"); +print (">>\n"); +EXPECT +print (...) interpreted as function at - line 3. +print (...) interpreted as function at - line 4. +(( +>> +######## +# RT #4346 Case 2: Warnings for print (...) +use warnings; +print ("((\n"); +print (">>\n") +EXPECT +print (...) interpreted as function at - line 3. +print (...) interpreted as function at - line 4. +(( +>> +######## +# RT #4346 Case 3: Warnings for print (...) +# TODO RT #4346: Warnings for print(...) are inconsistent +use warnings; +print (">>\n"); +print ("((\n"); +EXPECT +print (...) interpreted as function at - line 3. +print (...) interpreted as function at - line 4. +>> +(( +######## +# RT #4346 Case 4: Warnings for print (...) +# TODO RT #4346: Warnings for print(...) are inconsistent +use warnings; +print (")\n"); +print ("))\n"); +EXPECT +print (...) interpreted as function at - line 3. +print (...) interpreted as function at - line 4. +) +)) +######## +# NAME Non-grapheme delimiters +BEGIN{ + if (ord('A') == 193) { + print "SKIPPED\n# ebcdic platforms generates different Malformed UTF-8 warnings."; + exit 0; + } +} +use utf8; +my $a = qr ̂foobar̂; +EXPECT +Use of unassigned code point or non-standalone grapheme for a delimiter will be a fatal error starting in Perl 5.30 at - line 8. +######## +# NAME [perl #130567] Assertion failure +BEGIN { + if (ord('A') != 65) { + print "SKIPPED\n# test is ASCII-specific"; + exit 0; + } +} +no warnings "uninitialized"; +$_= ""; +s//\3000/; +s//"\x{180};;s\221(*$@$`\241\275";/gee; +s//"s\221\302\302\302\302\302\302\302$@\241\275";/gee; +EXPECT +######## +# NAME [perl #130666] Assertion failure +no warnings "uninitialized"; +BEGIN{$^H=-1};my $l; s +EXPECT +######## +# NAME [perl #129036] Assertion failure +BEGIN{$0="";$^H=hex join""=>A00000}p? +EXPECT +OPTION fatal +syntax error at - line 1, at EOF +Execution of - aborted due to compilation errors. +######## +# NAME [perl #130655] +use utf8; +qw∘foo ∞ ♥ bar∘ +EXPECT diff --git a/gnu/usr.bin/perl/t/lib/warnings/utf8 b/gnu/usr.bin/perl/t/lib/warnings/utf8 index 4263c04958a..a9a6388d31e 100644 --- a/gnu/usr.bin/perl/t/lib/warnings/utf8 +++ b/gnu/usr.bin/perl/t/lib/warnings/utf8 @@ -15,6 +15,7 @@ __END__ # utf8.c [utf8_to_uvchr_buf] -W +# NAME Malformed under 'use utf8' in double-quoted string BEGIN { if (ord('A') == 193) { print "SKIPPED\n# ebcdic platforms generates different Malformed UTF-8 warnings."; @@ -22,16 +23,25 @@ BEGIN { } } use utf8 ; +no warnings; # Malformed is a fatal error, so gets output anyway. my $a = "snstorm" ; -{ - no warnings 'utf8' ; - my $a = "snstorm"; - use warnings 'utf8' ; - my $a = "snstorm"; +EXPECT +Malformed UTF-8 character: \xf8\x73\x74\x6f\x72 (unexpected non-continuation byte 0x73, immediately after start byte 0xf8; need 5 bytes, got 1) at - line 10. +Malformed UTF-8 character (fatal) at - line 10. +######## +# NAME Malformed under 'use utf8' in single-quoted string +BEGIN { + if (ord('A') == 193) { + print "SKIPPED\n# ebcdic platforms generates different Malformed UTF-8 warnings."; + exit 0; + } } +use utf8 ; +no warnings; # Malformed is a fatal error, so gets output anyway. +my $a = 'snstorm' ; EXPECT -Malformed UTF-8 character (unexpected non-continuation byte 0x73, immediately after start byte 0xf8) at - line 9. -Malformed UTF-8 character (unexpected non-continuation byte 0x73, immediately after start byte 0xf8) at - line 14. +Malformed UTF-8 character: \xf8\x73\x74\x6f\x72 (unexpected non-continuation byte 0x73, immediately after start byte 0xf8; need 5 bytes, got 1) at - line 9. +Malformed UTF-8 character (fatal) at - line 9. ######## use warnings 'utf8'; my $d7ff = uc(chr(0xD7FF)); @@ -89,12 +99,11 @@ Operation "uc" returns its argument for non-Unicode code point 0x110000 at - lin Operation "uc" returns its argument for UTF-16 surrogate U+D800 at - line 5. ######## use warnings 'utf8'; -no warnings 'deprecated'; # This is above IV_MAX on 32 bit machines -my $big_nonUnicode = uc(chr(0x8000_0000)); +my $big_nonUnicode = uc(chr(0x7FFF_FFFF)); no warnings 'non_unicode'; -my $big_nonUnicode = uc(chr(0x8000_0000)); +my $big_nonUnicode = uc(chr(0x7FFF_FFFF)); EXPECT -Operation "uc" returns its argument for non-Unicode code point 0x80000000 at - line 3. +Operation "uc" returns its argument for non-Unicode code point 0x7FFFFFFF at - line 2. ######## use warnings 'utf8'; my $d7ff = lc pack("U", 0xD7FF); @@ -726,37 +735,25 @@ $a = uc("\x{103}"); $a = ucfirst("\x{104}"); EXPECT ######## -# NAME Deprecation of too-large code points +# NAME Fatality of too-large code points, but IV_MAX works, warns require "../test.pl"; use warnings 'non_unicode'; my $max_cp = ~0 >> 1; my $max_char = chr $max_cp; -my $to_warn_cp = $max_cp + 1; -my $to_warn_char = chr $to_warn_cp; -$max_char =~ /[\x{110000}\P{Unassigned}]/; -$to_warn_char =~ /[\x{110000}\P{Unassigned}]/; my $temp = qr/$max_char/; -$temp = qr/$to_warn_char/; $temp = uc($max_char); -$temp = uc($to_warn_char); +$max_char =~ /[\x{110000}\P{Unassigned}]/; my $file = tempfile(); open(my $fh, "+>:utf8", $file); print $fh $max_char, "\n"; -print $fh $to_warn_char, "\n"; close $fh; +my $error_cp = $max_cp + 1; +my $error_char = chr $error_cp; EXPECT -OPTION regex -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ at - line \d+. -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ in pattern match \(m//\) at - line \d+. -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ in regexp compilation at - line \d+. -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ in regexp compilation at - line \d+. -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ at - line \d+. -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ in regexp compilation at - line \d+. +OPTIONS fatal regex Operation "uc" returns its argument for non-Unicode code point 0x7F+ at - line \d+. -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ at - line \d+. -Operation "uc" returns its argument for non-Unicode code point 0x80+ at - line \d+. -Code point 0x7F+ is not Unicode, may not be portable in print at - line \d+. -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ in print at - line \d+. +Code point 0x7F+ is not Unicode, (may not be|requires a Perl extension, and so is not) portable in print at - line \d+. +Use of code point 0x80+ is not allowed; the permissible max is 0x7F+\ at - line \d+. ######## # NAME [perl #127262] BEGIN{ @@ -764,6 +761,25 @@ BEGIN{ print "SKIPPED\n# ebcdic platforms generates different Malformed UTF-8 warnings."; exit 0; } -{};$^H=2**400} + use Config; + unless ($Double{double_style_ieee}) { + print "SKIPPED\n# non-IEEE fp range."; + exit 0; + } +{};$^H=eval'2**400'} +EXPECT +Malformed UTF-8 character: \xc2\x0a (unexpected non-continuation byte 0x0a, immediately after start byte 0xc2; need 2 bytes, got 1) at - line 11. +######## +# NAME [perl #131646] +BEGIN{ + if (ord('A') == 193) { + print "SKIPPED\n# ebcdic platforms generates different Malformed UTF-8 warnings."; + exit 0; + } +} +no warnings; +use warnings 'utf8'; +for(uc 0..t){0~~pack"UXc",exp} EXPECT -Malformed UTF-8 character (unexpected non-continuation byte 0x0a, immediately after start byte 0xc2) at - line 6. +OPTIONS regex +Malformed UTF-8 character: \\x([[:xdigit:]]{2})\\x([[:xdigit:]]{2}) \(unexpected non-continuation byte 0x\2, immediately after start byte 0x\1; need 2 bytes, got 1\) in smart match at - line 9. |