allow C<print v10>, $h{v13.10} etc.

[p5sagit/p5-mst-13.2.git] / toke.c

diff --git a/toke.c b/toke.c
index d978140..727fc01 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -58,13 +58,6 @@ static void restore_rsfp(pTHXo_ void *f);
 #define LEX_FORMLINE            1
 #define LEX_KNOWNEXT            0
 
-#ifdef I_FCNTL
-#include <fcntl.h>
-#endif
-#ifdef I_SYS_FILE
-#include <sys/file.h>
-#endif
-
 /* XXX If this causes problems, set i_unistd=undef in the hint file.  */
 #ifdef I_UNISTD
 #  include <unistd.h> /* Needed for execv() */
@@ -828,18 +821,27 @@ STATIC char *
 S_force_version(pTHX_ char *s)
 {
     OP *version = Nullop;
+    bool is_vstr = FALSE;
+    char *d;
 
     s = skipspace(s);
 
-    if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
-        char *d = s;
-       if (*d == 'v')
-           d++;
+    d = s;
+    if (*d == 'v') {
+       is_vstr = TRUE;
+       d++;
+    }
+    if (isDIGIT(*d)) {
         for (; isDIGIT(*d) || *d == '_' || *d == '.'; d++);
         if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
             s = scan_num(s);
             /* real VERSION number -- GBARR */
             version = yylval.opval;
+           if (is_vstr) {
+               SV *ver = cSVOPx(version)->op_sv;
+               SvUPGRADE(ver, SVt_PVIV);
+               SvIOKp_on(ver);         /* hint that it is a version */
+           }
         }
     }
 
