From 5458a98a294861b5056e599fe9e1cbe7c1f7b678 Mon Sep 17 00:00:00 2001 From: Rafael Garcia-Suarez Date: Wed, 20 Sep 2006 15:22:22 +0000 Subject: [PATCH] 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 --- embed.fnc | 2 +- embed.h | 2 +- perl_keyword.pl | 4 ++-- pp.c | 4 ++-- proto.h | 2 +- t/op/cproto.t | 8 ++++++-- toke.c | 38 +++++++++++++++++++------------------- 7 files changed, 32 insertions(+), 28 deletions(-) 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 <= 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 () { 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 = '@'; -- 2.7.4