From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Wed, 20 Sep 2006 15:22:22 +0000 (+0000)
Subject: prototype() wasn't working to get the prototype of optional core
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5458a98a294861b5056e599fe9e1cbe7c1f7b678;p=p5sagit%2Fp5-mst-13.2.git
prototype() wasn't working to get the prototype of optional core
keywords (like say, err, given.) Fix this by adding a parameter to
Perl_keyword to always get the keyword number, even if the feature
isn't in effect.
p4raw-id: //depot/perl@28874
---
diff --git a/embed.fnc b/embed.fnc
index 63e9e8f..7320b9f 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -395,7 +395,7 @@ ApR |bool |is_utf8_punct |NN const U8 *p
ApR |bool |is_utf8_xdigit |NN const U8 *p
ApR |bool |is_utf8_mark |NN const U8 *p
p |OP* |jmaybe |NN OP* arg
-pP |I32 |keyword |NN const char* d|I32 len
+pP |I32 |keyword |NN const char* d|I32 len|bool all_keywords
Ap |void |leave_scope |I32 base
p |void |lex_end
p |void |lex_start |NN SV* line
diff --git a/embed.h b/embed.h
index fa43f4b..4ae5706 100644
--- a/embed.h
+++ b/embed.h
@@ -2573,7 +2573,7 @@
#define is_utf8_mark(a) Perl_is_utf8_mark(aTHX_ a)
#ifdef PERL_CORE
#define jmaybe(a) Perl_jmaybe(aTHX_ a)
-#define keyword(a,b) Perl_keyword(aTHX_ a,b)
+#define keyword(a,b,c) Perl_keyword(aTHX_ a,b,c)
#endif
#define leave_scope(a) Perl_leave_scope(aTHX_ a)
#ifdef PERL_CORE
diff --git a/perl_keyword.pl b/perl_keyword.pl
index b2e9e34..ab9559c 100644
--- a/perl_keyword.pl
+++ b/perl_keyword.pl
@@ -67,7 +67,7 @@ print <<END;
*/
I32
-Perl_keyword (pTHX_ const char *name, I32 len)
+Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
{
dVAR;
$switch
@@ -90,7 +90,7 @@ END
elsif (my $feature = $feature_kw{$k}) {
$feature =~ s/([\\"])/\\$1/g;
return <<END;
-return (FEATURE_IS_ENABLED("$feature") ? ${sign}KEY_$k : 0);
+return (all_keywords || FEATURE_IS_ENABLED("$feature") ? ${sign}KEY_$k : 0);
END
}
return <<END;
diff --git a/pp.c b/pp.c
index 0c9ef63..6809b31 100644
--- a/pp.c
+++ b/pp.c
@@ -389,7 +389,7 @@ PP(pp_prototype)
if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
const char * const s = SvPVX_const(TOPs);
if (strnEQ(s, "CORE::", 6)) {
- const int code = keyword(s + 6, SvCUR(TOPs) - 6);
+ const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1);
if (code < 0) { /* Overridable. */
#define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
int i = 0, n = 0, seen_question = 0;
@@ -397,7 +397,7 @@ PP(pp_prototype)
char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
if (code == -KEY_chop || code == -KEY_chomp
- || code == -KEY_exec || code == -KEY_system)
+ || code == -KEY_exec || code == -KEY_system || code == -KEY_err)
goto set;
while (i < MAXO) { /* The slow way. */
if (strEQ(s + 6, PL_op_name[i])
diff --git a/proto.h b/proto.h
index a957f32..87daeeb 100644
--- a/proto.h
+++ b/proto.h
@@ -1007,7 +1007,7 @@ PERL_CALLCONV bool Perl_is_utf8_mark(pTHX_ const U8 *p)
PERL_CALLCONV OP* Perl_jmaybe(pTHX_ OP* arg)
__attribute__nonnull__(pTHX_1);
-PERL_CALLCONV I32 Perl_keyword(pTHX_ const char* d, I32 len)
+PERL_CALLCONV I32 Perl_keyword(pTHX_ const char* d, I32 len, bool all_keywords)
__attribute__pure__
__attribute__nonnull__(pTHX_1);
diff --git a/t/op/cproto.t b/t/op/cproto.t
index 3f3e871..a02ab46 100644
--- a/t/op/cproto.t
+++ b/t/op/cproto.t
@@ -7,7 +7,7 @@ BEGIN {
}
BEGIN { require './test.pl'; }
-plan tests => 234;
+plan tests => 238;
while (<DATA>) {
chomp;
@@ -68,7 +68,7 @@ endpwent ()
endservent ()
eof (;*)
eq ($$)
-err unknown
+err ()
eval undef
exec undef
exists undef
@@ -109,6 +109,7 @@ getservbyport ($$)
getservent ()
getsockname (*)
getsockopt (*$$)
+given undef
glob undef
gmtime (;$)
goto undef
@@ -186,6 +187,7 @@ rewinddir (*)
rindex ($$;$)
rmdir (;$)
s undef
+say (;*@)
scalar undef
seek (*$$)
seekdir (*$)
@@ -220,6 +222,7 @@ sprintf ($@)
sqrt (;$)
srand (;$)
stat (*)
+state undef
study undef
sub undef
substr ($$;$$)
@@ -256,6 +259,7 @@ wait ()
waitpid ($$)
wantarray ()
warn (@)
+when undef
while undef
write (;*)
x unknown
diff --git a/toke.c b/toke.c
index b097e39..f5aa5d1 100644
--- a/toke.c
+++ b/toke.c
@@ -1275,7 +1275,7 @@ S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow
(allow_initial_tick && *s == '\'') )
{
s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len);
- if (check_keyword && keyword(PL_tokenbuf, len))
+ if (check_keyword && keyword(PL_tokenbuf, len, 0))
return start;
start_force(PL_curforce);
if (PL_madskills)
@@ -2514,7 +2514,7 @@ S_intuit_more(pTHX_ register char *s)
while (isALPHA(*s))
*d++ = *s++;
*d = '\0';
- if (keyword(tmpbuf, d - tmpbuf))
+ if (keyword(tmpbuf, d - tmpbuf, 0))
weight -= 150;
}
if (un_char == last_un_char + 1)
@@ -2600,7 +2600,7 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
PL_expect = XREF;
return *s == '(' ? FUNCMETH : METHOD;
}
- if (!keyword(tmpbuf, len)) {
+ if (!keyword(tmpbuf, len, 0)) {
if (len > 2 && tmpbuf[len - 2] == ':' && tmpbuf[len - 1] == ':') {
len -= 2;
tmpbuf[len] = '\0';
@@ -4116,7 +4116,7 @@ Perl_yylex(pTHX)
I32 tmp;
SV *sv;
d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
- if (isLOWER(*s) && (tmp = keyword(PL_tokenbuf, len))) {
+ if (isLOWER(*s) && (tmp = keyword(PL_tokenbuf, len, 0))) {
if (tmp < 0) tmp = -tmp;
switch (tmp) {
case KEY_or:
@@ -4762,7 +4762,7 @@ Perl_yylex(pTHX)
char tmpbuf[sizeof PL_tokenbuf];
int t2;
scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
- if ((t2 = keyword(tmpbuf, len))) {
+ if ((t2 = keyword(tmpbuf, len, 0))) {
/* binary operators exclude handle interpretations */
switch (t2) {
case -KEY_x:
@@ -5067,7 +5067,7 @@ Perl_yylex(pTHX)
}
/* Check for keywords */
- tmp = keyword(PL_tokenbuf, len);
+ tmp = keyword(PL_tokenbuf, len, 0);
/* Is this a word before a => operator? */
if (*d == '=' && d[1] == '>') {
@@ -5451,7 +5451,7 @@ Perl_yylex(pTHX)
STRLEN tmplen;
d = s;
d = scan_word(d, tmpbuf, sizeof tmpbuf, TRUE, &tmplen);
- if (!keyword(tmpbuf,tmplen))
+ if (!keyword(tmpbuf, tmplen, 0))
probable_sub = 1;
else {
while (d < PL_bufend && isSPACE(*d))
@@ -5651,7 +5651,7 @@ Perl_yylex(pTHX)
s += 2;
d = s;
s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
- if (!(tmp = keyword(PL_tokenbuf, len)))
+ if (!(tmp = keyword(PL_tokenbuf, len, 0)))
Perl_croak(aTHX_ "CORE::%s is not a keyword", PL_tokenbuf);
if (tmp < 0)
tmp = -tmp;
@@ -6953,7 +6953,7 @@ S_pending_ident(pTHX)
*/
I32
-Perl_keyword (pTHX_ const char *name, I32 len)
+Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
{
dVAR;
switch (len)
@@ -7225,7 +7225,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
case 'r':
if (name[2] == 'r')
{ /* err */
- return (FEATURE_IS_ENABLED("err") ? -KEY_err : 0);
+ return (all_keywords || FEATURE_IS_ENABLED("err") ? -KEY_err : 0);
}
goto unknown;
@@ -7364,7 +7364,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
case 'a':
if (name[2] == 'y')
{ /* say */
- return (FEATURE_IS_ENABLED("say") ? -KEY_say : 0);
+ return (all_keywords || FEATURE_IS_ENABLED("say") ? -KEY_say : 0);
}
goto unknown;
@@ -7888,7 +7888,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
if (name[2] == 'e' &&
name[3] == 'n')
{ /* when */
- return (FEATURE_IS_ENABLED("switch") ? KEY_when : 0);
+ return (all_keywords || FEATURE_IS_ENABLED("switch") ? KEY_when : 0);
}
goto unknown;
@@ -7971,7 +7971,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
name[3] == 'a' &&
name[4] == 'k')
{ /* break */
- return (FEATURE_IS_ENABLED("switch") ? -KEY_break : 0);
+ return (all_keywords || FEATURE_IS_ENABLED("switch") ? -KEY_break : 0);
}
goto unknown;
@@ -8099,7 +8099,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
name[3] == 'e' &&
name[4] == 'n')
{ /* given */
- return (FEATURE_IS_ENABLED("switch") ? KEY_given : 0);
+ return (all_keywords || FEATURE_IS_ENABLED("switch") ? KEY_given : 0);
}
goto unknown;
@@ -8267,7 +8267,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
if (name[3] == 't' &&
name[4] == 'e')
{ /* state */
- return (FEATURE_IS_ENABLED("state") ? KEY_state : 0);
+ return (all_keywords || FEATURE_IS_ENABLED("state") ? KEY_state : 0);
}
goto unknown;
@@ -8935,7 +8935,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
name[5] == 'l' &&
name[6] == 't')
{ /* default */
- return (FEATURE_IS_ENABLED("switch") ? KEY_default : 0);
+ return (all_keywords || FEATURE_IS_ENABLED("switch") ? KEY_default : 0);
}
goto unknown;
@@ -10368,7 +10368,7 @@ S_checkcomma(pTHX_ const char *s, const char *name, const char *what)
s++;
if (*s == ',') {
GV* gv;
- if (keyword(w, s - w))
+ if (keyword(w, s - w, 0))
return;
gv = gv_fetchpvn_flags(w, s - w, 0, SVt_PVCV);
@@ -10628,7 +10628,7 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL
while (s < send && SPACE_OR_TAB(*s))
s++;
if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
- if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
+ if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest, 0)) {
const char * const brack =
(const char *)
((*s == '[') ? "[...]" : "{...}");
@@ -10662,7 +10662,7 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL
}
if (PL_lex_state == LEX_NORMAL) {
if (ckWARN(WARN_AMBIGUOUS) &&
- (keyword(dest, d - dest) || get_cv(dest, FALSE)))
+ (keyword(dest, d - dest, 0) || get_cv(dest, FALSE)))
{
if (funny == '#')
funny = '@';