@@ -1346,8 +1348,8 @@ S_scan_const(pTHX_ char *start)
            default:
                {
                    dTHR;
-                   if (ckWARN(WARN_UNSAFE) && isALPHA(*s))
-                       Perl_warner(aTHX_ WARN_UNSAFE, 
+                   if (ckWARN(WARN_MISC) && isALPHA(*s))
+                       Perl_warner(aTHX_ WARN_MISC, 
                               "Unrecognized escape \\%c passed through",
                               *s);
                    /* default action is to copy the quoted character */
@@ -3465,7 +3467,7 @@ Perl_yylex(pTHX)
        OPERATOR(REFGEN);
 
     case 'v':
-       if (isDIGIT(s[1]) && PL_expect == XTERM) {
+       if (isDIGIT(s[1]) && PL_expect != XOPERATOR) {
            char *start = s;
            start++;
            start++;
@@ -3475,6 +3477,18 @@ Perl_yylex(pTHX)
                s = scan_num(s);
                TERM(THING);
            }
+           /* avoid v123abc() or $h{v1}, allow C<print v10;> */
+           else if (!isALPHA(*start) && (PL_expect == XTERM || PL_expect == XREF)) {
+               char c = *start;
+               GV *gv;
+               *start = '\0';
+               gv = gv_fetchpv(s, FALSE, SVt_PVCV);
+               *start = c;
+               if (!gv) {
+                   s = scan_num(s);
+                   TERM(THING);
+               }
+           }
        }
        goto keylookup;
     case 'x':
@@ -3634,8 +3648,8 @@ Perl_yylex(pTHX)
                if (len > 2 &&
                    PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
                {
-                   if (ckWARN(WARN_UNSAFE) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
-                       Perl_warner(aTHX_ WARN_UNSAFE, 
+                   if (ckWARN(WARN_BAREWORD) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
+                       Perl_warner(aTHX_ WARN_BAREWORD, 
                            "Bareword \"%s\" refers to nonexistent package",
                             PL_tokenbuf);
                    len -= 2;
@@ -3958,11 +3972,11 @@ Perl_yylex(pTHX)
            LOP(OP_CRYPT,XTERM);
 
        case KEY_chmod:
-           if (ckWARN(WARN_OCTAL)) {
+           if (ckWARN(WARN_CHMOD)) {
                for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
                if (*d != '0' && isDIGIT(*d))
-                   Perl_warner(aTHX_ WARN_OCTAL,
-                               "chmod: mode argument is missing initial 0");
+                   Perl_warner(aTHX_ WARN_CHMOD,
+                               "chmod() mode argument is missing initial 0");
            }
            LOP(OP_CHMOD,XTERM);
 
@@ -4332,8 +4346,8 @@ Perl_yylex(pTHX)
                char *t;
                for (d = s; isALNUM_lazy_if(d,UTF); d++) ;
                t = skipspace(d);
-               if (strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_AMBIGUOUS))
-                   Perl_warner(aTHX_ WARN_AMBIGUOUS,
+               if (strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE))
+                   Perl_warner(aTHX_ WARN_PRECEDENCE,
                           "Precedence problem: open %.*s should be open(%.*s)",
                            d-s,s, d-s,s);
            }
@@ -4405,15 +4419,15 @@ Perl_yylex(pTHX)
                    for (; isSPACE(*d) && len; --len, ++d) ;
                    if (len) {
                        char *b = d;
-                       if (!warned && ckWARN(WARN_SYNTAX)) {
+                       if (!warned && ckWARN(WARN_QW)) {
                            for (; !isSPACE(*d) && len; --len, ++d) {
                                if (*d == ',') {
-                                   Perl_warner(aTHX_ WARN_SYNTAX,
+                                   Perl_warner(aTHX_ WARN_QW,
                                        "Possible attempt to separate words with commas");
                                    ++warned;
                                }
                                else if (*d == '#') {
-                                   Perl_warner(aTHX_ WARN_SYNTAX,
+                                   Perl_warner(aTHX_ WARN_QW,
                                        "Possible attempt to put comments in qw() list");
                                    ++warned;
                                }
@@ -4820,10 +4834,10 @@ Perl_yylex(pTHX)
            LOP(OP_UTIME,XTERM);
 
        case KEY_umask:
-           if (ckWARN(WARN_OCTAL)) {
+           if (ckWARN(WARN_UMASK)) {
                for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
                if (*d != '0' && isDIGIT(*d)) 
-                   Perl_warner(aTHX_ WARN_OCTAL,
+                   Perl_warner(aTHX_ WARN_UMASK,
                                "umask: argument is missing initial 0");
            }
            UNI(OP_UMASK);
@@ -6902,52 +6916,34 @@ Perl_scan_num(pTHX_ char *start)
            pos++;
            while (isDIGIT(*pos))
                pos++;
-           if (*pos == '.' && isDIGIT(pos[1])) {
+           if (!isALPHA(*pos)) {
                UV rev;
                U8 tmpbuf[UTF8_MAXLEN];
                U8 *tmpend;
-               NV nshift = 1.0;
                bool utf8 = FALSE;
                s++;                            /* get past 'v' */
 
                sv = NEWSV(92,5);
-               SvUPGRADE(sv, SVt_PVNV);
                sv_setpvn(sv, "", 0);
 
-               do {
+               for (;;) {
                    if (*s == '0' && isDIGIT(s[1]))
                        yyerror("Octal number in vector unsupported");
                    rev = atoi(s);
-                   s = ++pos;
-                   while (isDIGIT(*pos))
-                       pos++;
-
-                   if (rev > 127) {
-                       tmpend = uv_to_utf8(tmpbuf, rev);
-                       utf8 = TRUE;
-                   }
+                   tmpend = uv_to_utf8(tmpbuf, rev);
+                   utf8 = utf8 || rev > 127;
+                   sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
+                   if (*pos == '.' && isDIGIT(pos[1]))
+                       s = ++pos;
                    else {
-                       tmpbuf[0] = (U8)rev;
-                       tmpend = &tmpbuf[1];
+                       s = pos;
+                       break;
                    }
-                   sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
-                   if (rev > 0)
-                       SvNVX(sv) += (NV)rev/nshift;
-                   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);
-               utf8 = utf8 || rev > 127;
-               sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
-               if (rev > 0)
-                   SvNVX(sv) += (NV)rev/nshift;
+                   while (isDIGIT(*pos))
+                       pos++;
+               }
 
                SvPOK_on(sv);
-               SvNOK_on(sv);
                SvREADONLY_on(sv);
                if (utf8) {
                    SvUTF8_on(sv);