64-bit work. Now 32-bit platforms get a 100% make test

with -Duse64bits (using long long).
Tested in Solaris 2.6 sparc  RH Linux 6.0 x86
(and Digital IX 4.0D, to get a true 64-bit opinion).  Now e.g.
'print unpack "q", pack "q", 12345678901'
should work on such 32-bit platforms.
Still a lot of printf()s behind -D which wrongly assume
that %ld/%lx and (long) are a good combination.
Introducing a slew of new macros intended to be used in printf()
format strings: e. g. PERL_PRId64 is the string to be used
when printing an IV, printf("%" PERL_PRId64 "\n", iv).
The PRI... naming follows the C9X naming of <inttypes.h> macros.

p4raw-id: //depot/cfgperl@3861

1 files changed, 68 insertions, 23 deletions

diff --git a/sv.c b/sv.c
index 4bdf847c73..ef4656367c 100644
--- a/sv.c
+++ b/sv.c
@@ -1068,7 +1068,7 @@ S_not_a_number(pTHX_ SV *sv)
 	Perl_warner(aTHX_ WARN_NUMERIC, "Argument \"%s\" isn't numeric", tmpbuf);
 }
 
-/* the number can be converted to _integer_ with atol() */
+/* the number can be converted to integer with atol() or atoll() */
 #define IS_NUMBER_TO_INT_BY_ATOL 0x01
 #define IS_NUMBER_TO_INT_BY_ATOF 0x02 /* atol() may be != atof() */
 #define IS_NUMBER_NOT_IV	 0x04 /* (IV)atof() may be != atof() */
@@ -1125,7 +1125,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
     if (SvNOKp(sv)) {
 	/* We can cache the IV/UV value even if it not good enough
 	 * to reconstruct NV, since the conversion to PV will prefer
-	 * NV over IV/UV.				XXXX 64-bit?
+	 * NV over IV/UV.
 	 */
 
 	if (SvTYPE(sv) == SVt_NV)
@@ -1138,10 +1138,17 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 	    SvUVX(sv) = U_V(SvNVX(sv));
 	    SvIsUV_on(sv);
 	  ret_iv_max:
+#ifdef IV_IS_QUAD
+	    DEBUG_c(PerlIO_printf(Perl_debug_log, 
+				  "0x%" PERL_PRIx64 " 2iv(%" PERL_PRIu64 " => %" PERL_PRId64 ") (as unsigned)\n",
+				  (UV)sv,
+				  (UV)SvUVX(sv), (IV)SvUVX(sv)));
+#else
 	    DEBUG_c(PerlIO_printf(Perl_debug_log, 
 				  "0x%lx 2iv(%lu => %ld) (as unsigned)\n",
 				  (unsigned long)sv,
 				  (unsigned long)SvUVX(sv), (long)(IV)SvUVX(sv)));
+#endif
 	    return (IV)SvUVX(sv);
 	}
     }
@@ -1169,7 +1176,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 	    (void)SvNOK_on(sv);
 	    (void)SvIOK_on(sv);
 #if defined(USE_LONG_DOUBLE)
-	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%Lg)\n",
+	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIgldbl ")\n",
 				  (unsigned long)sv, SvNVX(sv)));
 #else
 	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n",
@@ -1189,7 +1196,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 	    if (SvTYPE(sv) == SVt_PV)
 		sv_upgrade(sv, SVt_PVIV);
 	    (void)SvIOK_on(sv);
