diff options
author | Nicholas Clark <nick@ccl4.org> | 2008-02-12 13:15:20 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2008-02-12 13:15:20 +0000 |
commit | 7918f24d20384771923d344a382e1d16d9552018 (patch) | |
tree | 627e24f3c520f70ddfd3fc9779420bd72fd00c55 /toke.c | |
parent | 9f10164a6c9d93684fedbbc188fb9dfe004c22c4 (diff) | |
download | perl-7918f24d20384771923d344a382e1d16d9552018.tar.gz |
assert() that every NN argument is not NULL. Otherwise we have the
ability to create landmines that will explode under someone in the
future when they upgrade their compiler to one with better
optimisation. We've already done this at least twice.
(Yes, some of the assertions are after code that would already have
SEGVd because it already deferences a pointer, but they are put in
to make it easier to automate checking that each and every case is
covered.)
Add a tool, checkARGS_ASSERT.pl, to check that every case is covered.
p4raw-id: //depot/perl@33291
Diffstat (limited to 'toke.c')
-rw-r--r-- | toke.c | 106 |
1 files changed, 105 insertions, 1 deletions
@@ -377,6 +377,9 @@ STATIC int S_tokereport(pTHX_ I32 rv, const YYSTYPE* lvalp) { dVAR; + + PERL_ARGS_ASSERT_TOKEREPORT; + if (DEBUG_T_TEST) { const char *name = NULL; enum token_type type = TOKENTYPE_NONE; @@ -438,6 +441,9 @@ STATIC void S_printbuf(pTHX_ const char *const fmt, const char *const s) { SV* const tmp = newSVpvs(""); + + PERL_ARGS_ASSERT_PRINTBUF; + PerlIO_printf(Perl_debug_log, fmt, pv_display(tmp, s, strlen(s), 0, 60)); SvREFCNT_dec(tmp); } @@ -488,6 +494,8 @@ S_no_op(pTHX_ const char *const what, char *s) char * const oldbp = PL_bufptr; const bool is_first = (PL_oldbufptr == PL_linestart); + PERL_ARGS_ASSERT_NO_OP; + if (!s) s = oldbp; else @@ -572,6 +580,9 @@ S_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen) dVAR; HV * const hinthv = GvHV(PL_hintgv); char he_name[8 + MAX_FEATURE_LEN] = "feature_"; + + PERL_ARGS_ASSERT_FEATURE_IS_ENABLED; + assert(namelen <= MAX_FEATURE_LEN); memcpy(&he_name[8], name, namelen); @@ -585,6 +596,8 @@ S_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen) void Perl_deprecate(pTHX_ const char *const s) { + PERL_ARGS_ASSERT_DEPRECATE; + if (ckWARN(WARN_DEPRECATED)) Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), "Use of %s is deprecated", s); } @@ -600,6 +613,8 @@ Perl_deprecate_old(pTHX_ const char *const s) /* live under the "syntax" category. It is now a top-level category */ /* in its own right. */ + PERL_ARGS_ASSERT_DEPRECATE_OLD; + if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "Use of %s is deprecated", s); @@ -616,6 +631,9 @@ strip_return(SV *sv) { register const char *s = SvPVX_const(sv); register const char * const e = s + SvCUR(sv); + + PERL_ARGS_ASSERT_STRIP_RETURN; + /* outer loop optimized to do nothing if there are no CR-LFs */ while (s < e) { if (*s++ == '\r' && *s == '\n') { @@ -735,6 +753,8 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, bool new_filter) void Perl_parser_free(pTHX_ const yy_parser *parser) { + PERL_ARGS_ASSERT_PARSER_FREE; + PL_curcop = parser->saved_curcop; SvREFCNT_dec(parser->linestr); @@ -784,6 +804,8 @@ S_incline(pTHX_ const char *s) const char *n; const char *e; + PERL_ARGS_ASSERT_INCLINE; + CopLINE_inc(PL_curcop); if (*s++ != '#') return; @@ -900,6 +922,8 @@ S_incline(pTHX_ const char *s) STATIC char * S_skipspace0(pTHX_ register char *s) { + PERL_ARGS_ASSERT_SKIPSPACE0; + s = skipspace(s); if (!PL_madskills) return s; @@ -922,6 +946,8 @@ S_skipspace1(pTHX_ register char *s) const char *start = s; I32 startoff = start - SvPVX(PL_linestr); + PERL_ARGS_ASSERT_SKIPSPACE1; + s = skipspace(s); if (!PL_madskills) return s; @@ -948,6 +974,8 @@ S_skipspace2(pTHX_ register char *s, SV **svp) const I32 bufptroff = PL_bufptr - SvPVX(PL_linestr); const I32 startoff = s - SvPVX(PL_linestr); + PERL_ARGS_ASSERT_SKIPSPACE2; + s = skipspace(s); PL_bufptr = SvPVX(PL_linestr) + bufptroff; if (!PL_madskills || !svp) @@ -1000,11 +1028,14 @@ S_skipspace(pTHX_ register char *s) int curoff; int startoff = s - SvPVX(PL_linestr); + PERL_ARGS_ASSERT_SKIPSPACE; + if (PL_skipwhite) { sv_free(PL_skipwhite); PL_skipwhite = 0; } #endif + PERL_ARGS_ASSERT_SKIPSPACE; if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) { while (s < PL_bufend && SPACE_OR_TAB(*s)) @@ -1217,6 +1248,9 @@ STATIC I32 S_lop(pTHX_ I32 f, int x, char *s) { dVAR; + + PERL_ARGS_ASSERT_LOP; + pl_yylval.ival = f; CLINE; PL_expect = x; @@ -1382,6 +1416,8 @@ S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow register char *s; STRLEN len; + PERL_ARGS_ASSERT_FORCE_WORD; + start = SKIPSPACE1(start); s = start; if (isIDFIRST_lazy_if(s,UTF) || @@ -1426,6 +1462,9 @@ STATIC void S_force_ident(pTHX_ register const char *s, int kind) { dVAR; + + PERL_ARGS_ASSERT_FORCE_IDENT; + if (*s) { const STRLEN len = strlen(s); OP* const o = (OP*)newSVOP(OP_CONST, 0, newSVpvn(s, len)); @@ -1458,6 +1497,9 @@ Perl_str_to_version(pTHX_ SV *sv) const char *start = SvPV_const(sv,len); const char * const end = start + len; const bool utf = SvUTF8(sv) ? TRUE : FALSE; + + PERL_ARGS_ASSERT_STR_TO_VERSION; + while (start < end) { STRLEN skip; UV n; @@ -1492,6 +1534,8 @@ S_force_version(pTHX_ char *s, int guessing) I32 startoff = s - SvPVX(PL_linestr); #endif + PERL_ARGS_ASSERT_FORCE_VERSION; + s = SKIPSPACE1(s); d = s; @@ -1562,6 +1606,8 @@ S_tokeq(pTHX_ SV *sv) STRLEN len = 0; SV *pv = sv; + PERL_ARGS_ASSERT_TOKEQ; + if (!SvLEN(sv)) goto finish; @@ -1910,6 +1956,8 @@ S_scan_const(pTHX_ char *start) bool native_range = TRUE; /* turned to FALSE if the first endpoint is Unicode. */ #endif + PERL_ARGS_ASSERT_SCAN_CONST; + if (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op) { /* If we are doing a trans and we know we want UTF8 set expectation */ has_utf8 = PL_sublex_info.sub_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF); @@ -2518,6 +2566,9 @@ STATIC int S_intuit_more(pTHX_ register char *s) { dVAR; + + PERL_ARGS_ASSERT_INTUIT_MORE; + if (PL_lex_brackets) return TRUE; if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{')) @@ -2683,6 +2734,8 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv) int soff; #endif + PERL_ARGS_ASSERT_INTUIT_METHOD; + if (gv) { if (SvTYPE(gv) == SVt_PVGV && GvIO(gv)) return 0; @@ -2809,6 +2862,8 @@ Perl_filter_del(pTHX_ filter_t funcp) dVAR; SV *datasv; + PERL_ARGS_ASSERT_FILTER_DEL; + #ifdef DEBUGGING DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", FPTR2DPTR(void*, funcp))); @@ -2849,6 +2904,8 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) #endif : maxlen; + PERL_ARGS_ASSERT_FILTER_READ; + if (!PL_parser || !PL_rsfp_filters) return -1; if (idx > AvFILLp(PL_rsfp_filters)) { /* Any more filters? */ @@ -2904,6 +2961,9 @@ STATIC char * S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append) { dVAR; + + PERL_ARGS_ASSERT_FILTER_GETS; + #ifdef PERL_CR_FILTER if (!PL_rsfp_filters) { filter_add(S_cr_textfilter,NULL); @@ -2927,6 +2987,8 @@ S_find_in_my_stash(pTHX_ const char *pkgname, STRLEN len) dVAR; GV *gv; + PERL_ARGS_ASSERT_FIND_IN_MY_STASH; + if (len == 11 && *pkgname == '_' && strEQ(pkgname, "__PACKAGE__")) return PL_curstash; @@ -3161,6 +3223,9 @@ Perl_madlex(pTHX) STATIC char * S_tokenize_use(pTHX_ int is_use, char *s) { dVAR; + + PERL_ARGS_ASSERT_TOKENIZE_USE; + if (PL_expect != XSTATE) yyerror(Perl_form(aTHX_ "\"%s\" not allowed in expression", is_use ? "use" : "no")); @@ -7058,6 +7123,9 @@ I32 Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) { dVAR; + + PERL_ARGS_ASSERT_KEYWORD; + switch (len) { case 1: /* 5 tokens of length 1 */ @@ -10446,6 +10514,8 @@ S_checkcomma(pTHX_ const char *s, const char *name, const char *what) { dVAR; + PERL_ARGS_ASSERT_CHECKCOMMA; + if (*s == ' ' && s[1] == '(') { /* XXX gotta be a better way */ if (ckWARN(WARN_SYNTAX)) { int level = 1; @@ -10508,6 +10578,8 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen, SV *cv, *typesv; const char *why1 = "", *why2 = "", *why3 = ""; + PERL_ARGS_ASSERT_NEW_CONSTANT; + if (!table || !(PL_hints & HINT_LOCALIZE_HH)) { SV *msg; @@ -10602,6 +10674,9 @@ S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_packag dVAR; register char *d = dest; register char * const e = d + destlen - 3; /* two-character token, ending NUL */ + + PERL_ARGS_ASSERT_SCAN_WORD; + for (;;) { if (d >= e) Perl_croak(aTHX_ ident_too_long); @@ -10645,6 +10720,8 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL register char *d = dest; register char * const e = d + destlen + 3; /* two-character token, ending NUL */ + PERL_ARGS_ASSERT_SCAN_IDENT; + if (isSPACE(*s)) s = PEEKSPACE(s); if (isDIGIT(*s)) { @@ -10799,6 +10876,8 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL void Perl_pmflag(pTHX_ U32* pmfl, int ch) { + PERL_ARGS_ASSERT_PMFLAG; + PERL_UNUSED_CONTEXT; if (ch<256) { const char c = (char)ch; @@ -10824,6 +10903,7 @@ S_scan_pat(pTHX_ char *start, I32 type) char *modstart; #endif + PERL_ARGS_ASSERT_SCAN_PAT; if (!s) { const char * const delimiter = skipspace(start); @@ -10893,6 +10973,8 @@ S_scan_subst(pTHX_ char *start) char *modstart; #endif + PERL_ARGS_ASSERT_SCAN_SUBST; + pl_yylval.ival = OP_NULL; s = scan_str(start,!!PL_madskills,FALSE); @@ -10999,6 +11081,8 @@ S_scan_trans(pTHX_ char *start) char *modstart; #endif + PERL_ARGS_ASSERT_SCAN_TRANS; + pl_yylval.ival = OP_NULL; s = scan_str(start,!!PL_madskills,FALSE); @@ -11096,6 +11180,8 @@ S_scan_heredoc(pTHX_ register char *s) PL_realtokenstart = -1; #endif + PERL_ARGS_ASSERT_SCAN_HEREDOC; + s += 2; d = PL_tokenbuf; e = PL_tokenbuf + sizeof PL_tokenbuf - 1; @@ -11359,10 +11445,11 @@ S_scan_inputsymbol(pTHX_ char *start) register char *s = start; /* current position in buffer */ char *end; I32 len; - char *d = PL_tokenbuf; /* start of temp holding space */ const char * const e = PL_tokenbuf + sizeof PL_tokenbuf; /* end of temp holding space */ + PERL_ARGS_ASSERT_SCAN_INPUTSYMBOL; + end = strchr(s, '\n'); if (!end) end = PL_bufend; @@ -11559,6 +11646,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) char *tstart; #endif + PERL_ARGS_ASSERT_SCAN_STR; + /* skip space before the delimiter */ if (isSPACE(*s)) { s = PEEKSPACE(s); @@ -11899,6 +11988,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) const char *lastub = NULL; /* position of last underbar */ static char const number_too_long[] = "Number too long"; + PERL_ARGS_ASSERT_SCAN_NUM; + /* We use the first character to decide what type of number this is */ switch (*s) { @@ -12289,6 +12380,8 @@ S_scan_formline(pTHX_ register char *s) } #endif + PERL_ARGS_ASSERT_SCAN_FORMLINE; + while (!needargs) { if (*s == '.') { t = s+1; @@ -12433,6 +12526,9 @@ int Perl_yywarn(pTHX_ const char *const s) { dVAR; + + PERL_ARGS_ASSERT_YYWARN; + PL_in_eval |= EVAL_WARNONLY; yyerror(s); PL_in_eval &= ~EVAL_WARNONLY; @@ -12449,6 +12545,8 @@ Perl_yyerror(pTHX_ const char *const s) SV *msg; int yychar = PL_parser->yychar; + PERL_ARGS_ASSERT_YYERROR; + if (!yychar || (yychar == ';' && !PL_rsfp)) where = "at EOF"; else if (PL_oldoldbufptr && PL_bufptr > PL_oldoldbufptr && @@ -12547,6 +12645,9 @@ S_swallow_bom(pTHX_ U8 *s) { dVAR; const STRLEN slen = SvCUR(PL_linestr); + + PERL_ARGS_ASSERT_SWALLOW_BOM; + switch (s[0]) { case 0xFF: if (s[1] == 0xFE) { @@ -12725,6 +12826,9 @@ Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv) dVAR; const char *pos = s; const char *start = s; + + PERL_ARGS_ASSERT_SCAN_VSTRING; + if (*pos == 'v') pos++; /* get past 'v' */ while (pos < e && (isDIGIT(*pos) || *pos == '_')) pos++; |