[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

1 files changed, 44 insertions, 12 deletions

diff --git a/toke.c b/toke.c
index ef2ace0cd8..128b828d1c 100644
--- 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++;
 	}