diff options
| -rw-r--r-- | pod/perldelta.pod | 6 | ||||
| -rw-r--r-- | pod/perldiag.pod | 6 | ||||
| -rw-r--r-- | toke.c | 56 |
3 files changed, 56 insertions, 12 deletions
diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 5c99211e62..ac02ac68af 100644 --- 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 5f2876bc73..35eff72ef7 100644 --- 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. @@ -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++; } |