-	    SvIVX(sv) = atol(SvPVX(sv)); /* XXXX 64-bit? */
+	    SvIVX(sv) = Atol(SvPVX(sv));
 	}
 	else {				/* Not a number.  Cache 0. */
 	    dTHR;
@@ -1263,7 +1270,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
     if (SvNOKp(sv)) {
 	/* We can cache the IV/UV value even if it not good enough
 	 * to reconstruct NV, since the conversion to PV will prefer
-	 * NV over IV/UV.				XXXX 64-bit?
+	 * NV over IV/UV.
 	 */
 	if (SvTYPE(sv) == SVt_NV)
 	    sv_upgrade(sv, SVt_PVNV);
@@ -1275,10 +1282,17 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	else {
 	    SvIVX(sv) = I_V(SvNVX(sv));
 	  ret_zero:
+#ifdef IV_IS_QUAD
+	    DEBUG_c(PerlIO_printf(Perl_debug_log, 
+				  "0x%" PERL_PRIx64 " 2uv(%" PERL_PRId64 " => %" PERL_PRIu64 ") (as signed)\n",
+				  (unsigned long)sv,(long)SvIVX(sv),
+				  (long)(UV)SvIVX(sv)));
+#else
 	    DEBUG_c(PerlIO_printf(Perl_debug_log, 
 				  "0x%lx 2uv(%ld => %lu) (as signed)\n",
 				  (unsigned long)sv,(long)SvIVX(sv),
 				  (long)(UV)SvIVX(sv)));
+#endif
 	    return (UV)SvIVX(sv);
 	}
     }
@@ -1298,7 +1312,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	     * - otherwise future conversion to NV will be wrong.  */
 	    NV d;
 
-	    d = Atof(SvPVX(sv));	/* XXXX 64-bit? */
+	    d = Atof(SvPVX(sv));
 
 	    if (SvTYPE(sv) < SVt_PVNV)
 		sv_upgrade(sv, SVt_PVNV);
@@ -1306,7 +1320,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	    (void)SvNOK_on(sv);
 	    (void)SvIOK_on(sv);
 #if defined(USE_LONG_DOUBLE)
-	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%Lg)\n",
+	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIg64 ")\n",
 				  (unsigned long)sv, SvNVX(sv)));
 #else
 	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n",
@@ -1326,7 +1340,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	    if (SvTYPE(sv) == SVt_PV)
 		sv_upgrade(sv, SVt_PVIV);
 	    (void)SvIOK_on(sv);
-	    SvIVX(sv) = (IV)atol(SvPVX(sv)); /* XXXX 64-bit? */
+	    SvIVX(sv) = (IV)Atol(SvPVX(sv));
 	}
 	else if (numtype) {		/* Non-negative */
 	    /* The NV may be reconstructed from UV - safe to cache UV,
@@ -1336,10 +1350,10 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	    (void)SvIOK_on(sv);
 	    (void)SvIsUV_on(sv);
 #ifdef HAS_STRTOUL
-	    SvUVX(sv) = strtoul(SvPVX(sv), Null(char**), 10); /* XXXX 64-bit? */
+	    SvUVX(sv) = Strtoul(SvPVX(sv), Null(char**), 10);
 #else			/* no atou(), but we know the number fits into IV... */
 	    		/* The only problem may be if it is negative... */
-	    SvUVX(sv) = (UV)atol(SvPVX(sv)); /* XXXX 64-bit? */
+	    SvUVX(sv) = (UV)Atol(SvPVX(sv));
 #endif
 	}
 	else {				/* Not a number.  Cache 0. */
@@ -1424,7 +1438,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 #if defined(USE_LONG_DOUBLE)
 	DEBUG_c({
 	    RESTORE_NUMERIC_STANDARD();
-	    PerlIO_printf(Perl_debug_log, "0x%lx num(%Lg)\n",
+	    PerlIO_printf(Perl_debug_log, "0x%lx num(%" PERL_PRIg64 ")\n",
 			  (unsigned long)sv, SvNVX(sv));
 	    RESTORE_NUMERIC_LOCAL();
 	});
@@ -1463,7 +1477,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 #if defined(USE_LONG_DOUBLE)
     DEBUG_c({
 	RESTORE_NUMERIC_STANDARD();
-	PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%Lg)\n",
+	PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIg64 ")\n",
 		      (unsigned long)sv, SvNVX(sv));
 	RESTORE_NUMERIC_LOCAL();
     });
@@ -1485,7 +1499,7 @@ S_asIV(pTHX_ SV *sv)
     NV d;
 
     if (numtype & IS_NUMBER_TO_INT_BY_ATOL)
