This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Reduce false positives for @hsh{$s} and @ary[$s] warnings
[perl5.git] / t / lib / warnings / op
index 8f57920..bb46eb8 100644 (file)
@@ -1,8 +1,15 @@
   op.c         AOK
 
+     Use of my $_ is experimental
+       my $_ ;
+
      Found = in conditional, should be ==
        1 if $a = 1 ;
 
+     Scalar value %.*s better written as $%.*s" 
+       @a[3] = 2;
+       @a{3} = 2;
+
      Useless use of time in void context
      Useless use of a variable in void context
      Useless use of a constant in void context
@@ -73,6 +80,8 @@
        (Maybe you should just omit the defined()?)
        my %h ; defined %h ;
 
+     "my %s" used in sort comparison
+
      $[ used in comparison (did you mean $] ?)
 
      length() used on @array (did you mean "scalar(@array)"?)
         sub fred() ;
         sub fred($) {}
 
-    Runaway prototype          [newSUB]        TODO
     oops: oopsAV               [oopsAV]        TODO
     oops: oopsHV               [oopsHV]        TODO
     
 __END__
 # op.c
+use warnings 'experimental::lexical_topic' ;
+my $_;
+CORE::state $_;
+no warnings 'experimental::lexical_topic' ;
+my $_;
+CORE::state $_;
+EXPECT
+Use of my $_ is experimental at - line 3.
+Use of state $_ is experimental at - line 4.
+########
+# op.c
 use warnings 'syntax' ;
 1 if $a = 1 ;
+1 if $a
+  = 1 ;
 no warnings 'syntax' ;
 1 if $a = 1 ;
+1 if $a
+  = 1 ;
 EXPECT
 Found = in conditional, should be == at - line 3.
+Found = in conditional, should be == at - line 4.
 ########
 # op.c
 use warnings 'syntax' ;
@@ -119,6 +143,165 @@ no warnings 'syntax' ;
 EXPECT
 ########
 # op.c
