From eb3fce905f8436bbc374998ec8c7c34ce2b73e4e Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Sun, 22 Oct 2000 20:59:35 +0000 Subject: [PATCH] Support s?printf parameter reordering. p4raw-id: //depot/perl@7402 --- pod/perldelta.pod | 5 +++++ pod/perlfunc.pod | 28 ++++++++++++++++++----- sv.c | 67 ++++++++++++++++++++++++++++++++++++++++--------------- t/op/sprintf.t | 13 +++++++++++ 4 files changed, 90 insertions(+), 23 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index ba94081..95dd6c5 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -131,6 +131,11 @@ C can now be used to force a string to UTF8. =item * +The printf and sprintf now support parameter reordering using the +C<%\d+\$> and C<*\d+\$> syntaxes. + +=item * + prototype(\&) is now available. =item * diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index db90b86..31fa5dc 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -4478,13 +4478,31 @@ and the conversion letter: h interpret integer as C type "short" or "unsigned short" If no flags, interpret integer as C type "int" or "unsigned" +Perl supports parameter ordering, in other words, fetching the +parameters in some explicitly specified "random" ordering as opposed +to the default implicit sequential ordering. The syntax is, instead +of the C<%> and C<*>, to use C<%>IC<$> and C<*>IC<$>, +where the I is the wanted index, from one upwards. For example: + + printf "%2\$d %1\$d\n", 12, 34; # will print "34 12\n" + printf "%*2\$d\n", 12, 3; # will print " 12\n" + +Note that using the reordering syntax does not interfere with the usual +implicit sequential fetching of the parameters: + + printf "%2\$d %d\n", 12, 34; # will print "34 12\n" + printf "%2\$d %d %d\n", 12, 34; # will print "34 12 34\n" + printf "%3\$d %d %d\n", 12, 34, 56; # will print "56 12 34\n" + printf "%2\$*3\$d %d\n", 12, 34, 3; # will print " 34 12\n" + printf "%*3\$2\$d %d\n", 12, 34, 3; # will print " 34 12\n" + There are also two Perl-specific flags: - V interpret integer as Perl's standard integer type - v interpret string as a vector of integers, output as - numbers separated either by dots, or by an arbitrary - string received from the argument list when the flag - is preceded by C<*> + V interpret integer as Perl's standard integer type + v interpret string as a vector of integers, output as + numbers separated either by dots, or by an arbitrary + string received from the argument list when the flag + is preceded by C<*> Where a number would appear in the flags, an asterisk (C<*>) may be used instead, in which case Perl uses the next item in the parameter diff --git a/sv.c b/sv.c index 148c762..1fac162 100644 --- a/sv.c +++ b/sv.c @@ -6054,7 +6054,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV bool has_precis = FALSE; STRLEN precis = 0; bool is_utf = FALSE; - + char esignbuf[4]; U8 utf8buf[UTF8_MAXLEN]; STRLEN esignlen = 0; @@ -6082,6 +6082,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV STRLEN gap; char *dotstr = "."; STRLEN dotstrlen = 1; + I32 epix = 0; /* explicit parameter index */ + I32 ewix = 0; /* explicit width index */ + bool asterisk = FALSE; for (q = p; q < patend && *q != '%'; ++q) ; if (q > p) { @@ -6142,6 +6145,15 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV /* WIDTH */ + scanwidth: + + if (*q == '*') { + if (asterisk) + goto unknown; + asterisk = TRUE; + q++; + } + switch (*q) { case '1': case '2': case '3': case '4': case '5': case '6': @@ -6149,17 +6161,30 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV width = 0; while (isDIGIT(*q)) width = width * 10 + (*q++ - '0'); - break; + if (*q == '$') { + if (asterisk && ewix == 0) { + ewix = width; + width = 0; + q++; + goto scanwidth; + } else if (epix == 0) { + epix = width; + width = 0; + q++; + goto scanwidth; + } else + goto unknown; + } + } - case '*': + if (asterisk) { if (args) i = va_arg(*args, int); else - i = (svix < svmax) ? SvIVx(svargs[svix++]) : 0; + i = (ewix ? ewix <= svmax : svix < svmax) ? + SvIVx(svargs[ewix ? ewix-1 : svix++]) : 0; left |= (i < 0); width = (i < 0) ? -i : i; - q++; - break; } /* PRECISION */ @@ -6170,7 +6195,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV if (args) i = va_arg(*args, int); else - i = (svix < svmax) ? SvIVx(svargs[svix++]) : 0; + i = (ewix ? ewix <= svmax : svix < svmax) + ? SvIVx(svargs[ewix ? ewix-1 : svix++]) : 0; precis = (i < 0) ? 0 : i; q++; } @@ -6188,8 +6214,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV vecstr = (U8*)SvPVx(vecsv,veclen); utf = DO_UTF8(vecsv); } - else if (svix < svmax) { - vecsv = svargs[svix++]; + else if (epix ? epix <= svmax : svix < svmax) { + vecsv = svargs[epix ? epix-1 : svix++]; vecstr = (U8*)SvPVx(vecsv,veclen); utf = DO_UTF8(vecsv); } @@ -6243,7 +6269,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV if (args) uv = va_arg(*args, int); else - uv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0; + uv = (epix ? epix <= svmax : svix < svmax) ? + SvIVx(svargs[epix ? epix-1 : svix++]) : 0; if ((uv > 255 || (uv > 127 && SvUTF8(sv))) && !IN_BYTE) { eptr = (char*)utf8buf; elen = uv_to_utf8((U8*)eptr, uv) - utf8buf; @@ -6272,8 +6299,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV elen = sizeof nullstr - 1; } } - else if (svix < svmax) { - argsv = svargs[svix++]; + else if (epix ? epix <= svmax : svix < svmax) { + argsv = svargs[epix ? epix-1 : svix++]; eptr = SvPVx(argsv, elen); if (DO_UTF8(argsv)) { if (has_precis && precis < elen) { @@ -6316,7 +6343,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV if (args) uv = PTR2UV(va_arg(*args, void*)); else - uv = (svix < svmax) ? PTR2UV(svargs[svix++]) : 0; + uv = (epix ? epix <= svmax : svix < svmax) ? + PTR2UV(svargs[epix ? epix-1 : svix++]) : 0; base = 16; goto integer; @@ -6356,7 +6384,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV } } else { - iv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0; + iv = (epix ? epix <= svmax : svix < svmax) ? + SvIVx(svargs[epix ? epix-1 : svix++]) : 0; switch (intsize) { case 'h': iv = (short)iv; break; default: break; @@ -6438,7 +6467,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV } } else { - uv = (svix < svmax) ? SvUVx(svargs[svix++]) : 0; + uv = (epix ? epix <= svmax : svix < svmax) ? + SvUVx(svargs[epix ? epix-1 : svix++]) : 0; switch (intsize) { case 'h': uv = (unsigned short)uv; break; default: break; @@ -6530,7 +6560,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV if (args) nv = va_arg(*args, NV); else - nv = (svix < svmax) ? SvNVx(svargs[svix++]) : 0.0; + nv = (epix ? epix <= svmax : svix < svmax) ? + SvNVx(svargs[epix ? epix-1 : svix++]) : 0.0; need = 0; if (c != 'e' && c != 'E') { @@ -6615,8 +6646,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV #endif } } - else if (svix < svmax) - sv_setuv_mg(svargs[svix++], (UV)i); + else if (epix ? epix <= svmax : svix < svmax) + sv_setuv_mg(svargs[epix ? epix-1 : svix++], (UV)i); continue; /* not "break" */ /* UNKNOWN */ diff --git a/t/op/sprintf.t b/t/op/sprintf.t index 2f6cd27..97b66a5 100755 --- a/t/op/sprintf.t +++ b/t/op/sprintf.t @@ -308,3 +308,16 @@ __END__ >%0*x< >[-10, ,2**32-1]< >ffffffff < >%y< >''< >%y INVALID< >%z< >''< >%z INVALID< +>%2$d %1$d< >[12, 34]< >34 12< +>%*2$d< >[12, 3]< > 12< +>%2$d %d< >[12, 34]< >34 12< +>%2$d %d %d< >[12, 34]< >34 12 34< +>%3$d %d %d< >[12, 34, 56]< >56 12 34< +>%2$*3$d %d< >[12, 34, 3]< > 34 12< +>%*3$2$d %d< >[12, 34, 3]< > 34 12< +>%2$d< >12< >0< +>%0$d< >12< >%0$d INVALID< +>%1$$d< >12< >%1$$d INVALID< +>%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.7.4