dslinux/user/perl/t/lib/warnings 1global 2use 3both 4lint 5nolint 6default 7fatal 8signal 9enabled av doio doop gv hv malloc mg op pad perl perlio perly pp pp_ctl pp_hot pp_pack pp_sys regcomp regexec run sv taint toke universal utf8 util
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:02:01 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/t/lib/warnings
In directory antilope:/tmp/cvs-serv17422/t/lib/warnings
Added Files:
1global 2use 3both 4lint 5nolint 6default 7fatal 8signal
9enabled av doio doop gv hv malloc mg op pad perl perlio perly
pp pp_ctl pp_hot pp_pack pp_sys regcomp regexec run sv taint
toke universal utf8 util
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: gv ---
gv.c AOK
Can't locate package %s for @%s::ISA
@ISA = qw(Fred); joe()
Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated
sub Other::AUTOLOAD { 1 } sub Other::fred {}
@ISA = qw(Other) ;
fred() ;
Use of $# is deprecated
Use of $* is deprecated
$a = ${"#"} ;
$a = ${"*"} ;
Mandatory Warnings ALL TODO
------------------
Had to create %s unexpectedly [gv_fetchpv]
Attempt to free unreferenced glob pointers [gp_free]
__END__
# gv.c
use warnings 'misc' ;
@ISA = qw(Fred); joe()
EXPECT
Can't locate package Fred for @main::ISA at - line 3.
Undefined subroutine &main::joe called at - line 3.
########
# gv.c
no warnings 'misc' ;
@ISA = qw(Fred); joe()
EXPECT
Undefined subroutine &main::joe called at - line 3.
########
# gv.c
sub Other::AUTOLOAD { 1 } sub Other::fred {}
@ISA = qw(Other) ;
use warnings 'deprecated' ;
fred() ;
EXPECT
Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5.
########
# gv.c
use warnings 'deprecated' ;
$a = ${"#"};
$a = ${"*"};
no warnings 'deprecated' ;
$a = ${"#"};
$a = ${"*"};
EXPECT
Use of $# is deprecated at - line 3.
Use of $* is deprecated at - line 4.
--- NEW FILE: malloc ---
malloc.c
Mandatory Warnings ALL TODO
------------------
%s free() ignored [Perl_mfree]
%s", "Bad free() ignored [Perl_mfree]
__END__
--- NEW FILE: universal ---
universal.c AOK
Can't locate package %s for @%s::ISA [S_isa_lookup]
__END__
# universal.c [S_isa_lookup]
use warnings 'misc' ;
@ISA = qw(Joe) ;
my $a = bless [] ;
UNIVERSAL::isa $a, Jim ;
EXPECT
Can't locate package Joe for @main::ISA at - line 5.
--- NEW FILE: taint ---
taint.c AOK
Insecure %s%s while running with -T switch
__END__
-T
--FILE-- abc
def
--FILE--
# taint.c
open(FH, "<abc") ;
$a = <FH> ;
close FH ;
chdir $a ;
print "xxx\n" ;
EXPECT
Insecure dependency in chdir while running with -T switch at - line 5.
########
-TU
--FILE-- abc
def
--FILE--
# taint.c
open(FH, "<abc") ;
$a = <FH> ;
close FH ;
chdir $a ;
print "xxx\n" ;
EXPECT
xxx
########
-TU
--FILE-- abc
def
--FILE--
# taint.c
open(FH, "<abc") ;
$a = <FH> ;
close FH ;
use warnings 'taint' ;
chdir $a ;
print "xxx\n" ;
no warnings 'taint' ;
chdir $a ;
print "yyy\n" ;
EXPECT
Insecure dependency in chdir while running with -T switch at - line 6.
xxx
yyy
--- NEW FILE: perlio ---
perlio.c
Mandatory Warnings ALL TODO
------------------
Setting cnt to %d
Setting ptr %p > end+1 %p
Setting cnt to %d, ptr implies %d
Invalid separator character %c%c%c in PerlIO layer specification %s
open(F, ">:-aa", "bb")
Argument list not closed for PerlIO layer \"%.*s\""
open(F, ">:aa(", "bb")
Unknown PerlIO layer \"%.*s\"
# PerlIO/xyz.pm has 1;
open(F, ">xyz", "bb")
__END__
# perlio [PerlIO_parse_layers]
no warnings 'layer';
open(F, ">:-aa", "bb");
use warnings 'layer';
open(F, ">:-aa", "bb");
close F;
EXPECT
Invalid separator character '-' in PerlIO layer specification -aa at - line 6.
########
# perlio [PerlIO_parse_layers]
no warnings 'layer';
open(F, ">:aa(", "bb");
use warnings 'layer';
open(F, ">:aa(", "bb");
close F;
EXPECT
Argument list not closed for PerlIO layer "aa(" at - line 6.
########
--FILE-- PerlIO_test_dir/xyz.pm
1;
--FILE--
# perlio [PerlIO_parse_layers]
no warnings 'layer';
open(F, ">:xyz", "bb");
use warnings 'layer';
open(F, ">:xyz", "bb");
close F;
END { 1 while unlink "bb" } # KEEP THIS WITH THE LAST TEST.
EXPECT
Unknown PerlIO layer "xyz" at - line 5.
--- NEW FILE: 5nolint ---
syntax anti-lint
__END__
-X
# nolint: check compile time $^W is zapped
BEGIN { $^W = 1 ;}
$a = $b = 1 ;
$a =+ 1 ;
close STDIN ; print STDIN "abc" ;
EXPECT
########
-X
# nolint: check runtime $^W is zapped
$^W = 1 ;
close STDIN ; print STDIN "abc" ;
EXPECT
########
-X
# nolint: check runtime $^W is zapped
{
$^W = 1 ;
close STDIN ; print STDIN "abc" ;
}
EXPECT
########
-X
# nolint: check "no warnings" is zapped
use warnings ;
$a = $b = 1 ;
$a =+ 1 ;
close STDIN ; print STDIN "abc" ;
EXPECT
########
-X
# nolint: check "no warnings" is zapped
{
use warnings ;
close STDIN ; print STDIN "abc" ;
}
EXPECT
########
-Xw
# nolint: check combination of -w and -X
{
$^W = 1 ;
close STDIN ; print STDIN "abc" ;
}
EXPECT
########
-X
--FILE-- abc.pm
use warnings 'syntax' ;
my $a = 0;
$a =+ 1 ;
1;
--FILE--
use warnings 'uninitialized' ;
use abc;
my $a ; chop $a ;
EXPECT
########
-X
--FILE-- abc
use warnings 'syntax' ;
my $a = 0;
$a =+ 1 ;
1;
--FILE--
use warnings 'uninitialized' ;
require "./abc";
my $a ; chop $a ;
EXPECT
########
-X
--FILE-- abc.pm
BEGIN {$^W = 1}
my ($a, $b) = (0,0);
$a =+ 1 ;
1;
--FILE--
$^W = 1 ;
use abc;
my $a ; chop $a ;
EXPECT
########
-X
--FILE-- abc
BEGIN {$^W = 1}
my ($a, $b) = (0,0);
$a =+ 1 ;
1;
--FILE--
$^W = 1 ;
require "./abc";
my $a ; chop $a ;
EXPECT
########
-X
# Check scope of pragma with eval
use warnings;
{
no warnings ;
eval '
my $b ; chop $b ;
'; print STDERR $@ ;
my $b ; chop $b ;
}
EXPECT
########
-X
# Check scope of pragma with eval
use warnings;
{
no warnings ;
eval q[
use warnings 'uninitialized' ;
my $b ; chop $b ;
]; print STDERR $@;
my $b ; chop $b ;
}
EXPECT
########
-X
# Check scope of pragma with eval
no warnings;
{
use warnings 'uninitialized' ;
eval '
my $b ; chop $b ;
'; print STDERR $@ ;
my $b ; chop $b ;
}
EXPECT
########
-X
# Check scope of pragma with eval
no warnings;
{
use warnings 'uninitialized' ;
eval '
no warnings ;
my $b ; chop $b ;
'; print STDERR $@ ;
my $b ; chop $b ;
}
EXPECT
########
-X
# Check scope of pragma with eval
use warnings;
{
no warnings ;
eval '
my $a =+ 1 ;
'; print STDERR $@ ;
my $a =+ 1 ;
}
EXPECT
########
-X
# Check scope of pragma with eval
use warnings;
{
no warnings ;
eval q[
use warnings 'syntax' ;
my $a =+ 1 ;
]; print STDERR $@;
my $a =+ 1 ;
}
EXPECT
########
-X
# Check scope of pragma with eval
no warnings;
{
use warnings 'syntax' ;
eval '
my $a =+ 1 ;
'; print STDERR $@;
my $a =+ 1 ;
}
EXPECT
########
-X
# Check scope of pragma with eval
no warnings;
{
use warnings 'syntax' ;
eval '
no warnings ;
my $a =+ 1 ;
'; print STDERR $@;
my $a =+ 1 ;
}
EXPECT
--- NEW FILE: av ---
av.c
Mandatory Warnings ALL TODO
------------------
av_reify called on tied array [av_reify]
Attempt to clear deleted array [av_clear]
__END__
# av.c
$struct = [{foo => 1, bar => 2}, "FOO", "BAR"];
use warnings 'deprecated';
$a = $struct->{foo}; # This should warn.
no warnings 'deprecated';
$b = $struct->{bar}; # This should not warn.
bless $struct, 'HlagHlag';
use warnings 'deprecated';
$a = $struct->{foo}; # This should warn.
no warnings 'deprecated';
$b = $struct->{bar}; # This should not warn.
EXPECT
Pseudo-hashes are deprecated at - line 4.
Pseudo-hashes are deprecated at - line 9.
########
package Foo;
use warnings 'deprecated';
use fields qw(foo bar);
my $foo = fields::new('Foo');
$foo->{foo} = 42;
EXPECT
--- NEW FILE: pp_sys ---
pp_sys.c AOK
untie attempted while %d inner references still exist [pp_untie]
sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
fileno() on unopened filehandle abc [pp_fileno]
$a = "abc"; fileno($a)
binmode() on unopened filehandle abc [pp_binmode]
$a = "abc"; fileno($a)
printf() on unopened filehandle abc [pp_prtf]
$a = "abc"; printf $a "fred"
Filehandle %s opened only for input [pp_leavewrite]
format STDIN =
.
write STDIN;
write() on closed filehandle %s [pp_leavewrite]
format STDIN =
.
close STDIN;
write STDIN ;
page overflow [pp_leavewrite]
printf() on unopened filehandle abc [pp_prtf]
$a = "abc"; printf $a "fred"
Filehandle %s opened only for input [pp_prtf]
$a = "abc";
printf $a "fred"
printf() on closed filehandle %s [pp_prtf]
close STDIN ;
printf STDIN "fred"
syswrite() on closed filehandle %s [pp_send]
close STDIN;
syswrite STDIN, "fred", 1;
send() on closed socket %s [pp_send]
close STDIN;
send STDIN, "fred", 1
bind() on closed socket %s [pp_bind]
close STDIN;
bind STDIN, "fred" ;
connect() on closed socket %s [pp_connect]
close STDIN;
connect STDIN, "fred" ;
listen() on closed socket %s [pp_listen]
close STDIN;
listen STDIN, 2;
accept() on closed socket %s [pp_accept]
close STDIN;
accept "fred", STDIN ;
shutdown() on closed socket %s [pp_shutdown]
close STDIN;
shutdown STDIN, 0;
setsockopt() on closed socket %s [pp_ssockopt]
getsockopt() on closed socket %s [pp_ssockopt]
close STDIN;
setsockopt STDIN, 1,2,3;
getsockopt STDIN, 1,2;
getsockname() on closed socket %s [pp_getpeername]
getpeername() on closed socket %s [pp_getpeername]
close STDIN;
getsockname STDIN;
getpeername STDIN;
flock() on closed socket %s [pp_flock]
flock() on closed socket [pp_flock]
close STDIN;
flock STDIN, 8;
flock $a, 8;
warn(warn_nl, "stat"); [pp_stat]
-T on closed filehandle %s
stat() on closed filehandle %s
close STDIN ; -T STDIN ; stat(STDIN) ;
warn(warn_nl, "open"); [pp_fttext]
-T "abc\ndef" ;
Filehandle %s opened only for output [pp_sysread]
my $file = "./xcv" ;
open(F, ">$file") ;
my $a = sysread(F, $a,10) ;
lstat on filehandle %s [pp_lstat]
getc() on unopened filehandle [pp_getc]
getc() on closed filehandle [pp_getc]
Non-string passed as bitmask [pp_sselect]
__END__
# pp_sys.c [pp_untie]
use warnings 'untie' ;
sub TIESCALAR { bless [] } ;
$b = tie $a, 'main';
untie $a ;
no warnings 'untie' ;
$c = tie $d, 'main';
untie $d ;
EXPECT
untie attempted while 1 inner references still exist at - line 5.
########
# pp_sys.c [pp_leavewrite]
use warnings 'io' ;
format STDIN =
.
write STDIN;
no warnings 'io' ;
write STDIN;
EXPECT
Filehandle STDIN opened only for input at - line 5.
########
# pp_sys.c [pp_leavewrite]
use warnings 'closed' ;
format STDIN =
.
close STDIN;
write STDIN;
opendir STDIN, ".";
write STDIN;
closedir STDIN;
no warnings 'closed' ;
write STDIN;
opendir STDIN, ".";
write STDIN;
EXPECT
write() on closed filehandle STDIN at - line 6.
write() on closed filehandle STDIN at - line 8.
(Are you trying to call write() on dirhandle STDIN?)
########
# pp_sys.c [pp_leavewrite]
use warnings 'io' ;
format STDOUT_TOP =
abc
.
format STDOUT =
def
ghi
.
$= = 1 ;
$- =1 ;
open STDOUT, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ;
write ;
no warnings 'io' ;
write ;
EXPECT
page overflow at - line 13.
########
# pp_sys.c [pp_prtf]
use warnings 'unopened' ;
$a = "abc";
printf $a "fred";
no warnings 'unopened' ;
printf $a "fred";
EXPECT
printf() on unopened filehandle abc at - line 4.
########
# pp_sys.c [pp_prtf]
use warnings 'closed' ;
close STDIN ;
printf STDIN "fred";
opendir STDIN, ".";
printf STDIN "fred";
closedir STDIN;
no warnings 'closed' ;
printf STDIN "fred";
opendir STDIN, ".";
printf STDIN "fred";
EXPECT
printf() on closed filehandle STDIN at - line 4.
printf() on closed filehandle STDIN at - line 6.
(Are you trying to call printf() on dirhandle STDIN?)
########
# pp_sys.c [pp_prtf]
use warnings 'io' ;
printf STDIN "fred";
no warnings 'io' ;
printf STDIN "fred";
EXPECT
Filehandle STDIN opened only for input at - line 3.
########
# pp_sys.c [pp_send]
use warnings 'closed' ;
close STDIN;
syswrite STDIN, "fred", 1;
opendir STDIN, ".";
syswrite STDIN, "fred", 1;
closedir STDIN;
no warnings 'closed' ;
syswrite STDIN, "fred", 1;
opendir STDIN, ".";
syswrite STDIN, "fred", 1;
EXPECT
syswrite() on closed filehandle STDIN at - line 4.
syswrite() on closed filehandle STDIN at - line 6.
(Are you trying to call syswrite() on dirhandle STDIN?)
########
# pp_sys.c [pp_flock]
use Config;
BEGIN {
if ( !$Config{d_flock} &&
!$Config{d_fcntl_can_lock} &&
!$Config{d_lockf} ) {
print <<EOM ;
SKIPPED
# flock not present
EOM
exit ;
}
}
use warnings qw(unopened closed);
close STDIN;
flock STDIN, 8;
opendir STDIN, ".";
flock STDIN, 8;
flock FOO, 8;
flock $a, 8;
no warnings qw(unopened closed);
flock STDIN, 8;
opendir STDIN, ".";
flock STDIN, 8;
flock FOO, 8;
flock $a, 8;
EXPECT
flock() on closed filehandle STDIN at - line 16.
flock() on closed filehandle STDIN at - line 18.
(Are you trying to call flock() on dirhandle STDIN?)
flock() on unopened filehandle FOO at - line 19.
flock() on unopened filehandle at - line 20.
########
# pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername]
use warnings 'io' ;
use Config;
BEGIN {
if ( $^O ne 'VMS' and ! $Config{d_socket}) {
print <<EOM ;
SKIPPED
# send not present
# bind not present
# connect not present
# accept not present
# shutdown not present
# setsockopt not present
# getsockopt not present
# getsockname not present
# getpeername not present
EOM
exit ;
}
}
close STDIN;
send STDIN, "fred", 1;
bind STDIN, "fred" ;
connect STDIN, "fred" ;
listen STDIN, 2;
accept "fred", STDIN;
shutdown STDIN, 0;
setsockopt STDIN, 1,2,3;
getsockopt STDIN, 1,2;
getsockname STDIN;
getpeername STDIN;
opendir STDIN, ".";
send STDIN, "fred", 1;
bind STDIN, "fred" ;
connect STDIN, "fred" ;
listen STDIN, 2;
accept "fred", STDIN;
shutdown STDIN, 0;
setsockopt STDIN, 1,2,3;
getsockopt STDIN, 1,2;
getsockname STDIN;
getpeername STDIN;
closedir STDIN;
no warnings 'io' ;
send STDIN, "fred", 1;
bind STDIN, "fred" ;
connect STDIN, "fred" ;
listen STDIN, 2;
accept STDIN, "fred" ;
shutdown STDIN, 0;
setsockopt STDIN, 1,2,3;
getsockopt STDIN, 1,2;
getsockname STDIN;
getpeername STDIN;
opendir STDIN, ".";
send STDIN, "fred", 1;
bind STDIN, "fred" ;
connect STDIN, "fred" ;
listen STDIN, 2;
accept "fred", STDIN;
shutdown STDIN, 0;
setsockopt STDIN, 1,2,3;
getsockopt STDIN, 1,2;
getsockname STDIN;
getpeername STDIN;
EXPECT
send() on closed socket STDIN at - line 22.
bind() on closed socket STDIN at - line 23.
connect() on closed socket STDIN at - line 24.
listen() on closed socket STDIN at - line 25.
accept() on closed socket STDIN at - line 26.
shutdown() on closed socket STDIN at - line 27.
setsockopt() on closed socket STDIN at - line 28.
getsockopt() on closed socket STDIN at - line 29.
getsockname() on closed socket STDIN at - line 30.
getpeername() on closed socket STDIN at - line 31.
send() on closed socket STDIN at - line 33.
(Are you trying to call send() on dirhandle STDIN?)
bind() on closed socket STDIN at - line 34.
(Are you trying to call bind() on dirhandle STDIN?)
connect() on closed socket STDIN at - line 35.
(Are you trying to call connect() on dirhandle STDIN?)
listen() on closed socket STDIN at - line 36.
(Are you trying to call listen() on dirhandle STDIN?)
accept() on closed socket STDIN at - line 37.
(Are you trying to call accept() on dirhandle STDIN?)
shutdown() on closed socket STDIN at - line 38.
(Are you trying to call shutdown() on dirhandle STDIN?)
setsockopt() on closed socket STDIN at - line 39.
(Are you trying to call setsockopt() on dirhandle STDIN?)
getsockopt() on closed socket STDIN at - line 40.
(Are you trying to call getsockopt() on dirhandle STDIN?)
getsockname() on closed socket STDIN at - line 41.
(Are you trying to call getsockname() on dirhandle STDIN?)
getpeername() on closed socket STDIN at - line 42.
(Are you trying to call getpeername() on dirhandle STDIN?)
########
# pp_sys.c [pp_stat]
use warnings 'newline' ;
stat "abc\ndef";
no warnings 'newline' ;
stat "abc\ndef";
EXPECT
Unsuccessful stat on filename containing newline at - line 3.
########
# pp_sys.c [pp_fttext]
use warnings qw(unopened closed) ;
close STDIN ;
-T STDIN ;
stat(STDIN) ;
-T HOCUS;
stat(POCUS);
no warnings qw(unopened closed) ;
-T STDIN ;
stat(STDIN);
-T HOCUS;
stat(POCUS);
EXPECT
-T on closed filehandle STDIN at - line 4.
stat() on closed filehandle STDIN at - line 5.
-T on unopened filehandle HOCUS at - line 6.
stat() on unopened filehandle POCUS at - line 7.
########
# pp_sys.c [pp_fttext]
use warnings 'newline' ;
-T "abc\ndef" ;
no warnings 'newline' ;
-T "abc\ndef" ;
EXPECT
Unsuccessful open on filename containing newline at - line 3.
########
# pp_sys.c [pp_sysread]
use warnings 'io' ;
if ($^O eq 'dos') {
print <<EOM ;
SKIPPED
# skipped on dos
EOM
exit ;
}
my $file = "./xcv" ;
open(F, ">$file") ;
my $a = sysread(F, $a,10) ;
no warnings 'io' ;
my $a = sysread(F, $a,10) ;
close F ;
use warnings 'io' ;
sysread(F, $a, 10);
read(F, $a, 10);
sysread(NONEXISTENT, $a, 10);
read(NONEXISTENT, $a, 10);
unlink $file ;
EXPECT
Filehandle F opened only for output at - line 12.
sysread() on closed filehandle F at - line 17.
read() on closed filehandle F at - line 18.
sysread() on unopened filehandle NONEXISTENT at - line 19.
read() on unopened filehandle NONEXISTENT at - line 20.
########
# pp_sys.c [pp_binmode]
use warnings 'unopened' ;
binmode(BLARG);
$a = "BLERG";binmode($a);
EXPECT
binmode() on unopened filehandle BLARG at - line 3.
binmode() on unopened filehandle at - line 4.
########
# pp_sys.c [pp_lstat]
use warnings 'io';
open FH, "harness" or die "# $!";
lstat FH;
open my $fh, $0 or die "# $!";
lstat $fh;
no warnings 'io';
lstat FH;
lstat $fh;
close FH;
close $fh;
EXPECT
lstat() on filehandle FH at - line 4.
lstat() on filehandle $fh at - line 6.
########
# pp_sys.c [pp_getc]
use warnings qw(unopened closed) ;
getc FOO;
close STDIN;
getc STDIN;
# Create an empty file
$file = 'getcwarn.tmp';
open FH1, ">$file" or die "# $!"; close FH1;
open FH2, $file or die "# $!";
getc FH2; # Should not warn at EOF
close FH2;
getc FH2; # Warns, now
unlink $file;
no warnings qw(unopened closed) ;
getc FOO;
getc STDIN;
getc FH2;
EXPECT
getc() on unopened filehandle FOO at - line 3.
getc() on closed filehandle STDIN at - line 5.
getc() on closed filehandle FH2 at - line 12.
########
# pp_sys.c [pp_sselect]
use warnings 'misc';
$x = 1;
select $x, undef, undef, undef;
no warnings 'misc';
select $x, undef, undef, undef;
EXPECT
Non-string passed as bitmask at - line 4.
--- NEW FILE: 2use ---
Check lexical warnings functionality
TODO
check that the warning hierarchy works.
__END__
# check illegal category is caught
use warnings 'this-should-never-be-a-warning-category' ;
EXPECT
Unknown warnings category 'this-should-never-be-a-warning-category' at - line 3
BEGIN failed--compilation aborted at - line 3.
########
# Check compile time scope of pragma
use warnings 'syntax' ;
{
no warnings ;
my $a =+ 1 ;
}
my $a =+ 1 ;
EXPECT
Reversed += operator at - line 8.
########
# Check compile time scope of pragma
no warnings;
{
use warnings 'syntax' ;
my $a =+ 1 ;
}
my $a =+ 1 ;
EXPECT
Reversed += operator at - line 6.
########
# Check runtime scope of pragma
use warnings 'uninitialized' ;
{
no warnings ;
my $b ; chop $b ;
}
my $b ; chop $b ;
EXPECT
Use of uninitialized value in scalar chop at - line 8.
########
# Check runtime scope of pragma
no warnings ;
{
use warnings 'uninitialized' ;
my $b ; chop $b ;
}
my $b ; chop $b ;
EXPECT
Use of uninitialized value in scalar chop at - line 6.
########
# Check runtime scope of pragma
no warnings ;
{
use warnings 'uninitialized' ;
$a = sub { my $b ; chop $b ; }
}
&$a ;
EXPECT
Use of uninitialized value in scalar chop at - line 6.
########
use warnings 'syntax' ;
my $a =+ 1 ;
EXPECT
Reversed += operator at - line 3.
########
-w
no warnings 'reserved' ;
foo.bar;
EXPECT
Useless use of concatenation (.) or string in void context at - line 3.
########
--FILE-- abc
my $a =+ 1 ;
1;
--FILE--
use warnings 'syntax' ;
require "./abc";
EXPECT
########
--FILE-- abc
use warnings 'syntax' ;
1;
--FILE--
require "./abc";
my $a =+ 1 ;
EXPECT
########
--FILE-- abc
use warnings 'syntax' ;
my $a =+ 1 ;
1;
--FILE--
use warnings 'uninitialized' ;
require "./abc";
my $a ; chop $a ;
EXPECT
Reversed += operator at ./abc line 2.
Use of uninitialized value in scalar chop at - line 3.
########
--FILE-- abc.pm
use warnings 'syntax' ;
my $a =+ 1 ;
1;
--FILE--
use warnings 'uninitialized' ;
use abc;
my $a ; chop $a ;
EXPECT
Reversed += operator at abc.pm line 2.
Use of uninitialized value in scalar chop at - line 3.
########
# Check scope of pragma with eval
use warnings;
{
no warnings ;
eval {
my $b ; chop $b ;
}; print STDERR $@ ;
my $b ; chop $b ;
}
EXPECT
########
# Check scope of pragma with eval
use warnings;
{
no warnings ;
eval {
use warnings 'uninitialized' ;
my $b ; chop $b ;
}; print STDERR $@ ;
my $b ; chop $b ;
}
EXPECT
Use of uninitialized value in scalar chop at - line 8.
########
# Check scope of pragma with eval
no warnings;
{
use warnings 'uninitialized' ;
eval {
my $b ; chop $b ;
}; print STDERR $@ ;
my $b ; chop $b ;
}
EXPECT
Use of uninitialized value in scalar chop at - line 7.
Use of uninitialized value in scalar chop at - line 9.
########
# Check scope of pragma with eval
no warnings;
{
use warnings 'uninitialized' ;
eval {
no warnings ;
my $b ; chop $b ;
}; print STDERR $@ ;
my $b ; chop $b ;
}
EXPECT
Use of uninitialized value in scalar chop at - line 10.
########
# Check scope of pragma with eval
use warnings;
{
no warnings ;
eval {
my $a =+ 1 ;
}; print STDERR $@ ;
my $a =+ 1 ;
}
EXPECT
########
# Check scope of pragma with eval
use warnings;
{
no warnings ;
eval {
use warnings 'syntax' ;
my $a =+ 1 ;
}; print STDERR $@ ;
my $a =+ 1 ;
}
EXPECT
Reversed += operator at - line 8.
########
# Check scope of pragma with eval
no warnings;
{
use warnings 'syntax' ;
eval {
my $a =+ 1 ;
}; print STDERR $@ ;
my $a =+ 1 ;
}
EXPECT
Reversed += operator at - line 7.
Reversed += operator at - line 9.
########
# Check scope of pragma with eval
no warnings;
{
use warnings 'syntax' ;
eval {
no warnings ;
my $a =+ 1 ;
}; print STDERR $@ ;
my $a =+ 1 ;
}
EXPECT
Reversed += operator at - line 10.
########
# Check scope of pragma with eval
use warnings;
{
no warnings ;
eval '
my $b ; chop $b ;
'; print STDERR $@ ;
my $b ; chop $b ;
}
EXPECT
########
# Check scope of pragma with eval
use warnings;
{
no warnings ;
eval q[
use warnings 'uninitialized' ;
my $b ; chop $b ;
]; print STDERR $@;
my $b ; chop $b ;
}
EXPECT
Use of uninitialized value in scalar chop at (eval 1) line 3.
########
# Check scope of pragma with eval
no warnings;
{
use warnings 'uninitialized' ;
eval '
my $b ; chop $b ;
'; print STDERR $@ ;
my $b ; chop $b ;
}
EXPECT
Use of uninitialized value in scalar chop at (eval 1) line 2.
Use of uninitialized value in scalar chop at - line 9.
########
# Check scope of pragma with eval
no warnings;
{
use warnings 'uninitialized' ;
eval '
no warnings ;
my $b ; chop $b ;
'; print STDERR $@ ;
my $b ; chop $b ;
}
EXPECT
Use of uninitialized value in scalar chop at - line 10.
########
# Check scope of pragma with eval
use warnings;
{
no warnings ;
eval '
my $a =+ 1 ;
'; print STDERR $@ ;
my $a =+ 1 ;
}
EXPECT
########
# Check scope of pragma with eval
use warnings;
{
no warnings ;
eval q[
use warnings 'syntax' ;
my $a =+ 1 ;
]; print STDERR $@;
my $a =+ 1 ;
}
EXPECT
Reversed += operator at (eval 1) line 3.
########
# Check scope of pragma with eval
no warnings;
{
use warnings 'syntax' ;
eval '
my $a =+ 1 ;
'; print STDERR $@;
my $a =+ 1 ;
}
EXPECT
Reversed += operator at - line 9.
Reversed += operator at (eval 1) line 2.
########
# Check scope of pragma with eval
no warnings;
{
use warnings 'syntax' ;
eval '
no warnings ;
my $a =+ 1 ;
'; print STDERR $@;
my $a =+ 1 ;
}
EXPECT
Reversed += operator at - line 10.
########
# Check the additive nature of the pragma
my $a =+ 1 ;
my $a ; chop $a ;
use warnings 'syntax' ;
$a =+ 1 ;
my $b ; chop $b ;
use warnings 'uninitialized' ;
my $c ; chop $c ;
no warnings 'syntax' ;
$a =+ 1 ;
EXPECT
Reversed += operator at - line 6.
Use of uninitialized value in scalar chop at - line 9.
--- NEW FILE: 6default ---
Check default warnings
__END__
# default warnings should be displayed if you don't add anything
# optional shouldn't
my $a = oct "7777777777777777777777777777777777779" ;
EXPECT
Integer overflow in octal number at - line 3.
########
# no warnings should be displayed
no warnings ;
my $a = oct "7777777777777777777777777777777777778" ;
EXPECT
########
# all warnings should be displayed
use warnings ;
my $a = oct "7777777777777777777777777777777777778" ;
EXPECT
Integer overflow in octal number at - line 3.
Illegal octal digit '8' ignored at - line 3.
Octal number > 037777777777 non-portable at - line 3.
########
# check scope
use warnings ;
my $a = oct "7777777777777777777777777777777777778" ;
{
no warnings ;
my $a = oct "7777777777777777777777777777777777778" ;
}
my $c = oct "7777777777777777777777777777777777778" ;
EXPECT
Integer overflow in octal number at - line 3.
Illegal octal digit '8' ignored at - line 3.
Octal number > 037777777777 non-portable at - line 3.
Integer overflow in octal number at - line 8.
Illegal octal digit '8' ignored at - line 8.
Octal number > 037777777777 non-portable at - line 8.
########
# all warnings should be displayed
use warnings ;
my $a = oct "0xfffffffffffffffffg" ;
EXPECT
Integer overflow in hexadecimal number at - line 3.
Illegal hexadecimal digit 'g' ignored at - line 3.
Hexadecimal number > 0xffffffff non-portable at - line 3.
########
# all warnings should be displayed
use warnings ;
my $a = oct "0b111111111111111111111111111111111111111111111111111111111111111112";
EXPECT
Integer overflow in binary number at - line 3.
Illegal binary digit '2' ignored at - line 3.
Binary number > 0b11111111111111111111111111111111 non-portable at - line 3.
########
# Check scope of pragma with eval
use warnings;
{
no warnings ;
eval '
my $a = oct "0xfffffffffffffffffg" ;
'; print STDERR $@ ;
my $a = oct "0xfffffffffffffffffg" ;
}
EXPECT
########
# Check scope of pragma with eval
use warnings;
{
no warnings ;
eval q[
use warnings ;
my $a = oct "0xfffffffffffffffffg" ;
]; print STDERR $@;
my $a = oct "0xfffffffffffffffffg" ;
}
EXPECT
Integer overflow in hexadecimal number at (eval 1) line 3.
Illegal hexadecimal digit 'g' ignored at (eval 1) line 3.
Hexadecimal number > 0xffffffff non-portable at (eval 1) line 3.
########
# Check scope of pragma with eval
no warnings;
{
use warnings ;
eval '
my $a = oct "0xfffffffffffffffffg" ;
'; print STDERR $@ ;
}
EXPECT
Integer overflow in hexadecimal number at (eval 1) line 2.
Illegal hexadecimal digit 'g' ignored at (eval 1) line 2.
Hexadecimal number > 0xffffffff non-portable at (eval 1) line 2.
########
# Check scope of pragma with eval
no warnings;
{
use warnings;
eval '
no warnings ;
my $a = oct "0xfffffffffffffffffg" ;
'; print STDERR $@ ;
}
EXPECT
########
# Check scope of pragma with eval
no warnings;
{
use warnings 'deprecated' ;
eval '
my $a = oct "0xfffffffffffffffffg" ;
'; print STDERR $@;
}
EXPECT
--- NEW FILE: 1global ---
Check existing $^W functionality
__END__
# warnable code, warnings disabled
$a =+ 3 ;
EXPECT
########
-w
# warnable code, warnings enabled via command line switch
$a =+ 3 ;
EXPECT
Reversed += operator at - line 3.
Name "main::a" used only once: possible typo at - line 3.
########
#! perl -w
# warnable code, warnings enabled via #! line
$a =+ 3 ;
EXPECT
Reversed += operator at - line 3.
Name "main::a" used only once: possible typo at - line 3.
########
# warnable code, warnings enabled via compile time $^W
BEGIN { $^W = 1 }
$a =+ 3 ;
EXPECT
Reversed += operator at - line 4.
Name "main::a" used only once: possible typo at - line 4.
########
# compile-time warnable code, warnings enabled via runtime $^W
# so no warning printed.
$^W = 1 ;
$a =+ 3 ;
EXPECT
########
# warnable code, warnings enabled via runtime $^W
$^W = 1 ;
my $b ; chop $b ;
EXPECT
Use of uninitialized value in scalar chop at - line 4.
########
# warnings enabled at compile time, disabled at run time
BEGIN { $^W = 1 }
$^W = 0 ;
my $b ; chop $b ;
EXPECT
########
# warnings disabled at compile time, enabled at run time
BEGIN { $^W = 0 }
$^W = 1 ;
my $b ; chop $b ;
EXPECT
Use of uninitialized value in scalar chop at - line 5.
########
-w
--FILE-- abcd
my $b ; chop $b ;
1 ;
--FILE--
require "./abcd";
EXPECT
Use of uninitialized value in scalar chop at ./abcd line 1.
########
--FILE-- abcd
my $b ; chop $b ;
1 ;
--FILE--
#! perl -w
require "./abcd";
EXPECT
Use of uninitialized value in scalar chop at ./abcd line 1.
########
--FILE-- abcd
my $b ; chop $b ;
1 ;
--FILE--
$^W =1 ;
require "./abcd";
EXPECT
Use of uninitialized value in scalar chop at ./abcd line 1.
########
--FILE-- abcd
$^W = 0;
my $b ; chop $b ;
1 ;
--FILE--
$^W =1 ;
require "./abcd";
EXPECT
########
--FILE-- abcd
$^W = 1;
1 ;
--FILE--
$^W =0 ;
require "./abcd";
my $b ; chop $b ;
EXPECT
Use of uninitialized value in scalar chop at - line 3.
########
$^W = 1;
eval 'my $b ; chop $b ;' ;
print $@ ;
EXPECT
Use of uninitialized value in scalar chop at (eval 1) line 1.
########
eval '$^W = 1;' ;
print $@ ;
my $b ; chop $b ;
EXPECT
Use of uninitialized value in scalar chop at - line 4.
########
eval {$^W = 1;} ;
print $@ ;
my $b ; chop $b ;
EXPECT
Use of uninitialized value in scalar chop at - line 4.
########
{
local ($^W) = 1;
}
my $b ; chop $b ;
EXPECT
########
my $a ; chop $a ;
{
local ($^W) = 1;
my $b ; chop $b ;
}
my $c ; chop $c ;
EXPECT
Use of uninitialized value in scalar chop at - line 5.
########
-w
-e undef
EXPECT
Use of uninitialized value in -e at - line 2.
########
$^W = 1 + 2 ;
EXPECT
########
$^W = $a ;
EXPECT
########
sub fred {}
$^W = fred() ;
EXPECT
########
sub fred { my $b ; chop $b ;}
{ local $^W = 0 ;
fred() ;
}
EXPECT
########
sub fred { my $b ; chop $b ;}
{ local $^W = 1 ;
fred() ;
}
EXPECT
Use of uninitialized value in scalar chop at - line 2.
--- NEW FILE: pp ---
pp.c TODO
substr outside of string
$a = "ab" ; $b = substr($a, 4,5) ;
Attempt to use reference as lvalue in substr
$a = "ab" ; $b = \$a ; substr($b, 1,1) = $b
Use of uninitialized value in ref-to-glob cast [pp_rv2gv()]
*b = *{ undef()}
Use of uninitialized value in scalar dereference [pp_rv2sv()]
my $a = undef ; my $b = $$a
Odd number of elements in hash list
my $a = { 1,2,3 } ;
Explicit blessing to '' (assuming package main)
bless \[], "";
Constant subroutine %s undefined
sub foo () { 1 }; undef &foo;
Constant subroutine (anonymous) undefined
$foo = sub () { 3 }; undef &$foo;
__END__
# pp.c
use warnings 'substr' ;
$a = "ab" ;
$b = substr($a, 4,5) ;
no warnings 'substr' ;
$a = "ab" ;
$b = substr($a, 4,5) ;
EXPECT
substr outside of string at - line 4.
########
# pp.c
use warnings 'substr' ;
$a = "ab" ;
$b = \$a ;
substr($b, 1,1) = "ab" ;
no warnings 'substr' ;
substr($b, 1,1) = "ab" ;
EXPECT
Attempt to use reference as lvalue in substr at - line 5.
########
# pp.c
use warnings 'uninitialized' ;
*x = *{ undef() };
no warnings 'uninitialized' ;
*y = *{ undef() };
EXPECT
Use of uninitialized value in ref-to-glob cast at - line 3.
########
# pp.c
use warnings 'uninitialized';
$x = undef; $y = $$x;
no warnings 'uninitialized' ;
$u = undef; $v = $$u;
EXPECT
Use of uninitialized value in scalar dereference at - line 3.
########
# pp.c
use warnings 'misc' ;
my $a = { 1,2,3};
no warnings 'misc' ;
my $b = { 1,2,3};
EXPECT
Odd number of elements in anonymous hash at - line 3.
########
# pp.c
use warnings 'misc' ;
bless \[], "" ;
no warnings 'misc' ;
bless \[], "" ;
EXPECT
Explicit blessing to '' (assuming package main) at - line 3.
########
# pp.c
use warnings 'misc';
sub foo () { 1 }
undef &foo;
no warnings 'misc';
sub bar () { 2 }
undef &bar;
EXPECT
Constant subroutine foo undefined at - line 4.
########
# pp.c
use warnings 'misc';
$foo = sub () { 3 };
undef &$foo;
no warnings 'misc';
$bar = sub () { 4 };
undef &$bar;
EXPECT
Constant subroutine (anonymous) undefined at - line 4.
########
# pp.c
use utf8 ;
$_ = "\x80 \xff" ;
reverse ;
EXPECT
--- NEW FILE: 9enabled ---
Check warnings::enabled & warnings::warn
__END__
--FILE-- abc.pm
package abc ;
use warnings "io" ;
print "ok1\n" if ! warnings::enabled('all') ;
print "ok2\n" if ! warnings::enabled("io") ;
1;
--FILE--
no warnings;
use abc ;
EXPECT
ok1
ok2
########
--FILE-- abc.pm
[...1142 lines suppressed...]
EXPECT
ok1
ok2
ok3
ok4
ok5
ok6
my message 1 at - line 5
my message 2 at - line 5
my message 4 at - line 5
my message 8 at - line 5
**
ok1
ok2
ok3
ok4
ok5
my message 1 at - line 8
my message 2 at - line 8
my message 4 at - line 8
--- NEW FILE: perl ---
perl.c AOK
gv_check(defstash)
Name \"%s::%s\" used only once: possible typo
Mandatory Warnings All TODO
------------------
Recompile perl with -DDEBUGGING to use -D switch [moreswitches]
Unbalanced scopes: %ld more ENTERs than LEAVEs [perl_destruct]
Unbalanced saves: %ld more saves than restores [perl_destruct]
Unbalanced tmps: %ld more allocs than frees [perl_destruct]
Unbalanced context: %ld more PUSHes than POPs [perl_destruct]
Unbalanced string table refcount: (%d) for \"%s\" [perl_destruct]
Scalars leaked: %ld [perl_destruct]
__END__
# perl.c
no warnings 'once' ;
$x = 3 ;
use warnings 'once' ;
$z = 3 ;
EXPECT
Name "main::z" used only once: possible typo at - line 5.
########
-w
# perl.c
$x = 3 ;
no warnings 'once' ;
$z = 3
EXPECT
Name "main::x" used only once: possible typo at - line 3.
########
# perl.c
BEGIN { $^W =1 ; }
$x = 3 ;
no warnings 'once' ;
$z = 3
EXPECT
Name "main::x" used only once: possible typo at - line 3.
########
-W
# perl.c
no warnings 'once' ;
$x = 3 ;
use warnings 'once' ;
$z = 3 ;
EXPECT
OPTION random
Name "main::z" used only once: possible typo at - line 6.
Name "main::x" used only once: possible typo at - line 4.
########
-X
# perl.c
use warnings 'once' ;
$x = 3 ;
EXPECT
########
# perl.c
{ use warnings 'once' ; $x = 3 ; }
$y = 3 ;
EXPECT
Name "main::x" used only once: possible typo at - line 3.
########
# perl.c
$z = 3 ;
BEGIN { $^W = 1 }
{ no warnings 'once' ; $x = 3 ; }
$y = 3 ;
EXPECT
Name "main::y" used only once: possible typo at - line 6.
--- NEW FILE: regcomp ---
regcomp.c AOK
Quantifier unexpected on zero-length expression [S_study_chunk]
(?p{}) is deprecated - use (??{}) [S_reg]
$a =~ /(?p{'x'})/ ;
Useless (%s%c) - %suse /%c modifier [S_reg]
Useless (%sc) - %suse /gc modifier [S_reg]
Strange *+?{} on zero-length expression [S_study_chunk]
/(?=a)?/
%.*s matches null string many times [S_regpiece]
$a = "ABC123" ; $a =~ /(?=a)*/'
/%.127s/: Unrecognized escape \\%c passed through [S_regatom]
$x = '\m' ; /$x/
POSIX syntax [%c %c] belongs inside character classes [S_checkposixcc]
Character class [:%.*s:] unknown [S_regpposixcc]
Character class syntax [%c %c] belongs inside character classes [S_checkposixcc]
/%.127s/: false [] range \"%*.*s\" in regexp [S_regclass]
/%.127s/: false [] range \"%*.*s\" in regexp [S_regclassutf8]
/%.127s/: Unrecognized escape \\%c in character class passed through" [S_regclass]
/%.127s/: Unrecognized escape \\%c in character class passed through" [S_regclassutf8]
False [] range \"%*.*s\" [S_regclass]
__END__
# regcomp.c [S_regpiece]
use warnings 'regexp' ;
my $a = "ABC123" ;
$a =~ /(?=a)*/ ;
no warnings 'regexp' ;
$a =~ /(?=a)*/ ;
EXPECT
(?=a)* matches null string many times in regex; marked by <-- HERE in m/(?=a)* <-- HERE / at - line 4.
########
# regcomp.c [S_regatom]
$x = '\m' ;
use warnings 'regexp' ;
$a =~ /a$x/ ;
no warnings 'regexp' ;
$a =~ /a$x/ ;
EXPECT
Unrecognized escape \m passed through in regex; marked by <-- HERE in m/a\m <-- HERE / at - line 4.
########
# regcomp.c [S_regpposixcc S_checkposixcc]
#
use warnings 'regexp' ;
$_ = "" ;
/[:alpha:]/;
/[:zog:]/;
no warnings 'regexp' ;
/[:alpha:]/;
/[:zog:]/;
EXPECT
POSIX syntax [: :] belongs inside character classes in regex; marked by <-- HERE in m/[:alpha:] <-- HERE / at - line 5.
POSIX syntax [: :] belongs inside character classes in regex; marked by <-- HERE in m/[:zog:] <-- HERE / at - line 6.
########
# regcomp.c [S_checkposixcc]
#
use warnings 'regexp' ;
$_ = "" ;
/[.zog.]/;
no warnings 'regexp' ;
/[.zog.]/;
EXPECT
POSIX syntax [. .] belongs inside character classes in regex; marked by <-- HERE in m/[.zog.] <-- HERE / at - line 5.
POSIX syntax [. .] is reserved for future extensions in regex; marked by <-- HERE in m/[.zog.] <-- HERE / at - line 5.
########
# regcomp.c [S_regclass]
$_ = "";
use warnings 'regexp' ;
/[a-b]/;
/[a-\d]/;
/[\d-b]/;
/[\s-\d]/;
/[\d-\s]/;
/[a-[:digit:]]/;
/[[:digit:]-b]/;
/[[:alpha:]-[:digit:]]/;
/[[:digit:]-[:alpha:]]/;
no warnings 'regexp' ;
/[a-b]/;
/[a-\d]/;
/[\d-b]/;
/[\s-\d]/;
/[\d-\s]/;
/[a-[:digit:]]/;
/[[:digit:]-b]/;
/[[:alpha:]-[:digit:]]/;
/[[:digit:]-[:alpha:]]/;
EXPECT
False [] range "a-\d" in regex; marked by <-- HERE in m/[a-\d <-- HERE ]/ at - line 5.
False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE b]/ at - line 6.
False [] range "\s-" in regex; marked by <-- HERE in m/[\s- <-- HERE \d]/ at - line 7.
False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE \s]/ at - line 8.
False [] range "a-[:digit:]" in regex; marked by <-- HERE in m/[a-[:digit:] <-- HERE ]/ at - line 9.
False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE b]/ at - line 10.
False [] range "[:alpha:]-" in regex; marked by <-- HERE in m/[[:alpha:]- <-- HERE [:digit:]]/ at - line 11.
False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE [:alpha:]]/ at - line 12.
########
# regcomp.c [S_regclassutf8]
BEGIN {
if (ord("\t") == 5) {
print "SKIPPED\n# ebcdic regular expression ranges differ.";
exit 0;
}
}
use utf8;
$_ = "";
use warnings 'regexp' ;
/[a-b]/;
/[a-\d]/;
/[\d-b]/;
/[\s-\d]/;
/[\d-\s]/;
/[a-[:digit:]]/;
/[[:digit:]-b]/;
/[[:alpha:]-[:digit:]]/;
/[[:digit:]-[:alpha:]]/;
no warnings 'regexp' ;
/[a-b]/;
/[a-\d]/;
/[\d-b]/;
/[\s-\d]/;
/[\d-\s]/;
/[a-[:digit:]]/;
/[[:digit:]-b]/;
/[[:alpha:]-[:digit:]]/;
/[[:digit:]-[:alpha:]]/;
EXPECT
False [] range "a-\d" in regex; marked by <-- HERE in m/[a-\d <-- HERE ]/ at - line 12.
False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE b]/ at - line 13.
False [] range "\s-" in regex; marked by <-- HERE in m/[\s- <-- HERE \d]/ at - line 14.
False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE \s]/ at - line 15.
False [] range "a-[:digit:]" in regex; marked by <-- HERE in m/[a-[:digit:] <-- HERE ]/ at - line 16.
False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE b]/ at - line 17.
False [] range "[:alpha:]-" in regex; marked by <-- HERE in m/[[:alpha:]- <-- HERE [:digit:]]/ at - line 18.
False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE [:alpha:]]/ at - line 19.
########
# regcomp.c [S_regclass S_regclassutf8]
use warnings 'regexp' ;
$a =~ /[a\zb]/ ;
no warnings 'regexp' ;
$a =~ /[a\zb]/ ;
EXPECT
Unrecognized escape \z in character class passed through in regex; marked by <-- HERE in m/[a\z <-- HERE b]/ at - line 3.
########
# regcomp.c [S_study_chunk]
use warnings 'deprecated' ;
$a = "xx" ;
$a =~ /(?p{'x'})/ ;
no warnings ;
use warnings 'regexp' ;
$a =~ /(?p{'x'})/ ;
use warnings;
no warnings 'deprecated' ;
no warnings 'regexp' ;
no warnings 'syntax' ;
$a =~ /(?p{'x'})/ ;
EXPECT
(?p{}) is deprecated - use (??{}) in regex; marked by <-- HERE in m/(?p <-- HERE {'x'})/ at - line 4.
(?p{}) is deprecated - use (??{}) in regex; marked by <-- HERE in m/(?p <-- HERE {'x'})/ at - line 7.
########
# regcomp.c [S_reg]
use warnings 'regexp' ;
$a = qr/(?c)/;
$a = qr/(?-c)/;
$a = qr/(?g)/;
$a = qr/(?-g)/;
$a = qr/(?o)/;
$a = qr/(?-o)/;
$a = qr/(?g-o)/;
$a = qr/(?g-c)/;
$a = qr/(?o-cg)/; # (?c) means (?g) error won't be thrown
$a = qr/(?ogc)/;
no warnings 'regexp' ;
$a = qr/(?c)/;
$a = qr/(?-c)/;
$a = qr/(?g)/;
$a = qr/(?-g)/;
$a = qr/(?o)/;
$a = qr/(?-o)/;
$a = qr/(?g-o)/;
$a = qr/(?g-c)/;
$a = qr/(?o-cg)/; # (?c) means (?g) error won't be thrown
$a = qr/(?ogc)/;
#EXPECT
EXPECT
Useless (?c) - use /gc modifier in regex; marked by <-- HERE in m/(?c <-- HERE )/ at - line 3.
Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?-c <-- HERE )/ at - line 4.
Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE )/ at - line 5.
Useless (?-g) - don't use /g modifier in regex; marked by <-- HERE in m/(?-g <-- HERE )/ at - line 6.
Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE )/ at - line 7.
Useless (?-o) - don't use /o modifier in regex; marked by <-- HERE in m/(?-o <-- HERE )/ at - line 8.
Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE -o)/ at - line 9.
Useless (?-o) - don't use /o modifier in regex; marked by <-- HERE in m/(?g-o <-- HERE )/ at - line 9.
Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE -c)/ at - line 10.
Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?g-c <-- HERE )/ at - line 10.
Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE -cg)/ at - line 11.
Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?o-c <-- HERE g)/ at - line 11.
Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE gc)/ at - line 12.
Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?og <-- HERE c)/ at - line 12.
Useless (?c) - use /gc modifier in regex; marked by <-- HERE in m/(?ogc <-- HERE )/ at - line 12.
--- NEW FILE: pad ---
pad.c AOK
"my" variable %s masks earlier declaration in same scope
my $x;
my $x ;
Variable "%s" may be unavailable
sub x {
my $x;
sub y {
$x
}
}
Variable "%s" will not stay shared
sub x {
my $x;
sub y {
sub { $x }
}
}
"our" variable %s redeclared (Did you mean "local" instead of "our"?)
our $x;
{
our $x;
}
%s never introduced [pad_leavemy] TODO
__END__
# pad.c
use warnings 'misc' ;
my $x ;
my $x ;
my $y = my $y ;
no warnings 'misc' ;
my $x ;
my $y ;
EXPECT
"my" variable $x masks earlier declaration in same scope at - line 4.
"my" variable $y masks earlier declaration in same statement at - line 5.
########
# pad.c
use warnings 'closure' ;
sub x {
my $x;
sub y {
$x
}
}
EXPECT
Variable "$x" will not stay shared at - line 7.
########
# pad.c
no warnings 'closure' ;
sub x {
my $x;
sub y {
$x
}
}
EXPECT
########
# pad.c
use warnings 'closure' ;
sub x {
our $x;
sub y {
$x
}
}
EXPECT
########
# pad.c
use warnings 'closure' ;
sub x {
my $x;
sub y {
sub { $x }
}
}
EXPECT
Variable "$x" may be unavailable at - line 6.
########
# pad.c
no warnings 'closure' ;
sub x {
my $x;
sub y {
sub { $x }
}
}
EXPECT
########
use warnings 'misc' ;
our $x;
{
our $x;
}
EXPECT
"our" variable $x redeclared at - line 4.
(Did you mean "local" instead of "our"?)
########
# an our var being introduced should suppress errors about global syms
use strict;
use warnings;
our $x unless $x;
EXPECT
--- NEW FILE: regexec ---
regexec.c
This test generates "bad free" warnings when run under
PERL_DESTRUCT_LEVEL. This file merely serves as a placeholder
for investigation.
Complex regular subexpression recursion limit (%d) exceeded
$_ = 'a' x (2**15+1); /^()(a\1)*$/ ;
Complex regular subexpression recursion limit (%d) exceeded
$_ = 'a' x (2**15+1); /^()(a\1)*?$/ ;
(The actual value substituted for %d is masked in the tests so that
REG_INFTY configuration variable value does not affect outcome.)
__END__
# regexec.c
print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
use warnings 'regexp' ;
$SIG{__WARN__} = sub{local ($m) = shift;
$m =~ s/\(\d+\)/(*MASKED*)/;
print STDERR $m};
$_ = 'a' x (2**15+1);
/^()(a\1)*$/ ;
#
# If this test fails with a segmentation violation or similar,
# you may have to increase the default stacksize limit in your
# shell. You may need superuser privileges.
#
# Under the sh, ksh, zsh:
# $ ulimit -s
# 8192
# $ ulimit -s 16000
#
# Under the csh:
# % limit stacksize
# stacksize 8192 kbytes
# % limit stacksize 16000
#
EXPECT
Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9.
########
# regexec.c
print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
no warnings 'regexp' ;
$SIG{__WARN__} = sub{local ($m) = shift;
$m =~ s/\(\d+\)/(*MASKED*)/;
print STDERR $m};
$_ = 'a' x (2**15+1);
/^()(a\1)*$/ ;
#
# If this test fails with a segmentation violation or similar,
# you may have to increase the default stacksize limit in your
# shell. You may need superuser privileges.
#
# Under the sh, ksh, zsh:
# $ ulimit -s
# 8192
# $ ulimit -s 16000
#
# Under the csh:
# % limit stacksize
# stacksize 8192 kbytes
# % limit stacksize 16000
#
EXPECT
########
# regexec.c
print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
use warnings 'regexp' ;
$SIG{__WARN__} = sub{local ($m) = shift;
$m =~ s/\(\d+\)/(*MASKED*)/;
print STDERR $m};
$_ = 'a' x (2**15+1);
/^()(a\1)*?$/ ;
#
# If this test fails with a segmentation violation or similar,
# you may have to increase the default stacksize limit in your
# shell. You may need superuser privileges.
#
# Under the sh, ksh, zsh:
# $ ulimit -s
# 8192
# $ ulimit -s 16000
#
# Under the csh:
# % limit stacksize
# stacksize 8192 kbytes
# % limit stacksize 16000
#
EXPECT
Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9.
########
# regexec.c
print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
no warnings 'regexp' ;
$SIG{__WARN__} = sub{local ($m) = shift;
$m =~ s/\(\d+\)/(*MASKED*)/;
print STDERR $m};
$_ = 'a' x (2**15+1);
/^()(a\1)*?$/ ;
#
# If this test fails with a segmentation violation or similar,
# you may have to increase the default stacksize limit in your
# shell. You may need superuser privileges.
#
# Under the sh, ksh, zsh:
# $ ulimit -s
# 8192
# $ ulimit -s 16000
#
# Under the csh:
# % limit stacksize
# stacksize 8192 kbytes
# % limit stacksize 16000
#
EXPECT
--- NEW FILE: perly ---
perly.y AOK
dep() => deprecate("\"do\" to call subroutines")
Use of "do" to call subroutines is deprecated
sub fred {} do fred()
sub fred {} do fred(1)
sub fred {} $a = "fred" ; do $a()
sub fred {} $a = "fred" ; do $a(1)
__END__
# perly.y
use warnings 'deprecated' ;
sub fred {}
do fred() ;
do fred(1) ;
$a = "fred" ;
do $a() ;
do $a(1) ;
no warnings 'deprecated' ;
do fred() ;
do fred(1) ;
$a = "fred" ;
do $a() ;
do $a(1) ;
EXPECT
Use of "do" to call subroutines is deprecated at - line 4.
Use of "do" to call subroutines is deprecated at - line 5.
Use of "do" to call subroutines is deprecated at - line 7.
Use of "do" to call subroutines is deprecated at - line 8.
--- NEW FILE: 4lint ---
Check lint
__END__
-W
# lint: check compile time $^W is zapped
BEGIN { $^W = 0 ;}
$a = 1 ;
$a =+ 1 ;
close STDIN ; print STDIN "abc" ;
EXPECT
Reversed += operator at - line 5.
print() on closed filehandle STDIN at - line 6.
########
-W
# lint: check runtime $^W is zapped
$^W = 0 ;
close STDIN ; print STDIN "abc" ;
EXPECT
print() on closed filehandle STDIN at - line 4.
########
-W
# lint: check runtime $^W is zapped
{
$^W = 0 ;
close STDIN ; print STDIN "abc" ;
}
EXPECT
print() on closed filehandle STDIN at - line 5.
########
-W
# lint: check "no warnings" is zapped
no warnings ;
$a = 1 ;
$a =+ 1 ;
close STDIN ; print STDIN "abc" ;
EXPECT
Reversed += operator at - line 5.
print() on closed filehandle STDIN at - line 6.
########
-W
# lint: check "no warnings" is zapped
{
no warnings ;
close STDIN ; print STDIN "abc" ;
}
EXPECT
print() on closed filehandle STDIN at - line 5.
########
-Ww
# lint: check combination of -w and -W
{
$^W = 0 ;
close STDIN ; print STDIN "abc" ;
}
EXPECT
print() on closed filehandle STDIN at - line 5.
########
-W
--FILE-- abc.pm
package abc;
no warnings 'syntax' ;
my $a = 0;
$a =+ 1 ;
1;
--FILE--
no warnings 'uninitialized' ;
use abc;
my $a ; chop $a ;
EXPECT
Reversed += operator at abc.pm line 4.
Use of uninitialized value in scalar chop at - line 3.
########
-W
--FILE-- abc
package abc;
no warnings 'syntax' ;
my $a = 0;
$a =+ 1 ;
1;
--FILE--
no warnings 'uninitialized' ;
require "./abc";
my $a ; chop $a ;
EXPECT
Reversed += operator at ./abc line 4.
Use of uninitialized value in scalar chop at - line 3.
########
-W
--FILE-- abc.pm
package abc;
BEGIN {$^W = 0}
my $a = 0 ;
$a =+ 1 ;
1;
--FILE--
$^W = 0 ;
use abc;
my $a ; chop $a ;
EXPECT
Reversed += operator at abc.pm line 4.
Use of uninitialized value in scalar chop at - line 3.
########
-W
--FILE-- abc
BEGIN {$^W = 0}
my $a = 0 ;
$a =+ 1 ;
1;
--FILE--
$^W = 0 ;
require "./abc";
my $a ; chop $a ;
EXPECT
Reversed += operator at ./abc line 3.
Use of uninitialized value in scalar chop at - line 3.
########
-W
# Check scope of pragma with eval
{
no warnings ;
eval '
my $b ; chop $b ;
'; print STDERR $@ ;
my $b ; chop $b ;
}
EXPECT
Use of uninitialized value in scalar chop at (eval 1) line 2.
Use of uninitialized value in scalar chop at - line 8.
########
-W
# Check scope of pragma with eval
use warnings;
{
no warnings ;
eval q[
use warnings 'uninitialized' ;
my $b ; chop $b ;
]; print STDERR $@;
my $b ; chop $b ;
}
EXPECT
Use of uninitialized value in scalar chop at (eval 1) line 3.
Use of uninitialized value in scalar chop at - line 10.
########
-W
# Check scope of pragma with eval
no warnings;
{
use warnings 'uninitialized' ;
eval '
my $b ; chop $b ;
'; print STDERR $@ ;
my $b ; chop $b ;
}
EXPECT
Use of uninitialized value in scalar chop at (eval 1) line 2.
Use of uninitialized value in scalar chop at - line 9.
########
-W
# Check scope of pragma with eval
no warnings;
{
use warnings 'uninitialized' ;
eval '
no warnings ;
my $b ; chop $b ;
'; print STDERR $@ ;
my $b ; chop $b ;
}
EXPECT
Use of uninitialized value in scalar chop at (eval 1) line 3.
Use of uninitialized value in scalar chop at - line 10.
########
-W
# Check scope of pragma with eval
use warnings;
{
my $a = "1"; my $b = "2";
no warnings ;
eval q[
use warnings 'syntax' ;
$a =+ 1 ;
]; print STDERR $@;
$a =+ 1 ;
}
EXPECT
Reversed += operator at - line 11.
Reversed += operator at (eval 1) line 3.
########
-W
# Check scope of pragma with eval
no warnings;
{
my $a = "1"; my $b = "2";
use warnings 'syntax' ;
eval '
$a =+ 1 ;
'; print STDERR $@;
$a =+ 1 ;
}
EXPECT
Reversed += operator at - line 10.
Reversed += operator at (eval 1) line 2.
########
-W
# Check scope of pragma with eval
no warnings;
{
my $a = "1"; my $b = "2";
use warnings 'syntax' ;
eval '
no warnings ;
$a =+ 1 ;
'; print STDERR $@;
$a =+ 1 ;
}
EXPECT
Reversed += operator at - line 11.
Reversed += operator at (eval 1) line 3.
--- NEW FILE: pp_hot ---
pp_hot.c
print() on unopened filehandle abc [pp_print]
$f = $a = "abc" ; print $f $a
Filehandle %s opened only for input [pp_print]
print STDIN "abc" ;
Filehandle %s opened only for output [pp_print]
$a = <STDOUT> ;
print() on closed filehandle %s [pp_print]
close STDIN ; print STDIN "abc" ;
uninitialized [pp_rv2av]
my $a = undef ; my @b = @$a
uninitialized [pp_rv2hv]
my $a = undef ; my %b = %$a
Odd number of elements in hash list [pp_aassign]
%X = (1,2,3) ;
Reference found where even-sized list expected [pp_aassign]
$X = [ 1 ..3 ];
Filehandle %s opened only for output [Perl_do_readline]
open (FH, ">./xcv") ;
my $a = <FH> ;
glob failed (can't start child: %s) [Perl_do_readline] <<TODO
readline() on closed filehandle %s [Perl_do_readline]
close STDIN ; $a = <STDIN>;
readline() on closed filehandle %s [Perl_do_readline]
readline(NONESUCH);
glob failed (child exited with status %d%s) [Perl_do_readline] <<TODO
Deep recursion on subroutine \"%s\" [Perl_sub_crush_depth]
sub fred { fred() if $a++ < 200} fred()
Deep recursion on anonymous subroutine [Perl_sub_crush_depth]
$a = sub { &$a if $a++ < 200} &$a
Possible Y2K bug: about to append an integer to '19' [pp_concat]
$x = "19$yy\n";
Use of reference "%s" as array index [pp_aelem]
$x[\1]
__END__
# pp_hot.c [pp_print]
use warnings 'unopened' ;
$f = $a = "abc" ;
print $f $a;
no warnings 'unopened' ;
print $f $a;
use warnings;
no warnings 'unopened' ;
print $f $a;
EXPECT
print() on unopened filehandle abc at - line 4.
########
# pp_hot.c [pp_print]
use warnings 'io' ;
# There is no guarantee that STDOUT is output only, or STDIN input only.
# Certainly on some BSDs (at least FreeBSD, Darwin, BSDi) file descriptors
# 1 and 2 are opened read/write on the tty, and the IO layers may reflect this.
# So we must make our own file handle that is read only.
my $file = "./xcv" ; unlink $file ;
open (FH, ">$file") or die $! ;
close FH or die $! ;
die "There is no file $file" unless -f $file ;
open (FH, "<$file") or die $! ;
print FH "anc" ;
open(FOO, "<&FH") or die $! ;
print FOO "anc" ;
no warnings 'io' ;
print FH "anc" ;
print FOO "anc" ;
use warnings 'io' ;
print FH "anc" ;
print FOO "anc" ;
close (FH) or die $! ;
close (FOO) or die $! ;
unlink $file ;
EXPECT
Filehandle FH opened only for input at - line 12.
Filehandle FOO opened only for input at - line 14.
Filehandle FH opened only for input at - line 19.
Filehandle FOO opened only for input at - line 20.
########
# pp_hot.c [pp_print]
use warnings 'closed' ;
close STDIN ;
print STDIN "anc";
opendir STDIN, ".";
print STDIN "anc";
closedir STDIN;
no warnings 'closed' ;
print STDIN "anc";
opendir STDIN, ".";
print STDIN "anc";
use warnings;
no warnings 'closed' ;
print STDIN "anc";
EXPECT
print() on closed filehandle STDIN at - line 4.
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 at bakerst.rutgers.edu>
# This goes segv on 5.7.3
use warnings 'closed' ;
my $fh = *STDOUT{IO};
close STDOUT or die "Can't close STDOUT";
print $fh "Shouldn't print anything, but shouldn't SEGV either\n";
EXPECT
print() on closed filehandle at - line 7.
########
# pp_hot.c [pp_print]
package foo;
use warnings 'closed';
open my $fh1, "nonexistent";
print $fh1 42;
open $fh2, "nonexistent";
print $fh2 42;
open $bar::fh3, "nonexistent";
print $bar::fh3 42;
open bar::FH4, "nonexistent";
print bar::FH4 42;
EXPECT
print() on closed filehandle $fh1 at - line 5.
print() on closed filehandle $fh2 at - line 7.
print() on closed filehandle $fh3 at - line 9.
print() on closed filehandle FH4 at - line 11.
########
# pp_hot.c [pp_rv2av]
use warnings 'uninitialized' ;
my $a = undef ;
my @b = @$a;
no warnings 'uninitialized' ;
my @c = @$a;
EXPECT
Use of uninitialized value in array dereference at - line 4.
########
# pp_hot.c [pp_rv2hv]
use warnings 'uninitialized' ;
my $a = undef ;
my %b = %$a;
no warnings 'uninitialized' ;
my %c = %$a;
EXPECT
Use of uninitialized value in hash dereference at - line 4.
########
# pp_hot.c [pp_aassign]
use warnings 'misc' ;
my %X ; %X = (1,2,3) ;
no warnings 'misc' ;
my %Y ; %Y = (1,2,3) ;
EXPECT
Odd number of elements in hash assignment at - line 3.
########
# pp_hot.c [pp_aassign]
use warnings 'misc' ;
my %X ; %X = [1 .. 3] ;
no warnings 'misc' ;
my %Y ; %Y = [1 .. 3] ;
EXPECT
Reference found where even-sized list expected at - line 3.
########
# pp_hot.c [Perl_do_readline]
use warnings 'closed' ;
close STDIN ; $a = <STDIN> ;
opendir STDIN, "." ; $a = <STDIN> ;
closedir STDIN;
no warnings 'closed' ;
opendir STDIN, "." ; $a = <STDIN> ;
$a = <STDIN> ;
EXPECT
readline() on closed filehandle STDIN at - line 3.
readline() on closed filehandle STDIN at - line 4.
(Are you trying to call readline() on dirhandle STDIN?)
########
# pp_hot.c [Perl_do_readline]
use warnings 'io' ;
my $file = "./xcv" ; unlink $file ;
open (FH, ">$file") or die $! ;
my $a = <FH> ;
no warnings 'io' ;
$a = <FH> ;
use warnings 'io' ;
open(FOO, ">&FH") or die $! ;
$a = <FOO> ;
no warnings 'io' ;
$a = <FOO> ;
use warnings 'io' ;
$a = <FOO> ;
$a = <FH> ;
close (FH) or die $! ;
close (FOO) or die $! ;
unlink $file ;
EXPECT
Filehandle FH opened only for output at - line 5.
Filehandle FOO opened only for output at - line 10.
Filehandle FOO opened only for output at - line 14.
Filehandle FH opened only for output at - line 15.
########
# pp_hot.c [Perl_sub_crush_depth]
use warnings 'recursion' ;
sub fred
{
fred() if $a++ < 200
}
{
local $SIG{__WARN__} = sub {
die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
};
fred();
}
EXPECT
ok
########
# pp_hot.c [Perl_sub_crush_depth]
no warnings 'recursion' ;
sub fred
{
fred() if $a++ < 200
}
{
local $SIG{__WARN__} = sub {
die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
};
fred();
}
EXPECT
########
# pp_hot.c [Perl_sub_crush_depth]
use warnings 'recursion' ;
$b = sub
{
&$b if $a++ < 200
} ;
&$b ;
EXPECT
Deep recursion on anonymous subroutine at - line 5.
########
# pp_hot.c [Perl_sub_crush_depth]
no warnings 'recursion' ;
$b = sub
{
&$b if $a++ < 200
} ;
&$b ;
EXPECT
########
# pp_hot.c [pp_concat]
use warnings 'uninitialized';
my($x, $y);
sub a { shift }
a($x . "x"); # should warn once
a($x . $y); # should warn twice
$x .= $y; # should warn once
$y .= $y; # should warn once
EXPECT
Use of uninitialized value in concatenation (.) or string at - line 5.
Use of uninitialized value in concatenation (.) or string at - line 6.
Use of uninitialized value in concatenation (.) or string at - line 6.
Use of uninitialized value in concatenation (.) or string at - line 7.
Use of uninitialized value in concatenation (.) or string at - line 8.
########
# pp_hot.c [pp_concat]
use warnings 'y2k';
use Config;
BEGIN {
unless ($Config{ccflags} =~ /Y2KWARN/) {
print "SKIPPED\n# perl not built with -DPERL_Y2KWARN";
exit 0;
}
}
my $x;
my $yy = 78;
$x = "19$yy\n";
$x = "19" . $yy . "\n";
$x = "319$yy\n";
$x = "319" . $yy . "\n";
$yy = 19;
$x = "ok $yy\n";
$yy = 9;
$x = 1 . $yy;
no warnings 'y2k';
$x = "19$yy\n";
$x = "19" . $yy . "\n";
EXPECT
Possible Y2K bug: about to append an integer to '19' at - line 12.
Possible Y2K bug: about to append an integer to '19' at - line 13.
########
# pp_hot.c [pp_aelem]
{
use warnings 'misc';
print $x[\1];
}
{
no warnings 'misc';
print $x[\1];
}
EXPECT
OPTION regex
Use of reference ".*" as array index at - line 4.
########
# pp_hot.c [pp_aelem]
package Foo;use overload q("") => sub {};package main;$a = bless {}, "Foo";
$b = {};
{
use warnings 'misc';
print $x[$a];
print $x[$b];
}
{
no warnings 'misc';
print $x[$a];
print $x[$b];
}
EXPECT
OPTION regex
Use of reference ".*" as array index at - line 7.
--- NEW FILE: run ---
run.c
Mandatory Warnings ALL TODO
------------------
NULL OP IN RUN
__END__
--- NEW FILE: doop ---
# doop.c
use utf8 ;
$_ = "\x80 \xff" ;
chop ;
EXPECT
########
--- NEW FILE: utf8 ---
utf8.c AOK
[utf8_to_uv]
Malformed UTF-8 character
my $a = ord "\x80" ;
Malformed UTF-8 character
my $a = ord "\xf080" ;
<<<<<< this warning can't be easily triggered from perl anymore
[utf16_to_utf8]
Malformed UTF-16 surrogate
<<<<<< Add a test when somethig actually calls utf16_to_utf8
__END__
# utf8.c [utf8_to_uv] -W
BEGIN {
if (ord('A') == 193) {
print "SKIPPED\n# ebcdic platforms do not generate Malformed UTF-8 warnings.";
exit 0;
}
}
use utf8 ;
my $a = "snøstorm" ;
{
no warnings 'utf8' ;
my $a = "snøstorm";
use warnings 'utf8' ;
my $a = "snøstorm";
}
EXPECT
Malformed UTF-8 character (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.
########
use warnings 'utf8';
my $d7ff = chr(0xD7FF);
my $d800 = chr(0xD800);
my $dfff = chr(0xDFFF);
my $e000 = chr(0xE000);
my $feff = chr(0xFEFF);
my $fffd = chr(0xFFFD);
my $fffe = chr(0xFFFE);
my $ffff = chr(0xFFFF);
my $hex4 = chr(0x10000);
my $hex5 = chr(0x100000);
my $maxm1 = chr(0x10FFFE);
my $max = chr(0x10FFFF);
no warnings 'utf8';
my $d7ff = chr(0xD7FF);
my $d800 = chr(0xD800);
my $dfff = chr(0xDFFF);
my $e000 = chr(0xE000);
my $feff = chr(0xFEFF);
my $fffd = chr(0xFFFD);
my $fffe = chr(0xFFFE);
my $ffff = chr(0xFFFF);
my $hex4 = chr(0x10000);
my $hex5 = chr(0x100000);
my $maxm1 = chr(0x10FFFE);
my $max = chr(0x10FFFF);
EXPECT
UTF-16 surrogate 0xd800 at - line 3.
UTF-16 surrogate 0xdfff at - line 4.
Unicode character 0xfffe is illegal at - line 8.
Unicode character 0xffff is illegal at - line 9.
Unicode character 0x10fffe is illegal at - line 12.
Unicode character 0x10ffff is illegal at - line 13.
########
use warnings 'utf8';
my $d7ff = pack("U", 0xD7FF);
my $d800 = pack("U", 0xD800);
my $dfff = pack("U", 0xDFFF);
my $e000 = pack("U", 0xE000);
my $feff = pack("U", 0xFEFF);
my $fffd = pack("U", 0xFFFD);
my $fffe = pack("U", 0xFFFE);
my $ffff = pack("U", 0xFFFF);
my $hex4 = pack("U", 0x10000);
my $hex5 = pack("U", 0x100000);
my $maxm1 = pack("U", 0x10FFFE);
my $max = pack("U", 0x10FFFF);
no warnings 'utf8';
my $d7ff = pack("U", 0xD7FF);
my $d800 = pack("U", 0xD800);
my $dfff = pack("U", 0xDFFF);
my $e000 = pack("U", 0xE000);
my $feff = pack("U", 0xFEFF);
my $fffd = pack("U", 0xFFFD);
my $fffe = pack("U", 0xFFFE);
my $ffff = pack("U", 0xFFFF);
my $hex4 = pack("U", 0x10000);
my $hex5 = pack("U", 0x100000);
my $maxm1 = pack("U", 0x10FFFE);
my $max = pack("U", 0x10FFFF);
EXPECT
UTF-16 surrogate 0xd800 at - line 3.
UTF-16 surrogate 0xdfff at - line 4.
Unicode character 0xfffe is illegal at - line 8.
Unicode character 0xffff is illegal at - line 9.
Unicode character 0x10fffe is illegal at - line 12.
Unicode character 0x10ffff is illegal at - line 13.
########
use warnings 'utf8';
my $d7ff = "\x{D7FF}";
my $d800 = "\x{D800}";
my $dfff = "\x{DFFF}";
my $e000 = "\x{E000}";
my $feff = "\x{FEFF}";
my $fffd = "\x{FFFD}";
my $fffe = "\x{FFFE}";
my $ffff = "\x{FFFF}";
my $hex4 = "\x{10000}";
my $hex5 = "\x{100000}";
my $maxm1 = "\x{10FFFE}";
my $max = "\x{10FFFF}";
no warnings 'utf8';
my $d7ff = "\x{D7FF}";
my $d800 = "\x{D800}";
my $dfff = "\x{DFFF}";
my $e000 = "\x{E000}";
my $feff = "\x{FEFF}";
my $fffd = "\x{FFFD}";
my $fffe = "\x{FFFE}";
my $ffff = "\x{FFFF}";
my $hex4 = "\x{10000}";
my $hex5 = "\x{100000}";
my $maxm1 = "\x{10FFFE}";
my $max = "\x{10FFFF}";
EXPECT
UTF-16 surrogate 0xd800 at - line 3.
UTF-16 surrogate 0xdfff at - line 4.
Unicode character 0xfffe is illegal at - line 8.
Unicode character 0xffff is illegal at - line 9.
Unicode character 0x10fffe is illegal at - line 12.
Unicode character 0x10ffff is illegal at - line 13.
--- NEW FILE: doio ---
doio.c
Can't open bidirectional pipe [Perl_do_open9]
open(F, "| true |");
Missing command in piped open [Perl_do_open9]
open(F, "| ");
Missing command in piped open [Perl_do_open9]
open(F, " |");
warn(warn_nl, "open"); [Perl_do_open9]
open(F, "true\ncd")
close() on unopened filehandle %s [Perl_do_close]
$a = "fred";close("$a")
tell() on closed filehandle [Perl_do_tell]
$a = "fred";$a = tell($a)
seek() on closed filehandle [Perl_do_seek]
$a = "fred";$a = seek($a,1,1)
sysseek() on closed filehandle [Perl_do_sysseek]
$a = "fred";$a = seek($a,1,1)
warn(warn_uninit); [Perl_do_print]
print $a ;
-x on closed filehandle %s [Perl_my_stat]
close STDIN ; -x STDIN ;
warn(warn_nl, "stat"); [Perl_my_stat]
stat "ab\ncd"
warn(warn_nl, "lstat"); [Perl_my_lstat]
lstat "ab\ncd"
Use of -l on filehandle %s [Perl_my_lstat]
Can't exec \"%s\": %s [Perl_do_aexec5]
Can't exec \"%s\": %s [Perl_do_exec3]
Filehandle %s opened only for output [Perl_do_eof]
my $a = eof STDOUT
Mandatory Warnings ALL TODO
------------------
Can't do inplace edit: %s is not a regular file [Perl_nextargv]
edit a directory
Can't do inplace edit: %s would not be unique [Perl_nextargv]
Can't rename %s to %s: %s, skipping file [Perl_nextargv]
Can't rename %s to %s: %s, skipping file [Perl_nextargv]
Can't remove %s: %s, skipping file [Perl_nextargv]
Can't do inplace edit on %s: %s [Perl_nextargv]
__END__
# doio.c [Perl_do_open9]
use warnings 'io' ;
open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
close(F);
no warnings 'io' ;
open(G, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
close(G);
EXPECT
Can't open bidirectional pipe at - line 3.
########
# doio.c [Perl_do_open9]
use warnings 'io' ;
open(F, "| ");
no warnings 'io' ;
open(G, "| ");
EXPECT
Missing command in piped open at - line 3.
########
# doio.c [Perl_do_open9]
use warnings 'io' ;
open(F, " |");
no warnings 'io' ;
open(G, " |");
EXPECT
Missing command in piped open at - line 3.
########
# doio.c [Perl_do_open9]
use warnings 'io' ;
open(F, "<true\ncd");
no warnings 'io' ;
open(G, "<true\ncd");
EXPECT
Unsuccessful open on filename containing newline at - line 3.
########
# doio.c [Perl_do_close] <<TODO
use warnings 'unopened' ;
close "fred" ;
no warnings 'unopened' ;
close "joe" ;
EXPECT
close() on unopened filehandle fred at - line 3.
########
# doio.c [Perl_do_tell Perl_do_seek Perl_do_sysseek Perl_my_stat]
use warnings 'io' ;
close STDIN ;
tell(STDIN);
$a = seek(STDIN,1,1);
$a = sysseek(STDIN,1,1);
-x STDIN ;
stat(STDIN) ;
$a = "fred";
tell($a);
seek($a,1,1);
sysseek($a,1,1);
-x $a; # ok
stat($a); # ok
no warnings 'io' ;
close STDIN ;
tell(STDIN);
$a = seek(STDIN,1,1);
$a = sysseek(STDIN,1,1);
-x STDIN ;
stat(STDIN) ;
$a = "fred";
tell($a);
seek($a,1,1);
sysseek($a,1,1);
-x $a;
stat($a);
EXPECT
tell() on closed filehandle STDIN at - line 4.
seek() on closed filehandle STDIN at - line 5.
sysseek() on closed filehandle STDIN at - line 6.
-x on closed filehandle STDIN at - line 7.
stat() on closed filehandle STDIN at - line 8.
tell() on unopened filehandle at - line 10.
seek() on unopened filehandle at - line 11.
sysseek() on unopened filehandle at - line 12.
########
# doio.c [Perl_do_print]
use warnings 'uninitialized' ;
print $a ;
no warnings 'uninitialized' ;
print $b ;
EXPECT
Use of uninitialized value in print at - line 3.
########
# doio.c [Perl_my_stat Perl_my_lstat]
use warnings 'io' ;
stat "ab\ncd";
lstat "ab\ncd";
no warnings 'io' ;
stat "ab\ncd";
lstat "ab\ncd";
EXPECT
Unsuccessful stat on filename containing newline at - line 3.
Unsuccessful stat on filename containing newline at - line 4.
########
# doio.c [Perl_my_stat]
use warnings 'io';
-l STDIN;
-l $fh;
open $fh, $0 or die "# $!";
-l $fh;
no warnings 'io';
-l STDIN;
-l $fh;
close $fh;
EXPECT
Use of -l on filehandle STDIN at - line 3.
Use of -l on filehandle $fh at - line 6.
########
# doio.c [Perl_do_aexec5]
BEGIN {
if ($^O eq 'MacOS') {
print <<EOM;
SKIPPED
# no exec on Mac OS
EOM
exit;
}
}
use warnings 'io' ;
exec "lskdjfalksdjfdjfkls","" ;
no warnings 'io' ;
exec "lskdjfalksdjfdjfkls","" ;
EXPECT
OPTION regex
Can't exec "lskdjfalksdjfdjfkls": .+
########
# doio.c [Perl_do_exec3]
BEGIN {
if ($^O eq 'MacOS') {
print <<EOM;
SKIPPED
# no exec on Mac OS
EOM
exit;
}
}
use warnings 'io' ;
exec "lskdjfalksdjfdjfkls", "abc" ;
no warnings 'io' ;
exec "lskdjfalksdjfdjfkls", "abc" ;
EXPECT
OPTION regex
Can't exec "lskdjfalksdjfdjfkls(:? abc)?": .+
########
# doio.c [win32_execvp]
BEGIN {
if ($^O eq 'MacOS') {
print <<EOM;
SKIPPED
# no exec on Mac OS
EOM
exit;
}
}
use warnings 'exec' ;
exec $^X, "-e0" ;
EXPECT
########
# doio.c [Perl_nextargv]
$^W = 0 ;
my $filename = "./temp.dir" ;
mkdir $filename, 0777
or die "Cannot create directory $filename: $!\n" ;
{
local (@ARGV) = ($filename) ;
local ($^I) = "" ;
my $x = <> ;
}
{
no warnings 'inplace' ;
local (@ARGV) = ($filename) ;
local ($^I) = "" ;
my $x = <> ;
}
{
use warnings 'inplace' ;
local (@ARGV) = ($filename) ;
local ($^I) = "" ;
my $x = <> ;
}
rmdir $filename ;
EXPECT
Can't do inplace edit: ./temp.dir is not a regular file at - line 9.
Can't do inplace edit: ./temp.dir is not a regular file at - line 21.
########
# doio.c [Perl_do_eof]
use warnings 'io' ;
my $a = eof STDOUT ;
no warnings 'io' ;
$a = eof STDOUT ;
EXPECT
Filehandle STDOUT opened only for output at - line 3.
########
# doio.c [Perl_do_openn]
use Config;
BEGIN {
if ($Config{useperlio}) {
print <<EOM;
SKIPPED
# warns only without perlio
EOM
exit;
}
}
use warnings 'io';
my $x = "foo";
open FOO, '>', \$x;
open BAR, '>&', \*STDOUT; # should not warn
no warnings 'io';
open FOO, '>', \$x;
EXPECT
Can't open a reference at - line 14.
########
# doio.c [Perl_do_openn]
use Config;
BEGIN {
if (!$Config{useperlio}) {
print <<EOM;
SKIPPED
# warns only with perlio
EOM
exit;
}
}
use warnings 'io' ;
close STDOUT;
open FH1, "harness"; close FH1;
no warnings 'io' ;
open FH2, "harness"; close FH2;
EXPECT
Filehandle STDOUT reopened as FH1 only for input at - line 14.
########
# doio.c [Perl_do_openn]
use Config;
BEGIN {
if (!$Config{useperlio}) {
print <<EOM;
SKIPPED
# warns only with perlio
EOM
exit;
}
}
use warnings 'io' ;
close STDIN;
open my $fh1, ">doiowarn.tmp"; close $fh1;
no warnings 'io' ;
open my $fh2, ">doiowarn.tmp"; close $fh2;
unlink "doiowarn.tmp";
EXPECT
Filehandle STDIN reopened as $fh1 only for output at - line 14.
--- NEW FILE: hv ---
hv.c
Mandatory Warnings ALL TODO
------------------
Attempt to free non-existent shared string [unsharepvn]
__END__
--- NEW FILE: util ---
util.c AOK
Illegal octal digit ignored
my $a = oct "029" ;
Illegal hex digit ignored
my $a = hex "0xv9" ;
Illegal binary digit ignored
my $a = oct "0b9" ;
Integer overflow in binary number
my $a = oct "0b111111111111111111111111111111111111111111" ;
Binary number > 0b11111111111111111111111111111111 non-portable
$a = oct "0b111111111111111111111111111111111" ;
Integer overflow in octal number
my $a = oct "077777777777777777777777777777" ;
Octal number > 037777777777 non-portable
$a = oct "0047777777777" ;
Integer overflow in hexadecimal number
my $a = hex "0xffffffffffffffffffff" ;
Hexadecimal number > 0xffffffff non-portable
$a = hex "0x1ffffffff" ;
__END__
# util.c
use warnings 'digit' ;
my $a = oct "029" ;
no warnings 'digit' ;
$a = oct "029" ;
EXPECT
Illegal octal digit '9' ignored at - line 3.
########
# util.c
use warnings 'digit' ;
my $a = hex "0xv9" ;
no warnings 'digit' ;
$a = hex "0xv9" ;
EXPECT
Illegal hexadecimal digit 'v' ignored at - line 3.
########
# util.c
use warnings 'digit' ;
my $a = oct "0b9" ;
no warnings 'digit' ;
$a = oct "0b9" ;
EXPECT
Illegal binary digit '9' ignored at - line 3.
########
# util.c
use warnings 'overflow' ;
my $a = oct "0b11111111111111111111111111111111111111111111111111111111111111111";
no warnings 'overflow' ;
$a = oct "0b11111111111111111111111111111111111111111111111111111111111111111";
EXPECT
Integer overflow in binary number at - line 3.
########
# util.c
use warnings 'overflow' ;
my $a = hex "0xffffffffffffffffffff" ;
no warnings 'overflow' ;
$a = hex "0xffffffffffffffffffff" ;
EXPECT
Integer overflow in hexadecimal number at - line 3.
########
# util.c
use warnings 'overflow' ;
my $a = oct "077777777777777777777777777777" ;
no warnings 'overflow' ;
$a = oct "077777777777777777777777777777" ;
EXPECT
Integer overflow in octal number at - line 3.
########
# util.c
use warnings 'portable' ;
my $a = oct "0b011111111111111111111111111111110" ;
$a = oct "0b011111111111111111111111111111111" ;
$a = oct "0b111111111111111111111111111111111" ;
no warnings 'portable' ;
$a = oct "0b011111111111111111111111111111110" ;
$a = oct "0b011111111111111111111111111111111" ;
$a = oct "0b111111111111111111111111111111111" ;
EXPECT
Binary number > 0b11111111111111111111111111111111 non-portable at - line 5.
########
# util.c
use warnings 'portable' ;
my $a = hex "0x0fffffffe" ;
$a = hex "0x0ffffffff" ;
$a = hex "0x1ffffffff" ;
no warnings 'portable' ;
$a = hex "0x0fffffffe" ;
$a = hex "0x0ffffffff" ;
$a = hex "0x1ffffffff" ;
EXPECT
Hexadecimal number > 0xffffffff non-portable at - line 5.
########
# util.c
use warnings 'portable' ;
my $a = oct "0037777777776" ;
$a = oct "0037777777777" ;
$a = oct "0047777777777" ;
no warnings 'portable' ;
$a = oct "0037777777776" ;
$a = oct "0037777777777" ;
$a = oct "0047777777777" ;
EXPECT
Octal number > 037777777777 non-portable at - line 5.
########
# util.c
use warnings;
$x = 1;
if ($x) {
print $y;
}
EXPECT
Name "main::y" used only once: possible typo at - line 5.
Use of uninitialized value in print at - line 5.
########
# util.c
use warnings;
$x = 1;
if ($x) {
$x++;
print $y;
}
EXPECT
Name "main::y" used only once: possible typo at - line 6.
Use of uninitialized value in print at - line 6.
########
# util.c
use warnings;
$x = 0;
if ($x) {
print "1\n";
} elsif (!$x) {
print $y;
} else {
print "0\n";
}
EXPECT
Name "main::y" used only once: possible typo at - line 7.
Use of uninitialized value in print at - line 7.
########
# util.c
use warnings;
$x = 0;
if ($x) {
print "1\n";
} elsif (!$x) {
$x++;
print $y;
} else {
print "0\n";
}
EXPECT
Name "main::y" used only once: possible typo at - line 8.
Use of uninitialized value in print at - line 8.
--- NEW FILE: 8signal ---
Check interaction of __WARN__, __DIE__ & lexical Warnings
TODO
__END__
# 8signal
BEGIN { $| = 1; $SIG{__WARN__} = sub { print "WARN -- @_" } }
BEGIN { $SIG{__DIE__} = sub { print "DIE -- @_" } }
$a =+ 1 ;
use warnings qw(syntax) ;
$a =+ 1 ;
use warnings FATAL => qw(syntax) ;
$a =+ 1 ;
print "The End.\n" ;
EXPECT
WARN -- Reversed += operator at - line 6.
DIE -- Reversed += operator at - line 8.
Reversed += operator at - line 8.
--- NEW FILE: pp_ctl ---
pp_ctl.c AOK
Not enough format arguments
format STDOUT =
@<<< @<<<
$a
.
write;
Exiting substitution via %s
$_ = "abc" ;
while ($i ++ == 0)
{
s/ab/last/e ;
}
Exiting subroutine via %s
sub fred { last }
{ fred() }
Exiting eval via %s
{ eval "last" }
Exiting pseudo-block via %s
@a = (1,2) ; @b = sort { last } @a ;
Exiting substitution via %s
$_ = "abc" ;
last fred:
while ($i ++ == 0)
{
s/ab/last fred/e ;
}
Exiting subroutine via %s
sub fred { last joe }
joe: { fred() }
Exiting eval via %s
fred: { eval "last fred" }
Exiting pseudo-block via %s
@a = (1,2) ; fred: @b = sort { last fred } @a ;
Deep recursion on subroutine \"%s\"
sub fred
{
fred() if $a++ < 200
}
fred()
(in cleanup) foo bar
package Foo;
DESTROY { die "foo bar" }
{ bless [], 'Foo' for 1..10 }
__END__
# pp_ctl.c
use warnings 'syntax' ;
format STDOUT =
@<<< @<<<
1
.
write;
EXPECT
Not enough format arguments at - line 5.
1
########
# pp_ctl.c
no warnings 'syntax' ;
format =
@<<< @<<<
1
.
write ;
EXPECT
1
########
# pp_ctl.c
use warnings 'exiting' ;
$_ = "abc" ;
while ($i ++ == 0)
{
s/ab/last/e ;
}
no warnings 'exiting' ;
while ($i ++ == 0)
{
s/ab/last/e ;
}
EXPECT
Exiting substitution via last at - line 7.
########
# pp_ctl.c
use warnings 'exiting' ;
sub fred { last }
{ fred() }
no warnings 'exiting' ;
sub joe { last }
{ joe() }
EXPECT
Exiting subroutine via last at - line 3.
########
# pp_ctl.c
{
eval "use warnings 'exiting' ; last;"
}
print STDERR $@ ;
{
eval "no warnings 'exiting' ;last;"
}
print STDERR $@ ;
EXPECT
Exiting eval via last at (eval 1) line 1.
########
# pp_ctl.c
use warnings 'exiting' ;
@a = (1,2) ;
@b = sort { last } @a ;
no warnings 'exiting' ;
@b = sort { last } @a ;
EXPECT
Exiting pseudo-block via last at - line 4.
Can't "last" outside a loop block at - line 4.
########
# pp_ctl.c
use warnings 'exiting' ;
$_ = "abc" ;
fred:
while ($i ++ == 0)
{
s/ab/last fred/e ;
}
no warnings 'exiting' ;
while ($i ++ == 0)
{
s/ab/last fred/e ;
}
EXPECT
Exiting substitution via last at - line 7.
########
# pp_ctl.c
use warnings 'exiting' ;
sub fred { last joe }
joe: { fred() }
no warnings 'exiting' ;
sub Fred { last Joe }
Joe: { Fred() }
EXPECT
Exiting subroutine via last at - line 3.
########
# pp_ctl.c
joe:
{ eval "use warnings 'exiting' ; last joe;" }
print STDERR $@ ;
Joe:
{ eval "no warnings 'exiting' ; last Joe;" }
print STDERR $@ ;
EXPECT
Exiting eval via last at (eval 1) line 1.
########
# pp_ctl.c
use warnings 'exiting' ;
@a = (1,2) ;
fred: @b = sort { last fred } @a ;
no warnings 'exiting' ;
Fred: @b = sort { last Fred } @a ;
EXPECT
Exiting pseudo-block via last at - line 4.
Label not found for "last fred" at - line 4.
########
# pp_ctl.c
use warnings 'recursion' ;
BEGIN { warn "PREFIX\n" ;}
sub fred
{
fred() if $a++ < 200
}
fred()
EXPECT
Deep recursion on subroutine "main::fred" at - line 6.
########
# pp_ctl.c
no warnings 'recursion' ;
BEGIN { warn "PREFIX\n" ;}
sub fred
{
fred() if $a++ < 200
}
fred()
EXPECT
########
# pp_ctl.c
use warnings 'misc' ;
package Foo;
DESTROY { die "@{$_[0]} foo bar" }
{ bless ['A'], 'Foo' for 1..10 }
{ bless ['B'], 'Foo' for 1..10 }
EXPECT
(in cleanup) A foo bar at - line 4.
(in cleanup) B foo bar at - line 4.
########
# pp_ctl.c
no warnings 'misc' ;
package Foo;
DESTROY { die "@{$_[0]} foo bar" }
{ bless ['A'], 'Foo' for 1..10 }
{ bless ['B'], 'Foo' for 1..10 }
EXPECT
########
# pp_ctl.c
use warnings;
eval 'print $foo';
EXPECT
Use of uninitialized value in print at (eval 1) line 1.
########
# pp_ctl.c
use warnings;
{
no warnings;
eval 'print $foo';
}
EXPECT
--- NEW FILE: mg ---
mg.c AOK
No such signal: SIG%s
$SIG{FRED} = sub {}
SIG%s handler \"%s\" not defined.
$SIG{"INT"} = "ok3"; kill "INT",$$;
Mandatory Warnings TODO
------------------
Can't break at that line [magic_setdbline]
__END__
# mg.c
use warnings 'signal' ;
$SIG{FRED} = sub {};
EXPECT
No such signal: SIGFRED at - line 3.
########
# mg.c
no warnings 'signal' ;
$SIG{FRED} = sub {};
EXPECT
########
# mg.c
use warnings 'signal' ;
if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS' || $^O eq 'MacOS') {
print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit;
}
$|=1;
$SIG{"INT"} = "fred"; kill "INT",$$;
EXPECT
SIGINT handler "fred" not defined.
########
# mg.c
no warnings 'signal' ;
if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS' || $^O eq 'MacOS') {
print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit;
}
$|=1;
$SIG{"INT"} = "fred"; kill "INT",$$;
EXPECT
########
# mg.c
use warnings 'uninitialized';
'foo' =~ /(foo)/;
length $3;
EXPECT
Use of uninitialized value in length at - line 4.
########
# mg.c
use warnings 'uninitialized';
length $3;
EXPECT
Use of uninitialized value in length at - line 3.
--- NEW FILE: 7fatal ---
Check FATAL functionality
__END__
# Check compile time warning
use warnings FATAL => 'syntax' ;
{
no warnings ;
$a =+ 1 ;
}
$a =+ 1 ;
print STDERR "The End.\n" ;
EXPECT
Reversed += operator at - line 8.
########
# Check compile time warning
use warnings FATAL => 'all' ;
{
no warnings ;
my $a =+ 1 ;
}
my $a =+ 1 ;
print STDERR "The End.\n" ;
EXPECT
Reversed += operator at - line 8.
########
# Check runtime scope of pragma
use warnings FATAL => 'uninitialized' ;
{
no warnings ;
my $b ; chop $b ;
}
my $b ; chop $b ;
print STDERR "The End.\n" ;
EXPECT
Use of uninitialized value in scalar chop at - line 8.
########
# Check runtime scope of pragma
use warnings FATAL => 'all' ;
{
no warnings ;
my $b ; chop $b ;
}
my $b ; chop $b ;
print STDERR "The End.\n" ;
EXPECT
Use of uninitialized value in scalar chop at - line 8.
########
# Check runtime scope of pragma
no warnings ;
{
use warnings FATAL => 'uninitialized' ;
$a = sub { my $b ; chop $b ; }
}
&$a ;
print STDERR "The End.\n" ;
EXPECT
Use of uninitialized value in scalar chop at - line 6.
########
# Check runtime scope of pragma
no warnings ;
{
use warnings FATAL => 'all' ;
$a = sub { my $b ; chop $b ; }
}
&$a ;
print STDERR "The End.\n" ;
EXPECT
Use of uninitialized value in scalar chop at - line 6.
########
--FILE-- abc
$a =+ 1 ;
1;
--FILE--
use warnings FATAL => 'syntax' ;
require "./abc";
EXPECT
########
--FILE-- abc
use warnings FATAL => 'syntax' ;
1;
--FILE--
require "./abc";
$a =+ 1 ;
EXPECT
########
--FILE-- abc
use warnings 'syntax' ;
$a =+ 1 ;
1;
--FILE--
use warnings FATAL => 'uninitialized' ;
require "./abc";
my $a ; chop $a ;
print STDERR "The End.\n" ;
EXPECT
Reversed += operator at ./abc line 2.
Use of uninitialized value in scalar chop at - line 3.
########
--FILE-- abc.pm
use warnings 'syntax' ;
$a =+ 1 ;
1;
--FILE--
use warnings FATAL => 'uninitialized' ;
use abc;
my $a ; chop $a ;
print STDERR "The End.\n" ;
EXPECT
Reversed += operator at abc.pm line 2.
Use of uninitialized value in scalar chop at - line 3.
########
# Check scope of pragma with eval
no warnings ;
eval {
use warnings FATAL => 'uninitialized' ;
my $b ; chop $b ;
}; print STDERR "-- $@" ;
my $b ; chop $b ;
print STDERR "The End.\n" ;
EXPECT
-- Use of uninitialized value in scalar chop at - line 6.
The End.
########
# Check scope of pragma with eval
use warnings FATAL => 'uninitialized' ;
eval {
my $b ; chop $b ;
}; print STDERR "-- $@" ;
my $b ; chop $b ;
print STDERR "The End.\n" ;
EXPECT
-- Use of uninitialized value in scalar chop at - line 5.
Use of uninitialized value in scalar chop at - line 7.
########
# Check scope of pragma with eval
use warnings FATAL => 'uninitialized' ;
eval {
no warnings ;
my $b ; chop $b ;
}; print STDERR $@ ;
my $b ; chop $b ;
print STDERR "The End.\n" ;
EXPECT
Use of uninitialized value in scalar chop at - line 8.
########
# Check scope of pragma with eval
no warnings ;
eval {
use warnings FATAL => 'syntax' ;
$a =+ 1 ;
}; print STDERR "-- $@" ;
$a =+ 1 ;
print STDERR "The End.\n" ;
EXPECT
Reversed += operator at - line 6.
########
# Check scope of pragma with eval
use warnings FATAL => 'syntax' ;
eval {
$a =+ 1 ;
}; print STDERR "-- $@" ;
$a =+ 1 ;
print STDERR "The End.\n" ;
EXPECT
Reversed += operator at - line 5.
########
# Check scope of pragma with eval
use warnings FATAL => 'syntax' ;
eval {
no warnings ;
$a =+ 1 ;
}; print STDERR $@ ;
$a =+ 1 ;
print STDERR "The End.\n" ;
EXPECT
Reversed += operator at - line 8.
########
# Check scope of pragma with eval
no warnings ;
eval {
use warnings FATAL => 'syntax' ;
}; print STDERR $@ ;
$a =+ 1 ;
print STDERR "The End.\n" ;
EXPECT
The End.
########
# Check scope of pragma with eval
no warnings ;
eval q[
use warnings FATAL => 'uninitialized' ;
my $b ; chop $b ;
]; print STDERR "-- $@";
my $b ; chop $b ;
print STDERR "The End.\n" ;
EXPECT
-- Use of uninitialized value in scalar chop at (eval 1) line 3.
The End.
########
# Check scope of pragma with eval
use warnings FATAL => 'uninitialized' ;
eval '
my $b ; chop $b ;
'; print STDERR "-- $@" ;
my $b ; chop $b ;
print STDERR "The End.\n" ;
EXPECT
-- Use of uninitialized value in scalar chop at (eval 1) line 2.
Use of uninitialized value in scalar chop at - line 7.
########
# Check scope of pragma with eval
use warnings FATAL => 'uninitialized' ;
eval '
no warnings ;
my $b ; chop $b ;
'; print STDERR $@ ;
my $b ; chop $b ;
print STDERR "The End.\n" ;
EXPECT
Use of uninitialized value in scalar chop at - line 8.
########
# Check scope of pragma with eval
no warnings ;
eval q[
use warnings FATAL => 'syntax' ;
$a =+ 1 ;
]; print STDERR "-- $@";
$a =+ 1 ;
print STDERR "The End.\n" ;
EXPECT
-- Reversed += operator at (eval 1) line 3.
The End.
########
# Check scope of pragma with eval
use warnings FATAL => 'syntax' ;
eval '
$a =+ 1 ;
'; print STDERR "-- $@";
print STDERR "The End.\n" ;
EXPECT
-- Reversed += operator at (eval 1) line 2.
The End.
########
# Check scope of pragma with eval
use warnings FATAL => 'syntax' ;
eval '
no warnings ;
$a =+ 1 ;
'; print STDERR "-- $@";
$a =+ 1 ;
print STDERR "The End.\n" ;
EXPECT
Reversed += operator at - line 8.
########
use warnings 'void' ;
time ;
{
use warnings FATAL => qw(void) ;
length "abc" ;
}
join "", 1,2,3 ;
print "done\n" ;
EXPECT
Useless use of time in void context at - line 4.
Useless use of length in void context at - line 8.
########
use warnings ;
time ;
{
use warnings FATAL => qw(void) ;
length "abc" ;
}
join "", 1,2,3 ;
print "done\n" ;
EXPECT
Useless use of time in void context at - line 4.
Useless use of length in void context at - line 8.
########
use warnings FATAL => 'all';
{
no warnings;
my $b ; chop $b;
{
use warnings ;
my $b ; chop $b;
}
}
my $b ; chop $b;
print STDERR "The End.\n" ;
EXPECT
Use of uninitialized value in scalar chop at - line 8.
Use of uninitialized value in scalar chop at - line 11.
########
use warnings FATAL => 'all';
{
no warnings FATAL => 'all';
my $b ; chop $b;
{
use warnings ;
my $b ; chop $b;
}
}
my $b ; chop $b;
print STDERR "The End.\n" ;
EXPECT
Use of uninitialized value in scalar chop at - line 8.
Use of uninitialized value in scalar chop at - line 11.
########
use warnings FATAL => 'all';
{
no warnings 'syntax';
{
use warnings ;
my $b ; chop $b;
}
}
my $b ; chop $b;
print STDERR "The End.\n" ;
EXPECT
Use of uninitialized value in scalar chop at - line 7.
########
use warnings FATAL => 'syntax', NONFATAL => 'void' ;
length "abc";
print STDERR "The End.\n" ;
EXPECT
Useless use of length in void context at - line 4.
The End.
########
use warnings FATAL => 'all', NONFATAL => 'void' ;
length "abc";
print STDERR "The End.\n" ;
EXPECT
Useless use of length in void context at - line 4.
The End.
########
use warnings FATAL => 'all', NONFATAL => 'void' ;
my $a ; chomp $a;
length "abc";
print STDERR "The End.\n" ;
EXPECT
Useless use of length in void context at - line 5.
Use of uninitialized value in scalar chomp at - line 4.
########
use warnings FATAL => 'void', NONFATAL => 'void' ;
length "abc";
print STDERR "The End.\n" ;
EXPECT
Useless use of length in void context at - line 4.
The End.
########
use warnings NONFATAL => 'void', FATAL => 'void' ;
length "abc";
print STDERR "The End.\n" ;
EXPECT
Useless use of length in void context at - line 4.
########
use warnings FATAL => 'all', NONFATAL => 'io';
no warnings 'once';
open(F, "<true\ncd");
close "fred" ;
print STDERR "The End.\n" ;
EXPECT
Unsuccessful open on filename containing newline at - line 5.
close() on unopened filehandle fred at - line 6.
The End.
########
use warnings FATAL => 'all', NONFATAL => 'io', FATAL => 'unopened' ;
no warnings 'once';
open(F, "<true\ncd");
close "fred" ;
print STDERR "The End.\n" ;
EXPECT
Unsuccessful open on filename containing newline at - line 5.
close() on unopened filehandle fred at - line 6.
--- NEW FILE: 3both ---
Check interaction of $^W and lexical
__END__
# Check interaction of $^W and use warnings
sub fred {
use warnings ;
my $b ;
chop $b ;
}
{ local $^W = 0 ;
fred() ;
}
EXPECT
Use of uninitialized value in scalar chop at - line 6.
########
# Check interaction of $^W and use warnings
sub fred {
use warnings ;
my $b ;
chop $b ;
}
{ $^W = 0 ;
fred() ;
}
EXPECT
Use of uninitialized value in scalar chop at - line 6.
########
# Check interaction of $^W and use warnings
sub fred {
no warnings ;
my $b ;
chop $b ;
}
{ local $^W = 1 ;
fred() ;
}
EXPECT
########
# Check interaction of $^W and use warnings
sub fred {
no warnings ;
my $b ;
chop $b ;
}
{ $^W = 1 ;
fred() ;
}
EXPECT
########
# Check interaction of $^W and use warnings
use warnings ;
$^W = 1 ;
my $b ;
chop $b ;
EXPECT
Use of uninitialized value in scalar chop at - line 6.
########
# Check interaction of $^W and use warnings
$^W = 1 ;
use warnings ;
my $b ;
chop $b ;
EXPECT
Use of uninitialized value in scalar chop at - line 6.
########
# Check interaction of $^W and use warnings
$^W = 1 ;
no warnings ;
my $b ;
chop $b ;
EXPECT
########
# Check interaction of $^W and use warnings
no warnings ;
$^W = 1 ;
my $b ;
chop $b ;
EXPECT
########
-w
# Check interaction of $^W and use warnings
no warnings ;
my $b ;
chop $b ;
EXPECT
########
-w
# Check interaction of $^W and use warnings
use warnings ;
my $b ;
chop $b ;
EXPECT
Use of uninitialized value in scalar chop at - line 5.
########
# Check interaction of $^W and use warnings
sub fred {
use warnings ;
my $b ;
chop $b ;
}
BEGIN { $^W = 0 }
fred() ;
EXPECT
Use of uninitialized value in scalar chop at - line 6.
########
# Check interaction of $^W and use warnings
sub fred {
no warnings ;
my $b ;
chop $b ;
}
BEGIN { $^W = 1 }
fred() ;
EXPECT
########
# Check interaction of $^W and use warnings
use warnings ;
BEGIN { $^W = 1 }
my $b ;
chop $b ;
EXPECT
Use of uninitialized value in scalar chop at - line 6.
########
# Check interaction of $^W and use warnings
BEGIN { $^W = 1 }
use warnings ;
my $b ;
chop $b ;
EXPECT
Use of uninitialized value in scalar chop at - line 6.
########
# Check interaction of $^W and use warnings
BEGIN { $^W = 1 }
no warnings ;
my $b ;
chop $b ;
EXPECT
########
# Check interaction of $^W and use warnings
no warnings ;
BEGIN { $^W = 1 }
my $b ;
chop $b ;
EXPECT
########
# Check interaction of $^W and use warnings
BEGIN { $^W = 1 }
{
no warnings ;
my $b ;
chop $b ;
}
my $b ;
chop $b ;
EXPECT
Use of uninitialized value in scalar chop at - line 10.
########
# Check interaction of $^W and use warnings
BEGIN { $^W = 0 }
{
use warnings ;
my $b ;
chop $b ;
}
my $b ;
chop $b ;
EXPECT
Use of uninitialized value in scalar chop at - line 7.
########
# Check scope of pragma with eval
BEGIN { $^W = 1 }
{
no warnings ;
eval '
my $b ; chop $b ;
'; print STDERR $@ ;
my $b ; chop $b ;
}
EXPECT
########
# Check scope of pragma with eval
BEGIN { $^W = 1 }
use warnings;
{
no warnings ;
eval q[
use warnings 'uninitialized' ;
my $b ; chop $b ;
]; print STDERR $@;
my $b ; chop $b ;
}
EXPECT
Use of uninitialized value in scalar chop at (eval 1) line 3.
########
# Check scope of pragma with eval
BEGIN { $^W = 0 }
{
use warnings 'uninitialized' ;
eval '
my $b ; chop $b ;
'; print STDERR $@ ;
my $b ; chop $b ;
}
EXPECT
Use of uninitialized value in scalar chop at (eval 1) line 2.
Use of uninitialized value in scalar chop at - line 9.
########
# Check scope of pragma with eval
BEGIN { $^W = 0 }
{
use warnings 'uninitialized' ;
eval '
no warnings ;
my $b ; chop $b ;
'; print STDERR $@ ;
my $b ; chop $b ;
}
EXPECT
Use of uninitialized value in scalar chop at - line 10.
########
# Check scope of pragma with eval
BEGIN { $^W = 1 }
{
no warnings ;
eval '
my $a =+ 1 ;
'; print STDERR $@ ;
my $a =+ 1 ;
}
EXPECT
--- NEW FILE: sv ---
sv.c
warn(warn_uninit);
warn(warn_uninit);
warn(warn_uninit);
warn(warn_uninit);
not_a_number(sv);
not_a_number(sv);
warn(warn_uninit);
not_a_number(sv);
warn(warn_uninit);
not_a_number(sv);
not_a_number(sv);
warn(warn_uninit);
warn(warn_uninit);
Subroutine %s redefined
Invalid conversion in %s:
Undefined value assigned to typeglob
Possible Y2K bug: %d format string following '19'
Reference is already weak [Perl_sv_rvweaken] <<TODO
Mandatory Warnings
------------------
Malformed UTF-8 character [sv_pos_b2u] (not tested: difficult to produce
with perl now)
Mandatory Warnings TODO
------------------
Attempt to free non-arena SV: 0x%lx [del_sv]
Reference miscount in sv_replace() [sv_replace]
Attempt to free unreferenced scalar [sv_free]
Attempt to free temp prematurely: SV 0x%lx [sv_free]
semi-panic: attempt to dup freed string [newSVsv]
__END__
# sv.c
use integer ;
use warnings 'uninitialized' ;
$x = 1 + $a[0] ; # a
no warnings 'uninitialized' ;
$x = 1 + $b[0] ; # a
EXPECT
Use of uninitialized value in integer addition (+) at - line 4.
########
# sv.c (sv_2iv)
package fred ;
sub TIESCALAR { my $x ; bless \$x}
sub FETCH { return undef }
sub STORE { return 1 }
package main ;
tie $A, 'fred' ;
use integer ;
use warnings 'uninitialized' ;
$A *= 2 ;
no warnings 'uninitialized' ;
$A *= 2 ;
EXPECT
Use of uninitialized value in integer multiplication (*) at - line 10.
########
# sv.c
use integer ;
use warnings 'uninitialized' ;
my $x *= 2 ; #b
no warnings 'uninitialized' ;
my $y *= 2 ; #b
EXPECT
Use of uninitialized value in integer multiplication (*) at - line 4.
########
# sv.c (sv_2uv)
package fred ;
sub TIESCALAR { my $x ; bless \$x}
sub FETCH { return undef }
sub STORE { return 1 }
package main ;
tie $A, 'fred' ;
use warnings 'uninitialized' ;
$B = 0 ;
$B |= $A ;
no warnings 'uninitialized' ;
$B = 0 ;
$B |= $A ;
EXPECT
Use of uninitialized value in bitwise or (|) at - line 10.
########
# sv.c
use warnings 'uninitialized' ;
my $Y = 1 ;
my $x = 1 | $a[$Y] ;
no warnings 'uninitialized' ;
my $Y = 1 ;
$x = 1 | $b[$Y] ;
EXPECT
Use of uninitialized value in bitwise or (|) at - line 4.
########
# sv.c
use warnings 'uninitialized' ;
my $Y = 1 ;
my $x = 1 & $a[$Y] ;
no warnings 'uninitialized' ;
my $Y = 1 ;
$x = 1 & $b[$Y] ;
EXPECT
Use of uninitialized value in bitwise and (&) at - line 4.
########
# sv.c
use warnings 'uninitialized' ;
my $Y = 1 ;
my $x = ~$a[$Y] ;
no warnings 'uninitialized' ;
my $Y = 1 ;
$x = ~$b[$Y] ;
EXPECT
Use of uninitialized value in 1's complement (~) at - line 4.
########
# sv.c
use warnings 'uninitialized' ;
my $x *= 1 ; # d
no warnings 'uninitialized' ;
my $y *= 1 ; # d
EXPECT
Use of uninitialized value in multiplication (*) at - line 3.
########
# sv.c
use warnings 'uninitialized' ;
$x = 1 + $a[0] ; # e
no warnings 'uninitialized' ;
$x = 1 + $b[0] ; # e
EXPECT
Use of uninitialized value in addition (+) at - line 3.
########
# sv.c (sv_2nv)
package fred ;
sub TIESCALAR { my $x ; bless \$x}
sub FETCH { return undef }
sub STORE { return 1 }
package main ;
tie $A, 'fred' ;
use warnings 'uninitialized' ;
$A *= 2 ;
no warnings 'uninitialized' ;
$A *= 2 ;
EXPECT
Use of uninitialized value in multiplication (*) at - line 9.
########
# sv.c
use warnings 'uninitialized' ;
$x = $y + 1 ; # f
no warnings 'uninitialized' ;
$x = $z + 1 ; # f
EXPECT
Use of uninitialized value in addition (+) at - line 3.
########
# sv.c
use warnings 'uninitialized' ;
$x = chop undef ; # g
no warnings 'uninitialized' ;
$x = chop undef ; # g
EXPECT
Modification of a read-only value attempted at - line 3.
########
# sv.c
use warnings 'uninitialized' ;
$x = chop $y ; # h
no warnings 'uninitialized' ;
$x = chop $z ; # h
EXPECT
Use of uninitialized value in scalar chop at - line 3.
########
# sv.c (sv_2pv)
package fred ;
sub TIESCALAR { my $x ; bless \$x}
sub FETCH { return undef }
sub STORE { return 1 }
package main ;
tie $A, 'fred' ;
use warnings 'uninitialized' ;
$B = "" ;
$B .= $A ;
no warnings 'uninitialized' ;
$C = "" ;
$C .= $A ;
EXPECT
Use of uninitialized value in concatenation (.) or string at - line 10.
########
# perlbug 20011116.125
use warnings 'uninitialized';
$a = undef;
$foo = join '', $a, "\n";
$foo = "$a\n";
$foo = "a:$a\n";
EXPECT
Use of uninitialized value in join or string at - line 4.
Use of uninitialized value in concatenation (.) or string at - line 5.
Use of uninitialized value in concatenation (.) or string at - line 6.
########
# sv.c
use warnings 'numeric' ;
sub TIESCALAR{bless[]} ;
sub FETCH {"def"} ;
tie $a,"main" ;
my $b = 1 + $a;
no warnings 'numeric' ;
my $c = 1 + $a;
EXPECT
Argument "def" isn't numeric in addition (+) at - line 6.
########
# sv.c
use warnings 'numeric' ;
my $x = 1 + "def" ;
no warnings 'numeric' ;
my $z = 1 + "def" ;
EXPECT
Argument "def" isn't numeric in addition (+) at - line 3.
########
# sv.c
use warnings 'numeric' ;
my $a = "def" ;
my $x = 1 + $a ;
no warnings 'numeric' ;
my $y = 1 + $a ;
EXPECT
Argument "def" isn't numeric in addition (+) at - line 4.
########
# sv.c
use warnings 'numeric' ; use integer ;
my $a = "def" ;
my $x = 1 + $a ;
no warnings 'numeric' ;
my $z = 1 + $a ;
EXPECT
Argument "def" isn't numeric in integer addition (+) at - line 4.
########
# sv.c
use warnings 'numeric' ;
my $x = 1 & "def" ;
no warnings 'numeric' ;
my $z = 1 & "def" ;
EXPECT
Argument "def" isn't numeric in bitwise and (&) at - line 3.
########
# sv.c
use warnings 'numeric' ;
my $x = pack i => "def" ;
no warnings 'numeric' ;
my $z = pack i => "def" ;
EXPECT
Argument "def" isn't numeric in pack at - line 3.
########
# sv.c
use warnings 'numeric' ;
my $a = "d\0f" ;
my $x = 1 + $a ;
no warnings 'numeric' ;
my $z = 1 + $a ;
EXPECT
Argument "d\0f" isn't numeric in addition (+) at - line 4.
########
# sv.c
use warnings 'redefine' ;
sub fred {}
sub joe {}
*fred = \&joe ;
no warnings 'redefine' ;
sub jim {}
*jim = \&joe ;
EXPECT
Subroutine main::fred redefined at - line 5.
########
# sv.c
use warnings 'printf' ;
open F, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ;
printf F "%z\n" ;
my $a = sprintf "%z" ;
printf F "%" ;
$a = sprintf "%" ;
printf F "%\x02" ;
$a = sprintf "%\x02" ;
no warnings 'printf' ;
printf F "%z\n" ;
$a = sprintf "%z" ;
printf F "%" ;
$a = sprintf "%" ;
printf F "%\x02" ;
$a = sprintf "%\x02" ;
EXPECT
Invalid conversion in printf: "%z" at - line 4.
Invalid conversion in sprintf: "%z" at - line 5.
Invalid conversion in printf: end of string at - line 6.
Invalid conversion in sprintf: end of string at - line 7.
Invalid conversion in printf: "%\002" at - line 8.
Invalid conversion in sprintf: "%\002" at - line 9.
########
# sv.c
use warnings 'misc' ;
*a = undef ;
no warnings 'misc' ;
*b = undef ;
EXPECT
Undefined value assigned to typeglob at - line 3.
########
# sv.c
use warnings 'y2k';
use Config;
BEGIN {
unless ($Config{ccflags} =~ /Y2KWARN/) {
print "SKIPPED\n# perl not built with -DPERL_Y2KWARN";
exit 0;
}
$|=1;
}
my $x;
my $yy = 78;
$x = printf "19%02d\n", $yy;
$x = sprintf "#19%02d\n", $yy;
$x = printf " 19%02d\n", 78;
$x = sprintf "19%02d\n", 78;
$x = printf "319%02d\n", $yy;
$x = sprintf "319%02d\n", $yy;
no warnings 'y2k';
$x = printf "19%02d\n", $yy;
$x = sprintf "19%02d\n", $yy;
$x = printf "19%02d\n", 78;
$x = sprintf "19%02d\n", 78;
EXPECT
Possible Y2K bug: %d format string following '19' at - line 16.
Possible Y2K bug: %d format string following '19' at - line 13.
1978
Possible Y2K bug: %d format string following '19' at - line 14.
Possible Y2K bug: %d format string following '19' at - line 15.
1978
31978
1978
1978
########
# sv.c
use warnings 'numeric' ;
$a = "\x{100}\x{200}" * 42;
no warnings 'numeric' ;
$a = "\x{100}\x{200}" * 42;
EXPECT
Argument "\x{100}\x{200}" isn't numeric in multiplication (*) at - line 3.
########
# sv.c
use warnings 'numeric' ;
$a = "\x{100}\x{200}"; $a = -$a;
no warnings 'numeric' ;
$a = "\x{100}\x{200}"; $a = -$a;
EXPECT
Argument "\x{100}\x{200}" isn't numeric in negation (-) at - line 3.
########
# sv.c
open F, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ;
use warnings 'printf';
$a = "a\nb";
$s = sprintf "%4s", $a;
printf F "%4s", $a;
$s = sprintf "%-4s", $a;
printf F "%-4s", $a;
$s = sprintf "%*s", -4, $a;
no warnings 'printf';
$s = sprintf "%4s", $a;
printf F "%4s", $a;
$s = sprintf "%-4s", $a;
printf F "%-4s", $a;
EXPECT
Newline in left-justified string for sprintf at - line 7.
Newline in left-justified string for printf at - line 8.
Newline in left-justified string for sprintf at - line 9.
--- NEW FILE: toke ---
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)
\1 better written as $1
use warnings 'syntax' ;
s/(abc)/\1/;
warn(warn_nosemi)
Semicolon seems to be missing
$a = 1
&time ;
Reversed %c= operator
my $a =+ 2 ;
$a =- 2 ;
$a =* 2 ;
$a =% 2 ;
$a =& 2 ;
$a =. 2 ;
$a =^ 2 ;
$a =| 2 ;
$a =< 2 ;
$a =/ 2 ;
Multidimensional syntax %.*s not supported
my $a = $a[1,2] ;
You need to quote \"%s\""
sub fred {} ; $SIG{TERM} = fred;
Scalar value %.*s better written as $%.*s"
@a[3] = 2;
@a{3} = 2;
Can't use \\%c to mean $%c in expression
$_ = "ab" ; s/(ab)/\1/e;
Unquoted string "abc" may clash with future reserved word at - line 3.
warn(warn_reserved
$a = abc;
Possible attempt to separate words with commas
@a = qw(a, b, c) ;
Possible attempt to put comments in qw() list
@a = qw(a b # c) ;
%s (...) interpreted as function
print ("")
printf ("")
sort ("")
Ambiguous use of %c{%s%s} resolved to %c%s%s
$a = ${time[2]}
$a = ${time{2}}
Ambiguous use of %c{%s} resolved to %c%s
$a = ${time}
sub fred {} $a = ${fred}
Misplaced _ in number
$a = 1_2;
$a = 1_2345_6;
Bareword \"%s\" refers to nonexistent package
$a = FRED:: ;
Ambiguous call resolved as CORE::%s(), qualify as such or use &
sub time {}
my $a = time()
Unrecognized escape \\%c passed through
$a = "\m" ;
%s number > %s non-portable
my $a = 0b011111111111111111111111111111110 ;
$a = 0b011111111111111111111111111111111 ;
$a = 0b111111111111111111111111111111111 ;
$a = 0x0fffffffe ;
$a = 0x0ffffffff ;
$a = 0x1ffffffff ;
$a = 0037777777776 ;
$a = 0037777777777 ;
$a = 0047777777777 ;
Integer overflow in binary number
my $a = 0b011111111111111111111111111111110 ;
$a = 0b011111111111111111111111111111111 ;
$a = 0b111111111111111111111111111111111 ;
$a = 0x0fffffffe ;
$a = 0x0ffffffff ;
$a = 0x1ffffffff ;
$a = 0037777777776 ;
$a = 0037777777777 ;
$a = 0047777777777 ;
dump() better written as CORE::dump()
Use of /c modifier is meaningless without /g
Use of /c modifier is meaningless in s///
Mandatory Warnings
------------------
Use of "%s" without parentheses is ambiguous [check_uni]
rand + 4
Ambiguous use of -%s resolved as -&%s() [yylex]
sub fred {} ; - fred ;
Precedence problem: open %.*s should be open(%.*s) [yylex]
open FOO || die;
Operator or semicolon missing before %c%s [yylex]
Ambiguous use of %c resolved as operator %c
*foo *foo
__END__
# toke.c
use warnings 'deprecated' ;
format STDOUT =
@<<< @||| @>>> @>>>
$a $b "abc" 'def'
.
no warnings 'deprecated' ;
format STDOUT =
@<<< @||| @>>> @>>>
$a $b "abc" 'def'
.
EXPECT
Use of comma-less variable list is deprecated at - line 5.
Use of comma-less variable list is deprecated at - line 5.
Use of comma-less variable list is deprecated at - line 5.
########
# toke.c
use warnings 'deprecated' ;
$a = <<;
no warnings 'deprecated' ;
$a = <<;
EXPECT
Use of bare << to mean <<"" is deprecated at - line 3.
########
# toke.c
use warnings 'syntax' ;
s/(abc)/\1/;
no warnings 'syntax' ;
s/(abc)/\1/;
EXPECT
\1 better written as $1 at - line 3.
########
# toke.c
use warnings 'semicolon' ;
$a = 1
&time ;
no warnings 'semicolon' ;
$a = 1
&time ;
EXPECT
Semicolon seems to be missing at - line 3.
########
# toke.c
use warnings 'syntax' ;
my $a =+ 2 ;
$a =- 2 ;
$a =* 2 ;
$a =% 2 ;
$a =& 2 ;
$a =. 2 ;
$a =^ 2 ;
$a =| 2 ;
$a =< 2 ;
$a =/ 2 ;
EXPECT
Reversed += operator at - line 3.
Reversed -= operator at - line 4.
Reversed *= operator at - line 5.
Reversed %= operator at - line 6.
Reversed &= operator at - line 7.
Reversed .= operator at - line 8.
Reversed ^= operator at - line 9.
Reversed |= operator at - line 10.
Reversed <= operator at - line 11.
syntax error at - line 8, near "=."
syntax error at - line 9, near "=^"
syntax error at - line 10, near "=|"
Unterminated <> operator at - line 11.
########
# toke.c
no warnings 'syntax' ;
my $a =+ 2 ;
$a =- 2 ;
$a =* 2 ;
$a =% 2 ;
$a =& 2 ;
$a =. 2 ;
$a =^ 2 ;
$a =| 2 ;
$a =< 2 ;
$a =/ 2 ;
EXPECT
syntax error at - line 8, near "=."
syntax error at - line 9, near "=^"
syntax error at - line 10, near "=|"
Unterminated <> operator at - line 11.
########
# toke.c
use warnings 'syntax' ;
my $a = $a[1,2] ;
no warnings 'syntax' ;
my $a = $a[1,2] ;
EXPECT
Multidimensional syntax $a[1,2] not supported at - line 3.
########
# toke.c
use warnings 'syntax' ;
sub fred {} ; $SIG{TERM} = fred;
no warnings 'syntax' ;
$SIG{TERM} = fred;
EXPECT
You need to quote "fred" at - line 3.
########
# toke.c
use warnings 'syntax' ;
@a[3] = 2;
@a{3} = 2;
no warnings 'syntax' ;
@a[3] = 2;
@a{3} = 2;
EXPECT
Scalar value @a[3] better written as $a[3] at - line 3.
Scalar value @a{3} better written as $a{3} at - line 4.
########
# toke.c
use warnings 'syntax' ;
$_ = "ab" ;
s/(ab)/\1/e;
no warnings 'syntax' ;
$_ = "ab" ;
s/(ab)/\1/e;
EXPECT
Can't use \1 to mean $1 in expression at - line 4.
########
# toke.c
use warnings 'reserved' ;
$a = abc;
$a = { def
=> 1 };
no warnings 'reserved' ;
$a = abc;
EXPECT
Unquoted string "abc" may clash with future reserved word at - line 3.
########
# toke.c
use warnings 'qw' ;
@a = qw(a, b, c) ;
no warnings 'qw' ;
@a = qw(a, b, c) ;
EXPECT
Possible attempt to separate words with commas at - line 3.
########
# toke.c
use warnings 'qw' ;
@a = qw(a b #) ;
no warnings 'qw' ;
@a = qw(a b #) ;
EXPECT
Possible attempt to put comments in qw() list at - line 3.
########
# toke.c
use warnings 'syntax' ;
print ("")
EXPECT
print (...) interpreted as function at - line 3.
########
# toke.c
no warnings 'syntax' ;
print ("")
EXPECT
########
# toke.c
use warnings 'syntax' ;
printf ("")
EXPECT
printf (...) interpreted as function at - line 3.
########
# toke.c
no warnings 'syntax' ;
printf ("")
EXPECT
########
# toke.c
use warnings 'syntax' ;
sort ("")
EXPECT
sort (...) interpreted as function at - line 3.
########
# toke.c
no warnings 'syntax' ;
sort ("")
EXPECT
########
# toke.c
use warnings 'ambiguous' ;
$a = ${time[2]};
no warnings 'ambiguous' ;
$a = ${time[2]};
EXPECT
Ambiguous use of ${time[...]} resolved to $time[...] at - line 3.
########
# toke.c
use warnings 'ambiguous' ;
$a = ${time{2}};
EXPECT
Ambiguous use of ${time{...}} resolved to $time{...} at - line 3.
########
# toke.c
no warnings 'ambiguous' ;
$a = ${time{2}};
EXPECT
########
# toke.c
use warnings 'ambiguous' ;
$a = ${time} ;
no warnings 'ambiguous' ;
$a = ${time} ;
EXPECT
Ambiguous use of ${time} resolved to $time at - line 3.
########
# toke.c
use warnings 'ambiguous' ;
sub fred {}
$a = ${fred} ;
no warnings 'ambiguous' ;
$a = ${fred} ;
EXPECT
Ambiguous use of ${fred} resolved to $fred at - line 4.
########
# toke.c
use warnings 'syntax' ;
$a = _123; print "$a\n"; #( 3 string)
$a = 1_23; print "$a\n";
$a = 12_3; print "$a\n";
$a = 123_; print "$a\n"; # 6
$a = _+123; print "$a\n"; # 7 string)
$a = +_123; print "$a\n"; #( 8 string)
$a = +1_23; print "$a\n";
$a = +12_3; print "$a\n";
$a = +123_; print "$a\n"; # 11
$a = _-123; print "$a\n"; #(12 string)
$a = -_123; print "$a\n"; #(13 string)
$a = -1_23; print "$a\n";
$a = -12_3; print "$a\n";
$a = -123_; print "$a\n"; # 16
$a = 123._456; print "$a\n"; # 17
$a = 123.4_56; print "$a\n";
$a = 123.45_6; print "$a\n";
$a = 123.456_; print "$a\n"; # 20
$a = +123._456; print "$a\n"; # 21
$a = +123.4_56; print "$a\n";
$a = +123.45_6; print "$a\n";
$a = +123.456_; print "$a\n"; # 24
$a = -123._456; print "$a\n"; # 25
$a = -123.4_56; print "$a\n";
$a = -123.45_6; print "$a\n";
$a = -123.456_; print "$a\n"; # 28
$a = 123.456E_12; printf("%.0f\n", $a); # 29
$a = 123.456E1_2; printf("%.0f\n", $a);
$a = 123.456E12_; printf("%.0f\n", $a); # 31
$a = 123.456E_+12; printf("%.0f\n", $a); # 32
$a = 123.456E+_12; printf("%.0f\n", $a); # 33
$a = 123.456E+1_2; printf("%.0f\n", $a);
$a = 123.456E+12_; printf("%.0f\n", $a); # 35
$a = 123.456E_-12; print "$a\n"; # 36
$a = 123.456E-_12; print "$a\n"; # 37
$a = 123.456E-1_2; print "$a\n";
$a = 123.456E-12_; print "$a\n"; # 39
$a = 1__23; print "$a\n"; # 40
$a = 12.3__4; print "$a\n"; # 41
$a = 12.34e1__2; printf("%.0f\n", $a); # 42
no warnings 'syntax' ;
$a = _123; print "$a\n";
$a = 1_23; print "$a\n";
$a = 12_3; print "$a\n";
$a = 123_; print "$a\n";
$a = _+123; print "$a\n";
$a = +_123; print "$a\n";
$a = +1_23; print "$a\n";
$a = +12_3; print "$a\n";
$a = +123_; print "$a\n";
$a = _-123; print "$a\n";
$a = -_123; print "$a\n";
$a = -1_23; print "$a\n";
$a = -12_3; print "$a\n";
$a = -123_; print "$a\n";
$a = 123._456; print "$a\n";
$a = 123.4_56; print "$a\n";
$a = 123.45_6; print "$a\n";
$a = 123.456_; print "$a\n";
$a = +123._456; print "$a\n";
$a = +123.4_56; print "$a\n";
$a = +123.45_6; print "$a\n";
$a = +123.456_; print "$a\n";
$a = -123._456; print "$a\n";
$a = -123.4_56; print "$a\n";
$a = -123.45_6; print "$a\n";
$a = -123.456_; print "$a\n";
$a = 123.456E_12; printf("%.0f\n", $a);
$a = 123.456E1_2; printf("%.0f\n", $a);
$a = 123.456E12_; printf("%.0f\n", $a);
$a = 123.456E_+12; printf("%.0f\n", $a);
$a = 123.456E+_12; printf("%.0f\n", $a);
$a = 123.456E+1_2; printf("%.0f\n", $a);
$a = 123.456E+12_; printf("%.0f\n", $a);
$a = 123.456E_-12; print "$a\n";
$a = 123.456E-_12; print "$a\n";
$a = 123.456E-1_2; print "$a\n";
$a = 123.456E-12_; print "$a\n";
$a = 1__23; print "$a\n";
$a = 12.3__4; print "$a\n";
$a = 12.34e1__2; printf("%.0f\n", $a);
EXPECT
OPTIONS regex
Misplaced _ in number at - line 6.
Misplaced _ in number at - line 11.
Misplaced _ in number at - line 16.
Misplaced _ in number at - line 17.
Misplaced _ in number at - line 20.
Misplaced _ in number at - line 21.
Misplaced _ in number at - line 24.
Misplaced _ in number at - line 25.
Misplaced _ in number at - line 28.
Misplaced _ in number at - line 29.
Misplaced _ in number at - line 31.
Misplaced _ in number at - line 32.
Misplaced _ in number at - line 33.
Misplaced _ in number at - line 35.
Misplaced _ in number at - line 36.
Misplaced _ in number at - line 37.
Misplaced _ in number at - line 39.
Misplaced _ in number at - line 40.
Misplaced _ in number at - line 41.
Misplaced _ in number at - line 42.
_123
123
123
123
123
_123
123
123
123
-123
-_123
-123
-123
-123
123.456
123.456
123.456
123.456
123.456
123.456
123.456
123.456
-123.456
-123.456
-123.456
-123.456
123456000000000
123456000000000
123456000000000
123456000000000
123456000000000
123456000000000
123456000000000
1.23456e-0?10
1.23456e-0?10
1.23456e-0?10
1.23456e-0?10
123
12.34
12340000000000
_123
123
123
123
123
_123
123
123
123
-123
-_123
-123
-123
-123
123.456
123.456
123.456
123.456
123.456
123.456
123.456
123.456
-123.456
-123.456
-123.456
-123.456
123456000000000
123456000000000
123456000000000
123456000000000
123456000000000
123456000000000
123456000000000
1.23456e-0?10
1.23456e-0?10
1.23456e-0?10
1.23456e-0?10
123
12.34
12340000000000
########
# toke.c
use warnings 'bareword' ;
#line 25 "bar"
$a = FRED:: ;
no warnings 'bareword' ;
#line 25 "bar"
$a = FRED:: ;
EXPECT
Bareword "FRED::" refers to nonexistent package at bar line 25.
########
# toke.c
use warnings 'ambiguous' ;
sub time {}
my $a = time() ;
no warnings 'ambiguous' ;
my $b = time() ;
EXPECT
Ambiguous call resolved as CORE::time(), qualify as such or use & at - line 4.
########
# toke.c
use warnings ;
eval <<'EOE';
# line 30 "foo"
warn "yelp";
{
$_ = " \x{123} " ;
}
EOE
EXPECT
yelp at foo line 30.
########
# toke.c
my $a = rand + 4 ;
EXPECT
Warning: Use of "rand" without parentheses is ambiguous at - line 2.
########
# toke.c
$^W = 0 ;
my $a = rand + 4 ;
{
no warnings 'ambiguous' ;
$a = rand + 4 ;
use warnings 'ambiguous' ;
$a = rand + 4 ;
}
$a = rand + 4 ;
EXPECT
Warning: Use of "rand" without parentheses is ambiguous at - line 3.
Warning: Use of "rand" without parentheses is ambiguous at - line 8.
Warning: Use of "rand" without parentheses is ambiguous at - line 10.
########
# toke.c
sub fred {};
-fred ;
EXPECT
Ambiguous use of -fred resolved as -&fred() at - line 3.
########
# toke.c
$^W = 0 ;
sub fred {} ;
-fred ;
{
no warnings 'ambiguous' ;
-fred ;
use warnings 'ambiguous' ;
-fred ;
}
-fred ;
EXPECT
Ambiguous use of -fred resolved as -&fred() at - line 4.
Ambiguous use of -fred resolved as -&fred() at - line 9.
Ambiguous use of -fred resolved as -&fred() at - line 11.
########
# toke.c
open FOO || time;
EXPECT
Precedence problem: open FOO should be open(FOO) at - line 2.
########
# toke.c (and [perl #16184])
open FOO => "<&0"; close FOO;
EXPECT
########
# toke.c
$^W = 0 ;
open FOO || time;
{
no warnings 'precedence' ;
open FOO || time;
use warnings 'precedence' ;
open FOO || time;
}
open FOO || time;
EXPECT
Precedence problem: open FOO should be open(FOO) at - line 3.
Precedence problem: open FOO should be open(FOO) at - line 8.
Precedence problem: open FOO should be open(FOO) at - line 10.
########
# toke.c
$^W = 0 ;
*foo *foo ;
{
no warnings 'ambiguous' ;
*foo *foo ;
use warnings 'ambiguous' ;
*foo *foo ;
}
*foo *foo ;
EXPECT
Operator or semicolon missing before *foo at - line 3.
Ambiguous use of * resolved as operator * at - line 3.
Operator or semicolon missing before *foo at - line 8.
Ambiguous use of * resolved as operator * at - line 8.
Operator or semicolon missing before *foo at - line 10.
Ambiguous use of * resolved as operator * at - line 10.
########
# toke.c
use warnings 'misc' ;
my $a = "\m" ;
no warnings 'misc' ;
$a = "\m" ;
EXPECT
Unrecognized escape \m passed through at - line 3.
########
# toke.c
use warnings 'portable' ;
my $a = 0b011111111111111111111111111111110 ;
$a = 0b011111111111111111111111111111111 ;
$a = 0b111111111111111111111111111111111 ;
$a = 0x0fffffffe ;
$a = 0x0ffffffff ;
$a = 0x1ffffffff ;
$a = 0037777777776 ;
$a = 0037777777777 ;
$a = 0047777777777 ;
no warnings 'portable' ;
$a = 0b011111111111111111111111111111110 ;
$a = 0b011111111111111111111111111111111 ;
$a = 0b111111111111111111111111111111111 ;
$a = 0x0fffffffe ;
$a = 0x0ffffffff ;
$a = 0x1ffffffff ;
$a = 0037777777776 ;
$a = 0037777777777 ;
$a = 0047777777777 ;
EXPECT
Binary number > 0b11111111111111111111111111111111 non-portable at - line 5.
Hexadecimal number > 0xffffffff non-portable at - line 8.
Octal number > 037777777777 non-portable at - line 11.
########
# toke.c
use warnings 'overflow' ;
my $a = 0b011111111111111111111111111111110 ;
$a = 0b011111111111111111111111111111111 ;
$a = 0b10000000000000000000000000000000000000000000000000000000000000000 ;
$a = 0x0fffffffe ;
$a = 0x0ffffffff ;
$a = 0x10000000000000000 ;
$a = 0037777777776 ;
$a = 0037777777777 ;
$a = 002000000000000000000000;
no warnings 'overflow' ;
$a = 0b011111111111111111111111111111110 ;
$a = 0b011111111111111111111111111111111 ;
$a = 0b10000000000000000000000000000000000000000000000000000000000000000 ;
$a = 0x0fffffffe ;
$a = 0x0ffffffff ;
$a = 0x10000000000000000 ;
$a = 0037777777776 ;
$a = 0037777777777 ;
$a = 002000000000000000000000;
EXPECT
Integer overflow in binary number at - line 5.
Integer overflow in hexadecimal number at - line 8.
Integer overflow in octal number at - line 11.
########
# toke.c
BEGIN { $^C = 1; }
use warnings 'misc';
dump;
CORE::dump;
EXPECT
dump() better written as CORE::dump() at - line 4.
- syntax OK
########
# toke.c
use warnings 'misc';
use subs qw/dump/;
sub dump { print "no warning for overriden dump\n"; }
dump;
EXPECT
no warning for overriden dump
########
# toke.c
use warnings 'ambiguous';
"@mjd_previously_unused_array";
no warnings 'ambiguous';
"@mjd_previously_unused_array";
EXPECT
Possible unintended interpolation of @mjd_previously_unused_array in string at - line 3.
########
# toke.c
# The \q should warn, the \_ should NOT warn.
use warnings 'misc';
"foo" =~ /\q/;
"bar" =~ /\_/;
no warnings 'misc';
"foo" =~ /\q/;
"bar" =~ /\_/;
EXPECT
Unrecognized escape \q passed through at - line 4.
########
# toke.c
# 20020328 mjd-perl-patch+ at plover.com at behest of jfriedl at yahoo.com
use warnings 'regexp';
"foo" =~ /foo/c;
"foo" =~ /foo/cg;
no warnings 'regexp';
"foo" =~ /foo/c;
"foo" =~ /foo/cg;
EXPECT
Use of /c modifier is meaningless without /g at - line 4.
########
# toke.c
# 20020328 mjd-perl-patch+ at plover.com at behest of jfriedl at yahoo.com
use warnings 'regexp';
$_ = "ab" ;
s/ab/ab/c;
s/ab/ab/cg;
no warnings 'regexp';
s/ab/ab/c;
s/ab/ab/cg;
EXPECT
Use of /c modifier is meaningless in s/// at - line 5.
Use of /c modifier is meaningless in s/// at - line 6.
########
-wa
# toke.c
# 20020414 mjd-perl-patch+ at plover.com # -a flag should suppress these warnings
print "@F\n";
EXPECT
########
-w
# toke.c
# 20020414 mjd-perl-patch+ at plover.com # -a flag should suppress these warnings
print "@F\n";
EXPECT
Possible unintended interpolation of @F in string at - line 4.
Name "main::F" used only once: possible typo at - line 4.
########
-wa
# toke.c
# 20020414 mjd-perl-patch+ at plover.com
EXPECT
########
# toke.c
# 20020414 mjd-perl-patch+ at plover.com
# In 5.7.3, this emitted "Possible unintended interpolation" warnings
use warnings 'ambiguous';
$s = "(@-)(@+)";
EXPECT
########
# toke.c
# mandatory warning
eval q/if ($a) { } elseif ($b) { }/;
no warnings "syntax";
eval q/if ($a) { } elseif ($b) { }/;
EXPECT
elseif should be elsif at (eval 1) line 1.
########
# toke.c
# mandatory warning
eval q/5 6/;
no warnings "syntax";
eval q/5 6/;
EXPECT
Number found where operator expected at (eval 1) line 1, near "5 6"
(Missing operator before 6?)
--- NEW FILE: pp_pack ---
pp.c TODO
Invalid type in unpack: '%c
my $A = pack ("A,A", 1,2) ;
my @A = unpack ("A,A", "22") ;
Attempt to pack pointer to temporary value
pack("p", "abc") ;
__END__
# pp_pack.c
use warnings 'pack' ;
use warnings 'unpack' ;
my @a = unpack ("A,A", "22") ;
my $a = pack ("A,A", 1,2) ;
no warnings 'pack' ;
no warnings 'unpack' ;
my @b = unpack ("A,A", "22") ;
my $b = pack ("A,A", 1,2) ;
EXPECT
Invalid type ',' in unpack at - line 4.
Invalid type ',' in pack at - line 5.
########
# pp.c
use warnings 'uninitialized' ;
my $a = undef ;
my $b = $$a;
no warnings 'uninitialized' ;
my $c = $$a;
EXPECT
Use of uninitialized value in scalar dereference at - line 4.
########
# pp_pack.c
use warnings 'pack' ;
sub foo { my $a = "a"; return $a . $a++ . $a++ }
my $a = pack("p", &foo) ;
no warnings 'pack' ;
my $b = pack("p", &foo) ;
EXPECT
Attempt to pack pointer to temporary value at - line 4.
########
# pp.c
use warnings 'misc' ;
bless \[], "" ;
no warnings 'misc' ;
bless \[], "" ;
EXPECT
Explicit blessing to '' (assuming package main) at - line 3.
########
# pp.c
use utf8 ;
$_ = "\x80 \xff" ;
reverse ;
EXPECT
########
# pp_pack.c
use warnings 'pack' ;
print unpack("C", pack("C", -1)), "\n",
unpack("C", pack("C", 0)), "\n",
unpack("C", pack("C", 255)), "\n",
unpack("C", pack("C", 256)), "\n",
unpack("c", pack("c", -129)), "\n",
unpack("c", pack("c", -128)), "\n",
unpack("c", pack("c", 127)), "\n",
unpack("c", pack("c", 128)), "\n";
no warnings 'pack' ;
print unpack("C", pack("C", -1)), "\n";
print unpack("C", pack("C", 0)), "\n";
print unpack("C", pack("C", 255)), "\n";
print unpack("C", pack("C", 256)), "\n";
print unpack("c", pack("c", -129)), "\n";
print unpack("c", pack("c", -128)), "\n";
print unpack("c", pack("c", 127)), "\n";
print unpack("c", pack("c", 128)), "\n";
EXPECT
Character in 'C' format wrapped in pack at - line 3.
Character in 'C' format wrapped in pack at - line 3.
Character in 'c' format wrapped in pack at - line 3.
Character in 'c' format wrapped in pack at - line 3.
255
0
255
0
127
-128
127
-128
255
0
255
0
127
-128
127
-128
--- NEW FILE: op ---
op.c AOK
Found = in conditional, should be ==
1 if $a = 1 ;
Use of implicit split to @_ is deprecated
split ;
Use of implicit split to @_ is deprecated
$a = split ;
Useless use of time in void context
Useless use of a variable in void context
Useless use of a constant in void context
time ;
$a ;
"abc"
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 =
.
Array @%s missing the @ in argument %d of %s()
push fred ;
Hash %%%s missing the %% in argument %d of %s()
keys joe ;
Statement unlikely to be reached
(Maybe you meant system() when you said exec()?
exec "true" ; my $a
defined(@array) is deprecated
(Maybe you should just omit the defined()?)
my @a ; defined @a ;
defined (@a = (1,2,3)) ;
defined(%hash) is deprecated
(Maybe you should just omit the defined()?)
my %h ; defined %h ;
/---/ should probably be written as "---"
join(/---/, @foo);
%s() called too early to check prototype [Perl_peep]
fred() ; sub fred ($$) {}
Use of "package" with no arguments is deprecated
package;
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($) {}
Runaway prototype [newSUB] TODO
oops: oopsAV [oopsAV] TODO
oops: oopsHV [oopsHV] TODO
__END__
# op.c
use warnings 'syntax' ;
1 if $a = 1 ;
no warnings 'syntax' ;
1 if $a = 1 ;
EXPECT
Found = in conditional, should be == at - line 3.
########
# op.c
use warnings 'deprecated' ;
split ;
no warnings 'deprecated' ;
split ;
EXPECT
Use of implicit split to @_ is deprecated at - line 3.
########
# op.c
use warnings 'deprecated' ;
$a = split ;
no warnings 'deprecated' ;
$a = split ;
EXPECT
Use of implicit split to @_ is deprecated at - line 3.
########
# op.c
use warnings 'deprecated';
my (@foo, %foo);
%main::foo->{"bar"};
%foo->{"bar"};
@main::foo->[23];
@foo->[23];
$main::foo = {}; %$main::foo->{"bar"};
$foo = {}; %$foo->{"bar"};
$main::foo = []; @$main::foo->[34];
$foo = []; @$foo->[34];
no warnings 'deprecated';
%main::foo->{"bar"};
%foo->{"bar"};
@main::foo->[23];
@foo->[23];
$main::foo = {}; %$main::foo->{"bar"};
$foo = {}; %$foo->{"bar"};
$main::foo = []; @$main::foo->[34];
$foo = []; @$foo->[34];
EXPECT
Using a hash as a reference is deprecated at - line 4.
Using a hash as a reference is deprecated at - line 5.
Using an array as a reference is deprecated at - line 6.
Using an array as a reference is deprecated at - line 7.
Using a hash as a reference is deprecated at - line 8.
Using a hash as a reference is deprecated at - line 9.
Using an array as a reference is deprecated at - line 10.
Using an array as a reference is deprecated at - line 11.
########
# op.c
use warnings 'void' ; close STDIN ;
1 x 3 ; # OP_REPEAT
# OP_GVSV
wantarray ; # OP_WANTARRAY
# OP_GV
# OP_PADSV
# OP_PADAV
# OP_PADHV
# OP_PADANY
# OP_AV2ARYLEN
ref ; # OP_REF
\@a ; # OP_REFGEN
\$a ; # OP_SREFGEN
defined $a ; # OP_DEFINED
hex $a ; # OP_HEX
oct $a ; # OP_OCT
length $a ; # OP_LENGTH
substr $a,1 ; # OP_SUBSTR
vec $a,1,2 ; # OP_VEC
index $a,1,2 ; # OP_INDEX
rindex $a,1,2 ; # OP_RINDEX
sprintf $a ; # OP_SPRINTF
$a[0] ; # OP_AELEM
# OP_AELEMFAST
@a[0] ; # OP_ASLICE
#values %a ; # OP_VALUES
#keys %a ; # OP_KEYS
$a{0} ; # OP_HELEM
@a{0} ; # OP_HSLICE
unpack "a", "a" ; # OP_UNPACK
pack $a,"" ; # OP_PACK
join "" ; # OP_JOIN
(@a)[0,1] ; # OP_LSLICE
# OP_ANONLIST
# OP_ANONHASH
sort(1,2) ; # OP_SORT
reverse(1,2) ; # OP_REVERSE
# OP_RANGE
# OP_FLIP
(1 ..2) ; # OP_FLOP
caller ; # OP_CALLER
fileno STDIN ; # OP_FILENO
eof STDIN ; # OP_EOF
tell STDIN ; # OP_TELL
readlink 1; # OP_READLINK
time ; # OP_TIME
localtime ; # OP_LOCALTIME
gmtime ; # OP_GMTIME
eval { getgrnam 1 }; # OP_GGRNAM
eval { getgrgid 1 }; # OP_GGRGID
eval { getpwnam 1 }; # OP_GPWNAM
eval { getpwuid 1 }; # OP_GPWUID
prototype "foo"; # OP_PROTOTYPE
EXPECT
Useless use of repeat (x) in void context at - line 3.
Useless use of wantarray in void context at - line 5.
Useless use of reference-type operator in void context at - line 12.
Useless use of reference constructor in void context at - line 13.
Useless use of single ref constructor in void context at - line 14.
Useless use of defined operator in void context at - line 15.
Useless use of hex in void context at - line 16.
Useless use of oct in void context at - line 17.
Useless use of length in void context at - line 18.
Useless use of substr in void context at - line 19.
Useless use of vec in void context at - line 20.
Useless use of index in void context at - line 21.
Useless use of rindex in void context at - line 22.
Useless use of sprintf in void context at - line 23.
Useless use of array element in void context at - line 24.
Useless use of array slice in void context at - line 26.
Useless use of hash element in void context at - line 29.
Useless use of hash slice in void context at - line 30.
Useless use of unpack in void context at - line 31.
Useless use of pack in void context at - line 32.
Useless use of join 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.
########
# 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
5 || print "bad\n"; # test OPpCONST_SHORTCIRCUIT
use constant U => undef;
print "boo\n" if U; # test OPpCONST_SHORTCIRCUIT
no warnings 'void' ;
"abc"; # OP_CONST
7 ; # OP_CONST
EXPECT
Useless use of a constant in void context at - line 3.
Useless use of a constant in void context at - line 4.
########
# op.c
#
use warnings 'misc' ;
my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
@a =~ /abc/ ;
@a =~ s/a/b/ ;
@a =~ tr/a/b/ ;
@$b =~ /abc/ ;
@$b =~ s/a/b/ ;
@$b =~ tr/a/b/ ;
%a =~ /abc/ ;
%a =~ s/a/b/ ;
%a =~ tr/a/b/ ;
%$c =~ /abc/ ;
%$c =~ s/a/b/ ;
%$c =~ tr/a/b/ ;
{
no warnings 'misc' ;
my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
@a =~ /abc/ ;
@a =~ s/a/b/ ;
@a =~ tr/a/b/ ;
@$b =~ /abc/ ;
@$b =~ s/a/b/ ;
@$b =~ tr/a/b/ ;
%a =~ /abc/ ;
%a =~ s/a/b/ ;
%a =~ tr/a/b/ ;
%$c =~ /abc/ ;
%$c =~ s/a/b/ ;
%$c =~ tr/a/b/ ;
}
EXPECT
Applying pattern match (m//) to @array will act on scalar(@array) at - line 5.
Applying substitution (s///) to @array will act on scalar(@array) at - line 6.
Applying transliteration (tr///) to @array will act on scalar(@array) at - line 7.
Applying pattern match (m//) to @array will act on scalar(@array) at - line 8.
Applying substitution (s///) to @array will act on scalar(@array) at - line 9.
Applying transliteration (tr///) to @array will act on scalar(@array) at - line 10.
Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 11.
Applying substitution (s///) to %hash will act on scalar(%hash) at - line 12.
Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 13.
Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 14.
Applying substitution (s///) to %hash will act on scalar(%hash) at - line 15.
Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 16.
Can't modify private array in substitution (s///) at - line 6, near "s/a/b/ ;"
BEGIN not safe after errors--compilation aborted at - line 18.
########
# 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> ;
no warnings 'misc' ;
$x = 1 if $x = <FH> ;
EXPECT
Value of <HANDLE> construct can be "0"; test with defined() at - line 4.
########
# op.c
use warnings 'misc' ;
opendir FH, "." ;
$x = 1 if $x = readdir FH ;
no warnings 'misc' ;
$x = 1 if $x = readdir FH ;
closedir FH ;
EXPECT
Value of readdir() operator can be "0"; test with defined() at - line 4.
########
# op.c
use warnings 'misc' ;
$x = 1 if $x = <*> ;
no warnings 'misc' ;
$x = 1 if $x = <*> ;
EXPECT
Value of glob construct can be "0"; test with defined() at - line 3.
########
# op.c
use warnings 'misc' ;
%a = (1,2,3,4) ;
$x = 1 if $x = each %a ;
no warnings 'misc' ;
$x = 1 if $x = each %a ;
EXPECT
Value of each() operator can be "0"; test with defined() at - line 4.
########
# op.c
use warnings 'misc' ;
$x = 1 while $x = <*> and 0 ;
no warnings 'misc' ;
$x = 1 while $x = <*> and 0 ;
EXPECT
Value of glob construct can be "0"; test with defined() at - line 3.
########
# op.c
use warnings 'misc' ;
opendir FH, "." ;
$x = 1 while $x = readdir FH and 0 ;
no warnings 'misc' ;
$x = 1 while $x = readdir FH and 0 ;
closedir FH ;
EXPECT
Value of readdir() operator can be "0"; test with defined() at - line 4.
########
# op.c
use warnings 'redefine' ;
sub fred {}
sub fred {}
no warnings 'redefine' ;
sub fred {}
EXPECT
Subroutine fred redefined at - line 4.
########
# op.c
use warnings 'redefine' ;
sub fred () { 1 }
sub fred () { 1 }
no warnings 'redefine' ;
sub fred () { 1 }
EXPECT
Constant subroutine fred redefined at - line 4.
########
# op.c
no warnings 'redefine' ;
sub fred () { 1 }
sub fred () { 2 }
EXPECT
Constant subroutine fred redefined at - line 4.
########
# op.c
no warnings 'redefine' ;
sub fred () { 1 }
*fred = sub () { 2 };
EXPECT
Constant subroutine main::fred redefined at - line 4.
########
# op.c
use warnings 'redefine' ;
format FRED =
.
format FRED =
.
no warnings 'redefine' ;
format FRED =
.
EXPECT
Format FRED redefined at - line 5.
########
# op.c
use warnings 'deprecated' ;
push FRED;
no warnings 'deprecated' ;
push FRED;
EXPECT
Array @FRED missing the @ in argument 1 of push() at - line 3.
########
# op.c
use warnings 'deprecated' ;
@a = keys FRED ;
no warnings 'deprecated' ;
@a = keys FRED ;
EXPECT
Hash %FRED missing the % in argument 1 of keys() at - line 3.
########
# op.c
BEGIN {
if ($^O eq 'MacOS') {
print <<EOM;
SKIPPED
# no exec on Mac OS
EOM
exit;
}
}
use warnings 'syntax' ;
exec "$^X -e 1" ;
my $a
EXPECT
Statement unlikely to be reached at - line 13.
(Maybe you meant system() when you said exec()?)
########
# op.c
use warnings 'deprecated' ;
my @a; defined(@a);
EXPECT
defined(@array) is deprecated at - line 3.
(Maybe you should just omit the defined()?)
########
# op.c
use warnings 'deprecated' ;
defined(@a = (1,2,3));
EXPECT
defined(@array) is deprecated at - line 3.
(Maybe you should just omit the defined()?)
########
# op.c
use warnings 'deprecated' ;
my %h; defined(%h);
EXPECT
defined(%hash) is deprecated at - line 3.
(Maybe you should just omit the defined()?)
########
# op.c
BEGIN {
if ($^O eq 'MacOS') {
print <<EOM;
SKIPPED
# no exec on Mac OS
EOM
exit;
}
}
no warnings 'syntax' ;
exec "$^X -e 1" ;
my $a
EXPECT
########
# op.c
sub fred();
sub fred($) {}
EXPECT
Prototype mismatch: sub main::fred () vs ($) at - line 3.
########
# op.c
$^W = 0 ;
sub fred() ;
sub fred($) {}
{
no warnings 'prototype' ;
sub Fred() ;
sub Fred($) {}
use warnings 'prototype' ;
sub freD() ;
sub freD($) {}
}
sub FRED() ;
sub FRED($) {}
EXPECT
Prototype mismatch: sub main::fred () vs ($) at - line 4.
Prototype mismatch: sub main::freD () vs ($) at - line 11.
Prototype mismatch: sub main::FRED () vs ($) at - line 14.
########
# op.c
use warnings 'syntax' ;
join /---/, 'x', 'y', 'z';
EXPECT
/---/ should probably be written as "---" at - line 3.
########
# op.c [Perl_peep]
use warnings 'prototype' ;
fred() ;
sub fred ($$) {}
no warnings 'prototype' ;
joe() ;
sub joe ($$) {}
EXPECT
main::fred() called too early to check prototype at - line 3.
########
# op.c [Perl_newATTRSUB]
--FILE-- abc.pm
use warnings 'void' ;
BEGIN { $| = 1; print "in begin\n"; }
CHECK { print "in check\n"; }
INIT { print "in init\n"; }
END { print "in end\n"; }
print "in mainline\n";
1;
--FILE--
use abc;
delete $INC{"abc.pm"};
require abc;
do "abc.pm";
EXPECT
in begin
in mainline
in check
in init
in begin
Too late to run CHECK block at abc.pm line 3.
Too late to run INIT block at abc.pm line 4.
in mainline
in begin
Too late to run CHECK block at abc.pm line 3.
Too late to run INIT block at abc.pm line 4.
in mainline
in end
in end
in end
########
# op.c [Perl_newATTRSUB]
--FILE-- abc.pm
no warnings 'void' ;
BEGIN { $| = 1; print "in begin\n"; }
CHECK { print "in check\n"; }
INIT { print "in init\n"; }
END { print "in end\n"; }
print "in mainline\n";
1;
--FILE--
require abc;
do "abc.pm";
EXPECT
in begin
in mainline
in begin
in mainline
in end
in end
########
# 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
use warnings 'deprecated' ;
package;
no warnings 'deprecated' ;
package;
EXPECT
Use of "package" with no arguments is deprecated at - line 3.
Global symbol "BEGIN" requires explicit package name at - line 4.
BEGIN not safe after errors--compilation aborted at - line 4.
########
# op.c
# 20020401 mjd at plover.com at suggestion of jfriedl at 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.
More information about the dslinux-commit
mailing list