RE: blead: no longer supports %vd format

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

p4raw-id: //depot/perl@25171

diff --git a/perl.h b/perl.h
index b573c71..dbe2b3d 100644 (file)
--- 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 d041b7b..74ed663 100644 (file)
--- 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 4eeacea..2045c19 100755 (executable)
--- 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<