From: Gurusamy Sarathy <gsar@cpan.org>
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<perlport> 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<v1.2.3.4> 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<require> and C<use>. The C<$^V> variable
-contains the running Perl interpreter's version in this format.
-See L<perlvar/$^V>.
+A literal of the form C<v1.20.300.4000> 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<cmp>, C<gt>, C<lt> etc.
+
+Such "version tuples" or "vectors" are accepted by both C<require> and
+C<use>. The C<$^V> variable contains the running Perl interpreter's
+version in this format. See L<perlvar/$^V>.
=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);