support for v5.5.640 style version numbers

p4raw-id: //depot/utfperl@4705

diff --git a/configpm b/configpm
index 8c53dbb..f57ef0b 100755 (executable)
--- 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 6611921..837c030 100644 (file)
--- 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 e1e4ae0..e2c6349 100644 (file)
--- 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 3e2c563..606a892 100644 (file)
--- 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 3e07876..36c9f7c 100644 (file)
--- 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 5122217..d0fa32d 100644 (file)
--- 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 a235122..9af4a60 100644 (file)
--- 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 a1f97c9..626e413 100644 (file)
--- 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 f5a016f..c028b4e 100644 (file)
--- 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 7fa4514..36f88c7 100644 (file)
--- 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 cefe13c..a16dcdd 100644 (file)
--- 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 581dcba..d4c9d8c 100755 (executable)
--- 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 ff239a6..8109c3e 100644 (file)
--- 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;
 }