diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | perl.c | 4 | ||||
| -rw-r--r-- | pod/perldiag.pod | 6 | ||||
| -rw-r--r-- | pod/perlfunc.pod | 4 | ||||
| -rw-r--r-- | pod/perlop.pod | 17 | ||||
| -rw-r--r-- | sv.c | 54 | ||||
| -rwxr-xr-x | t/op/ver.t | 33 | ||||
| -rw-r--r-- | toke.c | 6 |
8 files changed, 114 insertions, 11 deletions
@@ -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 @@ -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 b7e115fb71..7891bc2ad3 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 fa8504ed38..c9efcd1231 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 150813e711..d932704666 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 @@ -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 0000000000..e05264682c --- /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; +} @@ -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); |