Fatalize using hash|array as reference

[perl5.git] / t / lib / warnings / op

  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
	time ;
	$a ;
	"abc"

     Useless use of sort in scalar context
	my $x = sort (2,1,3);

     Applying %s to %s will act on scalar(%s)
	my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
	@a =~ /abc/ ;
	@a =~ s/a/b/ ;
	@a =~ tr/a/b/ ;
	@$b =~ /abc/ ;
	@$b =~ s/a/b/ ;
	@$b =~ tr/a/b/ ;
	%a =~ /abc/ ;
	%a =~ s/a/b/ ;
	%a =~ tr/a/b/ ;
	%$c =~ /abc/ ;
	%$c =~ s/a/b/ ;
	%$c =~ tr/a/b/ ;


     Parentheses missing around "my" list at -e line 1.
       my $a, $b = (1,2);
 
     Parentheses missing around "local" list at -e line 1.
       local $a, $b = (1,2);
 
     Bareword found in conditional at -e line 1.
       use warnings 'bareword'; my $x = print(ABC || 1);
 
     Value of %s may be \"0\"; use \"defined\" 
	$x = 1 if $x = <FH> ;
	$x = 1 while $x = <FH> ;

     Subroutine fred redefined at -e line 1.
       sub fred{1;} sub fred{1;}
 
     Constant subroutine %s redefined 
        sub fred() {1;} sub fred() {1;}
 
     Format FRED redefined at /tmp/x line 5.
       format FRED =
       .
       format FRED =
       .
 
     push on reference is experimental			[ck_fun]
     pop on reference is experimental
     shift on reference is experimental
     unshift on reference is experimental
     splice on reference is experimental
 
     Statement unlikely to be reached
     	(Maybe you meant system() when you said exec()?
 	exec "true" ; my $a

     defined(@array) is deprecated
     	(Maybe you should just omit the defined()?)
	my @a ; defined @a ;
	defined (@a = (1,2,3)) ;

     defined(%hash) is deprecated
     	(Maybe you should just omit the defined()?)
	my %h ; defined %h ;

     "my %s" used in sort comparison

     $[ used in comparison (did you mean $] ?)

     each on reference is experimental			[ck_each]
     keys on reference is experimental
     values on reference is experimental

     length() used on @array (did you mean "scalar(@array)"?)
     length() used on %hash (did you mean "scalar(keys %hash)"?)

     /---/ should probably be written as "---"
        join(/---/, @foo);

    %s() called too early to check prototype		[Perl_peep]
        fred() ; sub fred ($$) {}


    Package '%s' not found (did you use the incorrect case?)

    Use of /g modifier is meaningless in split

    Possible precedence problem on bitwise %c operator	[Perl_ck_bitop]

    Mandatory Warnings 
    ------------------
    Prototype mismatch:		[cv_ckproto]
        sub fred() ;
        sub fred($) {}

    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' ;
use constant foo => 1;
1 if $a = foo ;
no warnings 'syntax' ;
1 if $a = foo ;
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
@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 ""};
{
    no warnings 'experimental::autoderef';
    @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
@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 ""];
{
    no warnings 'experimental::autoderef';
    @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;
%main::foo->{"bar"};
EXPECT
OPTION fatal
Can't use a hash as a reference at - line 3.
########
# op.c
my %foo;
%foo->{"bar"};
EXPECT
OPTION fatal
Can't use a hash as a reference at - line 3.
########
# op.c
my @foo;
@main::foo->[23];
EXPECT
OPTION fatal
Can't use an array as a reference at - line 3.
########
# op.c
my @foo;
@foo->[23];
EXPECT
OPTION fatal
Can't use an array as a reference at - line 3.
########
# op.c
my %foo;
$main::foo = {}; %$main::foo->{"bar"};
EXPECT
OPTION fatal
Can't use a hash as a reference at - line 3.
########
# op.c
my %foo;
$foo = {}; %$foo->{"bar"};
EXPECT
OPTION fatal
Can't use a hash as a reference at - line 3.
########
# op.c
my @foo;
$main::foo = []; @$main::foo->[34];
EXPECT
OPTION fatal
Can't use an array as a reference at - line 3.
########
# op.c
my @foo;
$foo = []; @$foo->[34];
EXPECT
OPTION fatal
Can't use an array as a reference at - line 3.
########
# op.c
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
			# 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
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.
Useless use of reference constructor in void context at - line 13.
Useless use of single ref constructor in void context at - line 14.
Useless use of defined operator in void context at - line 15.
Useless use of hex in void context at - line 16.
Useless use of oct in void context at - line 17.
Useless use of length in void context at - line 18.
Useless use of substr in void context at - line 19.
Useless use of vec in void context at - line 20.
Useless use of index in void context at - line 21.
Useless use of rindex in void context at - line 22.
Useless use of sprintf in void context at - line 23.
Useless use of array element in void context at - line 24.
Useless use of array slice in void context at - line 26.
Useless use of hash element in void context at - line 29.
Useless use of hash slice in void context at - line 30.
Useless use of unpack in void context at - line 31.
Useless use of pack in void context at - line 32.
Useless use of join or string in void context at - line 33.
Useless use of list slice in void context at - line 34.
Useless use of sort in void context at - line 37.
Useless use of reverse in void context at - line 38.
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.
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 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 ;
my $x = sort (2,1,3);
no warnings 'void' ;
$x = sort (2,1,3);
EXPECT
Useless use of sort in scalar context at - line 3.
########
# op.c
no warnings 'void' ; close STDIN ;
1 x 3 ;			# OP_REPEAT
			# OP_GVSV
wantarray ; 		# OP_WANTARRAY
			# OP_GV
			# OP_PADSV
			# OP_PADAV
			# OP_PADHV
			# OP_PADANY
			# OP_AV2ARYLEN
ref ;			# OP_REF
\@a ;			# OP_REFGEN
\$a ;			# OP_SREFGEN
defined $a ;		# OP_DEFINED
hex $a ;		# OP_HEX
oct $a ;		# OP_OCT
length $a ;		# OP_LENGTH
substr $a,1 ;		# OP_SUBSTR
vec $a,1,2 ;		# OP_VEC
index $a,1,2 ;		# OP_INDEX
rindex $a,1,2 ;		# OP_RINDEX
sprintf $a ;		# OP_SPRINTF
$a[0] ;			# OP_AELEM
			# OP_AELEMFAST
@a[0] ;			# OP_ASLICE
#values %a ;		# OP_VALUES
#keys %a ;		# OP_KEYS
$a{0} ;			# OP_HELEM
@a{0} ;			# OP_HSLICE
unpack "a", "a" ;	# OP_UNPACK
pack $a,"" ;		# OP_PACK
join "" ;		# OP_JOIN
(@a)[0,1] ;		# OP_LSLICE
			# OP_ANONLIST
			# OP_ANONHASH
sort(1,2) ;		# OP_SORT
reverse(1,2) ;		# OP_REVERSE
			# OP_RANGE
			# OP_FLIP
(1 ..2) ;		# OP_FLOP
caller ;		# OP_CALLER
fileno STDIN ;		# OP_FILENO
eof STDIN ;		# OP_EOF
tell STDIN ;		# OP_TELL
readlink 1;		# OP_READLINK
time ;			# OP_TIME
localtime ;		# OP_LOCALTIME
gmtime ;		# OP_GMTIME
eval { getgrnam 1 };	# OP_GGRNAM
eval { getgrgid 1 };	# OP_GGRGID
eval { getpwnam 1 };	# OP_GPWNAM
eval { getpwuid 1 };	# OP_GPWUID
prototype "foo";	# OP_PROTOTYPE
EXPECT
########
# op.c
use warnings 'void' ;
for (@{[0]}) { "$_" }		# check warning isn't duplicated
no warnings 'void' ;
for (@{[0]}) { "$_" }		# check warning isn't duplicated
EXPECT
Useless use of string in void context at - line 3.
########
# op.c
use warnings 'void' ;
use Config ;
BEGIN {
    if ( ! $Config{d_telldir}) {
        print <<EOM ;
SKIPPED
# telldir not present
EOM
        exit 
    }
}
telldir 1 ;		# OP_TELLDIR
no warnings 'void' ;
telldir 1 ;		# OP_TELLDIR
EXPECT
Useless use of telldir in void context at - line 13.
########
# op.c
use warnings 'void' ;
use Config ;
BEGIN {
    if ( ! $Config{d_getppid}) {
        print <<EOM ;
SKIPPED
# getppid not present
EOM
        exit 
    }
}
getppid ;		# OP_GETPPID
no warnings 'void' ;
getppid ;		# OP_GETPPID
EXPECT
Useless use of getppid in void context at - line 13.
########
# op.c
use warnings 'void' ;
use Config ;
BEGIN {
    if ( ! $Config{d_getpgrp}) {
        print <<EOM ;
SKIPPED
# getpgrp not present
EOM
        exit 
    }
}
getpgrp ;		# OP_GETPGRP
no warnings 'void' ;
getpgrp ;		# OP_GETPGRP
EXPECT
Useless use of getpgrp in void context at - line 13.
########
# op.c
use warnings 'void' ;
use Config ;
BEGIN {
    if ( ! $Config{d_times}) {
        print <<EOM ;
SKIPPED
# times not present
EOM
        exit 
    }
}
times ;			# OP_TMS
no warnings 'void' ;
times ;			# OP_TMS
EXPECT
Useless use of times in void context at - line 13.
########
# op.c
use warnings 'void' ;
use Config ;
BEGIN {
    if ( ! $Config{d_getprior} or $^O eq 'os2') { # Locks before fixpak22
        print <<EOM ;
SKIPPED
# getpriority not present
EOM
        exit 
    }
}
getpriority 1,2;	# OP_GETPRIORITY
no warnings 'void' ;
getpriority 1,2;	# OP_GETPRIORITY
EXPECT
Useless use of getpriority in void context at - line 13.
########
# op.c
use warnings 'void' ;
use Config ;
BEGIN {
    if ( ! $Config{d_getlogin}) {
        print <<EOM ;
SKIPPED
# getlogin not present
EOM
        exit 
    }
}
getlogin ;			# OP_GETLOGIN
no warnings 'void' ;
getlogin ;			# OP_GETLOGIN
EXPECT
Useless use of getlogin in void context at - line 13.
########
# op.c
use warnings 'void' ;
use Config ; BEGIN {
if ( ! $Config{d_socket}) {
    print <<EOM ;
SKIPPED
# getsockname not present
# getpeername not present
# gethostbyname not present
# gethostbyaddr not present
# gethostent not present
# getnetbyname not present
# getnetbyaddr not present
# getnetent not present
# getprotobyname not present
# getprotobynumber not present
# getprotoent not present
# getservbyname not present
# getservbyport not present
# getservent not present
EOM
    exit 
} }
getsockname STDIN ;	# OP_GETSOCKNAME
getpeername STDIN ;	# OP_GETPEERNAME
gethostbyname 1 ;	# OP_GHBYNAME
gethostbyaddr 1,2;	# OP_GHBYADDR
gethostent ;		# OP_GHOSTENT
getnetbyname 1 ;	# OP_GNBYNAME
getnetbyaddr 1,2 ;	# OP_GNBYADDR
getnetent ;		# OP_GNETENT
getprotobyname 1;	# OP_GPBYNAME
getprotobynumber 1;	# OP_GPBYNUMBER
getprotoent ;		# OP_GPROTOENT
getservbyname 1,2;	# OP_GSBYNAME
getservbyport 1,2;	# OP_GSBYPORT
getservent ;		# OP_GSERVENT

no warnings 'void' ;
getsockname STDIN ;	# OP_GETSOCKNAME
getpeername STDIN ;	# OP_GETPEERNAME
gethostbyname 1 ;	# OP_GHBYNAME
gethostbyaddr 1,2;	# OP_GHBYADDR
gethostent ;		# OP_GHOSTENT
getnetbyname 1 ;	# OP_GNBYNAME
getnetbyaddr 1,2 ;	# OP_GNBYADDR
getnetent ;		# OP_GNETENT
getprotobyname 1;	# OP_GPBYNAME
getprotobynumber 1;	# OP_GPBYNUMBER
getprotoent ;		# OP_GPROTOENT
getservbyname 1,2;	# OP_GSBYNAME
getservbyport 1,2;	# OP_GSBYPORT
getservent ;		# OP_GSERVENT
INIT {
   # some functions may not be there, so we exit without running
   exit;
}
EXPECT
Useless use of getsockname in void context at - line 24.
Useless use of getpeername in void context at - line 25.
Useless use of gethostbyname in void context at - line 26.
Useless use of gethostbyaddr in void context at - line 27.
Useless use of gethostent in void context at - line 28.
Useless use of getnetbyname in void context at - line 29.
Useless use of getnetbyaddr in void context at - line 30.
Useless use of getnetent in void context at - line 31.
Useless use of getprotobyname in void context at - line 32.
Useless use of getprotobynumber in void context at - line 33.
Useless use of getprotoent in void context at - line 34.
Useless use of getservbyname in void context at - line 35.
Useless use of getservbyport in void context at - line 36.
Useless use of getservent in void context at - line 37.
########
# op.c
use warnings 'void' ;
*a ; # OP_RV2GV
$a ; # OP_RV2SV
@a ; # OP_RV2AV
%a ; # OP_RV2HV
no warnings 'void' ;
*a ; # OP_RV2GV
$a ; # OP_RV2SV
@a ; # OP_RV2AV
%a ; # OP_RV2HV
EXPECT
Useless use of a variable in void context at - line 3.
Useless use of a variable in void context at - line 4.
Useless use of a variable in void context at - line 5.
Useless use of a variable in void context at - line 6.
########
# op.c
use warnings 'void' ;
"abc"; # OP_CONST
7 ; # OP_CONST
"x" . "y"; # optimized to OP_CONST
2 + 2; # optimized to OP_CONST
use constant U => undef;
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
"x" . "y"; # optimized to OP_CONST
2 + 2; # optimized to OP_CONST
EXPECT
Useless use of a constant ("abc") in void context at - line 3.
Useless use of a constant (7) in void context at - line 4.
Useless use of a constant ("xy") in void context at - line 5.
Useless use of a constant (4) in void context at - line 6.
Useless use of a constant (undef) in void context at - line 8.
Useless use of a constant ("\"\t\n") in void context at - line 9.
########
# op.c
use utf8;
use open qw( :utf8 :std );
use warnings 'void' ;
"àḆc"; # OP_CONST
"Ẋ" . "ƴ"; # optimized to OP_CONST
ＦＯＯ;     # Bareword optimized to OP_CONST
use constant ů => undef;
ů;
5 || print "bad\n";	# test OPpCONST_SHORTCIRCUIT
print "boo\n" if ů;	# test OPpCONST_SHORTCIRCUIT
no warnings 'void' ;
"àḆc"; # OP_CONST
"Ẋ" . "ƴ"; # optimized to OP_CONST
EXPECT
Useless use of a constant ("\340\x{1e06}c") in void context at - line 5.
Useless use of a constant ("\x{1e8a}\x{1b4}") in void context at - line 6.
Useless use of a constant ("\x{ff26}\x{ff2f}\x{ff2f}") in void context at - line 7.
Useless use of a constant (undef) in void context at - line 9.
########
# op.c
#
use warnings 'misc' ;
my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;my $d = 'test';
@a =~ /abc/ ;
@a2 =~ s/a/b/ ;
@a3 =~ tr/a/b/ ;
@$b =~ /abc/ ;
@$b =~ s/a/b/ ;
@$b =~ tr/a/b/ ;
%a =~ /abc/ ;
%a2 =~ s/a/b/ ;
%a3 =~ tr/a/b/ ;
%$c =~ /abc/ ;
%$c =~ s/a/b/ ;
%$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';
@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/ ;
$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.
Applying substitution (s///) to @a2 will act on scalar(@a2) at - line 6.
Applying transliteration (tr///) to @a3 will act on scalar(@a3) at - line 7.
Applying pattern match (m//) to @array will act on scalar(@array) at - line 8.
Applying substitution (s///) to @array will act on scalar(@array) at - line 9.
Applying transliteration (tr///) to @array will act on scalar(@array) at - line 10.
Applying pattern match (m//) to %a will act on scalar(%a) at - line 11.
Applying substitution (s///) to %a2 will act on scalar(%a2) at - line 12.
Applying transliteration (tr///) to %a3 will act on scalar(%a3) at - line 13.
Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 14.
Applying substitution (s///) to %hash will act on scalar(%hash) at - line 15.
Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 16.
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 21.
########
# op.c
use warnings 'parenthesis' ;
my $a, $b = (1,2);
my @foo,%bar,	$quux; # there's a TAB here
my $x, $y or print;
no warnings 'parenthesis' ;
my $c, $d = (1,2);
EXPECT
Parentheses missing around "my" list at - line 3.
Parentheses missing around "my" list at - line 4.
########
# op.c
use warnings 'parenthesis' ;
our $a, $b = (1,2);
no warnings 'parenthesis' ;
our $c, $d = (1,2);
EXPECT
Parentheses missing around "our" list at - line 3.
########
# op.c
use warnings 'parenthesis' ;
local $a, $b = (1,2);
local *f, *g;
no warnings 'parenthesis' ;
local $c, $d = (1,2);
EXPECT
Parentheses missing around "local" list at - line 3.
Parentheses missing around "local" list at - line 4.
########
# op.c
use warnings 'bareword' ;
print (ABC || 1) ;
no warnings 'bareword' ;
print (ABC || 1) ;
EXPECT
Bareword found in conditional at - line 3.
########
--FILE-- abc

--FILE--
# op.c
use warnings 'misc' ;
open FH, "<abc" ;
$x = 1 if $x = <FH> ;
$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' ;
%a = (1,2,3,4) ;
$x = 1 if $x = each %a ;
no warnings 'misc' ;
$x = 1 if $x = each %a ;
EXPECT
Value of each() operator can be "0"; test with defined() at - line 4.
########
# op.c
use warnings 'misc' ;
$x = 1 while $x = <*> and 0 ;
no warnings 'misc' ;
$x = 1 while $x = <*> and 0 ;
EXPECT
Value of glob construct can be "0"; test with defined() at - line 3.
########
# op.c
use warnings 'misc' ;
opendir FH, "." ;
$x = 1 while $x = readdir FH and 0 ;
no warnings 'misc' ;
$x = 1 while $x = readdir FH and 0 ;
closedir FH ;
EXPECT
Value of readdir() operator can be "0"; test with defined() at - line 4.
########
# op.c
use warnings 'misc';
open FH, "<abc";
($_ = <FH>) // ($_ = 1);
opendir DH, ".";
%a = (1,2,3,4) ;
EXPECT
########
# op.c
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' ;
sub fred () { 1 }
sub fred () { 1 }
no warnings 'redefine' ;
sub fred () { 1 }
EXPECT
Constant subroutine fred redefined at - line 4.
########
# op.c
sub fred () { 1 }
sub fred () { 2 }
EXPECT
Constant subroutine fred redefined at - line 3.
########
# op.c
sub fred () { 1 }
*fred = sub () { 2 };
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 }
EXPECT
########
# op.c
no warnings 'redefine' ;
sub fred () { 1 }
*fred = sub () { 2 };
EXPECT
########
# op.c
use warnings 'redefine' ;
format FRED =
.
format FRED =
.
no warnings 'redefine' ;
format FRED =
.
EXPECT
Format FRED redefined at - line 5.
########
# op.c [Perl_ck_fun]
$fred = [];
push $fred;
pop $fred;
shift $fred;
unshift $fred;
splice $fred;
no warnings 'experimental::autoderef' ;
push $fred;
pop $fred;
shift $fred;
unshift $fred;
splice $fred;
EXPECT
push on reference is experimental at - line 3.
pop on reference is experimental at - line 4.
shift on reference is experimental at - line 5.
unshift on reference is experimental at - line 6.
splice on reference is experimental at - line 7.
########
# op.c
use warnings 'exec' ;
exec "$^X -e 1" ; 
my $a
EXPECT
Statement unlikely to be reached at - line 4.
	(Maybe you meant system() when you said exec()?)
########
# op.c, no warning if exec isn't a statement.
use warnings 'exec' ;
$a || exec "$^X -e 1" ;
my $a
EXPECT
########
# op.c
defined(@a);
EXPECT
defined(@array) is deprecated at - line 2.
	(Maybe you should just omit the defined()?)
########
# op.c
my @a; defined(@a);
EXPECT
defined(@array) is deprecated at - line 2.
	(Maybe you should just omit the defined()?)
########
# op.c
defined(@a = (1,2,3));
EXPECT
defined(@array) is deprecated at - line 2.
	(Maybe you should just omit the defined()?)
########
# op.c
defined(%h);
EXPECT
defined(%hash) is deprecated at - line 2.
	(Maybe you should just omit the defined()?)
########
# op.c
my %h; defined(%h);
EXPECT
defined(%hash) is deprecated at - line 2.
	(Maybe you should just omit the defined()?)
########
# op.c
no warnings 'exec' ;
exec "$^X -e 1" ; 
my $a
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;
use open qw( :utf8 :std );
sub frèd();
sub frèd($) {}
EXPECT
Prototype mismatch: sub main::frèd () vs ($) at - line 5.
########
# op.c
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
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
Prototype mismatch: sub main::foo (ニ) vs none at (eval 1) line 1.
########
# op.c
$^W = 0 ;
sub fred() ;
sub fred($) {}
{
    no warnings 'prototype' ;
    sub Fred() ;
    sub Fred($) {}
    use warnings 'prototype' ;
    sub freD() ;
    sub freD($) {}
}
sub FRED() ;
sub FRED($) {}
EXPECT
Prototype mismatch: sub main::fred () vs ($) at - line 4.
Prototype mismatch: sub main::freD () vs ($) at - line 11.
Prototype mismatch: sub main::FRED () vs ($) at - line 14.
########
# op.c [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';
@a = $[ < 5;
@a = $[ > 5;
@a = $[ <= 5;
@a = $[ >= 5;
@a = 42 < $[;
@a = 42 > $[;
@a = 42 <= $[;
@a = 42 >= $[;
use integer;
@a = $[ < 5;
@a = $[ > 5;
@a = $[ <= 5;
@a = $[ >= 5;
@a = 42 < $[;
@a = 42 > $[;
@a = 42 <= $[;
@a = 42 >= $[;
no integer;
@a = $[ < $5;
@a = $[ > $5;
@a = $[ <= $5;
@a = $[ >= $5;
@a = $42 < $[;
@a = $42 > $[;
@a = $42 <= $[;
@a = $42 >= $[;
use integer;
@a = $[ < $5;
@a = $[ > $5;
@a = $[ <= $5;
@a = $[ >= $5;
@a = $42 < $[;
@a = $42 > $[;
@a = $42 <= $[;
@a = $42 >= $[;
EXPECT
$[ used in numeric lt (<) (did you mean $] ?) at - line 4.
$[ used in numeric gt (>) (did you mean $] ?) at - line 5.
$[ used in numeric le (<=) (did you mean $] ?) at - line 6.
$[ used in numeric ge (>=) (did you mean $] ?) at - line 7.
$[ used in numeric lt (<) (did you mean $] ?) at - line 8.
$[ used in numeric gt (>) (did you mean $] ?) at - line 9.
$[ used in numeric le (<=) (did you mean $] ?) at - line 10.
$[ used in numeric ge (>=) (did you mean $] ?) at - line 11.
$[ used in numeric lt (<) (did you mean $] ?) at - line 13.
$[ used in numeric gt (>) (did you mean $] ?) at - line 14.
$[ used in numeric le (<=) (did you mean $] ?) at - line 15.
$[ used in numeric ge (>=) (did you mean $] ?) at - line 16.
$[ used in numeric lt (<) (did you mean $] ?) at - line 17.
$[ used in numeric gt (>) (did you mean $] ?) at - line 18.
$[ used in numeric le (<=) (did you mean $] ?) at - line 19.
$[ used in numeric ge (>=) (did you mean $] ?) at - line 20.
########
# op.c [Perl_ck_each]
$fred = {};
keys $fred;
values $fred;
each $fred;
no warnings 'experimental::autoderef' ;
keys $fred;
values $fred;
each $fred;
EXPECT
keys on reference is experimental at - line 3.
values on reference is experimental at - line 4.
each on reference is experimental at - line 5.
########
# op.c [Perl_ck_length]
use warnings 'syntax' ;
length(@a);
length(%b);
length(@$c);
length(%$d);
length($a);
length(my %h);
length(my @g);
EXPECT
length() used on @a (did you mean "scalar(@a)"?) at - line 3.
length() used on %b (did you mean "scalar(keys %b)"?) at - line 4.
length() used on @array (did you mean "scalar(@array)"?) at - line 5.
length() used on %hash (did you mean "scalar(keys %hash)"?) at - line 6.
length() used on %h (did you mean "scalar(keys %h)"?) at - line 8.
length() used on @g (did you mean "scalar(@g)"?) at - line 9.
########
# op.c
use warnings 'syntax' ;
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() ; 
sub fred ($$) {}
no warnings 'prototype' ;
joe() ; 
sub joe ($$) {}
EXPECT
main::fred() called too early to check prototype at - line 3.
########
# op.c [Perl_newATTRSUB]
--FILE-- abc.pm
use warnings 'void' ;
BEGIN { $| = 1; print "in begin\n"; }
CHECK { print "in check\n"; }
INIT { print "in init\n"; }
END { print "in end\n"; }
print "in mainline\n";
1;
--FILE--
use abc;
delete $INC{"abc.pm"};
require abc;
do "abc.pm";
EXPECT
in begin
in mainline
in check
in init
in begin
Too late to run CHECK block at abc.pm line 3.
Too late to run INIT block at abc.pm line 4.
in mainline
in begin
Too late to run CHECK block at abc.pm line 3.
Too late to run INIT block at abc.pm line 4.
in mainline
in end
in end
in end
########
# op.c [Perl_newATTRSUB]
--FILE-- abc.pm
no warnings 'void' ;
BEGIN { $| = 1; print "in begin\n"; }
CHECK { print "in check\n"; }
INIT { print "in init\n"; }
END { print "in end\n"; }
print "in mainline\n";
1;
--FILE--
require abc;
do "abc.pm";
EXPECT
in begin
in mainline
in begin
in mainline
in end
in end
########
# op.c
my @x;
use warnings 'syntax' ;
push(@x);
unshift(@x);
no warnings 'syntax' ;
push(@x);
unshift(@x);
EXPECT
Useless use of push with no values at - line 4.
Useless use of unshift with no values at - line 5.
########
# op.c
# 20020401 mjd@plover.com at suggestion of jfriedl@yahoo.com
use warnings 'regexp';
split /blah/g, "blah";
no warnings 'regexp';
split /blah/g, "blah";
EXPECT
Use of /g modifier is meaningless in split at - line 4.
########
# op.c
use warnings 'precedence';
$a = $b & $c == $d;
$a = $b ^ $c != $d;
$a = $b | $c > $d;
$a = $b < $c & $d;
$a = $b >= $c ^ $d;
$a = $b <= $c | $d;
$a = $b <=> $c & $d;
$a &= $b == $c; $a |= $b == $c; $a ^= $b == $c; # shouldn't warn
no warnings 'precedence';
$a = $b & $c == $d;
$a = $b ^ $c != $d;
$a = $b | $c > $d;
$a = $b < $c & $d;
$a = $b >= $c ^ $d;
$a = $b <= $c | $d;
$a = $b <=> $c & $d;
EXPECT
Possible precedence problem on bitwise & operator at - line 3.
Possible precedence problem on bitwise ^ operator at - line 4.
Possible precedence problem on bitwise | operator at - line 5.
Possible precedence problem on bitwise & operator at - line 6.
Possible precedence problem on bitwise ^ operator at - line 7.
Possible precedence problem on bitwise | operator at - line 8.
Possible precedence problem on bitwise & operator at - line 9.
########
# op.c
use integer;
use warnings 'precedence';
$a = $b & $c == $d;
$a = $b ^ $c != $d;
$a = $b | $c > $d;
$a = $b < $c & $d;
$a = $b >= $c ^ $d;
$a = $b <= $c | $d;
$a = $b <=> $c & $d;
no warnings 'precedence';
$a = $b & $c == $d;
$a = $b ^ $c != $d;
$a = $b | $c > $d;
$a = $b < $c & $d;
$a = $b >= $c ^ $d;
$a = $b <= $c | $d;
$a = $b <=> $c & $d;
EXPECT
Possible precedence problem on bitwise & operator at - line 4.
Possible precedence problem on bitwise ^ operator at - line 5.
Possible precedence problem on bitwise | operator at - line 6.
Possible precedence problem on bitwise & operator at - line 7.
Possible precedence problem on bitwise ^ operator at - line 8.
Possible precedence problem on bitwise | operator at - line 9.
Possible precedence problem on bitwise & operator at - line 10.
########
# op.c

# ok	=> local() has desired effect;
# ignore=> local() silently ignored

use warnings 'syntax';

local(undef);		# OP_UNDEF		ignore
sub lval : lvalue {};
local(lval());		# OP_ENTERSUB
local($x **= 1);	# OP_POW
local($x *=  1);	# OP_MULTIPLY
local($x /=  1);	# OP_DIVIDE
local($x %=  1);	# OP_MODULO
local($x x=  1);	# OP_REPEAT
local($x +=  1);	# OP_ADD
local($x -=  1);	# OP_SUBTRACT
local($x .=  1);	# OP_CONCAT
local($x <<= 1);	# OP_LEFT_SHIFT
local($x >>= 1);	# OP_RIGHT_SHIFT
local($x &=  1);	# OP_BIT_AND
local($x ^=  1);	# OP_BIT_XOR
local($x |=  1);	# OP_BIT_OR
{
    use integer;
    local($x *= 1);	# OP_I_MULTIPLY
    local($x /= 1);	# OP_I_DIVIDE
    local($x %= 1);	# OP_I_MODULO
    local($x += 1);	# OP_I_ADD
    local($x -= 1);	# OP_I_SUBTRACT
}
local($x?$y:$z) = 1;	# OP_COND_EXPR		ok
# these two are fatal run-time errors instead
#local(@$a);		# OP_RV2AV		ok
#local(%$a);		# OP_RV2HV		ok
local(*a);		# OP_RV2GV		ok
local(@a[1,2]);		# OP_ASLICE		ok
local(@a{1,2});		# OP_HSLICE		ok
local(@a = (1,2));	# OP_AASSIGN
local($$x);		# OP_RV2SV		ok
local($#a);		# OP_AV2ARYLEN
local($x =   1);	# OP_SASSIGN
local($x &&= 1);	# OP_ANDASSIGN
local($x ||= 1);	# OP_ORASSIGN
local($x //= 1);	# OP_DORASSIGN
local($a[0]);		# OP_AELEMFAST		ok

local(substr($x,0,1));	# OP_SUBSTR
local(pos($x));		# OP_POS
local(vec($x,0,1));	# OP_VEC
local($a[$b]);		# OP_AELEM		ok
local($a{$b});		# OP_HELEM		ok

no warnings 'syntax';
EXPECT
Useless localization of subroutine entry at - line 10.
Useless localization of exponentiation (**) at - line 11.
Useless localization of multiplication (*) at - line 12.
Useless localization of division (/) at - line 13.
Useless localization of modulus (%) at - line 14.
Useless localization of repeat (x) at - line 15.
Useless localization of addition (+) at - line 16.
Useless localization of subtraction (-) at - line 17.
Useless localization of concatenation (.) or string at - line 18.
Useless localization of left bitshift (<<) at - line 19.
Useless localization of right bitshift (>>) at - line 20.
Useless localization of bitwise and (&) at - line 21.
Useless localization of bitwise xor (^) at - line 22.
Useless localization of bitwise or (|) at - line 23.
Useless localization of integer multiplication (*) at - line 26.
Useless localization of integer division (/) at - line 27.
Useless localization of integer modulus (%) at - line 28.
Useless localization of integer addition (+) at - line 29.
Useless localization of integer subtraction (-) at - line 30.
Useless localization of list assignment at - line 39.
Useless localization of array length at - line 41.
Useless localization of scalar assignment at - line 42.
Useless localization of logical and assignment (&&=) at - line 43.
Useless localization of logical or assignment (||=) at - line 44.
Useless localization of defined or assignment (//=) at - line 45.
Useless localization of substr at - line 48.
Useless localization of match position at - line 49.
Useless localization of vec at - line 50.
########
# op.c
my $x1 if 0;
my @x2 if 0;
my %x3 if 0;
my ($x4) if 0;
my ($x5,@x6, %x7) if 0;
0 && my $z1;
0 && my (%z2);
# these shouldn't warn
our $x if 0;
our $x unless 0;
if (0) { my $w1 }
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.
########
# op.c
$[ = 1;
($[) = 1;
use warnings 'deprecated';
$[ = 2;
($[) = 2;
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.
########
# op.c
use warnings 'void';
@x = split /y/, "z";
$x = split /y/, "z";
     split /y/, "z";
no warnings 'void';
@x = split /y/, "z";
$x = split /y/, "z";
     split /y/, "z";
EXPECT
Useless use of split in void context at - line 5.
########
# op.c
use warnings 'redefine' ;
use utf8;
use open qw( :utf8 :std );
sub frèd {}
sub frèd {}
no warnings 'redefine' ;
sub frèd {}
EXPECT
Subroutine frèd redefined at - line 6.
########
# op.c
use warnings 'redefine' ;
use utf8;
use open qw( :utf8 :std );
sub frèd () { 1 }
sub frèd () { 1 }
no warnings 'redefine' ;
sub frèd () { 1 }
EXPECT
Constant subroutine frèd redefined at - line 6.
########
# op.c
use utf8;
use open qw( :utf8 :std );
sub frèd () { 1 }
sub frèd () { 2 }
EXPECT
Constant subroutine frèd redefined at - line 5.
########
# op.c
use utf8;
use open qw( :utf8 :std );
sub frèd () { 1 }
*frèd = sub () { 2 };
EXPECT
Constant subroutine main::frèd redefined at - line 5.
########
# op.c
use warnings 'redefine' ;
use utf8;
use open qw( :utf8 :std );
sub ᚠርƊ {}
sub ᚠርƊ {}
no warnings 'redefine' ;
sub ᚠርƊ {}
EXPECT
Subroutine ᚠርƊ redefined at - line 6.
########
# op.c
use warnings 'redefine' ;
use utf8;
use open qw( :utf8 :std );
sub ᚠርƊ () { 1 }
sub ᚠርƊ () { 1 }
no warnings 'redefine' ;
sub ᚠርƊ () { 1 }
EXPECT
Constant subroutine ᚠርƊ redefined at - line 6.
########
# op.c
use utf8;
use open qw( :utf8 :std );
sub ᚠርƊ () { 1 }
sub ᚠርƊ () { 2 }
EXPECT
Constant subroutine ᚠርƊ redefined at - line 5.
########
# op.c
use utf8;
use open qw( :utf8 :std );
sub ᚠርƊ () { 1 }
*ᚠርƊ = sub () { 2 };
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\.
########
# op.c
use warnings;
sub do_warn_1  { return $a or $b; }
sub do_warn_2  { return $a and $b; }
sub do_warn_3  { return $a xor $b; }
sub do_warn_4  { die $a or $b; }
sub do_warn_5  { die $a and $b; }
sub do_warn_6  { die $a xor $b; }
sub do_warn_7  { exit $a or $b; }
sub do_warn_8  { exit $a and $b; }
sub do_warn_9  { exit $a xor $b; }

# Since exit is an unary operator, it is even stronger than
# || and &&.
sub do_warn_10 { exit $a || $b; }
sub do_warn_11 { exit $a && $b; }

sub do_warn_12 { goto $a or $b; }
sub do_warn_13 { goto $a and $b; }
sub do_warn_14 { goto $a xor $b; }
sub do_warn_15 { next $a or $b while(1);  }
sub do_warn_16 { next $a and $b while(1); }
sub do_warn_17 { next $a xor $b while(1); }
sub do_warn_18 { last $a or $b while(1);  }
sub do_warn_19 { last $a and $b while(1); }
sub do_warn_20 { last $a xor $b while(1); }
sub do_warn_21 { redo $a or $b while(1); }
sub do_warn_22 { redo $a and $b while(1); }
sub do_warn_23 { redo $a xor $b while(1); }
# These get re-written to "(return/die $a) and $b"
sub do_warn_24 { $b if return $a; }
sub do_warn_25 { $b if die $a; }
EXPECT
Possible precedence issue with control flow operator at - line 3.
Possible precedence issue with control flow operator at - line 4.
Possible precedence issue with control flow operator at - line 5.
Possible precedence issue with control flow operator at - line 6.
Possible precedence issue with control flow operator at - line 7.
Possible precedence issue with control flow operator at - line 8.
Possible precedence issue with control flow operator at - line 9.
Possible precedence issue with control flow operator at - line 10.
Possible precedence issue with control flow operator at - line 11.
Possible precedence issue with control flow operator at - line 15.
Possible precedence issue with control flow operator at - line 16.
Possible precedence issue with control flow operator at - line 18.
Possible precedence issue with control flow operator at - line 19.
Possible precedence issue with control flow operator at - line 20.
Possible precedence issue with control flow operator at - line 21.
Possible precedence issue with control flow operator at - line 22.
Possible precedence issue with control flow operator at - line 23.
Possible precedence issue with control flow operator at - line 24.
Possible precedence issue with control flow operator at - line 25.
Possible precedence issue with control flow operator at - line 26.
Possible precedence issue with control flow operator at - line 27.
Possible precedence issue with control flow operator at - line 28.
Possible precedence issue with control flow operator at - line 29.
Possible precedence issue with control flow operator at - line 31.
Possible precedence issue with control flow operator at - line 32.
########
# op.c
#  (same as above, except these should not warn)
use constant FEATURE => 1;
use constant MISSING_FEATURE => 0;

sub dont_warn_1  { MISSING_FEATURE and return or dont_warn_3(); }
sub dont_warn_2  { FEATURE || return and dont_warn_3(); }
sub dont_warn_3  { not FEATURE and return or dont_warn_3(); }
sub dont_warn_4  { !MISSING_FEATURE || return and dont_warn_3(); }
sub dont_warn_5  { MISSING_FEATURE and die or dont_warn_3(); }
sub dont_warn_6  { FEATURE || die and dont_warn_3(); }
sub dont_warn_7  { not FEATURE and die or dont_warn_3(); }
sub dont_warn_8  { !MISSING_FEATURE || die and dont_warn_3(); }
sub dont_warn_9  { MISSING_FEATURE and goto $a or dont_warn_3(); }
sub dont_warn_10 { FEATURE || goto $a and dont_warn_3(); }
sub dont_warn_11 { not FEATURE and goto $a or dont_warn_3(); }
sub dont_warn_12 { !MISSING_FEATURE || goto $a and dont_warn_3(); }

sub dont_warn_13 { MISSING_FEATURE and exit $a or dont_warn_3(); }
sub dont_warn_14 { FEATURE || exit $a and dont_warn_3(); }
sub dont_warn_15 { not FEATURE and exit $a or dont_warn_3(); }
sub dont_warn_16 { !MISSING_FEATURE || exit $a and dont_warn_3(); }

sub dont_warn_17 { MISSING_FEATURE and next or dont_warn_3() while(1); }
sub dont_warn_18 { FEATURE || next and dont_warn_3() while(1); }
sub dont_warn_19 { not FEATURE and next or dont_warn_3() while(1); }
sub dont_warn_20 { !MISSING_FEATURE || next and dont_warn_3() while(1); }
sub dont_warn_21 { MISSING_FEATURE and redo or dont_warn_3() while(1); }
sub dont_warn_22 { FEATURE || redo and dont_warn_3() while(1); }
sub dont_warn_23 { not FEATURE and redo or dont_warn_3() while(1); }
sub dont_warn_24 { !MISSING_FEATURE || redo and dont_warn_3() while(1); }
sub dont_warn_25 { MISSING_FEATURE and last or dont_warn_3() while(1); }
sub dont_warn_26 { FEATURE || last and dont_warn_3() while(1); }
sub dont_warn_27 { not FEATURE and last or dont_warn_3() while(1); }
sub dont_warn_28 { !MISSING_FEATURE || last and dont_warn_3() while(1); }

# These are weird, but at least not ambiguous.
sub dont_warn_29 { return ($a or $b); }
sub dont_warn_30 { return ($a and $b); }
sub dont_warn_31 { return ($a xor $b); }
sub dont_warn_32 { die ($a or $b); }
sub dont_warn_33 { die ($a and $b); }
sub dont_warn_34 { die ($a xor $b); }
sub dont_warn_35 { goto ($a or $b); }
sub dont_warn_36 { goto ($a and $b); }
sub dont_warn_37 { goto ($a xor $b); }
sub dont_warn_38 { next ($a or $b) while(1);  }
sub dont_warn_39 { next ($a and $b) while(1); }
sub dont_warn_40 { next ($a xor $b) while(1); }
sub dont_warn_41 { last ($a or $b) while(1);  }
sub dont_warn_42 { last ($a and $b) while(1); }
sub dont_warn_43 { last ($a xor $b) while(1); }
sub dont_warn_44 { redo ($a or $b) while(1);  }
sub dont_warn_45 { redo ($a and $b) while(1); }
sub dont_warn_46 { redo ($a xor $b) while(1); }
EXPECT
########
use feature "signatures";
sub aaa { 2 }
sub bbb ($a) { 4 }
$aaa = sub { 2 };
$bbb = sub ($a) { 4 };
EXPECT
The signatures feature is experimental at - line 3.
The signatures feature is experimental at - line 5.
########
no warnings "experimental::signatures";
use feature "signatures";
sub aaa { 2 }
sub bbb ($a) { 4 }
$aaa = sub { 2 };
$bbb = sub ($a) { 4 };
EXPECT