summaryrefslogtreecommitdiff
path: root/t/pragma
diff options
context:
space:
mode:
Diffstat (limited to 't/pragma')
-rw-r--r--t/pragma/warn/3both135
-rw-r--r--t/pragma/warn/6default34
-rw-r--r--t/pragma/warn/av9
-rw-r--r--t/pragma/warn/doio70
-rw-r--r--t/pragma/warn/doop25
-rw-r--r--t/pragma/warn/gv14
-rw-r--r--t/pragma/warn/hv8
-rw-r--r--t/pragma/warn/malloc9
-rw-r--r--t/pragma/warn/mg19
-rw-r--r--t/pragma/warn/op216
-rw-r--r--t/pragma/warn/perl45
-rw-r--r--t/pragma/warn/perlio10
-rw-r--r--t/pragma/warn/perly6
-rw-r--r--t/pragma/warn/pp48
-rw-r--r--t/pragma/warn/pp_ctl67
-rw-r--r--t/pragma/warn/pp_hot48
-rw-r--r--t/pragma/warn/pp_sys40
-rw-r--r--t/pragma/warn/regcomp12
-rw-r--r--t/pragma/warn/regexec52
-rw-r--r--t/pragma/warn/run8
-rw-r--r--t/pragma/warn/sv83
-rw-r--r--t/pragma/warn/taint56
-rw-r--r--t/pragma/warn/toke213
-rw-r--r--t/pragma/warn/universal2
-rw-r--r--t/pragma/warn/utf856
-rw-r--r--t/pragma/warn/util53
-rwxr-xr-xt/pragma/warning.t2
27 files changed, 1295 insertions, 45 deletions
diff --git a/t/pragma/warn/3both b/t/pragma/warn/3both
index 7c3260126b..1d7deb8636 100644
--- a/t/pragma/warn/3both
+++ b/t/pragma/warn/3both
@@ -18,6 +18,20 @@ Use of uninitialized value at - line 6.
# Check interaction of $^W and use warning
sub fred {
+ use warning ;
+ my $b ;
+ chop $b ;
+}
+{ $^W = 0 ;
+ fred() ;
+}
+
+EXPECT
+Use of uninitialized value at - line 6.
+########
+
+# Check interaction of $^W and use warning
+sub fred {
no warning ;
my $b ;
chop $b ;
@@ -27,7 +41,21 @@ sub fred {
}
EXPECT
-Use of uninitialized value at - line 6.
+
+########
+
+# Check interaction of $^W and use warning
+sub fred {
+ no warning ;
+ my $b ;
+ chop $b ;
+}
+{ $^W = 1 ;
+ fred() ;
+}
+
+EXPECT
+
########
# Check interaction of $^W and use warning
@@ -54,7 +82,7 @@ no warning ;
my $b ;
chop $b ;
EXPECT
-Use of uninitialized value at - line 6.
+
########
# Check interaction of $^W and use warning
@@ -63,4 +91,107 @@ $^W = 1 ;
my $b ;
chop $b ;
EXPECT
+
+########
+-w
+# Check interaction of $^W and use warning
+no warning ;
+my $b ;
+chop $b ;
+EXPECT
+
+########
+-w
+# Check interaction of $^W and use warning
+use warning ;
+my $b ;
+chop $b ;
+EXPECT
+Use of uninitialized value at - line 5.
+########
+
+# Check interaction of $^W and use warning
+sub fred {
+ use warning ;
+ my $b ;
+ chop $b ;
+}
+BEGIN { $^W = 0 }
+fred() ;
+EXPECT
+Use of uninitialized value at - line 6.
+########
+
+# Check interaction of $^W and use warning
+sub fred {
+ no warning ;
+ my $b ;
+ chop $b ;
+}
+BEGIN { $^W = 1 }
+fred() ;
+
+EXPECT
+
+########
+
+# Check interaction of $^W and use warning
+use warning ;
+BEGIN { $^W = 1 }
+my $b ;
+chop $b ;
+EXPECT
Use of uninitialized value at - line 6.
+########
+
+# Check interaction of $^W and use warning
+BEGIN { $^W = 1 }
+use warning ;
+my $b ;
+chop $b ;
+EXPECT
+Use of uninitialized value at - line 6.
+########
+
+# Check interaction of $^W and use warning
+BEGIN { $^W = 1 }
+no warning ;
+my $b ;
+chop $b ;
+EXPECT
+
+########
+
+# Check interaction of $^W and use warning
+no warning ;
+BEGIN { $^W = 1 }
+my $b ;
+chop $b ;
+EXPECT
+
+########
+
+# Check interaction of $^W and use warning
+BEGIN { $^W = 1 }
+{
+ no warning ;
+ my $b ;
+ chop $b ;
+}
+my $b ;
+chop $b ;
+EXPECT
+Use of uninitialized value at - line 10.
+########
+
+# Check interaction of $^W and use warning
+BEGIN { $^W = 0 }
+{
+ use warning ;
+ my $b ;
+ chop $b ;
+}
+my $b ;
+chop $b ;
+EXPECT
+Use of uninitialized value at - line 7.
diff --git a/t/pragma/warn/6default b/t/pragma/warn/6default
new file mode 100644
index 0000000000..c095b20827
--- /dev/null
+++ b/t/pragma/warn/6default
@@ -0,0 +1,34 @@
+Check default warnings
+
+__END__
+# default warning 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 warning should be displayed
+no warning ;
+my $a = oct "7777777777777777777777777777777777779" ;
+EXPECT
+########
+# all warning should be displayed
+use warning ;
+my $a = oct "7777777777777777777777777777777777779" ;
+EXPECT
+Integer overflow in octal number at - line 3.
+Illegal octal digit '9' ignored at - line 3.
+########
+# check scope
+use warning ;
+my $a = oct "7777777777777777777777777777777777779" ;
+{
+ no warning ;
+ my $a = oct "7777777777777777777777777777777777779" ;
+}
+my $c = oct "7777777777777777777777777777777777779" ;
+EXPECT
+Integer overflow in octal number at - line 3.
+Illegal octal digit '9' ignored at - line 3.
+Integer overflow in octal number at - line 8.
+Illegal octal digit '9' ignored at - line 8.
diff --git a/t/pragma/warn/av b/t/pragma/warn/av
new file mode 100644
index 0000000000..79bd3b7600
--- /dev/null
+++ b/t/pragma/warn/av
@@ -0,0 +1,9 @@
+ av.c
+
+ Mandatory Warnings ALL TODO
+ ------------------
+ av_reify called on tied array [av_reify]
+
+ Attempt to clear deleted array [av_clear]
+
+__END__
diff --git a/t/pragma/warn/doio b/t/pragma/warn/doio
index 97f0804bfa..5bcca8d78c 100644
--- a/t/pragma/warn/doio
+++ b/t/pragma/warn/doio
@@ -41,29 +41,50 @@
Can't exec \"%s\": %s
+ Mandatory Warnings ALL TODO
+ ------------------
+ Can't do inplace edit: %s is not a regular file
+ edit a directory
+
+ Can't do inplace edit: %s would not be unique
+ Can't rename %s to %s: %s, skipping file
+ Can't rename %s to %s: %s, skipping file
+ Can't remove %s: %s, skipping file
+ Can't do inplace edit on %s: %s
+
+
__END__
# doio.c
use warning 'io' ;
open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
close(F);
+no warning 'io' ;
+open(G, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
+close(G);
EXPECT
Can't do bidirectional pipe at - line 3.
########
# doio.c
use warning 'io' ;
-open(F, "| ")
+open(F, "| ");
+no warning 'io' ;
+open(G, "| ");
EXPECT
Missing command in piped open at - line 3.
########
# doio.c
use warning 'io' ;
-open(F, " |")
+open(F, " |");
+no warning 'io' ;
+open(G, " |");
EXPECT
Missing command in piped open at - line 3.
########
# doio.c
use warning 'io' ;
-open(F, "<true\ncd")
+open(F, "<true\ncd");
+no warning 'io' ;
+open(G, "<true\ncd");
EXPECT
Unsuccessful open on filename containing newline at - line 3.
########
@@ -74,6 +95,12 @@ tell(STDIN);
$a = seek(STDIN,1,1);
$a = sysseek(STDIN,1,1);
-x STDIN ;
+no warning 'io' ;
+close STDIN ;
+tell(STDIN);
+$a = seek(STDIN,1,1);
+$a = sysseek(STDIN,1,1);
+-x STDIN ;
EXPECT
tell() on unopened file at - line 4.
seek() on unopened file at - line 5.
@@ -83,6 +110,8 @@ Stat on unopened file <STDIN> at - line 7.
# doio.c
use warning 'uninitialized' ;
print $a ;
+no warning 'uninitialized' ;
+print $b ;
EXPECT
Use of uninitialized value at - line 3.
########
@@ -96,6 +125,9 @@ EXPECT
use warning 'io' ;
stat "ab\ncd";
lstat "ab\ncd";
+no warning 'io' ;
+stat "ab\ncd";
+lstat "ab\ncd";
EXPECT
Unsuccessful stat on filename containing newline at - line 3.
Unsuccessful stat on filename containing newline at - line 4.
@@ -103,6 +135,8 @@ Unsuccessful stat on filename containing newline at - line 4.
# doio.c
use warning 'io' ;
exec "lskdjfalksdjfdjfkls","" ;
+no warning 'io' ;
+exec "lskdjfalksdjfdjfkls","" ;
EXPECT
OPTION regex
Can't exec "lskdjfalksdjfdjfkls": .+
@@ -110,6 +144,36 @@ Can't exec "lskdjfalksdjfdjfkls": .+
# doio.c
use warning 'io' ;
exec "lskdjfalksdjfdjfkls", "abc" ;
+no warning 'io' ;
+exec "lskdjfalksdjfdjfkls", "abc" ;
EXPECT
OPTION regex
Can't exec "lskdjfalksdjfdjfkls(:? abc)?": .+
+########
+# doio.c
+$^W = 0 ;
+my $filename = "./temp" ;
+mkdir $filename, 0777
+ or die "Cannot create directory $filename: $!\n" ;
+{
+ local (@ARGV) = ($filename) ;
+ local ($^I) = "" ;
+ my $x = <> ;
+}
+{
+ no warning 'inplace' ;
+ local (@ARGV) = ($filename) ;
+ local ($^I) = "" ;
+ my $x = <> ;
+}
+{
+ use warning 'inplace' ;
+ local (@ARGV) = ($filename) ;
+ local ($^I) = "" ;
+ my $x = <> ;
+}
+rmdir $filename ;
+EXPECT
+Can't do inplace edit: ./temp is not a regular file at - line 9.
+Can't do inplace edit: ./temp is not a regular file at - line 21.
+
diff --git a/t/pragma/warn/doop b/t/pragma/warn/doop
new file mode 100644
index 0000000000..458a3b2803
--- /dev/null
+++ b/t/pragma/warn/doop
@@ -0,0 +1,25 @@
+ doop.c AOK
+
+ Malformed UTF-8 character
+
+
+__END__
+# doop.c
+use utf8 ;
+$_ = "\x80 \xff" ;
+chop ;
+EXPECT
+Malformed UTF-8 character at - line 4.
+########
+# doop.c
+use warning 'utf8' ;
+use utf8 ;
+$_ = "\x80 \xff" ;
+chop ;
+no warning 'utf8' ;
+$_ = "\x80 \xff" ;
+chop ;
+EXPECT
+\x80 will produce malformed UTF-8 character; use \x{80} for that at - line 4.
+\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 4.
+Malformed UTF-8 character at - line 5.
diff --git a/t/pragma/warn/gv b/t/pragma/warn/gv
index bd442b97d6..e33f8ca04f 100644
--- a/t/pragma/warn/gv
+++ b/t/pragma/warn/gv
@@ -14,7 +14,12 @@
$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 warning 'misc' ;
@@ -24,6 +29,12 @@ Can't locate package Fred for @main::ISA at - line 3.
Undefined subroutine &main::joe called at - line 3.
########
# gv.c
+no warning '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 warning 'deprecated' ;
@@ -35,6 +46,9 @@ Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5.
use warning 'deprecated' ;
$a = ${"#"};
$a = ${"*"};
+no warning 'deprecated' ;
+$a = ${"#"};
+$a = ${"*"};
EXPECT
Use of $# is deprecated at - line 3.
Use of $* is deprecated at - line 4.
diff --git a/t/pragma/warn/hv b/t/pragma/warn/hv
new file mode 100644
index 0000000000..c9eec028f1
--- /dev/null
+++ b/t/pragma/warn/hv
@@ -0,0 +1,8 @@
+ hv.c
+
+
+ Mandatory Warnings ALL TODO
+ ------------------
+ Attempt to free non-existent shared string [unsharepvn]
+
+__END__
diff --git a/t/pragma/warn/malloc b/t/pragma/warn/malloc
new file mode 100644
index 0000000000..2f8b096a51
--- /dev/null
+++ b/t/pragma/warn/malloc
@@ -0,0 +1,9 @@
+ malloc.c
+
+
+ Mandatory Warnings ALL TODO
+ ------------------
+ %s free() ignored [Perl_mfree]
+ %s", "Bad free() ignored [Perl_mfree]
+
+__END__
diff --git a/t/pragma/warn/mg b/t/pragma/warn/mg
index 14307e0de0..7f40ded7f8 100644
--- a/t/pragma/warn/mg
+++ b/t/pragma/warn/mg
@@ -6,6 +6,9 @@
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
@@ -15,6 +18,12 @@ EXPECT
No such signal: SIGFRED at - line 3.
########
# mg.c
+no warning 'signal' ;
+$SIG{FRED} = sub {};
+EXPECT
+
+########
+# mg.c
use warning 'signal' ;
if ($^O eq 'MSWin32' || $^O eq 'VMS') {
print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit;
@@ -23,3 +32,13 @@ $|=1;
$SIG{"INT"} = "fred"; kill "INT",$$;
EXPECT
SIGINT handler "fred" not defined.
+########
+# mg.c
+no warning 'signal' ;
+if ($^O eq 'MSWin32' || $^O eq 'VMS') {
+ print "SKIPPED\n# win32, can't kill() to raise()\n"; exit;
+}
+$|=1;
+$SIG{"INT"} = "fred"; kill "INT",$$;
+EXPECT
+
diff --git a/t/pragma/warn/op b/t/pragma/warn/op
index 7c2b6b8050..dce52d8c93 100644
--- a/t/pragma/warn/op
+++ b/t/pragma/warn/op
@@ -98,11 +98,27 @@
defined %h ;
my %h ; defined %h ;
+ Mandatory Warnings
+ ------------------
+ Prototype mismatch: [cv_ckproto]
+ sub fred() ;
+ sub fred($) {}
+
+ %s never introduced [pad_leavemy] TODO
+ Runaway prototype [newSUB] TODO
+ oops: oopsAV [oopsAV] TODO
+ oops: oopsHV [oopsHV] TODO
+
+
+
+
__END__
# op.c
use warning 'unsafe' ;
my $x ;
my $x ;
+no warning 'unsafe' ;
+my $x ;
EXPECT
"my" variable $x masks earlier declaration in same scope at - line 4.
########
@@ -118,6 +134,17 @@ EXPECT
Variable "$x" will not stay shared at - line 7.
########
# op.c
+no warning 'unsafe' ;
+sub x {
+ my $x;
+ sub y {
+ $x
+ }
+ }
+EXPECT
+
+########
+# op.c
use warning 'unsafe' ;
sub x {
my $x;
@@ -129,20 +156,37 @@ EXPECT
Variable "$x" may be unavailable at - line 6.
########
# op.c
+no warning 'unsafe' ;
+sub x {
+ my $x;
+ sub y {
+ sub { $x }
+ }
+ }
+EXPECT
+
+########
+# op.c
use warning 'syntax' ;
1 if $a = 1 ;
+no warning 'syntax' ;
+1 if $a = 1 ;
EXPECT
Found = in conditional, should be == at - line 3.
########
# op.c
use warning 'deprecated' ;
split ;
+no warning 'deprecated' ;
+split ;
EXPECT
Use of implicit split to @_ is deprecated at - line 3.
########
# op.c
use warning 'deprecated' ;
$a = split ;
+no warning 'deprecated' ;
+$a = split ;
EXPECT
Use of implicit split to @_ is deprecated at - line 3.
########
@@ -239,8 +283,65 @@ Useless use of getpwnam in void context at - line 52.
Useless use of getpwuid in void context at - line 53.
########
# op.c
+no warning 'void' ; close STDIN ;
+1 x 3 ; # OP_REPEAT
+ # OP_GVSV
+wantarray ; # OP_WANTARRAY
+ # OP_GV
+ # OP_PADSV
+ # OP_PADAV
+ # OP_PADHV
+ # OP_PADANY
+ # OP_AV2ARYLEN
+ref ; # OP_REF
+\@a ; # OP_REFGEN
+\$a ; # OP_SREFGEN
+defined $a ; # OP_DEFINED
+hex $a ; # OP_HEX
+oct $a ; # OP_OCT
+length $a ; # OP_LENGTH
+substr $a,1 ; # OP_SUBSTR
+vec $a,1,2 ; # OP_VEC
+index $a,1,2 ; # OP_INDEX
+rindex $a,1,2 ; # OP_RINDEX
+sprintf $a ; # OP_SPRINTF
+$a[0] ; # OP_AELEM
+ # OP_AELEMFAST
+@a[0] ; # OP_ASLICE
+#values %a ; # OP_VALUES
+#keys %a ; # OP_KEYS
+$a{0} ; # OP_HELEM
+@a{0} ; # OP_HSLICE
+unpack "a", "a" ; # OP_UNPACK
+pack $a,"" ; # OP_PACK
+join "" ; # OP_JOIN
+(@a)[0,1] ; # OP_LSLICE
+ # OP_ANONLIST
+ # OP_ANONHASH
+sort(1,2) ; # OP_SORT
+reverse(1,2) ; # OP_REVERSE
+ # OP_RANGE
+ # OP_FLIP
+(1 ..2) ; # OP_FLOP
+caller ; # OP_CALLER
+fileno STDIN ; # OP_FILENO
+eof STDIN ; # OP_EOF
+tell STDIN ; # OP_TELL
+readlink 1; # OP_READLINK
+time ; # OP_TIME
+localtime ; # OP_LOCALTIME
+gmtime ; # OP_GMTIME
+eval { getgrnam 1 }; # OP_GGRNAM
+eval { getgrgid 1 }; # OP_GGRGID
+eval { getpwnam 1 }; # OP_GPWNAM
+eval { getpwuid 1 }; # OP_GPWUID
+EXPECT
+########
+# op.c
use warning 'void' ;
for (@{[0]}) { "$_" } # check warning isn't duplicated
+no warning 'void' ;
+for (@{[0]}) { "$_" } # check warning isn't duplicated
EXPECT
Useless use of string in void context at - line 3.
########
@@ -257,6 +358,8 @@ EOM
}
}
telldir 1 ; # OP_TELLDIR
+no warning 'void' ;
+telldir 1 ; # OP_TELLDIR
EXPECT
Useless use of telldir in void context at - line 13.
########
@@ -273,6 +376,8 @@ EOM
}
}
getppid ; # OP_GETPPID
+no warning 'void' ;
+getppid ; # OP_GETPPID
EXPECT
Useless use of getppid in void context at - line 13.
########
@@ -289,6 +394,8 @@ EOM
}
}
getpgrp ; # OP_GETPGRP
+no warning 'void' ;
+getpgrp ; # OP_GETPGRP
EXPECT
Useless use of getpgrp in void context at - line 13.
########
@@ -305,6 +412,8 @@ EOM
}
}
times ; # OP_TMS
+no warning 'void' ;
+times ; # OP_TMS
EXPECT
Useless use of times in void context at - line 13.
########
@@ -321,6 +430,8 @@ EOM
}
}
getpriority 1,2; # OP_GETPRIORITY
+no warning 'void' ;
+getpriority 1,2; # OP_GETPRIORITY
EXPECT
Useless use of getpriority in void context at - line 13.
########
@@ -337,6 +448,8 @@ EOM
}
}
getlogin ; # OP_GETLOGIN
+no warning 'void' ;
+getlogin ; # OP_GETLOGIN
EXPECT
Useless use of getlogin in void context at - line 13.
########
@@ -377,6 +490,22 @@ getprotoent ; # OP_GPROTOENT
getservbyname 1,2; # OP_GSBYNAME
getservbyport 1,2; # OP_GSBYPORT
getservent ; # OP_GSERVENT
+
+no warning '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;
@@ -403,6 +532,11 @@ use warning 'void' ;
$a ; # OP_RV2SV
@a ; # OP_RV2AV
%a ; # OP_RV2HV
+no warning '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.
@@ -413,6 +547,9 @@ Useless use of a variable in void context at - line 6.
use warning 'void' ;
"abc"; # OP_CONST
7 ; # OP_CONST
+no warning '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.
@@ -432,6 +569,22 @@ my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
%$c =~ /abc/ ;
%$c =~ s/a/b/ ;
%$c =~ tr/a/b/ ;
+{
+no warning 'unsafe' ;
+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 to @array will act on scalar(@array) at - line 4.
Applying substitution to @array will act on scalar(@array) at - line 5.
@@ -446,23 +599,29 @@ Applying character translation to %hash will act on scalar(%hash) at - line 12.
Applying pattern match to %hash will act on scalar(%hash) at - line 13.
Applying substitution to %hash will act on scalar(%hash) at - line 14.
Applying character translation to %hash will act on scalar(%hash) at - line 15.
-Execution of - aborted due to compilation errors.
+BEGIN not safe after errors--compilation aborted at - line 17.
########
# op.c
use warning 'syntax' ;
my $a, $b = (1,2);
+no warning 'syntax' ;
+my $c, $d = (1,2);
EXPECT
Parentheses missing around "my" list at - line 3.
########
# op.c
use warning 'syntax' ;
local $a, $b = (1,2);
+no warning 'syntax' ;
+local $c, $d = (1,2);
EXPECT
Parentheses missing around "local" list at - line 3.
########
# op.c
use warning 'syntax' ;
print (ABC || 1) ;
+no warning 'syntax' ;
+print (ABC || 1) ;
EXPECT
Probable precedence problem on logical or at - line 3.
########
@@ -473,6 +632,8 @@ Probable precedence problem on logical or at - line 3.
use warning 'unsafe' ;
open FH, "<abc" ;
$x = 1 if $x = <FH> ;
+no warning 'unsafe' ;
+$x = 1 if $x = <FH> ;
EXPECT
Value of <HANDLE> construct can be "0"; test with defined() at - line 4.
########
@@ -480,6 +641,8 @@ Value of <HANDLE> construct can be "0"; test with defined() at - line 4.
use warning 'unsafe' ;
opendir FH, "." ;
$x = 1 if $x = readdir FH ;
+no warning 'unsafe' ;
+$x = 1 if $x = readdir FH ;
closedir FH ;
EXPECT
Value of readdir() operator can be "0"; test with defined() at - line 4.
@@ -487,6 +650,8 @@ Value of readdir() operator can be "0"; test with defined() at - line 4.
# op.c
use warning 'unsafe' ;
$x = 1 if $x = <*> ;
+no warning 'unsafe' ;
+$x = 1 if $x = <*> ;
EXPECT
Value of glob construct can be "0"; test with defined() at - line 3.
########
@@ -494,12 +659,16 @@ Value of glob construct can be "0"; test with defined() at - line 3.
use warning 'unsafe' ;
%a = (1,2,3,4) ;
$x = 1 if $x = each %a ;
+no warning 'unsafe' ;
+$x = 1 if $x = each %a ;
EXPECT
Value of each() operator can be "0"; test with defined() at - line 4.
########
# op.c
use warning 'unsafe' ;
$x = 1 while $x = <*> and 0 ;
+no warning 'unsafe' ;
+$x = 1 while $x = <*> and 0 ;
EXPECT
Value of glob construct can be "0"; test with defined() at - line 3.
########
@@ -507,6 +676,8 @@ Value of glob construct can be "0"; test with defined() at - line 3.
use warning 'unsafe' ;
opendir FH, "." ;
$x = 1 while $x = readdir FH and 0 ;
+no warning 'unsafe' ;
+$x = 1 while $x = readdir FH and 0 ;
closedir FH ;
EXPECT
Value of readdir() operator can be "0"; test with defined() at - line 4.
@@ -515,6 +686,8 @@ Value of readdir() operator can be "0"; test with defined() at - line 4.
use warning 'redefine' ;
sub fred {}
sub fred {}
+no warning 'redefine' ;
+sub fred {}
EXPECT
Subroutine fred redefined at - line 4.
########
@@ -522,6 +695,8 @@ Subroutine fred redefined at - line 4.
use warning 'redefine' ;
sub fred () { 1 }
sub fred () { 1 }
+no warning 'redefine' ;
+sub fred () { 1 }
EXPECT
Constant subroutine fred redefined at - line 4.
########
@@ -531,18 +706,25 @@ format FRED =
.
format FRED =
.
+no warning 'redefine' ;
+format FRED =
+.
EXPECT
Format FRED redefined at - line 5.
########
# op.c
use warning 'syntax' ;
push FRED;
+no warning 'syntax' ;
+push FRED;
EXPECT
Array @FRED missing the @ in argument 1 of push() at - line 3.
########
# op.c
use warning 'syntax' ;
@a = keys FRED ;
+no warning 'syntax' ;
+@a = keys FRED ;
EXPECT
Hash %FRED missing the % in argument 1 of keys() at - line 3.
########
@@ -588,3 +770,35 @@ my %h; defined(%h);
EXPECT
defined(%hash) is deprecated at - line 3.
(Maybe you should just omit the defined()?)
+########
+# op.c
+no warning '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 warning 'unsafe' ;
+ sub Fred() ;
+ sub Fred($) {}
+ use warning 'unsafe' ;
+ 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.
diff --git a/t/pragma/warn/perl b/t/pragma/warn/perl
index 5211990902..25f125e03d 100644
--- a/t/pragma/warn/perl
+++ b/t/pragma/warn/perl
@@ -3,10 +3,55 @@
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 warning 'once' ;
+$x = 3 ;
use warning 'once' ;
+$z = 3 ;
+EXPECT
+Name "main::z" used only once: possible typo at - line 5.
+########
+-w
+# perl.c
$x = 3 ;
+no warning 'once' ;
+$z = 3
EXPECT
Name "main::x" used only once: possible typo at - line 3.
+########
+# perl.c
+BEGIN { $^W =1 ; }
+$x = 3 ;
+no warning 'once' ;
+$z = 3
+EXPECT
+Name "main::x" used only once: possible typo at - line 3.
+########
+-W
+# perl.c
+no warning 'once' ;
+$x = 3 ;
+use warning 'once' ;
+$z = 3 ;
+EXPECT
+Name "main::x" used only once: possible typo at - line 4.
+Name "main::z" used only once: possible typo at - line 6.
+########
+-X
+# perl.c
+use warning 'once' ;
+$x = 3 ;
+EXPECT
+
diff --git a/t/pragma/warn/perlio b/t/pragma/warn/perlio
new file mode 100644
index 0000000000..18c0dfa89f
--- /dev/null
+++ b/t/pragma/warn/perlio
@@ -0,0 +1,10 @@
+ perlio.c
+
+
+ Mandatory Warnings ALL TODO
+ ------------------
+ Setting cnt to %d
+ Setting ptr %p > end+1 %p
+ Setting cnt to %d, ptr implies %d
+
+__END__
diff --git a/t/pragma/warn/perly b/t/pragma/warn/perly
index fd420d3b22..bddc39c716 100644
--- a/t/pragma/warn/perly
+++ b/t/pragma/warn/perly
@@ -18,6 +18,12 @@ do fred(1) ;
$a = "fred" ;
do $a() ;
do $a(1) ;
+no warning '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.
diff --git a/t/pragma/warn/pp b/t/pragma/warn/pp
index 7a3b28991c..9baf9c14b0 100644
--- a/t/pragma/warn/pp
+++ b/t/pragma/warn/pp
@@ -25,14 +25,21 @@
Explicit blessing to '' (assuming package main)
bless \[], "";
- Constant subroutine %s undefined <<<
- Constant subroutine (anonymous) undefined <<<
+ Constant subroutine %s undefined <<<TODO
+ Constant subroutine (anonymous) undefined <<<TODO
+
+ Mandatory Warnings
+ ------------------
+ Malformed UTF-8 character
__END__
# pp.c
use warning 'substr' ;
$a = "ab" ;
-$a = substr($a, 4,5)
+$a = substr($a, 4,5);
+no warning 'substr' ;
+$a = "ab" ;
+$a = substr($a, 4,5);
EXPECT
substr outside of string at - line 4.
########
@@ -41,6 +48,8 @@ use warning 'substr' ;
$a = "ab" ;
$b = \$a ;
substr($b, 1,1) = "ab" ;
+no warning 'substr' ;
+substr($b, 1,1) = "ab" ;
EXPECT
Attempt to use reference as lvalue in substr at - line 5.
########
@@ -53,6 +62,8 @@ EXPECT
# pp.c
use warning 'unsafe' ;
my $a = { 1,2,3};
+no warning 'unsafe' ;
+my $b = { 1,2,3};
EXPECT
Odd number of elements in hash assignment at - line 3.
########
@@ -60,6 +71,9 @@ Odd number of elements in hash assignment at - line 3.
use warning 'unsafe' ;
my @a = unpack ("A,A", "22") ;
my $a = pack ("A,A", 1,2) ;
+no warning 'unsafe' ;
+my @b = unpack ("A,A", "22") ;
+my $b = pack ("A,A", 1,2) ;
EXPECT
Invalid type in unpack: ',' at - line 3.
Invalid type in pack: ',' at - line 4.
@@ -67,7 +81,9 @@ Invalid type in pack: ',' at - line 4.
# pp.c
use warning 'uninitialized' ;
my $a = undef ;
-my $b = $$a
+my $b = $$a;
+no warning 'uninitialized' ;
+my $c = $$a;
EXPECT
Use of uninitialized value at - line 4.
########
@@ -75,11 +91,35 @@ Use of uninitialized value at - line 4.
use warning 'unsafe' ;
sub foo { my $a = "a"; return $a . $a++ . $a++ }
my $a = pack("p", &foo) ;
+no warning 'unsafe' ;
+my $b = pack("p", &foo) ;
EXPECT
Attempt to pack pointer to temporary value at - line 4.
########
# pp.c
use warning 'unsafe' ;
bless \[], "" ;
+no warning 'unsafe' ;
+bless \[], "" ;
EXPECT
Explicit blessing to '' (assuming package main) at - line 3.
+########
+# pp.c
+use utf8 ;
+$_ = "\x80 \xff" ;
+reverse ;
+EXPECT
+Malformed UTF-8 character at - line 4.
+########
+# pp.c
+use warning 'utf8' ;
+use utf8 ;
+$_ = "\x80 \xff" ;
+reverse ;
+no warning 'utf8' ;
+$_ = "\x80 \xff" ;
+reverse ;
+EXPECT
+\x80 will produce malformed UTF-8 character; use \x{80} for that at - line 4.
+\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 4.
+Malformed UTF-8 character at - line 5.
diff --git a/t/pragma/warn/pp_ctl b/t/pragma/warn/pp_ctl
index 5a1c2338ed..4d6d8ca2af 100644
--- a/t/pragma/warn/pp_ctl
+++ b/t/pragma/warn/pp_ctl
@@ -71,6 +71,16 @@ Not enough format arguments at - line 5.
1
########
# pp_ctl.c
+no warning 'syntax' ;
+format =
+@<<< @<<<
+1
+.
+write ;
+EXPECT
+1
+########
+# pp_ctl.c
use warning 'unsafe' ;
$_ = "abc" ;
@@ -78,6 +88,11 @@ while ($i ++ == 0)
{
s/ab/last/e ;
}
+no warning 'unsafe' ;
+while ($i ++ == 0)
+{
+ s/ab/last/e ;
+}
EXPECT
Exiting substitution via last at - line 7.
########
@@ -85,12 +100,20 @@ Exiting substitution via last at - line 7.
use warning 'unsafe' ;
sub fred { last }
{ fred() }
+no warning 'unsafe' ;
+sub joe { last }
+{ joe() }
EXPECT
Exiting subroutine via last at - line 3.
########
# pp_ctl.c
-use warning 'unsafe' ;
-{ eval "last;" }
+{
+ eval "use warning 'unsafe' ; last;"
+}
+print STDERR $@ ;
+{
+ eval "no warning 'unsafe' ;last;"
+}
print STDERR $@ ;
EXPECT
Exiting eval via last at (eval 1) line 1.
@@ -99,6 +122,8 @@ Exiting eval via last at (eval 1) line 1.
use warning 'unsafe' ;
@a = (1,2) ;
@b = sort { last } @a ;
+no warning 'unsafe' ;
+@b = sort { last } @a ;
EXPECT
Exiting pseudo-block via last at - line 4.
Can't "last" outside a block at - line 4.
@@ -111,6 +136,11 @@ while ($i ++ == 0)
{
s/ab/last fred/e ;
}
+no warning 'unsafe' ;
+while ($i ++ == 0)
+{
+ s/ab/last fred/e ;
+}
EXPECT
Exiting substitution via last at - line 7.
########
@@ -118,12 +148,18 @@ Exiting substitution via last at - line 7.
use warning 'unsafe' ;
sub fred { last joe }
joe: { fred() }
+no warning 'unsafe' ;
+sub Fred { last Joe }
+Joe: { Fred() }
EXPECT
Exiting subroutine via last at - line 3.
########
# pp_ctl.c
-use warning 'unsafe' ;
-joe: { eval "last joe;" }
+joe:
+{ eval "use warning 'unsafe' ; last joe;" }
+print STDERR $@ ;
+Joe:
+{ eval "no warning 'unsafe' ; last Joe;" }
print STDERR $@ ;
EXPECT
Exiting eval via last at (eval 1) line 1.
@@ -132,6 +168,8 @@ Exiting eval via last at (eval 1) line 1.
use warning 'unsafe' ;
@a = (1,2) ;
fred: @b = sort { last fred } @a ;
+no warning 'unsafe' ;
+Fred: @b = sort { last Fred } @a ;
EXPECT
Exiting pseudo-block via last at - line 4.
Label not found for "last fred" at - line 4.
@@ -149,6 +187,18 @@ EXPECT
Deep recursion on subroutine "main::fred" at - line 6.
########
# pp_ctl.c
+no warning 'recursion' ;
+BEGIN { warn "PREFIX\n" ;}
+sub fred
+{
+ goto &fred() if $a++ < 200
+}
+
+goto &fred()
+EXPECT
+Can't find label
+########
+# pp_ctl.c
use warning 'unsafe' ;
package Foo;
DESTROY { die "@{$_[0]} foo bar" }
@@ -157,3 +207,12 @@ DESTROY { die "@{$_[0]} foo bar" }
EXPECT
(in cleanup) A foo bar at - line 4.
(in cleanup) B foo bar at - line 4.
+########
+# pp_ctl.c
+no warning 'unsafe' ;
+package Foo;
+DESTROY { die "@{$_[0]} foo bar" }
+{ bless ['A'], 'Foo' for 1..10 }
+{ bless ['B'], 'Foo' for 1..10 }
+EXPECT
+
diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot
index 817c0c89d6..60490bcd6a 100644
--- a/t/pragma/warn/pp_hot
+++ b/t/pragma/warn/pp_hot
@@ -37,7 +37,9 @@ __END__
# pp_hot.c
use warning 'unopened' ;
$f = $a = "abc" ;
-print $f $a
+print $f $a;
+no warning 'unopened' ;
+print $f $a;
EXPECT
Filehandle main::abc never opened at - line 4.
########
@@ -50,6 +52,8 @@ open(FOO, ">&STDOUT") and print <FOO>;
print getc(STDERR);
print getc(FOO);
read(FOO,$_,1);
+no warning 'io' ;
+print STDIN "anc";
EXPECT
Filehandle main::STDIN opened only for input at - line 3.
Filehandle main::STDOUT opened only for output at - line 4.
@@ -63,38 +67,50 @@ Filehandle main::FOO opened only for output at - line 9.
use warning 'closed' ;
close STDIN ;
print STDIN "anc";
+no warning 'closed' ;
+print STDIN "anc";
EXPECT
print on closed filehandle main::STDIN at - line 4.
########
# pp_hot.c
use warning 'uninitialized' ;
my $a = undef ;
-my @b = @$a
+my @b = @$a;
+no warning 'uninitialized' ;
+my @c = @$a;
EXPECT
Use of uninitialized value at - line 4.
########
# pp_hot.c
use warning 'uninitialized' ;
my $a = undef ;
-my %b = %$a
+my %b = %$a;
+no warning 'uninitialized' ;
+my %c = %$a;
EXPECT
Use of uninitialized value at - line 4.
########
# pp_hot.c
use warning 'unsafe' ;
my %X ; %X = (1,2,3) ;
+no warning 'unsafe' ;
+my %Y ; %Y = (1,2,3) ;
EXPECT
Odd number of elements in hash assignment at - line 3.
########
# pp_hot.c
use warning 'unsafe' ;
my %X ; %X = [1 .. 3] ;
+no warning 'unsafe' ;
+my %Y ; %Y = [1 .. 3] ;
EXPECT
Reference found where even-sized list expected at - line 3.
########
# pp_hot.c
use warning 'closed' ;
close STDIN ; $a = <STDIN> ;
+no warning 'closed' ;
+$a = <STDIN> ;
EXPECT
Read on closed filehandle main::STDIN at - line 3.
########
@@ -114,6 +130,21 @@ EXPECT
ok
########
# pp_hot.c
+no warning '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
use warning 'recursion' ;
$b = sub
{
@@ -123,3 +154,14 @@ $b = sub
&$b ;
EXPECT
Deep recursion on anonymous subroutine at - line 5.
+########
+# pp_hot.c
+no warning 'recursion' ;
+$b = sub
+{
+ &$b if $a++ < 200
+} ;
+
+&$b ;
+EXPECT
+
diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys
index 82d1501147..bf64a940e1 100644
--- a/t/pragma/warn/pp_sys
+++ b/t/pragma/warn/pp_sys
@@ -82,6 +82,9 @@ use warning 'untie' ;
sub TIESCALAR { bless [] } ;
$b = tie $a, 'main';
untie $a ;
+no warning 'untie' ;
+$c = tie $d, 'main';
+untie $d ;
EXPECT
untie attempted while 1 inner references still exist at - line 5.
########
@@ -90,6 +93,8 @@ use warning 'io' ;
format STDIN =
.
write STDIN;
+no warning 'io' ;
+write STDIN;
EXPECT
Filehandle main::STDIN opened only for input at - line 5.
########
@@ -99,6 +104,8 @@ format STDIN =
.
close STDIN;
write STDIN;
+no warning 'closed' ;
+write STDIN;
EXPECT
Write on closed filehandle main::STDIN at - line 6.
########
@@ -115,26 +122,34 @@ $= = 1 ;
$- =1 ;
open STDOUT, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ;
write ;
+no warning 'io' ;
+write ;
EXPECT
page overflow at - line 13.
########
# pp_sys.c
use warning 'unopened' ;
$a = "abc";
-printf $a "fred"
+printf $a "fred";
+no warning 'unopened' ;
+printf $a "fred";
EXPECT
Filehandle main::abc never opened at - line 4.
########
# pp_sys.c
use warning 'closed' ;
close STDIN ;
-printf STDIN "fred"
+printf STDIN "fred";
+no warning 'closed' ;
+printf STDIN "fred";
EXPECT
printf on closed filehandle main::STDIN at - line 4.
########
# pp_sys.c
use warning 'io' ;
-printf STDIN "fred"
+printf STDIN "fred";
+no warning 'io' ;
+printf STDIN "fred";
EXPECT
Filehandle main::STDIN opened only for input at - line 3.
########
@@ -142,6 +157,8 @@ Filehandle main::STDIN opened only for input at - line 3.
use warning 'closed' ;
close STDIN;
syswrite STDIN, "fred", 1;
+no warning 'closed' ;
+syswrite STDIN, "fred", 1;
EXPECT
Syswrite on closed filehandle at - line 4.
########
@@ -176,6 +193,17 @@ setsockopt STDIN, 1,2,3;
getsockopt STDIN, 1,2;
getsockname STDIN;
getpeername STDIN;
+no warning '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;
EXPECT
Send on closed socket at - line 22.
bind() on closed fd at - line 23.
@@ -191,6 +219,8 @@ get{sock, peer}name() on closed fd at - line 31.
# pp_sys.c
use warning 'newline' ;
stat "abc\ndef";
+no warning 'newline' ;
+stat "abc\ndef";
EXPECT
Unsuccessful stat on filename containing newline at - line 3.
########
@@ -198,11 +228,15 @@ Unsuccessful stat on filename containing newline at - line 3.
use warning 'unopened' ;
close STDIN ;
-T STDIN ;
+no warning 'unopened' ;
+-T STDIN ;
EXPECT
Test on unopened file <STDIN> at - line 4.
########
# pp_sys.c
use warning 'newline' ;
-T "abc\ndef" ;
+no warning 'newline' ;
+-T "abc\ndef" ;
EXPECT
Unsuccessful open on filename containing newline at - line 3.
diff --git a/t/pragma/warn/regcomp b/t/pragma/warn/regcomp
index 52a163a2f5..4b2f7ff2ba 100644
--- a/t/pragma/warn/regcomp
+++ b/t/pragma/warn/regcomp
@@ -19,6 +19,8 @@ __END__
use warning 'unsafe' ;
my $a = "ABC123" ;
$a =~ /(?=a)*/ ;
+no warning 'unsafe' ;
+$a =~ /(?=a)*/ ;
EXPECT
(?=a)* matches null string many times at - line 4.
########
@@ -26,6 +28,8 @@ EXPECT
use warning 'unsafe' ;
$_ = "" ;
/(?=a)?/;
+no warning 'unsafe' ;
+/(?=a)?/;
EXPECT
Strange *+?{} on zero-length expression at - line 4.
########
@@ -35,6 +39,10 @@ $_ = "" ;
/[a[:xyz:]b]/;
/[a[.xyz.]b]/;
/[a[=xyz=]b]/;
+no warning 'unsafe' ;
+/[a[:xyz:]b]/;
+/[a[.xyz.]b]/;
+/[a[=xyz=]b]/;
EXPECT
Character class syntax [: :] is reserved for future extensions at - line 4.
Character class syntax [. .] is reserved for future extensions at - line 5.
@@ -47,6 +55,10 @@ $_ = "" ;
/[a[:xyz:]b]/;
/[a[.xyz.]b]/;
/[a[=xyz=]b]/;
+no warning 'unsafe' ;
+/[a[:xyz:]b]/;
+/[a[.xyz.]b]/;
+/[a[=xyz=]b]/;
EXPECT
Character class syntax [: :] is reserved for future extensions at - line 5.
Character class syntax [. .] is reserved for future extensions at - line 6.
diff --git a/t/pragma/warn/regexec b/t/pragma/warn/regexec
index 6d4ec320e7..ce4eac7083 100644
--- a/t/pragma/warn/regexec
+++ b/t/pragma/warn/regexec
@@ -42,6 +42,32 @@ Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9.
########
# regexec.c
print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
+no warning 'unsafe' ;
+$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 warning 'unsafe' ;
$SIG{__WARN__} = sub{local ($m) = shift;
$m =~ s/\(\d+\)/(*MASKED*)/;
@@ -65,3 +91,29 @@ $_ = 'a' x (2**15+1);
#
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 warning 'unsafe' ;
+$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
+
diff --git a/t/pragma/warn/run b/t/pragma/warn/run
new file mode 100644
index 0000000000..7a4be20e70
--- /dev/null
+++ b/t/pragma/warn/run
@@ -0,0 +1,8 @@
+ run.c
+
+
+ Mandatory Warnings ALL TODO
+ ------------------
+ NULL OP IN RUN
+
+__END__
diff --git a/t/pragma/warn/sv b/t/pragma/warn/sv
index f3c530f884..0421192104 100644
--- a/t/pragma/warn/sv
+++ b/t/pragma/warn/sv
@@ -1,4 +1,4 @@
- sv.c AOK
+ sv.c
warn(warn_uninit);
@@ -32,12 +32,27 @@
Undefined value assigned to typeglob
+ Mandatory Warnings
+ ------------------
+ Malformed UTF-8 character [sv_pos_b2u]
+ my $a = rindex "a\xff bc ", "bc" ;
+
+ 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 warning 'uninitialized' ;
$x = 1 + $a[0] ; # a
+no warning 'uninitialized' ;
+$x = 1 + $b[0] ; # a
EXPECT
Use of uninitialized value at - line 4.
########
@@ -51,6 +66,8 @@ tie $A, 'fred' ;
use integer ;
use warning 'uninitialized' ;
$A *= 2 ;
+no warning 'uninitialized' ;
+$A *= 2 ;
EXPECT
Use of uninitialized value at - line 10.
########
@@ -58,6 +75,8 @@ Use of uninitialized value at - line 10.
use integer ;
use warning 'uninitialized' ;
my $x *= 2 ; #b
+no warning 'uninitialized' ;
+my $y *= 2 ; #b
EXPECT
Use of uninitialized value at - line 4.
########
@@ -71,25 +90,35 @@ tie $A, 'fred' ;
use warning 'uninitialized' ;
$B = 0 ;
$B |= $A ;
+no warning 'uninitialized' ;
+$B = 0 ;
+$B |= $A ;
EXPECT
Use of uninitialized value at - line 10.
########
# sv.c
use warning 'uninitialized' ;
my $Y = 1 ;
-my $x = 1 | $a[$Y]
+my $x = 1 | $a[$Y] ;
+no warning 'uninitialized' ;
+my $Y = 1 ;
+$x = 1 | $b[$Y] ;
EXPECT
Use of uninitialized value at - line 4.
########
# sv.c
use warning 'uninitialized' ;
my $x *= 1 ; # d
+no warning 'uninitialized' ;
+my $y *= 1 ; # d
EXPECT
Use of uninitialized value at - line 3.
########
# sv.c
use warning 'uninitialized' ;
$x = 1 + $a[0] ; # e
+no warning 'uninitialized' ;
+$x = 1 + $b[0] ; # e
EXPECT
Use of uninitialized value at - line 3.
########
@@ -102,24 +131,32 @@ package main ;
tie $A, 'fred' ;
use warning 'uninitialized' ;
$A *= 2 ;
+no warning 'uninitialized' ;
+$A *= 2 ;
EXPECT
Use of uninitialized value at - line 9.
########
# sv.c
use warning 'uninitialized' ;
$x = $y + 1 ; # f
+no warning 'uninitialized' ;
+$x = $z + 1 ; # f
EXPECT
Use of uninitialized value at - line 3.
########
# sv.c
use warning 'uninitialized' ;
$x = chop undef ; # g
+no warning 'uninitialized' ;
+$x = chop undef ; # g
EXPECT
Modification of a read-only value attempted at - line 3.
########
# sv.c
use warning 'uninitialized' ;
$x = chop $y ; # h
+no warning 'uninitialized' ;
+$x = chop $z ; # h
EXPECT
Use of uninitialized value at - line 3.
########
@@ -133,6 +170,9 @@ tie $A, 'fred' ;
use warning 'uninitialized' ;
$B = "" ;
$B .= $A ;
+no warning 'uninitialized' ;
+$C = "" ;
+$C .= $A ;
EXPECT
Use of uninitialized value at - line 10.
########
@@ -141,13 +181,17 @@ use warning 'numeric' ;
sub TIESCALAR{bless[]} ;
sub FETCH {"def"} ;
tie $a,"main" ;
-my $b = 1 + $a
+my $b = 1 + $a;
+no warning 'numeric' ;
+my $c = 1 + $a;
EXPECT
Argument "def" isn't numeric in add at - line 6.
########
# sv.c
use warning 'numeric' ;
my $x = 1 + "def" ;
+no warning 'numeric' ;
+my $z = 1 + "def" ;
EXPECT
Argument "def" isn't numeric in add at - line 3.
########
@@ -155,6 +199,8 @@ Argument "def" isn't numeric in add at - line 3.
use warning 'numeric' ;
my $a = "def" ;
my $x = 1 + $a ;
+no warning 'numeric' ;
+my $y = 1 + $a ;
EXPECT
Argument "def" isn't numeric in add at - line 4.
########
@@ -162,12 +208,16 @@ Argument "def" isn't numeric in add at - line 4.
use warning 'numeric' ; use integer ;
my $a = "def" ;
my $x = 1 + $a ;
+no warning 'numeric' ;
+my $z = 1 + $a ;
EXPECT
Argument "def" isn't numeric in i_add at - line 4.
########
# sv.c
use warning 'numeric' ;
my $x = 1 & "def" ;
+no warning 'numeric' ;
+my $z = 1 & "def" ;
EXPECT
Argument "def" isn't numeric in bit_and at - line 3.
########
@@ -176,6 +226,9 @@ use warning 'redefine' ;
sub fred {}
sub joe {}
*fred = \&joe ;
+no warning 'redefine' ;
+sub jim {}
+*jim = \&joe ;
EXPECT
Subroutine fred redefined at - line 5.
########
@@ -188,6 +241,13 @@ printf F "%" ;
$a = sprintf "%" ;
printf F "%\x02" ;
$a = sprintf "%\x02" ;
+no warning 'printf' ;
+printf F "%q\n" ;
+$a = sprintf "%q" ;
+printf F "%" ;
+$a = sprintf "%" ;
+printf F "%\x02" ;
+$a = sprintf "%\x02" ;
EXPECT
Invalid conversion in sprintf: "%q" at - line 5.
Invalid conversion in sprintf: end of string at - line 7.
@@ -199,5 +259,22 @@ Invalid conversion in printf: "%\002" at - line 8.
# sv.c
use warning 'unsafe' ;
*a = undef ;
+no warning 'unsafe' ;
+*b = undef ;
EXPECT
Undefined value assigned to typeglob at - line 3.
+########
+# sv.c
+use utf8 ;
+$^W =0 ;
+{
+ use warning 'utf8' ;
+ my $a = rindex "a\xff bc ", "bc" ;
+ no warning 'utf8' ;
+ $a = rindex "a\xff bc ", "bc" ;
+}
+my $a = rindex "a\xff bc ", "bc" ;
+EXPECT
+\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 6.
+Malformed UTF-8 character at - line 6.
+Malformed UTF-8 character at - line 10.
diff --git a/t/pragma/warn/taint b/t/pragma/warn/taint
index 40fadd0913..17ab0423c6 100644
--- a/t/pragma/warn/taint
+++ b/t/pragma/warn/taint
@@ -1,25 +1,49 @@
- taint.c TODO
+ taint.c AOK
- Insecure %s%s while running setuid
- Insecure %s%s while running setgid
Insecure %s%s while running with -T switch
-
- Insecure directory in %s%s while running setuid
- Insecure directory in %s%s while running setgid
- Insecure directory in %s%s while running with -T switch
-
-
-
__END__
+-T
+--FILE-- abc
+def
+--FILE--
# taint.c
-use warning 'misc' ;
-
+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
-use warning 'misc' ;
-
+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 warning 'taint' ;
+chdir $a ;
+print "xxx\n" ;
+no warning 'taint' ;
+chdir $a ;
+print "yyy\n" ;
+EXPECT
+Insecure dependency in chdir while running with -T switch at - line 6.
+xxx
+yyy
diff --git a/t/pragma/warn/toke b/t/pragma/warn/toke
index da6c0dc9ae..72c1e2fddc 100644
--- a/t/pragma/warn/toke
+++ b/t/pragma/warn/toke
@@ -97,6 +97,21 @@ toke.c AOK
use utf8 ;
$_ = "\xffe"
+ 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 warning 'deprecated' ;
@@ -106,6 +121,13 @@ use warning 'deprecated' ;
1 if $a LT $b ;
1 if $a GE $b ;
1 if $a LE $b ;
+no warning 'deprecated' ;
+1 if $a EQ $b ;
+1 if $a NE $b ;
+1 if $a GT $b ;
+1 if $a LT $b ;
+1 if $a GE $b ;
+1 if $a LE $b ;
EXPECT
Use of EQ is deprecated at - line 3.
Use of NE is deprecated at - line 4.
@@ -120,24 +142,31 @@ format STDOUT =
@<<< @||| @>>> @>>>
$a $b "abc" 'def'
.
-($a, $b) = (1,2,3);
-write;
+no warning '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.
-1 2 abc def
########
# toke.c
use warning 'deprecated' ;
$a = <<;
+no warning 'deprecated' ;
+$a = <<;
+
EXPECT
Use of bare << to mean <<"" is deprecated at - line 3.
########
# toke.c
use warning 'syntax' ;
s/(abc)/\1/;
+no warning 'syntax' ;
+s/(abc)/\1/;
EXPECT
\1 better written as $1 at - line 3.
########
@@ -145,6 +174,9 @@ EXPECT
use warning 'semicolon' ;
$a = 1
&time ;
+no warning 'semicolon' ;
+$a = 1
+&time ;
EXPECT
Semicolon seems to be missing at - line 3.
########
@@ -180,14 +212,40 @@ Reversed <= operator at - line 15.
Unterminated <> operator at - line 15.
########
# toke.c
+BEGIN {
+ # Scalars leaked: due to syntax errors
+ $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
+}
+no warning '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 12, near "=."
+syntax error at - line 13, near "=^"
+syntax error at - line 14, near "=|"
+Unterminated <> operator at - line 15.
+########
+# toke.c
use warning 'syntax' ;
my $a = $a[1,2] ;
+no warning 'syntax' ;
+my $a = $a[1,2] ;
EXPECT
Multidimensional syntax $a[1,2] not supported at - line 3.
########
# toke.c
use warning 'syntax' ;
sub fred {} ; $SIG{TERM} = fred;
+no warning 'syntax' ;
+$SIG{TERM} = fred;
EXPECT
You need to quote "fred" at - line 3.
########
@@ -195,6 +253,9 @@ You need to quote "fred" at - line 3.
use warning 'syntax' ;
@a[3] = 2;
@a{3} = 2;
+no warning 'syntax' ;
+@a[3] = 2;
+@a{3} = 2;
EXPECT
Scalar value @a[3] better written as $a[3] at - line 3.
Scalar value @a{3} better written as $a{3} at - line 4.
@@ -203,36 +264,49 @@ Scalar value @a{3} better written as $a{3} at - line 4.
use warning 'syntax' ;
$_ = "ab" ;
s/(ab)/\1/e;
+no warning 'syntax' ;
+$_ = "ab" ;
+s/(ab)/\1/e;
EXPECT
Can't use \1 to mean $1 in expression at - line 4.
########
# toke.c
use warning 'reserved' ;
$a = abc;
+no warning 'reserved' ;
+$a = abc;
EXPECT
Unquoted string "abc" may clash with future reserved word at - line 3.
########
# toke.c
use warning 'octal' ;
chmod 3;
+no warning 'octal' ;
+chmod 3;
EXPECT
chmod: mode argument is missing initial 0 at - line 3, at end of line
########
# toke.c
use warning 'syntax' ;
@a = qw(a, b, c) ;
+no warning 'syntax' ;
+@a = qw(a, b, c) ;
EXPECT
Possible attempt to separate words with commas at - line 3.
########
# toke.c
use warning 'syntax' ;
@a = qw(a b #) ;
+no warning 'syntax' ;
+@a = qw(a b #) ;
EXPECT
Possible attempt to put comments in qw() list at - line 3.
########
# toke.c
use warning 'octal' ;
umask 3;
+no warning 'octal' ;
+umask 3;
EXPECT
umask: argument is missing initial 0 at - line 3, at end of line
########
@@ -243,20 +317,40 @@ EXPECT
print (...) interpreted as function at - line 3.
########
# toke.c
+no warning 'syntax' ;
+print ("")
+EXPECT
+
+########
+# toke.c
use warning 'syntax' ;
printf ("")
EXPECT
printf (...) interpreted as function at - line 3.
########
# toke.c
+no warning 'syntax' ;
+printf ("")
+EXPECT
+
+########
+# toke.c
use warning 'syntax' ;
sort ("")
EXPECT
sort (...) interpreted as function at - line 3.
########
# toke.c
+no warning 'syntax' ;
+sort ("")
+EXPECT
+
+########
+# toke.c
use warning 'ambiguous' ;
$a = ${time[2]};
+no warning 'ambiguous' ;
+$a = ${time[2]};
EXPECT
Ambiguous use of ${time[...]} resolved to $time[...] at - line 3.
########
@@ -267,8 +361,16 @@ EXPECT
Ambiguous use of ${time{...}} resolved to $time{...} at - line 3.
########
# toke.c
+no warning 'ambiguous' ;
+$a = ${time{2}};
+EXPECT
+
+########
+# toke.c
use warning 'ambiguous' ;
$a = ${time} ;
+no warning 'ambiguous' ;
+$a = ${time} ;
EXPECT
Ambiguous use of ${time} resolved to $time at - line 3.
########
@@ -276,6 +378,8 @@ Ambiguous use of ${time} resolved to $time at - line 3.
use warning 'ambiguous' ;
sub fred {}
$a = ${fred} ;
+no warning 'ambiguous' ;
+$a = ${fred} ;
EXPECT
Ambiguous use of ${fred} resolved to $fred at - line 4.
########
@@ -283,6 +387,9 @@ Ambiguous use of ${fred} resolved to $fred at - line 4.
use warning 'syntax' ;
$a = 1_2;
$a = 1_2345_6;
+no warning 'syntax' ;
+$a = 1_2;
+$a = 1_2345_6;
EXPECT
Misplaced _ in number at - line 3.
Misplaced _ in number at - line 4.
@@ -292,13 +399,18 @@ Misplaced _ in number at - line 4.
use warning 'unsafe' ;
#line 25 "bar"
$a = FRED:: ;
+no warning 'unsafe' ;
+#line 25 "bar"
+$a = FRED:: ;
EXPECT
Bareword "FRED::" refers to nonexistent package at bar line 25.
########
# toke.c
use warning 'ambiguous' ;
sub time {}
-my $a = time()
+my $a = time() ;
+no warning 'ambiguous' ;
+my $b = time() ;
EXPECT
Ambiguous call resolved as CORE::time(), qualify as such or use & at - line 4.
########
@@ -314,8 +426,101 @@ EXPECT
Use of \x{} without utf8 declaration at foo line 30.
########
# toke.c
+no warning 'utf8' ;
+eval <<'EOE';
+{
+#line 30 "foo"
+ $_ = " \x{123} " ;
+}
+EOE
+EXPECT
+
+########
+# toke.c
use warning 'utf8' ;
use utf8 ;
$_ = " \xffe " ;
+no warning 'utf8' ;
+$_ = " \xffe " ;
EXPECT
\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 4.
+########
+# toke.c
+my $a = rand + 4 ;
+EXPECT
+Warning: Use of "rand" without parens is ambiguous at - line 2.
+########
+# toke.c
+$^W = 0 ;
+my $a = rand + 4 ;
+{
+ no warning 'ambiguous' ;
+ $a = rand + 4 ;
+ use warning 'ambiguous' ;
+ $a = rand + 4 ;
+}
+$a = rand + 4 ;
+EXPECT
+Warning: Use of "rand" without parens is ambiguous at - line 3.
+Warning: Use of "rand" without parens is ambiguous at - line 8.
+Warning: Use of "rand" without parens 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 warning 'ambiguous' ;
+ -fred ;
+ use warning '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
+$^W = 0 ;
+open FOO || time;
+{
+ no warning 'ambiguous' ;
+ open FOO || time;
+ use warning 'ambiguous' ;
+ 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 warning 'ambiguous' ;
+ *foo *foo ;
+ use warning '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.
diff --git a/t/pragma/warn/universal b/t/pragma/warn/universal
index e2814e11c4..37e77195ca 100644
--- a/t/pragma/warn/universal
+++ b/t/pragma/warn/universal
@@ -1,4 +1,4 @@
- universal.c
+ universal.c TODO
Can't locate package %s for @%s::ISA
diff --git a/t/pragma/warn/utf8 b/t/pragma/warn/utf8
new file mode 100644
index 0000000000..380d53bbcc
--- /dev/null
+++ b/t/pragma/warn/utf8
@@ -0,0 +1,56 @@
+
+ utf8.c AOK
+
+ All Mandatory warnings
+
+ [utf8_to_uv]
+ Malformed UTF-8 character
+ my $a = ord "\x80" ;
+
+ Malformed UTF-8 character
+ my $a = ord "\xf080" ;
+
+ [utf16_to_utf8]
+ Malformed UTF-16 surrogate
+ <<<<<< Add a test when somethig actually calls utf16_to_utf8
+
+__END__
+# utf8.c
+use utf8 ;
+my $a = ord "\x80" ;
+EXPECT
+Malformed UTF-8 character at - line 3.
+########
+# utf8.c
+use utf8 ;
+my $a = ord "\x80" ;
+{
+ use warning 'utf8' ;
+ my $a = ord "\x80" ;
+ no warning 'utf8' ;
+ my $a = ord "\x80" ;
+}
+EXPECT
+Malformed UTF-8 character at - line 3.
+\x80 will produce malformed UTF-8 character; use \x{80} for that at - line 6.
+Malformed UTF-8 character at - line 6.
+########
+# utf8.c
+use utf8 ;
+my $a = ord "\xf080" ;
+EXPECT
+Malformed UTF-8 character at - line 3.
+########
+# utf8.c
+use utf8 ;
+my $a = ord "\xf080" ;
+{
+ use warning 'utf8' ;
+ my $a = ord "\xf080" ;
+ no warning 'utf8' ;
+ my $a = ord "\xf080" ;
+}
+EXPECT
+Malformed UTF-8 character at - line 3.
+\xf0 will produce malformed UTF-8 character; use \x{f0} for that at - line 6.
+Malformed UTF-8 character at - line 6.
diff --git a/t/pragma/warn/util b/t/pragma/warn/util
index d58f4b70fa..bd29f7b254 100644
--- a/t/pragma/warn/util
+++ b/t/pragma/warn/util
@@ -9,21 +9,74 @@
Illegal binary digit ignored
my $a = oct "0b9" ;
+
+ Mandatory Warnings
+ ------------------
+ Integer overflow in binary number
+ Integer overflow in octal number
+ Integer overflow in hex number
+
__END__
# util.c
use warning 'octal' ;
my $a = oct "029" ;
+no warning 'octal' ;
+my $a = oct "029" ;
EXPECT
Illegal octal digit '9' ignored at - line 3.
########
# util.c
use warning 'unsafe' ;
*a = hex "0xv9" ;
+no warning 'unsafe' ;
+*a = hex "0xv9" ;
EXPECT
Illegal hex digit 'v' ignored at - line 3.
########
# util.c
use warning 'unsafe' ;
*a = oct "0b9" ;
+no warning 'unsafe' ;
+*a = oct "0b9" ;
EXPECT
Illegal binary digit '9' ignored at - line 3.
+########
+# util.c
+$^W =1 ;
+{
+ use warning 'unsafe' ;
+ my $a = oct "0b111111111111111111111111111111111" ;
+ no warning 'unsafe' ;
+ $a = oct "0b111111111111111111111111111111111" ;
+}
+my $a = oct "0b111111111111111111111111111111111" ;
+EXPECT
+Integer overflow in binary number at - line 5.
+Integer overflow in binary number at - line 9.
+########
+# util.c
+$^W =1 ;
+{
+ use warning 'unsafe' ;
+ my $a = oct "777777777777777777777777777777777777" ;
+ no warning 'unsafe' ;
+ $a = oct "777777777777777777777777777777777777" ;
+}
+my $a = oct "777777777777777777777777777777777777" ;
+EXPECT
+Integer overflow in octal number at - line 5.
+Integer overflow in octal number at - line 9.
+########
+# util.c
+$^W =1 ;
+{
+ use warning 'unsafe' ;
+ my $a = hex "ffffffffffffffffffffffffffffffff" ;
+ no warning 'unsafe' ;
+ $a = hex "ffffffffffffffffffffffffffffffff" ;
+}
+my $a = hex "ffffffffffffffffffffffffffffffff" ;
+EXPECT
+Integer overflow in hex number at - line 5.
+Integer overflow in hex number at - line 9.
+
diff --git a/t/pragma/warning.t b/t/pragma/warning.t
index 7914121ae8..73e4c8d1a8 100755
--- a/t/pragma/warning.t
+++ b/t/pragma/warning.t
@@ -79,7 +79,7 @@ for (@prgs){
`MCR $^X $switch $tmpfile` :
$Is_MSWin32 ?
`.\\perl -I../lib $switch $tmpfile 2>&1` :
- `./perl $switch $tmpfile 2>&1`;
+ `./perl -I../lib $switch $tmpfile 2>&1`;
my $status = $?;
$results =~ s/\n+$//;
# allow expected output to be written as if $prog is on STDIN
View Lorry Controller Status