[win32] merge another toke.c patch and its dependent (very carefully)

	    #32:  "Support C<Package::> as function-blind bearword"
	   From:  Chip Salzenberg
	  Files:  toke.c
	--------
	    #86:  "Make warning on C<Nosuch::> optional, add to perl{diag,delta}.pod"
	   From:  Gurusamy Sarathy
	  Files:  toke.c pod/perldelta.pod pod/perldiag.pod

p4raw-id: //depot/win32/perl@633

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 5c99211..ac02ac6 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -1228,6 +1228,12 @@ that can no longer be found in the table.
 as an lvalue, which is pretty strange.  Perhaps you forgot to
 dereference it first.  See L<perlfunc/substr>.
 
+=item Bareword "%s" refers to nonexistent package
+
+(W) You used a qualified bareword of the form C<Foo::>, but
+the compiler saw no other uses of that namespace before that point.
+Perhaps you need to predeclare a package?
+
 =item Can't redefine active sort subroutine %s
 
 (F) Perl optimizes the internal handling of sort subroutines and keeps

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 5f2876b..35eff72 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -361,6 +361,12 @@ Perl yourself.
 subroutine identifier, in curly braces or to the left of the "=>" symbol.
 Perhaps you need to predeclare a subroutine?
 
+=item Bareword "%s" refers to nonexistent package
+
+(W) You used a qualified bareword of the form C<Foo::>, but
+the compiler saw no other uses of that namespace before that point.
+Perhaps you need to predeclare a package?
+
 =item BEGIN failed--compilation aborted
 
 (F) An untrapped exception was raised while executing a BEGIN subroutine.

diff --git a/toke.c b/toke.c
index ef2ace0..128b828 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1202,7 +1202,12 @@ intuit_method(char *start, GV *gv)
        return *s == '(' ? FUNCMETH : METHOD;
     }
     if (!keyword(tmpbuf, len)) {
-       indirgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVCV);
+       if (len > 2 && tmpbuf[len - 2] == ':' && tmpbuf[len - 1] == ':') {
+           len -= 2;
+           tmpbuf[len] = '\0';
+           goto bare_package;
+       }
+       indirgv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
        if (indirgv && GvCVu(indirgv))
            return 0;
        /* filehandle or package name makes it a method */
@@ -1210,11 +1215,10 @@ intuit_method(char *start, GV *gv)
            s = skipspace(s);
            if ((bufend - s) >= 2 && *s == '=' && *(s+1) == '>')
                return 0;       /* no assumptions -- "=>" quotes bearword */
-           nextval[nexttoke].opval =
-               (OP*)newSVOP(OP_CONST, 0,
-                           newSVpv(tmpbuf,0));
-           nextval[nexttoke].opval->op_private =
-               OPpCONST_BARE;
+      bare_package:
+           nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0,
+                                                  newSVpv(tmpbuf,0));
+           nextval[nexttoke].opval->op_private = OPpCONST_BARE;
            expect = XTERM;
            force_next(WORD);
            bufptr = s;
@@ -2840,10 +2844,12 @@ yylex(void)
                /* Get the rest if it looks like a package qualifier */
 
                if (*s == '\'' || *s == ':' && s[1] == ':') {
+                   STRLEN morelen;
                    s = scan_word(s, tokenbuf + len, sizeof tokenbuf - len,
-                                 TRUE, &len);
-                   if (!len)
+                                 TRUE, &morelen);
+                   if (!morelen)
                        croak("Bad name after %s::", tokenbuf);
+                   len += morelen;
                }
 
                if (expect == XOPERATOR) {
@@ -2856,7 +2862,28 @@ yylex(void)
                        no_op("Bareword",s);
                }
 
-               /* Look for a subroutine with this name in current package. */
+               /* Look for a subroutine with this name in current package,
+                  unless name is "Foo::", in which case Foo is a bearword
+                  (and a package name). */
+
+               if (len > 2 &&
+                   tokenbuf[len - 2] == ':' && tokenbuf[len - 1] == ':')
+               {
+                   if (dowarn && ! gv_fetchpv(tokenbuf, FALSE, SVt_PVHV))
+                       warn("Bareword \"%s\" refers to nonexistent package",
+                            tokenbuf);
+                   len -= 2;
+                   tokenbuf[len] = '\0';
+                   gv = Nullgv;
+                   gvp = 0;
+               }
+               else {
+                   len = 0;
+                   if (!gv)
+                       gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV);
+               }
+
+               /* if we saw a global override before, get the right name */
 
                if (gvp) {
                    sv = newSVpv("CORE::GLOBAL::",14);
@@ -2864,8 +2891,6 @@ yylex(void)
                }
                else
                    sv = newSVpv(tokenbuf,0);
-               if (!gv)
-                   gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV);
 
                /* Presume this is going to be a bareword of some sort. */
 
@@ -2873,6 +2898,11 @@ yylex(void)
                yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
                yylval.opval->op_private = OPpCONST_BARE;
 
+               /* And if "Foo::", then that's what it certainly is. */
+
+               if (len)
+                   goto safe_bareword;
+
                /* See if it's the indirect object for a list operator. */
 
                if (oldoldbufptr &&
@@ -3001,6 +3031,8 @@ yylex(void)
                            warn(warn_reserved, tokenbuf);
                    }
                }
+
+           safe_bareword:
                if (lastchar && strchr("*%&", lastchar)) {
                    warn("Operator or semicolon missing before %c%s",
                        lastchar, tokenbuf);
@@ -4682,7 +4714,7 @@ scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLE
            *d++ = ':';
            s++;
        }
-       else if (*s == ':' && s[1] == ':' && allow_package && isIDFIRST(s[2])) {
+       else if (*s == ':' && s[1] == ':' && allow_package && s[2] != '$') {
            *d++ = *s++;
            *d++ = *s++;
        }