diff options
| -rw-r--r-- | perl.h | 42 | ||||
| -rw-r--r-- | sv.c | 99 | ||||
| -rwxr-xr-x | t/op/sprintf.t | 2 |
3 files changed, 104 insertions, 39 deletions
@@ -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 @@ -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< |