X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=431938fdbdc969d02f3a2aebf0e3ce7ee638c022;hb=048d9da8ec2370ce3e00d2fda9649ad63736ab2f;hp=afcc1ddcca78761ef013063dfde9aac000c6024f;hpb=704d42154dde262d860a2d38dee033b3ee03f906;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/toke.c b/toke.c
index afcc1dd..431938f 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;
@@ -435,9 +438,12 @@ S_tokereport(pTHX_ I32 rv, const YYSTYPE* lvalp)
 /* print the buffer with suitable escapes */
 
 STATIC void
-S_printbuf(pTHX_ const char* fmt, const char* s)
+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);
 }
@@ -482,12 +488,14 @@ S_ao(pTHX_ int toketype)
  */
 
 STATIC void
-S_no_op(pTHX_ const char *what, char *s)
+S_no_op(pTHX_ const char *const what, char *s)
 {
     dVAR;
     char * const oldbp = PL_bufptr;
     const bool is_first = (PL_oldbufptr == PL_linestart);
 
+    PERL_ARGS_ASSERT_NO_OP;
+
     if (!s)
 	s = oldbp;
     else
@@ -567,11 +575,14 @@ S_missingterm(pTHX_ char *s)
  * Check whether the named feature is enabled.
  */
 STATIC bool
-S_feature_is_enabled(pTHX_ const char *name, STRLEN namelen)
+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);
 
@@ -583,14 +594,16 @@ S_feature_is_enabled(pTHX_ const char *name, STRLEN namelen)
  */
 
 void
-Perl_deprecate(pTHX_ const char *s)
+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);
 }
 
 void
-Perl_deprecate_old(pTHX_ const char *s)
+Perl_deprecate_old(pTHX_ const char *const s)
 {
     /* This function should NOT be called for any new deprecated warnings */
     /* Use Perl_deprecate instead                                         */
@@ -600,6 +613,8 @@ Perl_deprecate_old(pTHX_ const char *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') {
@@ -692,6 +710,7 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, bool new_filter)
 #else
     parser->nexttoke = 0;
 #endif
+    parser->error_count = oparser ? oparser->error_count : 0;
     parser->copline = NOLINE;
     parser->lex_state = LEX_NORMAL;
     parser->expect = XSTATE;
@@ -734,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);
 
@@ -783,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;
@@ -899,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;
@@ -921,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;
@@ -947,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)
@@ -970,7 +999,7 @@ S_skipspace2(pTHX_ register char *s, SV **svp)
 #endif
 
 STATIC void
-S_update_debugger_info(pTHX_ SV *orig_sv, const char *buf, STRLEN len)
+S_update_debugger_info(pTHX_ SV *orig_sv, const char *const buf, STRLEN len)
 {
     AV *av = CopFILEAVx(PL_curcop);
     if (av) {
@@ -999,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))
@@ -1216,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;
@@ -1348,7 +1383,7 @@ S_force_next(pTHX_ I32 type)
 }
 
 STATIC SV *
-S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len)
+S_newSV_maybe_utf8(pTHX_ const char *const start, STRLEN len)
 {
     dVAR;
     SV * const sv = newSVpvn_utf8(start, len,
@@ -1381,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) ||
@@ -1425,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));
@@ -1457,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;
@@ -1491,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;
@@ -1561,6 +1606,8 @@ S_tokeq(pTHX_ SV *sv)
     STRLEN len = 0;
     SV *pv = sv;
 
+    PERL_ARGS_ASSERT_TOKEQ;
+
     if (!SvLEN(sv))
 	goto finish;
 
@@ -1909,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);
@@ -2517,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] == '{'))
@@ -2682,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;
@@ -2808,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)));
@@ -2848,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?	*/
@@ -2903,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);
@@ -2926,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;
 
@@ -3160,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"));
@@ -6604,7 +6670,7 @@ Perl_yylex(pTHX)
 		    (*s == ':' && s[1] == ':'))
 		{
 #ifdef PERL_MAD
-		    SV *nametoke;
+		    SV *nametoke = NULL;
 #endif
 
 		    PL_expect = XBLOCK;
@@ -7057,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 */
@@ -10445,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;
@@ -10507,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;
 	
@@ -10601,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);
@@ -10644,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)) {
@@ -10798,9 +10876,11 @@ 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) {
-        char c = (char)ch;
+        const char c = (char)ch;
         switch (c) {
             CASE_STD_PMMOD_FLAGS_PARSE_SET(pmfl);
             case GLOBAL_PAT_MOD:    *pmfl |= PMf_GLOBAL; break;
@@ -10823,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);
@@ -10892,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);
@@ -10991,13 +11074,15 @@ S_scan_trans(pTHX_ char *start)
     register char* s;
     OP *o;
     short *tbl;
-    I32 squash;
-    I32 del;
-    I32 complement;
+    U8 squash;
+    U8 del;
+    U8 complement;
 #ifdef PERL_MAD
     char *modstart;
 #endif
 
+    PERL_ARGS_ASSERT_SCAN_TRANS;
+
     pl_yylval.ival = OP_NULL;
 
     s = scan_str(start,!!PL_madskills,FALSE);
@@ -11095,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;
@@ -11358,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;
@@ -11558,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);
@@ -11898,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) {
@@ -12280,14 +12372,16 @@ S_scan_formline(pTHX_ register char *s)
     bool eofmt = FALSE;
 #ifdef PERL_MAD
     char *tokenstart = s;
-    SV* savewhite;
-    
+    SV* savewhite = NULL;
+
     if (PL_madskills) {
 	savewhite = PL_thiswhite;
 	PL_thiswhite = 0;
     }
 #endif
 
+    PERL_ARGS_ASSERT_SCAN_FORMLINE;
+
     while (!needargs) {
 	if (*s == '.') {
 	    t = s+1;
@@ -12429,9 +12523,12 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
 #pragma segment Perl_yylex
 #endif
 int
-Perl_yywarn(pTHX_ const char *s)
+Perl_yywarn(pTHX_ const char *const s)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_YYWARN;
+
     PL_in_eval |= EVAL_WARNONLY;
     yyerror(s);
     PL_in_eval &= ~EVAL_WARNONLY;
@@ -12439,7 +12536,7 @@ Perl_yywarn(pTHX_ const char *s)
 }
 
 int
-Perl_yyerror(pTHX_ const char *s)
+Perl_yyerror(pTHX_ const char *const s)
 {
     dVAR;
     const char *where = NULL;
@@ -12448,6 +12545,8 @@ Perl_yyerror(pTHX_ const char *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 &&
@@ -12546,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) {
@@ -12719,11 +12821,14 @@ passed in, for performance reasons.
 */
 
 char *
-Perl_scan_vstring(pTHX_ const char *s, const char *e, SV *sv)
+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++;