From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Mon, 10 Jun 2002 12:40:16 +0000 (+0000)
Subject: Patch from Hugo for the 'printf' problem:
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9e5b023a336559f55602e1de2a7813a7d5d82eec;p=p5sagit%2Fp5-mst-13.2.git

Patch from Hugo for the 'printf' problem:
- for SV-style calling, we can only get NV
- for C-style calling, we assume %f is double;
- for simplicity we allow any of %Lf, %llf, %qf for long double

p4raw-id: //depot/perl@17163
---

diff --git a/sv.c b/sv.c
index 4f38159..58a7c03 100644
--- a/sv.c
+++ b/sv.c
@@ -7738,7 +7738,14 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	unsigned base = 0;
 	IV iv = 0;
 	UV uv = 0;
+	/* we need a long double target in case HAS_LONG_DOUBLE but
+	   not USE_LONG_DOUBLE
+	*/
+#if defined(HAS_LONG_DOUBLE)
+	long double nv;
+#else
 	NV nv;
+#endif
 	STRLEN have;
 	STRLEN need;
 	STRLEN gap;
@@ -7914,18 +7921,18 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    q++;
 	    break;
 #endif
-#if defined(HAS_QUAD) || (defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE))
+#if defined(HAS_QUAD) || defined(HAS_LONG_DOUBLE)
 	case 'L':			/* Ld */
 	    /* FALL THROUGH */
-#endif
 #ifdef HAS_QUAD
 	case 'q':			/* qd */
+#endif
 	    intsize = 'q';
 	    q++;
 	    break;
 #endif
 	case 'l':
-#if defined(HAS_QUAD) || (defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE))
+#if defined(HAS_QUAD) || defined(HAS_LONG_DOUBLE)
              if (*(q + 1) == 'l') {	/* lld, llf */
 		intsize = 'q';
 		q += 2;
@@ -8242,11 +8249,45 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    /* This is evil, but floating point is even more evil */
 
 	    vectorize = FALSE;
-	    nv = args ? va_arg(*args, NV) : SvNVx(argsv);
+	    /* for SV-style calling, we can only get NV
+	       for C-style calling, we assume %f is double;
+	       for simplicity we allow any of %Lf, %llf, %qf for long double
+	    */
+	    switch (intsize) {
+	    case 'V':
+#if defined(USE_LONG_DOUBLE)
+		intsize = 'q';
+#endif
+		break;
+	    default:
+#if defined(USE_LONG_DOUBLE)
+		intsize = args ? 0 : 'q';
+#endif
+		break;
+	    case 'q':
+#if defined(HAS_LONG_DOUBLE)
+		break;
+#else
+		/* FALL THROUGH */
+#endif
+	    case 'h':
+		/* FALL THROUGH */
+	    case 'l':
+		goto unknown;
+	    }
+
+	    /* now we need (long double) if intsize == 'q', else (double) */
+	    nv = args
+		? intsize == 'q'
+		    ? va_arg(*args, long double)
+		    : va_arg(*args, double)
+		: SvNVx(argsv);
 
 	    need = 0;
 	    if (c != 'e' && c != 'E') {
 		i = PERL_INT_MIN;
+		/* FIXME: if HAS_LONG_DOUBLE but not USE_LONG_DOUBLE this
+		   will cast our (long double) to (double) */
 		(void)Perl_frexp(nv, &i);
 		if (i == PERL_INT_MIN)
 		    Perl_die(aTHX_ "panic: frexp");
@@ -8268,8 +8309,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    eptr = ebuf + sizeof ebuf;
 	    *--eptr = '\0';
 	    *--eptr = c;
-#if defined(USE_LONG_DOUBLE) && defined(PERL_PRIfldbl)
-	    {
+	    /* FIXME: what to do if HAS_LONG_DOUBLE but not PERL_PRIfldbl? */
+#if defined(HAS_LONG_DOUBLE) && defined(PERL_PRIfldbl)
+	    if (intsize == 'q') {
 		/* Copy the one or more characters in a long double
 		 * format before the 'base' ([efgEFG]) character to
 		 * the format string. */
@@ -8300,8 +8342,14 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    /* No taint.  Otherwise we are in the strange situation
 	     * where printf() taints but print($float) doesn't.
 	     * --jhi */
+#if defined(HAS_LONG_DOUBLE)
+	    if (intsize == 'q')
+		(void)sprintf(PL_efloatbuf, eptr, nv);
+	    else
+		(void)sprintf(PL_efloatbuf, eptr, (double)nv);
+#else
 	    (void)sprintf(PL_efloatbuf, eptr, nv);
-
+#endif
 	    eptr = PL_efloatbuf;
 	    elen = strlen(PL_efloatbuf);
 	    break;