+use warnings 'syntax' ;
+@a[3];
+@a{3};
+@a["]"];
+@a{"]"};
+@a["}"];
+@a{"}"};
+@a{$_};
+@a{--$_};
+@a[$_];
+@a[--$_];
+no warnings 'syntax' ;
+@a[3];
+@a{3};
+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.
+Scalar value @a["]"] better written as $a["]"] at - line 5.
+Scalar value @a{"]"} better written as $a{"]"} at - line 6.
+Scalar value @a["}"] better written as $a["}"] at - line 7.
+Scalar value @a{"}"} better written as $a{"}"} at - line 8.
+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.
+########
+# op.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'syntax' ;
+@à[3];
+@à{3};
+no warnings 'syntax' ;
+@à[3];
+@à{3};
+EXPECT
+Scalar value @à[3] better written as $à[3] at - line 5.
+Scalar value @à{3} better written as $à{3} at - line 6.
+########
+# op.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'syntax' ;
+@ぁ[3];
+@ぁ{3};
+no warnings 'syntax' ;
+@ぁ[3];
+@ぁ{3};
+EXPECT
+Scalar value @ぁ[3] better written as $ぁ[3] at - line 5.
+Scalar value @ぁ{3} better written as $ぁ{3} at - line 6.
+########
+# op.c
+# "Scalar value better written as" false positives
+# [perl #28380] and [perl #114024]
+use warnings 'syntax';
+
+# hashes
+@h{qw"a b c"} = 1..3;
+@h{qw'a b c'} = 1..3;
+@h{qw$a b c$} = 1..3;
+@h{qw-a b c-} = 1..3;
+@h{qw#a b c#} = 1..3;
+@h{ qw#a b c#} = 1..3;
+@h{    qw#a b c#} = 1..3; # tab before qw
+@h{qw "a"};
+@h{ qw "a"};
+@h{    qw "a"};
+sub foo() { qw/abc def ghi/ }
+@X{+foo} = ( 1 .. 3 );
+$_ = "abc"; @X{split ""} = ( 1 .. 3 );
+my @s = @f{"}", "a"};
+my @s = @f{"]", "a"};
+@a{$],0};
+@_{0} = /(.*)/;
+@h{m "$re"};
+@h{qx ""} if 0;
+@h{glob ""};
+@h{readline ""};
+@h{m ""};
+use constant phoo => 1..3;
+@h{+phoo}; # rv2av
+{
+    no warnings 'deprecated';
+    @h{each H};
+    @h{values H};
+    @h{keys H};
+}
+@h{sort foo};
+@h{reverse foo};
+@h{caller 0};
+@h{lstat ""};
+@h{stat ""};
+@h{readdir ""};
+@h{system ""} if 0;
+@h{+times} if 0;
+@h{localtime 0};
+@h{gmtime 0};
+@h{eval ""};
+@h{each $foo} if 0;
+@h{keys $foo} if 0;
+@h{values $foo} if 0;
+
+# arrays
+@h[qw"a b c"] = 1..3;
+@h[qw'a b c'] = 1..3;
+@h[qw$a b c$] = 1..3;
+@h[qw-a b c-] = 1..3;
+@h[qw#a b c#] = 1..3;
+@h[ qw#a b c#] = 1..3;
+@h[    qw#a b c#] = 1..3; # tab before qw
+@h[qw "a"];
+@h[ qw "a"];
+@h[    qw "a"];
+sub foo() { qw/abc def ghi/ }
+@X[+foo] = ( 1 .. 3 );
+$_ = "abc"; @X[split ""] = ( 1 .. 3 );
+my @s = @f["}", "a"];
+my @s = @f["]", "a"];
+@a[$],0];
+@_[0] = /(.*)/;
+@h[m "$re"];
+@h[qx ""] if 0;
+@h[glob ""];
+@h[readline ""];
+@h[m ""];
+use constant phoo => 1..3;
+@h[+phoo]; # rv2av
+{
+    no warnings 'deprecated';
+    @h[each H];
+    @h[values H];
+    @h[keys H];
+}
+@h[sort foo];
+@h[reverse foo];
+@h[caller 0];
+@h[lstat ""];
+@h[stat ""];
+@h[readdir ""];
+@h[system ""] if 0;
+@h[+times] if 0;
+@h[localtime 0];
+@h[gmtime 0];
+@h[eval ""];
+@h[each $foo] if 0;
+@h[keys $foo] if 0;
+@h[values $foo] if 0;
+EXPECT
+########
+# op.c
+# "Scalar value better written as" should not trigger for syntax errors
+use warnings 'syntax';
+@a[]
+EXPECT
+syntax error at - line 4, near "[]"
+Execution of - aborted due to compilation errors.
+########
+# op.c
 my (@foo, %foo);
 %main::foo->{"bar"};
 %foo->{"bar"};
@@ -148,8 +331,10 @@ Using an array as a reference is deprecated at - line 9.
 Using an array as a reference is deprecated at - line 10.
 ########
 # op.c
-use warnings 'void' ; close STDIN ;
-1 x 3 ;                        # OP_REPEAT
+use warnings 'void' ; no warnings 'experimental::smartmatch'; close STDIN ;
+#line 2
+1 x 3 ;                        # OP_REPEAT (folded)
+(1) x 3 ;              # OP_REPEAT
                        # OP_GVSV
 wantarray ;            # OP_WANTARRAY
                        # OP_GV
@@ -203,9 +388,13 @@ eval { getpwuid 1 };       # OP_GPWUID
 prototype "foo";       # OP_PROTOTYPE
 $a ~~ $b;              # OP_SMARTMATCH
 $a <=> $b;             # OP_NCMP
+"dsatrewq";
+"diatrewq";
+"igatrewq";
 use 5.015;
 __SUB__                        # OP_RUNCV
 EXPECT
+Useless use of a constant ("111") in void context at - line 2.
 Useless use of repeat (x) in void context at - line 3.
 Useless use of wantarray in void context at - line 5.
 Useless use of reference-type operator in void context at - line 12.
@@ -246,7 +435,10 @@ Useless use of getpwuid in void context at - line 53.
 Useless use of subroutine prototype in void context at - line 54.
 Useless use of smart match in void context at - line 55.
 Useless use of numeric comparison (<=>) in void context at - line 56.
-Useless use of __SUB__ in void context at - line 58.
+Useless use of a constant ("dsatrewq") in void context at - line 57.
+Useless use of a constant ("diatrewq") in void context at - line 58.
+Useless use of a constant ("igatrewq") in void context at - line 59.
+Useless use of __SUB__ in void context at - line 61.
 ########
 # op.c
 use warnings 'void' ; close STDIN ;
@@ -529,6 +721,7 @@ U;
 qq/"   \n/;
 5 || print "bad\n";    # test OPpCONST_SHORTCIRCUIT
 print "boo\n" if U;    # test OPpCONST_SHORTCIRCUIT
+if($foo){}elsif(""){}  # test OPpCONST_SHORTCIRCUIT
 no warnings 'void' ;
 "abc"; # OP_CONST
 7 ; # OP_CONST
@@ -580,6 +773,7 @@ my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;my $d = 'test';
 %$c =~ tr/a/b/ ;
 $d =~ tr/a/b/d ;
 $d2 =~ tr/a/bc/;
+$d3 =~ tr//b/c;
 {
 no warnings 'misc' ;
 my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ; my $d = 'test';
@@ -597,6 +791,7 @@ my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ; my $d = 'test';
 %$c =~ tr/a/b/ ;
 $d =~ tr/a/b/d ;
 $d =~ tr/a/bc/ ;
+$d =~ tr//b/c;
 }
 EXPECT
 Applying pattern match (m//) to @a will act on scalar(@a) at - line 5.
@@ -614,7 +809,7 @@ Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 16
 Useless use of /d modifier in transliteration operator at - line 17.
 Replacement list is longer than search list at - line 18.
 Can't modify array dereference in substitution (s///) at - line 6, near "s/a/b/ ;"
-BEGIN not safe after errors--compilation aborted at - line 20.
+BEGIN not safe after errors--compilation aborted at - line 21.
 ########
 # op.c
 use warnings 'parenthesis' ;
@@ -660,28 +855,43 @@ Bareword found in conditional at - line 3.
 use warnings 'misc' ;
 open FH, "<abc" ;
 $x = 1 if $x = <FH> ;
+$x = 1 if $x
+     = <FH> ;
 no warnings 'misc' ;
 $x = 1 if $x = <FH> ;
+$x = 1 if $x
+     = <FH> ;
 EXPECT
 Value of <HANDLE> construct can be "0"; test with defined() at - line 4.
+Value of <HANDLE> construct can be "0"; test with defined() at - line 5.
 ########
 # op.c
 use warnings 'misc' ;
 opendir FH, "." ;
 $x = 1 if $x = readdir FH ;
+$x = 1 if $x
+    = readdir FH ;
 no warnings 'misc' ;
 $x = 1 if $x = readdir FH ;
+$x = 1 if $x
+    = readdir FH ;
 closedir FH ;
 EXPECT
 Value of readdir() operator can be "0"; test with defined() at - line 4.
+Value of readdir() operator can be "0"; test with defined() at - line 5.
 ########
 # op.c
 use warnings 'misc' ;
 $x = 1 if $x = <*> ;
+$x = 1 if $x
+    = <*> ;
 no warnings 'misc' ;
 $x = 1 if $x = <*> ;
+$x = 1 if $x
+    = <*> ;
 EXPECT
 Value of glob construct can be "0"; test with defined() at - line 3.
+Value of glob construct can be "0"; test with defined() at - line 4.
 ########
 # op.c
 use warnings 'misc' ;
@@ -722,10 +932,15 @@ EXPECT
 use warnings 'redefine' ;
 sub fred {}
 sub fred {}
+sub fred { # warning should be for this line
+}
 no warnings 'redefine' ;
 sub fred {}
+sub fred {
+}
 EXPECT
 Subroutine fred redefined at - line 4.
+Subroutine fred redefined at - line 5.
 ########
 # op.c
 use warnings 'redefine' ;
@@ -749,6 +964,28 @@ EXPECT
 Constant subroutine main::fred redefined at - line 3.
 ########
 # op.c
+use feature "lexical_subs", "state";
+my sub fred () { 1 }
+sub fred { 2 };
+my sub george { 1 }
+sub george () { 2 } # should *not* produce redef warnings by default
+state sub phred () { 1 }
+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
 no warnings 'redefine' ;
 sub fred () { 1 }
 sub fred () { 2 }
@@ -787,7 +1024,7 @@ EXPECT
 Hash %FRED missing the % in argument 1 of keys() at - line 2.
 ########
 # op.c
-use warnings 'syntax' ;
+use warnings 'exec' ;
 exec "$^X -e 1" ; 
 my $a
 EXPECT
@@ -795,7 +1032,7 @@ Statement unlikely to be reached at - line 4.
        (Maybe you meant system() when you said exec()?)
 ########
 # op.c, no warning if exec isn't a statement.
-use warnings 'syntax' ;
+use warnings 'exec' ;
 $a || exec "$^X -e 1" ;
 my $a
 EXPECT
@@ -831,7 +1068,7 @@ defined(%hash) is deprecated at - line 2.
        (Maybe you should just omit the defined()?)
 ########
 # op.c
-no warnings 'syntax' ;
+no warnings 'exec' ;
 exec "$^X -e 1" ; 
 my $a
 EXPECT
@@ -840,8 +1077,13 @@ EXPECT
 # op.c
 sub fred();
 sub fred($) {}
+use constant foo=>bar; sub foo(@);
+use constant bav=>bar; sub bav(); # no warning
+sub btu; sub btu();
 EXPECT
 Prototype mismatch: sub main::fred () vs ($) at - line 3.
+Prototype mismatch: sub foo () vs (@) at - line 4.
+Prototype mismatch: sub btu: none vs () at - line 6.
 ########
 # op.c
 use utf8;
@@ -855,34 +1097,54 @@ Prototype mismatch: sub main::frèd () vs ($) at - line 5.
 use utf8;
 use open qw( :utf8 :std );
 use warnings;
-eval "sub fòò (\$\0) {}";
+eval "sub fòò (@\$\0) {}";
 EXPECT
-Illegal character in prototype for main::fòò : $\x{0} at (eval 1) line 1.
+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) {}";
+eval "sub foo (@\0) {}";
 EXPECT
-Illegal character in prototype for main::foo : \x{0} at (eval 1) line 1.
+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 utf8;
 use open qw( :utf8 :std );
 use warnings;
-BEGIN { $::{"foo"} = "\$\0L\351on" }
-BEGIN { eval "sub foo (\$\0L\x{c3}\x{a9}on) {}"; }
+BEGIN { $::{"foo"} = "\@\$\0L\351on" }
+BEGIN { eval "sub foo (@\$\0L\x{c3}\x{a9}on) {}"; }
 EXPECT
-Illegal character in prototype for main::foo : $\x{0}L... at (eval 1) line 1.
+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) {}"; }
+BEGIN { eval "sub foo (@\0) {}"; }
 EXPECT
-Illegal character in prototype for main::foo : \x{0} at (eval 1) line 1.
+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;
@@ -912,6 +1174,116 @@ Prototype mismatch: sub main::fred () vs ($) at - line 4.
 Prototype mismatch: sub main::freD () vs ($) at - line 11.
 Prototype mismatch: sub main::FRED () vs ($) at - line 14.
 ########
+# op.c [S_simplify_sort]
+# [perl #86136]
+my @tests = split /^/, '
+  sort {$a <=> $b} @a;
+  sort {$a cmp $b} @a;
+  { use integer; sort {$a <=> $b} @a}
+  sort {$b <=> $a} @a;
+  sort {$b cmp $a} @a;
+  { use integer; sort {$b <=> $a} @a}
+';
+for my $pragma ('use warnings "syntax";', '') {
+  for my $vars ('', 'my $a;', 'my $b;', 'my ($a,$b);') {
+    for my $inner_stmt ('', 'print;', 'func();') {
+      eval "#line " . ++$line . "01 -\n$pragma\n$vars"
+          . join "", map s/sort \{\K/$inner_stmt/r, @tests;
+      $@ and die;
+    }
+  }
+}
+sub func{}
+use warnings 'syntax';
+my $a;
+# These used to be errors!
+sort { ; } $a <=> $b;
+sort { ; } $a, "<=>";
+sort { ; } $a, $cmp;
+sort $a, $b if $cmpany_name;
+sort if $a + $cmp;
+sort @t; $a + $cmp;
+EXPECT
+"my $a" used in sort comparison at - line 403.
+"my $a" used in sort comparison at - line 404.
+"my $a" used in sort comparison at - line 405.
+"my $a" used in sort comparison at - line 406.
+"my $a" used in sort comparison at - line 407.
+"my $a" used in sort comparison at - line 408.
+"my $a" used in sort comparison at - line 503.
+"my $a" used in sort comparison at - line 504.
+"my $a" used in sort comparison at - line 505.
+"my $a" used in sort comparison at - line 506.
+"my $a" used in sort comparison at - line 507.
+"my $a" used in sort comparison at - line 508.
+"my $a" used in sort comparison at - line 603.
+"my $a" used in sort comparison at - line 604.
+"my $a" used in sort comparison at - line 605.
+"my $a" used in sort comparison at - line 606.
+"my $a" used in sort comparison at - line 607.
+"my $a" used in sort comparison at - line 608.
+"my $b" used in sort comparison at - line 703.
+"my $b" used in sort comparison at - line 704.
+"my $b" used in sort comparison at - line 705.
+"my $b" used in sort comparison at - line 706.
+"my $b" used in sort comparison at - line 707.
+"my $b" used in sort comparison at - line 708.
+"my $b" used in sort comparison at - line 803.
+"my $b" used in sort comparison at - line 804.
+"my $b" used in sort comparison at - line 805.
+"my $b" used in sort comparison at - line 806.
+"my $b" used in sort comparison at - line 807.
+"my $b" used in sort comparison at - line 808.
+"my $b" used in sort comparison at - line 903.
+"my $b" used in sort comparison at - line 904.
+"my $b" used in sort comparison at - line 905.
+"my $b" used in sort comparison at - line 906.
+"my $b" used in sort comparison at - line 907.
+"my $b" used in sort comparison at - line 908.
+"my $a" used in sort comparison at - line 1003.
+"my $b" used in sort comparison at - line 1003.
+"my $a" used in sort comparison at - line 1004.
+"my $b" used in sort comparison at - line 1004.
+"my $a" used in sort comparison at - line 1005.
+"my $b" used in sort comparison at - line 1005.
+"my $b" used in sort comparison at - line 1006.
+"my $a" used in sort comparison at - line 1006.
+"my $b" used in sort comparison at - line 1007.
+"my $a" used in sort comparison at - line 1007.
+"my $b" used in sort comparison at - line 1008.
+"my $a" used in sort comparison at - line 1008.
+"my $a" used in sort comparison at - line 1103.
+"my $b" used in sort comparison at - line 1103.
+"my $a" used in sort comparison at - line 1104.
+"my $b" used in sort comparison at - line 1104.
+"my $a" used in sort comparison at - line 1105.
+"my $b" used in sort comparison at - line 1105.
+"my $b" used in sort comparison at - line 1106.
+"my $a" used in sort comparison at - line 1106.
+"my $b" used in sort comparison at - line 1107.
+"my $a" used in sort comparison at - line 1107.
+"my $b" used in sort comparison at - line 1108.
+"my $a" used in sort comparison at - line 1108.
+"my $a" used in sort comparison at - line 1203.
+"my $b" used in sort comparison at - line 1203.
+"my $a" used in sort comparison at - line 1204.
+"my $b" used in sort comparison at - line 1204.
+"my $a" used in sort comparison at - line 1205.
+"my $b" used in sort comparison at - line 1205.
+"my $b" used in sort comparison at - line 1206.
+"my $a" used in sort comparison at - line 1206.
+"my $b" used in sort comparison at - line 1207.
+"my $a" used in sort comparison at - line 1207.
+"my $b" used in sort comparison at - line 1208.
+"my $a" used in sort comparison at - line 1208.
+########
+# op.c [S_simplify_sort]
+use warnings 'syntax'; use 5.01;
+state $a;
+sort { $a <=> $b } ();
+EXPECT
+"state $a" used in sort comparison at - line 4.
+########
 # op.c [Perl_ck_cmp]
 use warnings 'syntax' ;
 no warnings 'deprecated';
@@ -991,6 +1363,14 @@ join /---/, 'x', 'y', 'z';
 EXPECT
 /---/ should probably be written as "---" at - line 3.
 ########
+# op.c
+use utf8;
+use open qw( :utf8 :std );
+use warnings 'syntax' ;
+join /~~~/, 'x', 'y', 'z';
+EXPECT
+/~~~/ should probably be written as "~~~" at - line 5.
+########
 # op.c [Perl_peep]
 use warnings 'prototype' ;
 fred() ; 
@@ -1338,3 +1718,24 @@ sub ᚠርƊ () { 1 }
 EXPECT
 Constant subroutine main::ᚠርƊ redefined at - line 5.
 ########
+# OPTION regex
+sub DynaLoader::dl_error {};
+use warnings;
+# We're testing that the warnings report the same line number:
+eval <<'EOC' or die $@;
+{
+    DynaLoader::boot_DynaLoader("DynaLoader");
+}
+EOC
+eval <<'EOC' or die $@;
+BEGIN {
+    DynaLoader::boot_DynaLoader("DynaLoader");
+}
+1
+EOC
+EXPECT
+OPTION regex
+\ASubroutine DynaLoader::dl_error redefined at \(eval 1\) line 2\.
+?(?s).*
+Subroutine DynaLoader::dl_error redefined at \(eval 2\) line 2\.
+########