-	return atol(SvPVX(sv));		/* XXXX 64-bit? */
+	return Atol(SvPVX(sv));
     if (!numtype) {
 	dTHR;
 	if (ckWARN(WARN_NUMERIC))
@@ -1502,7 +1516,7 @@ S_asUV(pTHX_ SV *sv)
 
 #ifdef HAS_STRTOUL
     if (numtype & IS_NUMBER_TO_INT_BY_ATOL)
-	return strtoul(SvPVX(sv), Null(char**), 10);
+	return Strtoul(SvPVX(sv), Null(char**), 10);
 #endif
     if (!numtype) {
 	dTHR;
@@ -1528,8 +1542,6 @@ S_asUV(pTHX_ SV *sv)
 I32
 Perl_looks_like_number(pTHX_ SV *sv)
 {
-    /* XXXX 64-bit?  It may be not IS_NUMBER_TO_INT_BY_ATOL, but
-     * using atof() may lose precision. */
     register char *s;
     register char *send;
     register char *sbegin;
@@ -1683,11 +1695,18 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 	    *lp = SvCUR(sv);
 	    return SvPVX(sv);
 	}
-	if (SvIOKp(sv)) {		/* XXXX 64-bit? */
+	if (SvIOKp(sv)) {
+#ifdef IV_IS_QUAD
+	    if (SvIsUV(sv)) 
+		(void)sprintf(tmpbuf,"%" PERL_PRIu64,(UV)SvUVX(sv));
+	    else
+		(void)sprintf(tmpbuf,"%" PERL_PRId64,(IV)SvIVX(sv));
+#else
 	    if (SvIsUV(sv)) 
 		(void)sprintf(tmpbuf,"%lu",(unsigned long)SvUVX(sv));
 	    else
 		(void)sprintf(tmpbuf,"%ld",(long)SvIVX(sv));
+#endif
 	    tsv = Nullsv;
 	    goto tokensave;
 	}
@@ -1785,8 +1804,11 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 		    Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)), s);
 		else
 		    sv_setpv(tsv, s);
-		/* XXXX 64-bit? */
+#ifdef IV_IS_QUAD
+		Perl_sv_catpvf(aTHX_ tsv, "(0x%" PERL_PRIx64")", (UV)sv);
+#else
 		Perl_sv_catpvf(aTHX_ tsv, "(0x%lx)", (unsigned long)sv);
+#endif
 		goto tokensaveref;
 	    }
 	    *lp = strlen(s);
@@ -4803,15 +4825,20 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 
 	switch (*q) {
 	case 'l':
-#if 0  /* when quads have better support within Perl */
-	    if (*(q + 1) == 'l') {
+#ifdef HAS_QUAD
+             if (*(q + 1) == 'l') {	/* lld */
 		intsize = 'q';
 		q += 2;
 		break;
-	    }
+	     }
+	case 'L':			/* Ld */
+	case 'q':			/* qd */
+	    intsize = 'q';
+	    q++;
+	    break;
 #endif
-	    /* FALL THROUGH */
 	case 'h':
+	    /* FALL THROUGH */
 	case 'V':
 	    intsize = *q++;
 	    break;
@@ -4908,6 +4935,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		default:	iv = va_arg(*args, int); break;
 		case 'l':	iv = va_arg(*args, long); break;
 		case 'V':	iv = va_arg(*args, IV); break;
+#ifdef HAS_QUAD
+		case 'q':	iv = va_arg(*args, Quad_t); break;
+#endif
 		}
 	    }
 	    else {
@@ -4917,6 +4947,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		default:	iv = (int)iv; break;
 		case 'l':	iv = (long)iv; break;
 		case 'V':	break;
+#ifdef HAS_QUAD
+		case 'q':	iv = (Quad_t)iv; break;
+#endif
 		}
 	    }
 	    if (iv >= 0) {
@@ -4960,6 +4993,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		default:   uv = va_arg(*args, unsigned); break;
 		case 'l':  uv = va_arg(*args, unsigned long); break;
 		case 'V':  uv = va_arg(*args, UV); break;
+#ifdef HAS_QUAD
+		case 'q':  uv = va_arg(*args, Quad_t); break;
+#endif
 		}
 	    }
 	    else {
@@ -4969,6 +5005,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		default:	uv = (unsigned)uv; break;
 		case 'l':	uv = (unsigned long)uv; break;
 		case 'V':	break;
+#ifdef HAS_QUAD
+		case 'q':	uv = (Quad_t)uv; break;
+#endif
 		}
 	    }
 
@@ -5061,7 +5100,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    *--eptr = '\0';
 	    *--eptr = c;
 #ifdef USE_LONG_DOUBLE
-	    *--eptr = 'L';
+	    {
+		char* p = PRIfldbl + sizeof(PRIfldbl) - 3;
+		while (p >= PRIfldbl) { *--eptr = *p-- }
+	    }
 #endif
 	    if (has_precis) {
 		base = precis;
@@ -5113,6 +5155,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		default:	*(va_arg(*args, int*)) = i; break;
 		case 'l':	*(va_arg(*args, long*)) = i; break;
 		case 'V':	*(va_arg(*args, IV*)) = i; break;
+#ifdef HAS_QUAD
+		case 'q':	*(va_arg(*args, Quad_t*)) = i; break;
+#endif
 		}
 	    }
 	    else if (svix < svmax)