RE: blead: no longer supports %vd format

Message-ID: <533D273D4014D411AB1D00062938C4D90849C730@hotel.npl.co.uk>

p4raw-id: //depot/perl@25171

3 files changed, 104 insertions, 39 deletions

diff --git a/perl.h b/perl.h
index b573c71113..dbe2b3dae6 100644
--- a/perl.h
+++ b/perl.h
@@ -2615,25 +2615,49 @@ typedef pthread_key_t	perl_key;
 #  define PERL_SET_THX(t)		PERL_SET_CONTEXT(t)
 #endif
 
-/*  This replaces the previous %_ "hack" by the "%-p" hack
+/* 
+    This replaces the previous %_ "hack" by the "%p" hacks.
     All that is required is that the perl source does not
-    use "%-p" or "%-<number>p" format.  These format will
-    still work in perl code.   RMB 2005/05/17
+    use "%-p" or "%-<number>p" or "%<number>p" formats.  
+    These formats will still work in perl code.   
+    See comments in sv.c for futher details.
+
+	-DvdNUMBER=<number> can be used to redefine VDf
+
+	-DvdNUMBER=0 reverts VDf to "vd", as in perl5.8.7,
+	    which works properly but gives compiler warnings
+
+    Robin Barker 2005-07-14
 */
-#ifndef SVf
-#  define SVf "-p"
+
+#ifndef SVf_
+#  define SVf_(n) "-" #n "p"
 #endif
 
-#ifndef SVf_precision
-#  define SVf_precision(n) "-" n "p"
+#ifndef SVf
+#  define SVf SVf_()
 #endif
 
 #ifndef SVf32
-#  define SVf32 SVf_precision("32")
+#  define SVf32 SVf_(32)
 #endif
 
 #ifndef SVf256
-#  define SVf256 SVf_precision("256")
+#  define SVf256 SVf_(256)
+#endif
+
+#ifndef vdNUMBER
+#  define vdNUMBER 1
+#endif
+ 
+#ifndef VDf
+#  if vdNUMBER 
+#    define vdFORMAT(n) #n "p"
+#    define VDf_(n) vdFORMAT(n)
+#    define VDf VDf_(vdNUMBER)
+#  else
+#    define VDf "vd"
+#  endif
 #endif
  
 #ifndef UVf
diff --git a/sv.c b/sv.c
index d041b7b423..74ed663fa3 100644
--- a/sv.c
+++ b/sv.c
@@ -8816,6 +8816,11 @@ Usually used via one of its frontends C<sv_vcatpvf> and C<sv_vcatpvf_mg>.
 =cut
 */
 
+
+#define VECTORIZE_ARGS	vecsv = va_arg(*args, SV*);\
+			vecstr = (U8*)SvPV_const(vecsv,veclen);\
+			vec_utf8 = DO_UTF8(vecsv);
+
 /* XXX maybe_tainted is never assigned to, so the doc above is lying. */
 
 void
@@ -8843,7 +8848,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
     /* no matter what, this is a string now */
     (void)SvPV_force(sv, origlen);
 
-    /* special-case "", "%s", and "%-p" (SVf) */
+    /* special-case "", "%s", and "%-p" (SVf - see below) */
     if (patlen == 0)
 	return;
     if (patlen == 2 && pat[0] == '%' && pat[1] == 's') {
@@ -8858,15 +8863,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    }
 	    return;
     }
