From: Gurusamy Sarathy Date: Sun, 6 Feb 2000 13:56:45 +0000 (+0000) Subject: support sprintf("v%v", v1.2.3) (works on any string argument, in X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3cb0bbe5af1ac1b0e46bbee66b7b457629e7ffa3;p=p5sagit%2Fp5-mst-13.2.git support sprintf("v%v", v1.2.3) (works on any string argument, in fact); add tests for version tuples p4raw-id: //depot/perl@4998 --- diff --git a/MANIFEST b/MANIFEST index 4753599..c3bbfee 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1388,6 +1388,7 @@ t/op/undef.t See if undef works t/op/universal.t See if UNIVERSAL class works t/op/unshift.t See if unshift works t/op/vec.t See if vectors work +t/op/ver.t See if version tuples work t/op/wantarray.t See if wantarray works t/op/write.t See if write works t/pod/emptycmd.t Test empty pod directives diff --git a/perl.c b/perl.c index 3153f59..186b85c 100644 --- a/perl.c +++ b/perl.c @@ -2028,8 +2028,8 @@ Perl_moreswitches(pTHX_ char *s) s++; return s; case 'v': - printf("\nThis is perl, v%"UVuf".%"UVuf".%"UVuf" built for %s", - (UV)PERL_REVISION, (UV)PERL_VERSION, (UV)PERL_SUBVERSION, ARCHNAME); + printf(Perl_form(aTHX_ "\nThis is perl, v%v built for %s", + PL_patchlevel, ARCHNAME)); #if defined(LOCAL_PATCH_COUNT) if (LOCAL_PATCH_COUNT > 0) printf("\n(with %d registered patch%s, see perl -V for more detail)", diff --git a/pod/perldiag.pod b/pod/perldiag.pod index b7e115f..7891bc2 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2170,6 +2170,12 @@ on portability concerns. See also L for writing portable code. +=item Octal number in vector unsupported + +(F) Numbers with a leading C<0> are not currently allowed in vectors. The +octal number interpretation of such numbers may be supported in a future +version. + =item Odd number of elements in hash assignment (W) You specified an odd number of elements to initialize a hash, which diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index fa8504e..c9efcd1 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -4310,6 +4310,10 @@ In addition, Perl permits the following widely-supported conversions: %n special: *stores* the number of characters output so far into the next variable in the parameter list +And the following Perl-specific conversion: + + %v a string, output as a tuple of integers ("Perl" is 80.101.114.108) + Finally, for backward (and we do mean "backward") compatibility, Perl permits these unnecessary but widely-supported conversions: diff --git a/pod/perlop.pod b/pod/perlop.pod index 150813e..d932704 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -1804,14 +1804,15 @@ in a bit vector. =head2 Version tuples -A version number of the form C is parsed as a dual-valued literal. -It has the string value of C<"\x{1}\x{2}\x{3}\x{4}"> (i.e., a utf8 string) -and a numeric value of C<1 + 2/1000 + 3/1000000 + 4/1000000000>. This is -useful for representing and comparing version numbers. - -Version tuples are accepted by both C and C. The C<$^V> variable -contains the running Perl interpreter's version in this format. -See L. +A literal of the form C is parsed as a dual-valued quantity. +It has the string value of C<"\x{1}\x{14}\x{12c}\x{fa0}"> (i.e., a UTF-8 +string) and a numeric value of C<1 + 20/1000 + 300/1000000 + 4000/1000000000>. +This is useful for representing Unicode strings, and for comparing version +numbers using the string comparison operators, C, C, C etc. + +Such "version tuples" or "vectors" are accepted by both C and +C. The C<$^V> variable contains the running Perl interpreter's +version in this format. See L. =head2 Integer Arithmetic diff --git a/sv.c b/sv.c index 94fbced..586c0dd 100644 --- a/sv.c +++ b/sv.c @@ -5875,6 +5875,60 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV } goto string; + case 'v': + if (args) + argsv = va_arg(*args, SV*); + else if (svix < svmax) + argsv = svargs[svix++]; + { + STRLEN len; + U8 *str = (U8*)SvPVx(argsv,len); + I32 vlen = len*3; + SV *vsv = NEWSV(73,vlen); + I32 ulen; + U8 *vptr = (U8*)SvPVX(vsv); + STRLEN vcur = 0; + bool utf = DO_UTF8(argsv); + + if (utf) + is_utf = TRUE; + while (len) { + UV uv; + + if (utf) + uv = utf8_to_uv(str, &ulen); + else { + uv = *str; + ulen = 1; + } + str += ulen; + len -= ulen; + eptr = ebuf + sizeof ebuf; + if (elen >= vlen-1) { + STRLEN off = vptr - (U8*)SvPVX(vsv); + vlen *= 2; + SvGROW(vsv, vlen); + vptr = SvPVX(vsv) + off; + } + do { + *--eptr = '0' + uv % 10; + } while (uv /= 10); + elen = (ebuf + sizeof ebuf) - eptr; + memcpy(vptr, eptr, elen); + vptr += elen; + *vptr++ = '.'; + vcur += elen + 1; + } + if (vcur) { + vcur--; + vptr[-1] = '\0'; + } + SvCUR_set(vsv,vcur); + eptr = SvPVX(vsv); + elen = vcur; + } + goto string; + case '_': /* * The "%_" hack might have to be changed someday, diff --git a/t/op/ver.t b/t/op/ver.t new file mode 100755 index 0000000..e052646 --- /dev/null +++ b/t/op/ver.t @@ -0,0 +1,33 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + unshift @INC, "../lib"; +} + +print "1..6\n"; + +my $test = 1; + +use v5.5.640; +require v5.5.640; +print "ok $test\n"; ++$test; + +print "not " unless v1.20.300.4000 eq "\x{1}\x{14}\x{12c}\x{fa0}"; +print "ok $test\n"; ++$test; + +print "not " unless v1.20.300.4000 > 1.0203039 and v1.20.300.4000 < 1.0203041; +print "ok $test\n"; ++$test; + +print "not " unless sprintf("%v", "Perl") eq '80.101.114.108'; +print "ok $test\n"; ++$test; + +print "not " unless sprintf("%v", v1.22.333.4444) eq '1.22.333.4444'; +print "ok $test\n"; ++$test; + +{ + use byte; + print "not " unless + sprintf("%v", v1.22.333.4444) eq '1.22.197.141.225.133.156'; + print "ok $test\n"; ++$test; +} diff --git a/toke.c b/toke.c index 55ffda3..22db523 100644 --- a/toke.c +++ b/toke.c @@ -1675,7 +1675,7 @@ S_intuit_more(pTHX_ register char *s) * Not a method if it's really "print foo $bar" * Method if it's really "foo package::" (interpreted as package->foo) * Not a method if bar is known to be a subroutne ("sub bar; foo bar") - * Not a method if bar is a filehandle or package, but is quotd with + * Not a method if bar is a filehandle or package, but is quoted with * => */ @@ -6894,6 +6894,8 @@ Perl_scan_num(pTHX_ char *start) sv_setpvn(sv, "", 0); do { + if (*s == '0' && isDIGIT(s[1])) + yyerror("Octal number in vector unsupported"); rev = atoi(s); s = ++pos; while (isDIGIT(*pos)) @@ -6907,6 +6909,8 @@ Perl_scan_num(pTHX_ char *start) nshift *= 1000; } while (*pos == '.' && isDIGIT(pos[1])); + if (*s == '0' && isDIGIT(s[1])) + yyerror("Octal number in vector unsupported"); rev = atoi(s); s = pos; tmpend = uv_to_utf8(tmpbuf, rev);