length = -1;
}
if (length < 0) {
- if (IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
- || IoIFP(io) == PerlIO_stderr())
+ if ((IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
+ || IoIFP(io) == PerlIO_stderr()) && ckWARN(WARN_IO))
{
SV* sv = sv_newmortal();
gv_efullname3(sv, gv, Nullch);
- doio.c AOK
+ doio.c
- Can't do bidirectional pipe
+ Can't do bidirectional pipe [Perl_do_open9]
open(F, "| true |");
- Missing command in piped open
+ Missing command in piped open [Perl_do_open9]
open(F, "| ");
- Missing command in piped open
+ Missing command in piped open [Perl_do_open9]
open(F, " |");
- warn(warn_nl, "open");
+ warn(warn_nl, "open"); [Perl_do_open9]
open(F, "true\ncd")
- Close on unopened file <%s>
- $a = "fred";close($a)
+ Close on unopened file <%s> [Perl_do_close] <<TODO
+ $a = "fred";close("$a")
- tell() on unopened file
+ tell() on unopened file [Perl_do_tell]
$a = "fred";$a = tell($a)
- seek() on unopened file
+ seek() on unopened file [Perl_do_seek]
$a = "fred";$a = seek($a,1,1)
- sysseek() on unopened file
+ sysseek() on unopened file [Perl_do_sysseek]
$a = "fred";$a = seek($a,1,1)
- warn(warn_uninit);
+ warn(warn_uninit); [Perl_do_print]
print $a ;
- Stat on unopened file <%s>
+ Stat on unopened file <%s> [Perl_my_stat]
close STDIN ; -x STDIN ;
- warn(warn_nl, "stat");
+ warn(warn_nl, "stat"); [Perl_my_stat]
stat "ab\ncd"
- warn(warn_nl, "lstat");
+ warn(warn_nl, "lstat"); [Perl_my_lstat]
lstat "ab\ncd"
- Can't exec \"%s\": %s
+ Can't exec \"%s\": %s [Perl_do_aexec5]
- Can't exec \"%s\": %s
+ 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
+ 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
- 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
+ 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
+# doio.c [Perl_do_open9]
use warnings 'io' ;
open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
close(F);
EXPECT
Can't do bidirectional pipe at - line 3.
########
-# doio.c
+# doio.c [Perl_do_open9]
use warnings 'io' ;
open(F, "| ");
no warnings 'io' ;
EXPECT
Missing command in piped open at - line 3.
########
-# doio.c
+# doio.c [Perl_do_open9]
use warnings 'io' ;
open(F, " |");
no warnings 'io' ;
EXPECT
Missing command in piped open at - line 3.
########
-# doio.c
+# doio.c [Perl_do_open9]
use warnings 'io' ;
open(F, "<true\ncd");
no warnings 'io' ;
EXPECT
Unsuccessful open on filename containing newline at - line 3.
########
-# doio.c
+# doio.c [Perl_do_close] <<TODO
+use warnings 'unopened' ;
+close "fred" ;
+no warnings 'unopened' ;
+close "joe" ;
+EXPECT
+Close on unopened file <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);
sysseek() on unopened file at - line 6.
Stat on unopened file <STDIN> at - line 7.
########
-# doio.c
+# doio.c [Perl_do_print]
use warnings 'uninitialized' ;
print $a ;
no warnings 'uninitialized' ;
EXPECT
Use of uninitialized value at - line 3.
########
-# doio.c
-use warnings 'io' ;
-
-EXPECT
-
-########
-# doio.c
+# doio.c [Perl_my_stat Perl_my_lstat]
use warnings 'io' ;
stat "ab\ncd";
lstat "ab\ncd";
Unsuccessful stat on filename containing newline at - line 3.
Unsuccessful stat on filename containing newline at - line 4.
########
-# doio.c
+# doio.c [Perl_do_aexec5]
use warnings 'io' ;
exec "lskdjfalksdjfdjfkls","" ;
no warnings 'io' ;
OPTION regex
Can't exec "lskdjfalksdjfdjfkls": .+
########
-# doio.c
+# doio.c [Perl_do_exec3]
use warnings 'io' ;
exec "lskdjfalksdjfdjfkls", "abc" ;
no warnings 'io' ;
OPTION regex
Can't exec "lskdjfalksdjfdjfkls(:? abc)?": .+
########
-# doio.c
+# doio.c [Perl_nextargv]
$^W = 0 ;
my $filename = "./temp" ;
mkdir $filename, 0777
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.
+########
+# doio.c [Perl_do_eof]
+use warnings 'io' ;
+my $a = eof STDOUT ;
+no warnings 'io' ;
+$a = eof STDOUT ;
+EXPECT
+Filehandle main::STDOUT opened only for output at - line 3.
/---/ should probably be written as "---"
join(/---/, @foo);
+ %s() called too early to check prototype [Perl_peep]
+ fred() ; sub fred ($$) {}
+
+
Mandatory Warnings
------------------
Prototype mismatch: [cv_ckproto]
join /---/, 'x', 'y', 'z';
EXPECT
/---/ should probably be written as "---" at - line 3.
+########
+# op.c [Perl_peep]
+use warnings 'unsafe' ;
+fred() ;
+sub fred ($$) {}
+no warnings 'unsafe' ;
+joe() ;
+sub joe ($$) {}
+EXPECT
+main::fred() called too early to check prototype at - line 3.
- pp_hot.c AOK
+ pp_hot.c
- Filehandle %s never opened
+ Filehandle %s never opened [pp_print]
$f = $a = "abc" ; print $f $a
- Filehandle %s opened only for input
+ Filehandle %s opened only for input [pp_print]
print STDIN "abc" ;
- Filehandle %s opened only for output
+ Filehandle %s opened only for output [pp_print]
print <STDOUT> ;
- print on closed filehandle %s
+ print on closed filehandle %s [pp_print]
close STDIN ; print STDIN "abc" ;
- uninitialized
+ uninitialized [pp_rv2av]
my $a = undef ; my @b = @$a
- uninitialized
+ uninitialized [pp_rv2hv]
my $a = undef ; my %b = %$a
- Odd number of elements in hash list
+ Odd number of elements in hash list [pp_aassign]
%X = (1,2,3) ;
- Reference found where even-sized list expected
+ Reference found where even-sized list expected [pp_aassign]
$X = [ 1 ..3 ];
- Read on closed filehandle %s
+ 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
+
+ Read on closed filehandle %s [Perl_do_readline]
close STDIN ; $a = <STDIN>;
- Deep recursion on subroutine \"%s\"
+ 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
+ Deep recursion on anonymous subroutine [Perl_sub_crush_depth]
$a = sub { &$a if $a++ < 200} &$a
+
__END__
-# pp_hot.c
+# pp_hot.c [pp_print]
use warnings 'unopened' ;
$f = $a = "abc" ;
print $f $a;
EXPECT
Filehandle main::abc never opened at - line 4.
########
-# pp_hot.c
+# pp_hot.c [pp_print]
use warnings 'io' ;
print STDIN "anc";
print <STDOUT>;
Filehandle main::STDERR opened only for output at - line 7.
Filehandle main::FOO opened only for output at - line 8.
########
-# pp_hot.c
+# pp_hot.c [pp_print]
use warnings 'closed' ;
close STDIN ;
print STDIN "anc";
EXPECT
print on closed filehandle main::STDIN at - line 4.
########
-# pp_hot.c
+# pp_hot.c [pp_rv2av]
use warnings 'uninitialized' ;
my $a = undef ;
my @b = @$a;
EXPECT
Use of uninitialized value at - line 4.
########
-# pp_hot.c
+# pp_hot.c [pp_rv2hv]
use warnings 'uninitialized' ;
my $a = undef ;
my %b = %$a;
EXPECT
Use of uninitialized value at - line 4.
########
-# pp_hot.c
+# pp_hot.c [pp_aassign]
use warnings 'unsafe' ;
my %X ; %X = (1,2,3) ;
no warnings 'unsafe' ;
EXPECT
Odd number of elements in hash assignment at - line 3.
########
-# pp_hot.c
+# pp_hot.c [pp_aassign]
use warnings 'unsafe' ;
my %X ; %X = [1 .. 3] ;
no warnings 'unsafe' ;
EXPECT
Reference found where even-sized list expected at - line 3.
########
-# pp_hot.c
+# pp_hot.c [Perl_do_readline]
use warnings 'closed' ;
close STDIN ; $a = <STDIN> ;
no warnings 'closed' ;
EXPECT
Read on closed filehandle main::STDIN at - line 3.
########
-# pp_hot.c
+# pp_hot.c [Perl_do_readline]
+use warnings 'io' ;
+my $file = "./xcv" ; unlink $file ;
+open (FH, ">./xcv") ;
+my $a = <FH> ;
+no warnings 'io' ;
+$a = <FH> ;
+unlink $file ;
+EXPECT
+Filehandle main::FH opened only for output at - line 5.
+########
+# pp_hot.c [Perl_sub_crush_depth]
use warnings 'recursion' ;
sub fred
{
EXPECT
ok
########
-# pp_hot.c
+# pp_hot.c [Perl_sub_crush_depth]
no warnings 'recursion' ;
sub fred
{
EXPECT
########
-# pp_hot.c
+# pp_hot.c [Perl_sub_crush_depth]
use warnings 'recursion' ;
$b = sub
{
EXPECT
Deep recursion on anonymous subroutine at - line 5.
########
-# pp_hot.c
+# pp_hot.c [Perl_sub_crush_depth]
no warnings 'recursion' ;
$b = sub
{
pp_sys.c AOK
- untie attempted while %d inner references still exist
+ untie attempted while %d inner references still exist [pp_untie]
sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
- Filehandle %s opened only for input
+ Filehandle %s opened only for input [pp_leavewrite]
format STDIN =
.
write STDIN;
- Write on closed filehandle %s
+ Write on closed filehandle %s [pp_leavewrite]
format STDIN =
.
close STDIN;
write STDIN ;
- page overflow
+ page overflow [pp_leavewrite]
- Filehandle %s never opened
+ Filehandle %s never opened [pp_prtf]
$a = "abc"; printf $a "fred"
- Filehandle %s opened only for input
+ Filehandle %s opened only for input [pp_prtf]
$a = "abc";
printf $a "fred"
- printf on closed filehandle %s
+ printf on closed filehandle %s [pp_prtf]
close STDIN ;
printf STDIN "fred"
- Syswrite on closed filehandle
+ Syswrite on closed filehandle [pp_send]
close STDIN;
syswrite STDIN, "fred", 1;
- Send on closed socket
+ Send on closed socket [pp_send]
close STDIN;
send STDIN, "fred", 1
- bind() on closed fd
+ bind() on closed fd [pp_bind]
close STDIN;
bind STDIN, "fred" ;
- connect() on closed fd
+ connect() on closed fd [pp_connect]
close STDIN;
connect STDIN, "fred" ;
- listen() on closed fd
+ listen() on closed fd [pp_listen]
close STDIN;
listen STDIN, 2;
- accept() on closed fd
+ accept() on closed fd [pp_accept]
close STDIN;
accept STDIN, "fred" ;
- shutdown() on closed fd
+ shutdown() on closed fd [pp_shutdown]
close STDIN;
shutdown STDIN, 0;
- [gs]etsockopt() on closed fd
+ [gs]etsockopt() on closed fd [pp_ssockopt]
close STDIN;
setsockopt STDIN, 1,2,3;
getsockopt STDIN, 1,2;
- get{sock, peer}name() on closed fd
+ get{sock, peer}name() on closed fd [pp_getpeername]
close STDIN;
getsockname STDIN;
getpeername STDIN;
- warn(warn_nl, "stat");
+ warn(warn_nl, "stat"); [pp_stat]
Test on unopened file <%s>
close STDIN ; -T STDIN ;
- warn(warn_nl, "open");
+ 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) ;
+
__END__
-# pp_sys.c
+# pp_sys.c [pp_untie]
use warnings 'untie' ;
sub TIESCALAR { bless [] } ;
$b = tie $a, 'main';
EXPECT
untie attempted while 1 inner references still exist at - line 5.
########
-# pp_sys.c
+# pp_sys.c [pp_leavewrite]
use warnings 'io' ;
format STDIN =
.
EXPECT
Filehandle main::STDIN opened only for input at - line 5.
########
-# pp_sys.c
+# pp_sys.c [pp_leavewrite]
use warnings 'closed' ;
format STDIN =
.
EXPECT
Write on closed filehandle main::STDIN at - line 6.
########
-# pp_sys.c
+# pp_sys.c [pp_leavewrite]
use warnings 'io' ;
format STDOUT_TOP =
abc
EXPECT
page overflow at - line 13.
########
-# pp_sys.c
+# pp_sys.c [pp_prtf]
use warnings 'unopened' ;
$a = "abc";
printf $a "fred";
EXPECT
Filehandle main::abc never opened at - line 4.
########
-# pp_sys.c
+# pp_sys.c [pp_prtf]
use warnings 'closed' ;
close STDIN ;
printf STDIN "fred";
EXPECT
printf on closed filehandle main::STDIN at - line 4.
########
-# pp_sys.c
+# pp_sys.c [pp_prtf]
use warnings 'io' ;
printf STDIN "fred";
no warnings 'io' ;
EXPECT
Filehandle main::STDIN opened only for input at - line 3.
########
-# pp_sys.c
+# pp_sys.c [pp_send]
use warnings 'closed' ;
close STDIN;
syswrite STDIN, "fred", 1;
EXPECT
Syswrite on closed filehandle at - line 4.
########
-# pp_sys.c
+# 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 {
get{sock, peer}name() on closed fd at - line 30.
get{sock, peer}name() on closed fd at - line 31.
########
-# pp_sys.c
+# pp_sys.c [pp_stat]
use warnings 'newline' ;
stat "abc\ndef";
no warnings 'newline' ;
EXPECT
Unsuccessful stat on filename containing newline at - line 3.
########
-# pp_sys.c
+# pp_sys.c [pp_fttext]
use warnings 'unopened' ;
close STDIN ;
-T STDIN ;
EXPECT
Test on unopened file <STDIN> at - line 4.
########
-# pp_sys.c
+# 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' ;
+my $file = "./xcv" ;
+open(F, ">$file") ;
+my $a = sysread(F, $a,10) ;
+no warnings 'io' ;
+my $a = sysread(F, $a,10) ;
+close F ;
+unlink $file ;
+EXPECT
+Filehandle main::F opened only for output at - line 5.
regcomp.c AOK
- %.*s matches null string many times
+ Strange *+?{} on zero-length expression [S_study_chunk]
+ /(?=a)?/
+ %.*s matches null string many times [S_regpiece]
$a = "ABC123" ; $a =~ /(?=a)*/'
- Strange *+?{} on zero-length expression
+ /%.127s/: Unrecognized escape \\%c passed through" [S_regatom]
+ /\m/
- /(?=a)?/
+ Character class syntax [. .] is reserved for future extensions [S_regpposixcc]
+
+ Character class syntax [= =] is reserved for future extensions [S_checkposixcc]
+
+ Character class syntax [%c %c] belongs inside character classes [S_checkposixcc]
+
- Character class syntax [. .] is reserved for future extensions
- Character class syntax [= =] is reserved for future extensions
+
__END__
-# regcomp.c
+# regcomp.c [S_regpiece]
use warnings 'unsafe' ;
my $a = "ABC123" ;
$a =~ /(?=a)*/ ;
EXPECT
(?=a)* matches null string many times at - line 4.
########
-# regcomp.c
+# regcomp.c [S_study_chunk]
use warnings 'unsafe' ;
$_ = "" ;
/(?=a)?/;
EXPECT
Strange *+?{} on zero-length expression at - line 4.
########
-# regcomp.c
+# regcomp.c [S_regatom]
+use warnings 'unsafe' ;
+$a =~ /\m/ ;
+no warnings 'unsafe' ;
+EXPECT
+Unrecognized escape \m passed through at - line 3.
+########
+# regcomp.c [S_regpposixcc S_checkposixcc]
use warnings 'unsafe' ;
$_ = "" ;
/[:alpha:]/;
Undefined value assigned to typeglob
+ Reference is already weak [Perl_sv_rvweaken] <<TODO
+
Mandatory Warnings
------------------
Malformed UTF-8 character [sv_pos_b2u]
\x%.*s will produce malformed UTF-8 character; use \x{%.*s} for that
use utf8 ;
$_ = "\xffe"
+
+ 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 ;
Mandatory Warnings
------------------
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 'unsafe' ;
+my $a = "\m" ;
+no warnings 'unsafe' ;
+$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 = 0b111111111111111111111111111111111 ;
+ $a = 0x0fffffffe ;
+ $a = 0x0ffffffff ;
+ $a = 0x1ffffffff ;
+ $a = 0037777777776 ;
+ $a = 0037777777777 ;
+ $a = 0047777777777 ;
+no warnings 'overflow' ;
+ $a = 0b011111111111111111111111111111110 ;
+ $a = 0b011111111111111111111111111111111 ;
+ $a = 0b111111111111111111111111111111111 ;
+ $a = 0x0fffffffe ;
+ $a = 0x0ffffffff ;
+ $a = 0x1ffffffff ;
+ $a = 0037777777776 ;
+ $a = 0037777777777 ;
+ $a = 0047777777777 ;
+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.
- universal.c TODO
+ universal.c AOK
- Can't locate package %s for @%s::ISA
+ Can't locate package %s for @%s::ISA [S_isa_lookup]
+
__END__
-# universal.c
+# 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.
+Can't locate package Joe for @main::ISA.
+Can't locate package Joe for @main::ISA.
<<<<<< Add a test when somethig actually calls utf16_to_utf8
__END__
-# utf8.c
+# utf8.c [utf8_to_uv]
use utf8 ;
my $a = ord "\x80" ;
EXPECT
Malformed UTF-8 character at - line 3.
########
-# utf8.c
+# utf8.c [utf8_to_uv]
use utf8 ;
my $a = ord "\x80" ;
{
\x80 will produce malformed UTF-8 character; use \x{80} for that at - line 6.
Malformed UTF-8 character at - line 6.
########
-# utf8.c
+# utf8.c [utf8_to_uv]
use utf8 ;
my $a = ord "\xf080" ;
EXPECT
Malformed UTF-8 character at - line 3.
########
-# utf8.c
+# utf8.c [utf8_to_uv]
use utf8 ;
my $a = ord "\xf080" ;
{
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 "0777777777777777777777777777777777777777777777777" ;
+ 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' ;
-my $a = oct "029" ;
+$a = oct "029" ;
EXPECT
Illegal octal digit '9' ignored at - line 3.
########
# util.c
use warnings 'digit' ;
-*a = hex "0xv9" ;
+my $a = hex "0xv9" ;
no warnings 'digit' ;
-*a = hex "0xv9" ;
+$a = hex "0xv9" ;
EXPECT
Illegal hexadecimal digit 'v' ignored at - line 3.
########
# util.c
use warnings 'digit' ;
-*a = oct "0b9" ;
+my $a = oct "0b9" ;
no warnings 'digit' ;
-*a = oct "0b9" ;
+$a = oct "0b9" ;
EXPECT
Illegal binary digit '9' ignored at - line 3.
+########
+# util.c
+use warnings 'overflow' ;
+my $a = oct "0b111111111111111111111111111111111111111111" ;
+no warnings 'overflow' ;
+$a = oct "0b111111111111111111111111111111111111111111" ;
+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 "0777777777777777777777777777777777777777777777777" ;
+no warnings 'overflow' ;
+$a = oct "0777777777777777777777777777777777777777777777777" ;
+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.
dTHR;
overflowed = TRUE;
n = (NV) u;
- if (ckWARN_d(WARN_UNSAFE))
- Perl_warner(aTHX_ ((shift == 3) ?
- WARN_OCTAL : WARN_UNSAFE),
+ if (ckWARN_d(WARN_OVERFLOW))
+ Perl_warner(aTHX_ WARN_OVERFLOW,
"Integer overflow in %s number",
base);
} else
sv = NEWSV(92,0);
if (overflowed) {
dTHR;
- if (ckWARN(WARN_UNSAFE) && n > 4294967295.0)
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_PORTABLE) && n > 4294967295.0)
+ Perl_warner(aTHX_ WARN_PORTABLE,
"%s number > %s non-portable",
Base, max);
sv_setnv(sv, n);
else {
#if UV_SIZEOF > 4
dTHR;
- if (ckWARN(WARN_UNSAFE) && u > 0xffffffff)
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_PORTABLE) && u > 0xffffffff)
+ Perl_warner(aTHX_ WARN_PORTABLE,
"%s number > %s non-portable",
Base, max);
#endif
projects / p5sagit/p5-mst-13.2.git / commitdiff