-    if (patlen == 3 && pat[0] == '%' &&
-	pat[1] == '-' && pat[2] == 'p') {
-	    if (args) {
-		argsv = va_arg(*args, SV*);
-		sv_catsv(sv, argsv);
-		if (DO_UTF8(argsv))
-		    SvUTF8_on(sv);
-		return;
-	    }
+    if (args && patlen == 3 && pat[0] == '%' &&
+		pat[1] == '-' && pat[2] == 'p') {
+	argsv = va_arg(*args, SV*);
+	sv_catsv(sv, argsv);
+	if (DO_UTF8(argsv))
+	    SvUTF8_on(sv);
+	return;
     }
 
 #ifndef USE_LONG_DOUBLE
@@ -8988,8 +8991,60 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	\d+|\*(\d+\$)?     width using optional (optionally specified) arg
 	\.(\d*|\*(\d+\$)?) precision using optional (optionally specified) arg
 	[hlqLV]            size
-    [%bcdefginopsux_DFOUX] format (mandatory)
+    [%bcdefginopsuxDFOUX] format (mandatory)
+*/
+
+	if (args) {
+/*  
+	As of perl5.9.3, printf format checking is on by default.
+	Internally, perl uses %p formats to provide an escape to
+	some extended formatting.  This block deals with those
+	extensions: if it does not match, (char*)q is reset and
+	the normal format processing code is used.
+
+	Currently defined extensions are:
+		%p		include pointer address (standard)	
+		%-p	(SVf)	include an SV (previously %_)
+		%-<num>p	include an SV with precision <num>	
+		%1p	(VDf)	include a v-string (as %vd)
+		%<num>p		reserved for future extensions
+
+	Robin Barker 2005-07-14
 */
+ 	    char* r = q; 
+	    bool sv = FALSE;	
+	    STRLEN n = 0;
+	    if (*q == '-')
+		sv = *q++;
+	    EXPECT_NUMBER(q, n);
+	    if (*q++ == 'p') {
+		if (sv) {			/* SVf */
+		    if (n) {
+			precis = n;
+			has_precis = TRUE;
+		    }
+		    argsv = va_arg(*args, SV*);
+		    eptr = SvPVx_const(argsv, elen);
+		    if (DO_UTF8(argsv))
+			is_utf8 = TRUE;
+		    goto string;
+		}
+#if vdNUMBER
+		else if (n == vdNUMBER) {	/* VDf */
+		    vectorize = TRUE;
+		    VECTORIZE_ARGS
+		    goto format_vd;
+	  	}
+#endif
+		else if (n) {
+		    if (ckWARN_d(WARN_INTERNAL))
+			Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
+			"internal %%<num>p might conflict with future printf extensions");
+		}
+	    }
+	    q = r; 
+	}
+
 	if (EXPECT_NUMBER(q, width)) {
 	    if (*q == '$') {
 		++q;
@@ -9068,9 +9123,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		    is_utf8 = TRUE;
 	    }
 	    if (args) {
-		vecsv = va_arg(*args, SV*);
-		vecstr = (U8*)SvPV_const(vecsv,veclen);
-		vec_utf8 = DO_UTF8(vecsv);
+		VECTORIZE_ARGS
 	    }
 	    else if (efix ? efix <= svmax : svix < svmax) {
 		vecsv = svargs[efix ? efix-1 : svix++];
@@ -9254,21 +9307,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    /* INTEGERS */
 
 	case 'p':
-	    if (left && args) {		/* SVf */
-		left = FALSE;
-		if (width) {
-		    precis = width;
-		    has_precis = TRUE;
-		    width = 0;
-		}
-		if (vectorize)
-		    goto unknown;
-		argsv = va_arg(*args, SV*);
-		eptr = SvPVx_const(argsv, elen);
-		if (DO_UTF8(argsv))
-		    is_utf8 = TRUE;
-		goto string;
-	    }
 	    if (alt || vectorize)
 		goto unknown;
 	    uv = PTR2UV(args ? va_arg(*args, void*) : argsv);
@@ -9284,6 +9322,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    /* FALL THROUGH */
 	case 'd':
 	case 'i':
+#if vdNUMBER
+	format_vd:
+#endif
 	    if (vectorize) {
 		STRLEN ulen;
 		if (!veclen)
diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index 4eeacea507..2045c19b76 100755
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -371,6 +371,7 @@ __END__
 >%1$1$d<	>12<	>%1$1$d INVALID<
 >%*2$*2$d<	>[12, 3]<	>%*2$*2$d INVALID<
 >%*2*2$d<	>[12, 3]<	>%*2*2$d INVALID<
+>%*2$1d<	>[12, 3]<	>%*2$1d INVALID<
 >%0v2.2d<	>''<	><
 >%vc,%d<	>[63, 64, 65]<	>?,64<
 >%vd,%d<	>[1, 2, 3]<	>49,2<
@@ -386,4 +387,3 @@ __END__
 >%4$K %d<	>[45, 67]<	>%4$K 45 INVALID<
 >%d %K %d<	>[23, 45]<	>23 %K 45 INVALID<
 >%*v*999\$d %d %d<	>[11, 22, 33]<	>%*v*999\$d 11 22 INVALID<
->%*2$1d<	>[12, 3]<	>%*2$1d INVALID<