they used to be just optional lexical warnings.
Also, with warnings turned on, constants > 2**32-1
trigger a non-portability warning.
p4raw-id: //depot/cfgperl@3798
$answer = 0b101010;
printf "The answer is: %b\n", oct("0b101010");
+=head2 Too large hexadecimal, octal, and binary constants more serious
+
+Too large hexadecimal, octal, and binary constants now cause fatal errors.
+
=head2 syswrite() ease-of-use
The length argument of C<syswrite()> is now optional.
could not be guaranteed (due to the errors), and since subsequent code
likely depends on its correct operation, Perl just gave up.
+=item Binary number > 0b11111111111111111111111111111111 non-portable
+
+(W) The binary number you specified is larger than 2**32-1 and
+therefore non-portable between systems. If you know that your code is
+always going to be used only in systems that have more than 32-bit
+integers (which means that Perl should be able to use such), you can
+silence this warning by
+
+ {
+ no warning 'unsafe';
+ .... your code here ...
+ }
+
+See also L<perlport> for writing portable code.
+
=item bind() on closed fd
(W) You tried to do a bind on a closed socket. Did you forget to check
(D) Really old Perl let you omit the % on hash names in some spots. This
is now heavily deprecated.
+=item Hexadecimal number > 0xffffffff non-portable
+
+(W) The hexadecimal number you specified is larger than 2**32-1 and
+therefore non-portable between systems. If you know that your code is
+always going to be used only in systems that have more than 32-bit
+integers (which means that Perl should be able to use such), you can
+silence this warning by
+
+ {
+ no warning 'unsafe';
+ .... your code here ...
+ }
+
+See also L<perlport> for writing portable code.
+
=item Identifier too long
(F) Perl limits identifiers (names for variables, functions, etc.) to
=item Illegal hexadecimal digit %s ignored
-(W) You may have tried to use a character other than 0 - 9 or A - F in a
-hexadecimal number. Interpretation of the hexadecimal number stopped
+(W) You may have tried to use a character other than 0 - 9 or A - F, a - f
+in a hexadecimal number. Interpretation of the hexadecimal number stopped
before the illegal character.
=item Illegal switch in PERL5OPT: %s
=item Integer overflow in %s number
-(S) The literal hexadecimal, octal or binary number you have specified
-is too big for your architecture. On a 32-bit architecture the largest
-literal hex, octal or binary number representable without overflow
-is 0xFFFFFFFF, 037777777777, or 0b11111111111111111111111111111111
-respectively. Note that Perl transparently promotes decimal literals
-to a floating point representation internally--subject to loss of
-precision errors in subsequent operations--so this limit usually
-doesn't apply to decimal literals.
+(F,X) The hexadecimal, octal or binary number you have specified
+either as a literal in your code or as a scalar is too big for your
+architecture. On a 32-bit architecture the largest literal hex, octal
+or binary number representable without overflow is 0xFFFFFFFF,
+037777777777, or 0b11111111111111111111111111111111 respectively.
+Note that Perl transparently promotes decimal literals to a floating
+point representation internally--subject to loss of precision errors
+in subsequent operations--so this limit usually doesn't apply to
+decimal literals. If the overflow is in a literal of your code, the
+error is untrappable (there is no way the code could work safely in
+your system), if the overflow happens in hex() or oct() the error is
+trappable.
=item Internal inconsistency in tracking vforks
Perl are likely to eliminate this arbitrary limitation. In the meantime,
try using scientific notation (e.g. "1e6" instead of "1_000_000").
+=item Octal number > 037777777777 non-portable
+
+(W) The octal number you specified is larger than 2**32-1 and
+therefore non-portable between systems. If you know that your code is
+always going to be used only in systems that have more than 32-bit
+integers (which means that Perl should be able to use such), you can
+silence this warning by
+
+ {
+ no warning 'unsafe';
+ .... your code here ...
+ }
+
+See also L<perlport> for writing portable code.
+
=item Odd number of elements in hash assignment
(S) You specified an odd number of elements to initialize a hash, which
As its name suggests, if your code tripped a mandatory warning, you
would get a warning whether you wanted it or not.
-For example, the code below would always produce an C<"integer overflow">
-warning.
+For example, the code below would always produce an C<"isn't numeric">
+warning about the "2:".
- my $a = oct "777777777777777777777777777777777777" ;
+ my $a = "2:" + 3;
+though the result will be 5.
With the introduction of lexical warnings, mandatory warnings now become
I<default> warnings. The difference is that although the previously
example, in the code below, an C<"integer overflow"> warning will only
be reported for the C<$a> variable.
- my $a = oct "777777777777777777777777777777777777" ;
+ my $a = "2:" + 3;
no warning ;
- my $b = oct "777777777777777777777777777777777777" ;
+ my $b = "2:" + 3;
Note that neither the B<-w> flag or the C<$^W> can be used to
disable/enable default warnings. They are still mandatory in this case.
=head2 Category Hierarchy
-A tentative hierarchy of "categories" have been defined to allow groups
+A B<tentative> hierarchy of "categories" have been defined to allow groups
of warnings to be enabled/disabled in isolation. The current
hierarchy is:
around the limitations of C<$^W>. Now that those limitations are gone,
the module should be revisited.
+ octal
+ 'octal' controls illegal octal characters warning but 'unsafe'
+ illegal hexadecimal and binary characters warning.
=head1 SEE ALSO
STRLEN n_a;
tmps = POPpx;
- XPUSHu(scan_hex(tmps, 99, &argtype));
+ XPUSHu(scan_hex(tmps, sizeof(UV) * 2 + 1, &argtype));
RETURN;
}
tmps = POPpx;
while (*tmps && isSPACE(*tmps))
tmps++;
- if (*tmps == '0')
- tmps++;
- if (*tmps == 'x')
- value = scan_hex(++tmps, 99, &argtype);
- else if (*tmps == 'b')
- value = scan_bin(++tmps, 99, &argtype);
+ /* Do not eat the leading 0[bx] because we need them
+ * to detect malformed binary and hexadecimal numbers. */
+ if ((tmps[0] == '0' && tmps[1] == 'x') || tmps[0] == 'x')
+ value = scan_hex(tmps, sizeof(UV) * 2 + 1, &argtype);
+ else if ((tmps[0] == '0' && tmps[1] == 'b') || tmps[0] == 'b')
+ value = scan_bin(tmps, sizeof(UV) * 8 + 1, &argtype);
else
- value = scan_oct(tmps, 99, &argtype);
+ value = scan_oct(tmps, sizeof(UV) * 4 + 1, &argtype);
XPUSHu(value);
RETURN;
}
#!./perl
-print "1..11\n";
-
-print +(oct('01234') == 01234) ? "ok" : "not ok", " 1\n";
-print +(oct('0x1234') == 0x1234) ? "ok" : "not ok", " 2\n";
-print +(hex('01234') == 0x1234) ? "ok" : "not ok", " 3\n";
-print +(oct('20000000000') == 020000000000) ? "ok" : "not ok", " 4\n";
-print +(oct('x80000000') == 0x80000000) ? "ok" : "not ok", " 5\n";
-print +(hex('80000000') == 0x80000000) ? "ok" : "not ok", " 6\n";
-print +(oct('1234') == 668) ? "ok" : "not ok", " 7\n";
-print +(hex('1234') == 4660) ? "ok" : "not ok", " 8\n";
-print +(hex('0x1234') == 0x1234) ? "ok" : "not ok", " 9\n";
-print +(oct('b11100') == 28) ? "ok" : "not ok", " 10\n";
-print +(oct('b101010') == 0b101010) ? "ok" : "not ok", " 11\n";
+print "1..24\n";
+
+print +(oct('0b10101') == 0b10101) ? "ok" : "not ok", " 1\n";
+print +(oct('0b10101') == 025) ? "ok" : "not ok", " 2\n";
+print +(oct('0b10101') == 21) ? "ok" : "not ok", " 3\n";
+print +(oct('0b10101') == 0x15) ? "ok" : "not ok", " 4\n";
+
+print +(oct('b10101') == 0b10101) ? "ok" : "not ok", " 5\n";
+print +(oct('b10101') == 025) ? "ok" : "not ok", " 6\n";
+print +(oct('b10101') == 21) ? "ok" : "not ok", " 7\n";
+print +(oct('b10101') == 0x15) ? "ok" : "not ok", " 8\n";
+
+print +(oct('01234') == 0b1010011100) ? "ok" : "not ok", " 9\n";
+print +(oct('01234') == 01234) ? "ok" : "not ok", " 10\n";
+print +(oct('01234') == 668) ? "ok" : "not ok", " 11\n";
+print +(oct('01234') == 0x29c) ? "ok" : "not ok", " 12\n";
+
+print +(oct('0x1234') == 0b1001000110100) ? "ok" : "not ok", " 13\n";
+print +(oct('0x1234') == 011064) ? "ok" : "not ok", " 14\n";
+print +(oct('0x1234') == 4660) ? "ok" : "not ok", " 15\n";
+print +(oct('0x1234') == 0x1234) ? "ok" : "not ok", " 16\n";
+
+print +(hex('01234') == 0b1001000110100) ? "ok" : "not ok", " 17\n";
+print +(hex('01234') == 011064) ? "ok" : "not ok", " 18\n";
+print +(hex('01234') == 4660) ? "ok" : "not ok", " 19\n";
+print +(hex('01234') == 0x1234) ? "ok" : "not ok", " 20\n";
+
+print +(hex('0x1234') == 0b1001000110100) ? "ok" : "not ok", " 21\n";
+print +(hex('0x1234') == 011064) ? "ok" : "not ok", " 22\n";
+print +(hex('0x1234') == 4660) ? "ok" : "not ok", " 23\n";
+print +(hex('0x1234') == 0x1234) ? "ok" : "not ok", " 24\n";
no warning ;
my $a = oct "7777777777777777777777777777777777779" ;
EXPECT
+Integer overflow in octal number at - line 3.
########
# all warning should be displayed
use warning ;
-my $a = oct "7777777777777777777777777777777777779" ;
+my $a = oct "77777777797";
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" ;
+my $a = oct "77777777797";
{
no warning ;
- my $a = oct "7777777777777777777777777777777777779" ;
+ my $b = oct "77777777797";
}
my $c = oct "7777777777777777777777777777777777779" ;
EXPECT
-Integer overflow in octal number at - line 3.
Illegal octal digit '9' ignored at - line 3.
+Octal number > 037777777777 non-portable at - line 8.
Integer overflow in octal number at - line 8.
-Illegal octal digit '9' ignored at - line 8.
Illegal octal digit ignored
my $a = oct "029" ;
- Illegal hex digit ignored
+ Illegal hexadecimal digit ignored
my $a = hex "0xv9" ;
Illegal binary digit ignored
use warning 'octal' ;
my $a = oct "029" ;
no warning 'octal' ;
-my $a = oct "029" ;
+my $b = oct "029" ;
EXPECT
Illegal octal digit '9' ignored at - line 3.
########
Illegal binary digit '9' ignored at - line 3.
########
# util.c
-BEGIN { require Config ; import Config }
-$^W =1 ;
+$^W = 1 ;
sub make_bin { "1" x $_[0] }
-my $s = $Config{longsize};
-eval { pack "q", 0 }; eval { $s = length pack "q", 0 } unless $@;
-$n = make_bin(8 * $s ) ;
-$o = make_bin(8 * $s + 1) ;
+$n = make_bin(33);
{
use warning 'unsafe' ;
my $a = oct "0b$n" ;
- my $b = oct "0b$o" ;
no warning 'unsafe' ;
- $b = oct "0b$o" ;
+ my $b = oct "0b$n" ;
}
-my $b = oct "0b$o" ;
+my $c = oct "0b$n" ;
EXPECT
-Integer overflow in binary number at - line 12.
-Integer overflow in binary number at - line 16.
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 7.
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 11.
########
# util.c
-BEGIN { require Config ; import Config }
-$^W =1 ;
+$^W = 1 ;
sub make_oct { ("","1","3")[$_[0]%3] . "7" x int($_[0]/3) }
-my $s = $Config{longsize};
-eval { pack "q", 0 }; eval { $s = length pack "q", 0 } unless $@;
-$n = make_oct(8 * $s );
-$o = make_oct(8 * $s + 1);
+$n = make_oct(33);
{
use warning 'unsafe' ;
my $a = oct "$n" ;
- my $b = oct "$o" ;
no warning 'unsafe' ;
- $b = oct "$o" ;
+ my $b = oct "$n" ;
}
-my $b = oct "$o" ;
+my $c = oct "$n" ;
EXPECT
-Integer overflow in octal number at - line 12.
-Integer overflow in octal number at - line 16.
+Octal number > 037777777777 non-portable at - line 7.
+Octal number > 037777777777 non-portable at - line 11.
########
# util.c
-BEGIN { require Config ; import Config }
-$^W =1 ;
+$^W = 1 ;
sub make_hex { ("","1","3","7")[$_[0]%4] . "f" x int($_[0]/4) }
-my $s = $Config{longsize};
-eval { pack "q", 0 }; eval { $s = length pack "q", 0 } unless $@;
-$n = make_hex(8 * $s ) ;
-$o = make_hex(8 * $s + 1) ;
+$n = make_hex(33);
{
use warning 'unsafe' ;
my $a = hex "$n" ;
- my $b = hex "$o" ;
no warning 'unsafe' ;
- $b = hex "$o" ;
+ my $b = hex "$n" ;
}
-my $b = hex "$o" ;
+my $c = hex "$n" ;
EXPECT
-Integer overflow in hexadecimal number at - line 12.
-Integer overflow in hexadecimal number at - line 16.
+Hexadecimal number > 0xffffffff non-portable at - line 7.
+Hexadecimal number > 0xffffffff non-portable at - line 11.
I32 thisutf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op)
? (PL_sublex_info.sub_op->op_private & (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF))
: UTF;
-
/* leaveit is the set of acceptably-backslashed characters */
char *leaveit =
PL_lex_inpat
d = (char*)uv_to_utf8((U8*)d,
scan_hex(s + 1, e - s - 1, &len));
s = e + 1;
-
}
else {
UV uv = (UV)scan_hex(s, 2, &len);
dTHR;
UV u;
I32 shift;
- bool overflowed = FALSE;
/* check for hex */
if (s[1] == 'x') {
digit:
n = u << shift; /* make room for the digit */
- if (!overflowed && (n >> shift) != u
+ if ((n >> shift) != u
&& !(PL_hints & HINT_NEW_BINARY))
{
- if (ckWARN_d(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE,
- "Integer overflow in %s number",
- (shift == 4) ? "hex"
- : ((shift == 3) ? "octal" : "binary"));
- overflowed = TRUE;
+ Perl_croak(aTHX_
+ "Integer overflow in %s number",
+ (shift == 4) ? "hexadecimal"
+ : ((shift == 3) ? "octal" : "binary"));
}
u = n | b; /* add the digit to the end */
break;
{
register char *s = start;
register UV retval = 0;
- bool overflowed = FALSE;
- while (len && *s >= '0' && *s <= '1') {
- register UV n = retval << 1;
- if (!overflowed && (n >> 1) != retval) {
- dTHR;
- if (ckWARN_d(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Integer overflow in binary number");
- overflowed = TRUE;
+ register UV n;
+ register I32 d = 0;
+ register bool seenb = FALSE;
+ register bool overflow = FALSE;
+
+ for (; len-- && *s; s++) {
+ if (!(*s == '0' || *s == '1')) {
+ if (*s == '_')
+ continue;
+ if (seenb == FALSE && *s == 'b' && retval == 0) {
+ /* Disallow 0bbb0b0bbb... */
+ seenb = TRUE;
+ d = 0; /* Forget any leading zeros before the 'b'. */
+ continue;
+ }
+ else {
+ dTHR;
+ if (ckWARN(WARN_UNSAFE))
+ Perl_warner(aTHX_ WARN_UNSAFE,
+ "Illegal binary digit '%c' ignored", *s);
+ break;
+ }
}
- retval = n | (*s++ - '0');
- len--;
+ n = retval << 1;
+ overflow |= (n >> 1) != retval;
+ retval = n | (*s - '0');
+ d++;
}
- if (len && (*s >= '2' && *s <= '9')) {
- dTHR;
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Illegal binary digit '%c' ignored", *s);
+ if (sizeof(UV) > 4 && d > 32) {
+ dTHR;
+ if (ckWARN(WARN_UNSAFE))
+ Perl_warner(aTHX_ WARN_UNSAFE,
+ "Binary number > 0b11111111111111111111111111111111 non-portable");
}
+ if (overflow)
+ Perl_croak(aTHX_ "Integer overflow in binary number");
*retlen = s - start;
return retval;
}
{
register char *s = start;
register UV retval = 0;
- bool overflowed = FALSE;
-
- while (len && *s >= '0' && *s <= '7') {
- register UV n = retval << 3;
- if (!overflowed && (n >> 3) != retval) {
- dTHR;
- if (ckWARN_d(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Integer overflow in octal number");
- overflowed = TRUE;
+ register UV n;
+ register I32 d = 0;
+ register bool seeno = FALSE;
+ register bool overflow = FALSE;
+
+ for (; len-- && *s; s++) {
+ if (!(*s >= '0' && *s <= '7')) {
+ if (*s == '_')
+ continue;
+ else {
+ /* Allow \octal to work DWIM way (that is, stop scanning
+ * as soon as non-octal characters seen, complain only iff
+ * someone seems to want to use the eight and nine. */
+ if (*s == '8' || *s == '9') {
+ dTHR;
+ if (ckWARN(WARN_OCTAL))
+ Perl_warner(aTHX_ WARN_OCTAL,
+ "Illegal octal digit '%c' ignored", *s);
+ }
+ break;
+ }
}
- retval = n | (*s++ - '0');
- len--;
+ n = retval << 3;
+ overflow |= (n >> 3) != retval;
+ retval = n | (*s - '0');
+ d++;
}
- if (len && (*s == '8' || *s == '9')) {
+ if (sizeof(UV) > 4 && d > 10 && (retval >> 30) > 3) {
dTHR;
- if (ckWARN(WARN_OCTAL))
- Perl_warner(aTHX_ WARN_OCTAL, "Illegal octal digit '%c' ignored", *s);
+ if (ckWARN(WARN_UNSAFE))
+ Perl_warner(aTHX_ WARN_UNSAFE,
+ "Octal number > 037777777777 non-portable");
}
+ if (overflow)
+ Perl_croak(aTHX_ "Integer overflow in octal number");
*retlen = s - start;
return retval;
}
{
register char *s = start;
register UV retval = 0;
- bool overflowed = FALSE;
char *tmp = s;
register UV n;
+ register I32 d = 0;
+ register bool seenx = FALSE;
+ register bool overflow = FALSE;
while (len-- && *s) {
tmp = strchr((char *) PL_hexdigit, *s++);
if (!tmp) {
- if (*(s-1) == '_' || (*(s-1) == 'x' && retval == 0))
+ if (*(s-1) == '_')
continue;
+ if (seenx == FALSE && *(s-1) == 'x' && retval == 0) {
+ /* Disallow 0xxx0x0xxx... */
+ seenx = TRUE;
+ d = 0; /* Forget any leading zeros before the 'x'. */
+ continue;
+ }
else {
dTHR;
--s;
if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE,"Illegal hexadecimal digit '%c' ignored", *s);
+ Perl_warner(aTHX_ WARN_UNSAFE,
+ "Illegal hexadecimal digit '%c' ignored", *s);
break;
}
}
+ d++;
n = retval << 4;
- if (!overflowed && (n >> 4) != retval) {
- dTHR;
- if (ckWARN_d(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Integer overflow in hexadecimal number");
- overflowed = TRUE;
- }
+ overflow |= (n >> 4) != retval;
retval = n | ((tmp - PL_hexdigit) & 15);
}
+ if (sizeof(UV) > 4 && d > 8) {
+ dTHR;
+ if (ckWARN(WARN_UNSAFE))
+ Perl_warner(aTHX_ WARN_UNSAFE,
+ "Hexadecimal number > 0xffffffff non-portable");
+ }
+ if (overflow)
+ Perl_croak(aTHX_ "Integer overflow in hexadecimal number");
*retlen = s - start;
return retval;
}
projects / p5sagit/p5-mst-13.2.git / commitdiff