summaryrefslogtreecommitdiff
path: root/toke.c
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2008-02-12 13:15:20 +0000
committerNicholas Clark <nick@ccl4.org>2008-02-12 13:15:20 +0000
commit7918f24d20384771923d344a382e1d16d9552018 (patch)
tree627e24f3c520f70ddfd3fc9779420bd72fd00c55 /toke.c
parent9f10164a6c9d93684fedbbc188fb9dfe004c22c4 (diff)
downloadperl-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.c106
1 files changed, 105 insertions, 1 deletions
diff --git a/toke.c b/toke.c
index ecee9025ab..cb731045a4 100644
--- a/toke.c
+++ b/toke.c
@@ -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++;