summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xconfigpm4
-rw-r--r--embedvar.h4
-rw-r--r--gv.c6
-rw-r--r--intrpvar.h3
-rw-r--r--objXSUB.h2
-rw-r--r--patchlevel.h4
-rw-r--r--perl.c69
-rw-r--r--perl.h7
-rw-r--r--pp_ctl.c52
-rw-r--r--sv.c5
-rw-r--r--sv.h6
-rwxr-xr-xt/comp/require.t52
-rw-r--r--toke.c107
13 files changed, 242 insertions, 79 deletions
diff --git a/configpm b/configpm
index 8c53dbb724..f57ef0b9e2 100755
--- a/configpm
+++ b/configpm
@@ -17,7 +17,7 @@ my $glossary = $ARGV[1] || 'Porting/Glossary';
open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
-$myver = $];
+$myver = 0+$];
print CONFIG <<'ENDOFBEG_NOQ', <<"ENDOFBEG";
package Config;
@@ -39,7 +39,7 @@ sub import {
ENDOFBEG_NOQ
\$] == $myver
- or die "Perl lib version ($myver) doesn't match executable version (\$])";
+ or die "Perl lib version ($myver) doesn't match executable version (" . 0+\$] . ")";
# This file was created by configpm when Perl was built. Any changes
# made to this file will be lost the next time perl is built.
diff --git a/embedvar.h b/embedvar.h
index 6611921e50..837c0308cf 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -191,7 +191,6 @@
#define PL_StdIO (PERL_GET_INTERP->IStdIO)
#define PL_amagic_generation (PERL_GET_INTERP->Iamagic_generation)
#define PL_an (PERL_GET_INTERP->Ian)
-#define PL_archpat_auto (PERL_GET_INTERP->Iarchpat_auto)
#define PL_argvgv (PERL_GET_INTERP->Iargvgv)
#define PL_argvout_stack (PERL_GET_INTERP->Iargvout_stack)
#define PL_argvoutgv (PERL_GET_INTERP->Iargvoutgv)
@@ -456,7 +455,6 @@
#define PL_StdIO (vTHX->IStdIO)
#define PL_amagic_generation (vTHX->Iamagic_generation)
#define PL_an (vTHX->Ian)
-#define PL_archpat_auto (vTHX->Iarchpat_auto)
#define PL_argvgv (vTHX->Iargvgv)
#define PL_argvout_stack (vTHX->Iargvout_stack)
#define PL_argvoutgv (vTHX->Iargvoutgv)
@@ -858,7 +856,6 @@
#define PL_StdIO (aTHXo->interp.IStdIO)
#define PL_amagic_generation (aTHXo->interp.Iamagic_generation)
#define PL_an (aTHXo->interp.Ian)
-#define PL_archpat_auto (aTHXo->interp.Iarchpat_auto)
#define PL_argvgv (aTHXo->interp.Iargvgv)
#define PL_argvout_stack (aTHXo->interp.Iargvout_stack)
#define PL_argvoutgv (aTHXo->interp.Iargvoutgv)
@@ -1124,7 +1121,6 @@
#define PL_IStdIO PL_StdIO
#define PL_Iamagic_generation PL_amagic_generation
#define PL_Ian PL_an
-#define PL_Iarchpat_auto PL_archpat_auto
#define PL_Iargvgv PL_argvgv
#define PL_Iargvout_stack PL_argvout_stack
#define PL_Iargvoutgv PL_argvoutgv
diff --git a/gv.c b/gv.c
index e1e4ae081c..e2c63497ce 100644
--- a/gv.c
+++ b/gv.c
@@ -812,10 +812,8 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
case ']':
if (len == 1) {
SV *sv = GvSV(gv);
- (void)SvUPGRADE(sv, SVt_PVNV);
- sv_setpv(sv, PL_patchlevel);
- (void)sv_2nv(sv);
- SvREADONLY_on(sv);
+ GvSV(gv) = SvREFCNT_inc(PL_patchlevel);
+ SvREFCNT_dec(sv);
}
break;
}
diff --git a/intrpvar.h b/intrpvar.h
index 3e2c563e73..606a892374 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -25,7 +25,7 @@ PERLVAR(Iwarnhook, SV *)
/* switches */
PERLVAR(Iminus_c, bool)
-PERLVARA(Ipatchlevel,10,char)
+PERLVAR(Ipatchlevel, SV *)
PERLVAR(Ilocalpatches, char **)
PERLVARI(Isplitstr, char *, " ")
PERLVAR(Ipreprocess, bool)
@@ -170,7 +170,6 @@ PERLVAR(Isys_intern, struct interp_intern)
/* more statics moved here */
PERLVARI(Igeneration, int, 100) /* from op.c */
PERLVAR(IDBcv, CV *) /* from perl.c */
-PERLVAR(Iarchpat_auto, char*) /* from perl.c */
PERLVARI(Iin_clean_objs,bool, FALSE) /* from sv.c */
PERLVARI(Iin_clean_all, bool, FALSE) /* from sv.c */
diff --git a/objXSUB.h b/objXSUB.h
index 3e07876d4d..36c9f7c432 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -48,8 +48,6 @@
#define PL_amagic_generation (*Perl_Iamagic_generation_ptr(aTHXo))
#undef PL_an
#define PL_an (*Perl_Ian_ptr(aTHXo))
-#undef PL_archpat_auto
-#define PL_archpat_auto (*Perl_Iarchpat_auto_ptr(aTHXo))
#undef PL_argvgv
#define PL_argvgv (*Perl_Iargvgv_ptr(aTHXo))
#undef PL_argvout_stack
diff --git a/patchlevel.h b/patchlevel.h
index 51222176a0..d0fa32d768 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -5,7 +5,7 @@
#define PERL_REVISION 5 /* age */
#define PERL_VERSION 5 /* epoch */
-#define PERL_SUBVERSION 63 /* generation */
+#define PERL_SUBVERSION 640 /* generation */
/* Compatibility across versions: MakeMaker will install add-on
modules in a directory with the PERL_APIVERSION version number.
@@ -18,7 +18,7 @@
See INSTALL for how this works.
*/
-#define PERL_APIVERSION 5.00563 /* Adjust manually as needed. */
+#define PERL_APIVERSION 5.00564 /* Adjust manually as needed. */
#define __PATCHLEVEL_H_INCLUDED__
#endif
diff --git a/perl.c b/perl.c
index a2351223ee..9af4a6071a 100644
--- a/perl.c
+++ b/perl.c
@@ -204,14 +204,29 @@ perl_construct(pTHXx)
init_i18nl10n(1);
SET_NUMERIC_STANDARD();
+ {
+ U8 *s;
+ PL_patchlevel = NEWSV(0,4);
+ SvUPGRADE(PL_patchlevel, SVt_PVNV);
+ if (PERL_REVISION > 127 || PERL_VERSION > 127 || PERL_SUBVERSION > 127)
+ SvGROW(PL_patchlevel,24);
+ s = (U8*)SvPVX(PL_patchlevel);
+ s = uv_to_utf8(s, (UV)PERL_REVISION);
+ s = uv_to_utf8(s, (UV)PERL_VERSION);
+ s = uv_to_utf8(s, (UV)PERL_SUBVERSION);
+ *s = '\0';
+ SvCUR_set(PL_patchlevel, s - (U8*)SvPVX(PL_patchlevel));
+ SvPOK_on(PL_patchlevel);
+ SvNVX(PL_patchlevel) = (NV)PERL_REVISION
+ + ((NV)PERL_VERSION / (NV)1000)
#if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0
- sprintf(PL_patchlevel, "%7.5f", (double) PERL_REVISION
- + ((double) PERL_VERSION / (double) 1000)
- + ((double) PERL_SUBVERSION / (double) 100000));
-#else
- sprintf(PL_patchlevel, "%5.3f", (double) PERL_REVISION +
- ((double) PERL_VERSION / (double) 1000));
+ + ((NV)PERL_SUBVERSION / (NV)1000000)
#endif
+ ;
+ SvNOK_on(PL_patchlevel); /* dual valued */
+ SvUTF8_on(PL_patchlevel);
+ SvREADONLY_on(PL_patchlevel);
+ }
#if defined(LOCAL_PATCH_COUNT)
PL_localpatches = local_patches; /* For possible -v */
@@ -394,6 +409,7 @@ perl_destruct(pTHXx)
Safefree(PL_inplace);
PL_inplace = Nullch;
+ SvREFCNT_dec(PL_patchlevel);
if (PL_e_script) {
SvREFCNT_dec(PL_e_script);
@@ -599,7 +615,6 @@ perl_destruct(pTHXx)
/* No SVs have survived, need to clean out */
Safefree(PL_origfilename);
- Safefree(PL_archpat_auto);
Safefree(PL_reg_start_tmp);
if (PL_reg_curpm)
Safefree(PL_reg_curpm);
@@ -1841,13 +1856,8 @@ Perl_moreswitches(pTHX_ char *s)
s++;
return s;
case 'v':
-#if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0
- printf("\nThis is perl, version %d.%03d_%02d built for %s",
- PERL_REVISION, PERL_VERSION, PERL_SUBVERSION, ARCHNAME);
-#else
- printf("\nThis is perl, version %s built for %s",
- PL_patchlevel, ARCHNAME);
-#endif
+ printf("\nThis is perl, v%"UVuf".%"UVuf".%"UVuf" built for %s",
+ (UV)PERL_REVISION, (UV)PERL_VERSION, (UV)PERL_SUBVERSION, ARCHNAME);
#if defined(LOCAL_PATCH_COUNT)
if (LOCAL_PATCH_COUNT > 0)
printf("\n(with %d registered patch%s, see perl -V for more detail)",
@@ -2243,7 +2253,9 @@ sed %s -e \"/^[^#]/b\" \
PL_statbuf.st_mode & (S_ISUID|S_ISGID))
{
/* try again */
- PerlProc_execv(Perl_form(aTHX_ "%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv);
+ PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP,
+ (UV)PERL_REVISION, (UV)PERL_VERSION,
+ (UV)PERL_SUBVERSION), PL_origargv);
Perl_croak(aTHX_ "Can't do setuid\n");
}
#endif
@@ -2490,7 +2502,9 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
(void)PerlIO_close(PL_rsfp);
#ifndef IAMSUID
/* try again */
- PerlProc_execv(Perl_form(aTHX_ "%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv);
+ PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP,
+ (UV)PERL_REVISION, (UV)PERL_VERSION,
+ (UV)PERL_SUBVERSION), PL_origargv);
#endif
Perl_croak(aTHX_ "Can't do setuid\n");
}
@@ -2572,7 +2586,9 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
#if defined(HAS_FCNTL) && defined(F_SETFD)
fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0); /* ensure no close-on-exec */
#endif
- PerlProc_execv(Perl_form(aTHX_ "%s/perl%s", BIN_EXP, PL_patchlevel), PL_origargv);/* try again */
+ PerlProc_execv(Perl_form(aTHX_ "%s/perl"PERL_FS_VER_FMT, BIN_EXP,
+ (UV)PERL_REVISION, (UV)PERL_VERSION,
+ (UV)PERL_SUBVERSION), PL_origargv);/* try again */
Perl_croak(aTHX_ "Can't do setuid\n");
#endif /* IAMSUID */
#else /* !DOSUID */
@@ -2969,17 +2985,6 @@ S_incpush(pTHX_ char *p, int addsubdirs)
if (addsubdirs) {
subdir = sv_newmortal();
- if (!PL_archpat_auto) {
- STRLEN len = (sizeof(ARCHNAME) + strlen(PL_patchlevel)
- + sizeof("//auto"));
- New(55, PL_archpat_auto, len, char);
- sprintf(PL_archpat_auto, "/%s/%s/auto", ARCHNAME, PL_patchlevel);
-#ifdef VMS
- for (len = sizeof(ARCHNAME) + 2;
- PL_archpat_auto[len] != '\0' && PL_archpat_auto[len] != '/'; len++)
- if (PL_archpat_auto[len] == '.') PL_archpat_auto[len] = '_';
-#endif
- }
}
/* Break at all separators */
@@ -3025,16 +3030,16 @@ S_incpush(pTHX_ char *p, int addsubdirs)
SvPV(libdir,len));
#endif
/* .../archname/version if -d .../archname/version/auto */
- sv_setsv(subdir, libdir);
- sv_catpv(subdir, PL_archpat_auto);
+ Perl_sv_setpvf(aTHX_ subdir, "%_/%s/"PERL_FS_VER_FMT"/auto", libdir,
+ ARCHNAME, (UV)PERL_REVISION,
+ (UV)PERL_VERSION, (UV)PERL_SUBVERSION);
if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode))
av_push(GvAVn(PL_incgv),
newSVpvn(SvPVX(subdir), SvCUR(subdir) - sizeof "auto"));
/* .../archname if -d .../archname/auto */
- sv_insert(subdir, SvCUR(libdir) + sizeof(ARCHNAME),
- strlen(PL_patchlevel) + 1, "", 0);
+ Perl_sv_setpvf(aTHX_ subdir, "%_/%s/auto", libdir, ARCHNAME);
if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode))
av_push(GvAVn(PL_incgv),
diff --git a/perl.h b/perl.h
index a1f97c9a80..626e413de5 100644
--- a/perl.h
+++ b/perl.h
@@ -1596,7 +1596,12 @@ typedef pthread_key_t perl_key;
#define PERL_EXIT_EXPECTED 0x01
#ifndef MEMBER_TO_FPTR
-#define MEMBER_TO_FPTR(name) name
+# define MEMBER_TO_FPTR(name) name
+#endif
+
+/* format to use for version numbers in file/directory names */
+#ifndef PERL_FS_VER_FMT
+# define PERL_FS_VER_FMT "%"UVuf".%"UVuf".%"UVuf
#endif
/* This defines a way to flush all output buffers. This may be a
diff --git a/pp_ctl.c b/pp_ctl.c
index f5a016fcdc..c028b4eca5 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2834,10 +2834,54 @@ PP(pp_require)
SV *filter_sub = 0;
sv = POPs;
- if (SvNIOKp(sv) && !SvPOKp(sv)) {
- if (Atof(PL_patchlevel) + 0.00000999 < SvNV(sv))
- DIE(aTHX_ "Perl %s required--this is only version %s, stopped",
- SvPV(sv,n_a),PL_patchlevel);
+ if (SvNIOKp(sv)) {
+ UV rev, ver, sver;
+ if (SvPOKp(sv) && SvUTF8(sv)) { /* require v5.6.1 */
+ I32 len;
+ U8 *s = (U8*)SvPVX(sv);
+ U8 *end = (U8*)SvPVX(sv) + SvCUR(sv);
+ if (s < end) {
+ rev = utf8_to_uv(s, &len);
+ s += len;
+ if (s < end) {
+ ver = utf8_to_uv(s, &len);
+ s += len;
+ if (s < end)
+ sver = utf8_to_uv(s, &len);
+ else
+ sver = 0;
+ }
+ else
+ ver = 0;
+ }
+ else
+ rev = 0;
+ if (PERL_REVISION < rev
+ || (PERL_REVISION == rev
+ && (PERL_VERSION < ver
+ || (PERL_VERSION == ver
+ && PERL_SUBVERSION < sver))))
+ {
+ DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--this is only version "
+ "v%"UVuf".%"UVuf".%"UVuf", stopped", rev, ver, sver, PERL_REVISION,
+ PERL_VERSION, PERL_SUBVERSION);
+ }
+ }
+ else if (!SvPOKp(sv)) { /* require 5.005_03 */
+ NV n = SvNV(sv);
+ rev = (UV)n;
+ ver = (UV)((n-rev)*1000);
+ sver = (UV)((((n-rev)*1000 - ver) + 0.0009) * 1000);
+
+ if ((NV)PERL_REVISION + ((NV)PERL_VERSION/(NV)1000)
+ + ((NV)PERL_SUBVERSION/(NV)1000000)
+ + 0.00000099 < SvNV(sv))
+ {
+ DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--this is only version "
+ "v%"UVuf".%"UVuf".%"UVuf", stopped", rev, ver, sver, PERL_REVISION,
+ PERL_VERSION, PERL_SUBVERSION);
+ }
+ }
RETPUSHYES;
}
name = SvPV(sv, len);
diff --git a/sv.c b/sv.c
index 7fa451455c..36f88c7e6f 100644
--- a/sv.c
+++ b/sv.c
@@ -2655,6 +2655,8 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
*SvEND(dstr) = '\0';
(void)SvPOK_only(dstr);
}
+ if (SvUTF8(sstr))
+ SvUTF8_on(dstr);
/*SUPPRESS 560*/
if (sflags & SVp_NOK) {
SvNOK_on(dstr);
@@ -6710,7 +6712,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
/* switches */
PL_minus_c = proto_perl->Iminus_c;
- Copy(proto_perl->Ipatchlevel, PL_patchlevel, 10, char);
+ PL_patchlevel = sv_dup_inc(proto_perl->Ipatchlevel);
PL_localpatches = proto_perl->Ilocalpatches;
PL_splitstr = proto_perl->Isplitstr;
PL_preprocess = proto_perl->Ipreprocess;
@@ -6850,7 +6852,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
/* more statics moved here */
PL_generation = proto_perl->Igeneration;
PL_DBcv = cv_dup(proto_perl->IDBcv);
- PL_archpat_auto = SAVEPV(proto_perl->Iarchpat_auto);
PL_in_clean_objs = proto_perl->Iin_clean_objs;
PL_in_clean_all = proto_perl->Iin_clean_all;
diff --git a/sv.h b/sv.h
index cefe13ced1..a16dcdd249 100644
--- a/sv.h
+++ b/sv.h
@@ -373,9 +373,9 @@ struct xpvio {
#define SvNOK_only(sv) (SvOK_off(sv), \
SvFLAGS(sv) |= (SVf_NOK|SVp_NOK))
-#define SvUTF8(sv) (SvFLAGS(sv) & SVf_ISUTF8)
-#define SvUTF8_on(sv) (SvFLAGS(sv) |= (SVf_ISUTF8))
-#define SvUTF8_off(sv) (SvFLAGS(sv) &= ~(SVf_ISUTF8))
+#define SvUTF8(sv) (SvFLAGS(sv) & SVf_UTF8)
+#define SvUTF8_on(sv) (SvFLAGS(sv) |= (SVf_UTF8))
+#define SvUTF8_off(sv) (SvFLAGS(sv) &= ~(SVf_UTF8))
#define SvPOK(sv) (SvFLAGS(sv) & SVf_POK)
#define SvPOK_on(sv) (SvFLAGS(sv) |= (SVf_POK|SVp_POK))
diff --git a/t/comp/require.t b/t/comp/require.t
index 581dcba75c..d4c9d8ca61 100755
--- a/t/comp/require.t
+++ b/t/comp/require.t
@@ -7,7 +7,7 @@ BEGIN {
# don't make this lexical
$i = 1;
-print "1..4\n";
+print "1..16\n";
sub do_require {
%INC = ();
@@ -23,6 +23,56 @@ sub write_file {
close REQ;
}
+# new style version numbers
+
+eval { require v5.5.630; };
+print "# $@\nnot " if $@;
+print "ok ",$i++,"\n";
+
+eval { require v10.0.2; };
+print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/;
+print "ok ",$i++,"\n";
+
+eval q{ use v5.5.630; };
+print "# $@\nnot " if $@;
+print "ok ",$i++,"\n";
+
+eval q{ use v10.0.2; };
+print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/;
+print "ok ",$i++,"\n";
+
+my $ver = v5.5.630;
+eval { require $ver; };
+print "# $@\nnot " if $@;
+print "ok ",$i++,"\n";
+
+$ver = v10.0.2;
+eval { require $ver; };
+print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/;
+print "ok ",$i++,"\n";
+
+print "not " unless v5.5.1 gt v5.5;
+print "ok ",$i++,"\n";
+
+print "not " unless 5.005_01 > v5.5;
+print "ok ",$i++,"\n";
+
+print "not " unless 5.005_64 - v5.5.640 < 0.0000001;
+print "ok ",$i++,"\n";
+
+{
+ use utf8;
+ print "not " unless v5.5.640 eq "\x{5}\x{5}\x{280}";
+ print "ok ",$i++,"\n";
+
+ print "not " unless v7.15 eq "\x{7}\x{f}";
+ print "ok ",$i++,"\n";
+
+ print "not "
+ unless v1.20.300.4000.50000.600000 eq "\x{1}\x{14}\x{12c}\x{fa0}\x{c350}\x{927c0}";
+ print "ok ",$i++,"\n";
+}
+
# interaction with pod (see the eof)
write_file('bleah.pm', "print 'ok $i\n'; 1;\n");
require "bleah.pm";
diff --git a/toke.c b/toke.c
index ff239a6743..8109c3e47a 100644
--- a/toke.c
+++ b/toke.c
@@ -803,13 +803,12 @@ S_force_version(pTHX_ char *s)
s = skipspace(s);
- /* default VERSION number -- GBARR */
-
- if(isDIGIT(*s)) {
- char *d;
- int c;
- for( d=s, c = 1; isDIGIT(*d) || *d == '_' || (*d == '.' && c--); d++);
- if((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') {
+ if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
+ char *d = s;
+ if (*d == 'v')
+ d++;
+ for (; isDIGIT(*d) || *d == '_' || *d == '.'; d++);
+ if ((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') {
s = scan_num(s);
/* real VERSION number -- GBARR */
version = yylval.opval;
@@ -3399,6 +3398,19 @@ Perl_yylex(pTHX)
no_op("Backslash",s);
OPERATOR(REFGEN);
+ case 'v':
+ if (isDIGIT(s[1]) && PL_expect == XTERM) {
+ char *start = s;
+ start++;
+ start++;
+ while (isDIGIT(*start))
+ start++;
+ if (*start == '.' && isDIGIT(start[1])) {
+ s = scan_num(s);
+ TERM(THING);
+ }
+ }
+ goto keylookup;
case 'x':
if (isDIGIT(s[1]) && PL_expect == XOPERATOR) {
s++;
@@ -3428,7 +3440,7 @@ Perl_yylex(pTHX)
case 's': case 'S':
case 't': case 'T':
case 'u': case 'U':
- case 'v': case 'V':
+ case 'V':
case 'w': case 'W':
case 'X':
case 'y': case 'Y':
@@ -4362,12 +4374,18 @@ Perl_yylex(pTHX)
OLDLOP(OP_RETURN);
case KEY_require:
- *PL_tokenbuf = '\0';
- s = force_word(s,WORD,TRUE,TRUE,FALSE);
- if (isIDFIRST_lazy(PL_tokenbuf))
- gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), TRUE);
- else if (*s == '<')
- yyerror("<> should be quotes");
+ s = skipspace(s);
+ if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
+ s = force_version(s);
+ }
+ else {
+ *PL_tokenbuf = '\0';
+ s = force_word(s,WORD,TRUE,TRUE,FALSE);
+ if (isIDFIRST_lazy(PL_tokenbuf))
+ gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), TRUE);
+ else if (*s == '<')
+ yyerror("<> should be quotes");
+ }
UNI(OP_REQUIRE);
case KEY_reset:
@@ -4729,9 +4747,9 @@ Perl_yylex(pTHX)
if (PL_expect != XSTATE)
yyerror("\"use\" not allowed in expression");
s = skipspace(s);
- if(isDIGIT(*s)) {
+ if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
s = force_version(s);
- if(*s == ';' || (s = skipspace(s), *s == ';')) {
+ if (*s == ';' || (s = skipspace(s), *s == ';')) {
PL_nextval[PL_nexttoke].opval = Nullop;
force_next(WORD);
}
@@ -6506,7 +6524,7 @@ Perl_scan_num(pTHX_ char *start)
register char *e; /* end of temp buffer */
IV tryiv; /* used to see if it can be an IV */
NV value; /* number read, as a double */
- SV *sv; /* place to put the converted number */
+ SV *sv = Nullsv; /* place to put the converted number */
bool floatit; /* boolean: int or float? */
char *lastub = 0; /* position of last underbar */
static char number_too_long[] = "Number too long";
@@ -6518,8 +6536,7 @@ Perl_scan_num(pTHX_ char *start)
Perl_croak(aTHX_ "panic: scan_num");
/* if it starts with a 0, it could be an octal number, a decimal in
- 0.13 disguise, or a hexadecimal number, or a binary number.
- */
+ 0.13 disguise, or a hexadecimal number, or a binary number. */
case '0':
{
/* variables:
@@ -6781,11 +6798,61 @@ Perl_scan_num(pTHX_ char *start)
(floatit ? "float" : "integer"),
sv, Nullsv, NULL);
break;
+ /* if it starts with a v, it could be a version number */
+ case 'v':
+ {
+ UV rev, ver, sver;
+ char *pos = s;
+ pos++;
+ while (isDIGIT(*pos))
+ pos++;
+ if (*pos == '.' && isDIGIT(pos[1])) {
+ U8 tmpbuf[10];
+ U8 *tmpend;
+ NV nshift = 1.0;
+ s++; /* get past 'v' */
+
+ sv = NEWSV(92,5);
+ SvUPGRADE(sv, SVt_PVNV);
+ sv_setpvn(sv, "", 0);
+
+ do {
+ rev = atoi(s);
+ s = ++pos;
+ while (isDIGIT(*pos))
+ pos++;
+
+ tmpend = uv_to_utf8(tmpbuf, rev);
+ *tmpend = '\0';
+ sv_catpvn(sv, tmpbuf, tmpend - tmpbuf);
+ if (rev > 0)
+ SvNVX(sv) += (NV)rev/nshift;
+ nshift *= 1000;
+ } while (*pos == '.' && isDIGIT(pos[1]));
+
+ rev = atoi(s);
+ s = pos;
+ tmpend = uv_to_utf8(tmpbuf, rev);
+ *tmpend = '\0';
+ sv_catpvn(sv, tmpbuf, tmpend - tmpbuf);
+ if (rev > 0)
+ SvNVX(sv) += (NV)rev/nshift;
+
+ SvPOK_on(sv);
+ SvNOK_on(sv);
+ SvREADONLY_on(sv);
+ SvUTF8_on(sv);
+ }
+ }
+ break;
}
/* make the op for the constant and return */
- yylval.opval = newSVOP(OP_CONST, 0, sv);
+ if (sv)
+ yylval.opval = newSVOP(OP_CONST, 0, sv);
+ else
+ yylval.opval = Nullop;
return s;
}
View Lorry Controller Status