Add flag to num groks to silence non-portable warnings

Unicode inversion lists commonly will contain UV_MAX, which may trigger these warnings. Add a flag to suppress them to the numeric grok functions, which can be set by the code that is dealing with these lists
schwern · Jul 3, 2011 · 0247078 · 0247078
1 parent f1b6712
commit 0247078
Show file tree

Hide file tree

Showing 3 changed files with 29 additions and 7 deletions.
diff --git a/numeric.c b/numeric.c
@@ -131,6 +131,10 @@ C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the binary
 number may use '_' characters to separate digits.
 
 =cut
+
+Not documented yet because experimental is C<PERL_SCAN_SILENT_NON_PORTABLE
+which suppresses any message for non-portable numbers that are still valid
+on this platform.
  */
 
 UV
@@ -206,7 +210,8 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
 
     if (   ( overflowed && value_nv > 4294967295.0)
 #if UVSIZE > 4
-	|| (!overflowed && value > 0xffffffff  )
+	|| (!overflowed && value > 0xffffffff
+	    && ! (*flags & PERL_SCAN_SILENT_NON_PORTABLE))
 #endif
 	) {
 	Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
@@ -248,6 +253,10 @@ C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the hex
 number may use '_' characters to separate digits.
 
 =cut
+
+Not documented yet because experimental is C<PERL_SCAN_SILENT_NON_PORTABLE
+which suppresses any message for non-portable numbers that are still valid
+on this platform.
  */
 
 UV
@@ -323,7 +332,8 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
 
     if (   ( overflowed && value_nv > 4294967295.0)
 #if UVSIZE > 4
-	|| (!overflowed && value > 0xffffffff  )
+	|| (!overflowed && value > 0xffffffff
+	    && ! (*flags & PERL_SCAN_SILENT_NON_PORTABLE))
 #endif
 	) {
 	Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
@@ -363,6 +373,10 @@ If C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the octal
 number may use '_' characters to separate digits.
 
 =cut
+
+Not documented yet because experimental is C<PERL_SCAN_SILENT_NON_PORTABLE
+which suppresses any message for non-portable numbers that are still valid
+on this platform.
  */
 
 UV
@@ -428,7 +442,8 @@ Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
 
     if (   ( overflowed && value_nv > 4294967295.0)
 #if UVSIZE > 4
-	|| (!overflowed && value > 0xffffffff  )
+	|| (!overflowed && value > 0xffffffff
+	    && ! (*flags & PERL_SCAN_SILENT_NON_PORTABLE))
 #endif
 	) {
 	Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),

diff --git a/perl.h b/perl.h
@@ -5543,6 +5543,8 @@ int flock(int fd, int op);
 #define PERL_SCAN_ALLOW_UNDERSCORES   0x01 /* grok_??? accept _ in numbers */
 #define PERL_SCAN_DISALLOW_PREFIX     0x02 /* grok_??? reject 0x in hex etc */
 #define PERL_SCAN_SILENT_ILLDIGIT     0x04 /* grok_??? not warn about illegal digits */
+#define PERL_SCAN_SILENT_NON_PORTABLE 0x08 /* grok_??? not warn about very large
+					      numbers which are <= UV_MAX */
 /* Output flags: */
 #define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 /* should this merge with above? */
 

diff --git a/utf8.c b/utf8.c
@@ -2268,7 +2268,9 @@ S_swash_scan_list_line(pTHX_ U8* l, U8* const lend, UV* min, UV* max, UV* val,
 {
     const int  typeto  = typestr[0] == 'T' && typestr[1] == 'o';
     STRLEN numlen;	    /* Length of the number */
-    I32 flags = PERL_SCAN_SILENT_ILLDIGIT | PERL_SCAN_DISALLOW_PREFIX;
+    I32 flags = PERL_SCAN_SILENT_ILLDIGIT
+		| PERL_SCAN_DISALLOW_PREFIX
+		| PERL_SCAN_SILENT_NON_PORTABLE;
 
     /* nl points to the next \n in the scan */
     U8* const nl = (U8*)memchr(l, '\n', lend - l);
@@ -2288,7 +2290,9 @@ S_swash_scan_list_line(pTHX_ U8* l, U8* const lend, UV* min, UV* max, UV* val,
     /* The max range value follows, separated by a BLANK */
     if (isBLANK(*l)) {
 	++l;
-	flags = PERL_SCAN_SILENT_ILLDIGIT | PERL_SCAN_DISALLOW_PREFIX;
+	flags = PERL_SCAN_SILENT_ILLDIGIT
+		| PERL_SCAN_DISALLOW_PREFIX
+		| PERL_SCAN_SILENT_NON_PORTABLE;
 	numlen = lend - l;
 	*max = grok_hex((char *)l, &numlen, &flags, NULL);
 	if (numlen)
@@ -2301,8 +2305,9 @@ S_swash_scan_list_line(pTHX_ U8* l, U8* const lend, UV* min, UV* max, UV* val,
 	if (wants_value) {
 	    if (isBLANK(*l)) {
 		++l;
-		flags = PERL_SCAN_SILENT_ILLDIGIT |
-			PERL_SCAN_DISALLOW_PREFIX;
+		flags = PERL_SCAN_SILENT_ILLDIGIT
+		      | PERL_SCAN_DISALLOW_PREFIX
+		      | PERL_SCAN_SILENT_NON_PORTABLE;
 		numlen = lend - l;
 		*val = grok_hex((char *)l, &numlen, &flags, NULL);
 		if (numlen)