This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
De-duplicate the code that creates new GPs into Perl_newGP().
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index 6076484..b0c0ccc 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1194,8 +1194,8 @@ S_curmad(pTHX_ char slot, SV *sv)
        addmad(newMADsv(slot, sv), where, 0);
 }
 #else
-#  define start_force(where)    /*EMPTY*/
-#  define curmad(slot, sv)      /*EMPTY*/
+#  define start_force(where)    NOOP
+#  define curmad(slot, sv)      NOOP
 #endif
 
 /*
@@ -2592,7 +2592,8 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
     IoANY(datasv) = FPTR2DPTR(void *, funcp); /* stash funcp into spare field */
     IoFLAGS(datasv) |= IOf_FAKE_DIRP;
     DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n",
-                         IoANY(datasv), SvPV_nolen(datasv)));
+                         FPTR2DPTR(void *, IoANY(datasv)),
+                         SvPV_nolen(datasv)));
     av_unshift(PL_rsfp_filters, 1);
     av_store(PL_rsfp_filters, 0, datasv) ;
     return(datasv);
@@ -2607,7 +2608,8 @@ Perl_filter_del(pTHX_ filter_t funcp)
     SV *datasv;
 
 #ifdef DEBUGGING
-    DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", FPTR2DPTR(XPVIO *, funcp)));
+    DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p",
+                         FPTR2DPTR(void*, funcp)));
 #endif
     if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
        return;
@@ -2689,7 +2691,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
     funcp = DPTR2FPTR(filter_t, IoANY(datasv));
     DEBUG_P(PerlIO_printf(Perl_debug_log,
                          "filter_read %d: via function %p (%s)\n",
-                         idx, datasv, SvPV_nolen_const(datasv)));
+                         idx, (void*)datasv, SvPV_nolen_const(datasv)));
     /* Call function. The function is expected to      */
     /* call "FILTER_READ(idx+1, buf_sv)" first.                */
     /* Return: <0:error, =0:eof, >0:not eof            */
@@ -4000,6 +4002,7 @@ Perl_yylex(pTHX)
            attrs = NULL;
            while (isIDFIRST_lazy_if(s,UTF)) {
                I32 tmp;
+               SV *sv;
                d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
                if (isLOWER(*s) && (tmp = keyword(PL_tokenbuf, len))) {
                    if (tmp < 0) tmp = -tmp;
@@ -4017,6 +4020,7 @@ Perl_yylex(pTHX)
                        break;
                    }
                }
+               sv = newSVpvn(s, len);
                if (*d == '(') {
                    d = scan_str(d,TRUE,TRUE);
                    if (!d) {
@@ -4027,11 +4031,11 @@ Perl_yylex(pTHX)
                        yyerror("Unterminated attribute parameter in attribute list");
                        if (attrs)
                            op_free(attrs);
+                       sv_free(sv);
                        return REPORT(0);       /* EOF indicator */
                    }
                }
                if (PL_lex_stuff) {
-                   SV *sv = newSVpvn(s, len);
                    sv_catsv(sv, PL_lex_stuff);
                    attrs = append_elem(OP_LIST, attrs,
                                        newSVOP(OP_CONST, 0, sv));
@@ -4039,7 +4043,8 @@ Perl_yylex(pTHX)
                    PL_lex_stuff = NULL;
                }
                else {
-                   if (len == 6 && strnEQ(s, "unique", len)) {
+                   if (len == 6 && strnEQ(SvPVX(sv), "unique", len)) {
+                       sv_free(sv);
                        if (PL_in_my == KEY_our) {
 #ifdef USE_ITHREADS
                            GvUNIQUE_on(cGVOPx_gv(yylval.opval));
@@ -4054,14 +4059,22 @@ Perl_yylex(pTHX)
 
                    /* NOTE: any CV attrs applied here need to be part of
                       the CVf_BUILTIN_ATTRS define in cv.h! */
-                   else if (!PL_in_my && len == 6 && strnEQ(s, "lvalue", len))
+                   else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "lvalue", len)) {
+                       sv_free(sv);
                        CvLVALUE_on(PL_compcv);
-                   else if (!PL_in_my && len == 6 && strnEQ(s, "locked", len))
+                   }
+                   else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "locked", len)) {
+                       sv_free(sv);
                        CvLOCKED_on(PL_compcv);
-                   else if (!PL_in_my && len == 6 && strnEQ(s, "method", len))
+                   }
+                   else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "method", len)) {
+                       sv_free(sv);
                        CvMETHOD_on(PL_compcv);
-                   else if (!PL_in_my && len == 9 && strnEQ(s, "assertion", len))
+                   }
+                   else if (!PL_in_my && len == 9 && strnEQ(SvPVX(sv), "assertion", len)) {
+                       sv_free(sv);
                        CvASSERTION_on(PL_compcv);
+                   }
                    /* After we've set the flags, it could be argued that
                       we don't need to do the attributes.pm-based setting
                       process, and shouldn't bother appending recognized
@@ -4075,7 +4088,7 @@ Perl_yylex(pTHX)
                    else
                        attrs = append_elem(OP_LIST, attrs,
                                            newSVOP(OP_CONST, 0,
-                                                   newSVpvn(s, len)));
+                                                   sv));
                }
                s = PEEKSPACE(d);
                if (*s == ':' && s[1] != ':')
@@ -5471,7 +5484,7 @@ Perl_yylex(pTHX)
                        PUTBACK;
                        PerlIO_apply_layers(aTHX_ PL_rsfp, NULL,
                                            Perl_form(aTHX_ ":encoding(%"SVf")",
-                                                     name));
+                                                     (void*)name));
                        FREETMPS;
                        LEAVE;
                    }
@@ -5964,7 +5977,11 @@ Perl_yylex(pTHX)
                if (!PL_in_my_stash) {
                    char tmpbuf[1024];
                    PL_bufptr = s;
+#ifdef USE_SNPRINTF
+                   snprintf(tmpbuf, sizeof(tmpbuf), "No such class %.1000s", PL_tokenbuf);
+#else
                    sprintf(tmpbuf, "No such class %.1000s", PL_tokenbuf);
+#endif /* #ifdef USE_SNPRINTF */
                    yyerror(tmpbuf);
                }
 #ifdef PERL_MAD
@@ -6454,7 +6471,7 @@ Perl_yylex(pTHX)
                    if (bad_proto && ckWARN(WARN_SYNTAX))
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                                    "Illegal character in prototype for %"SVf" : %s",
-                                   PL_subname, d);
+                                   (void*)PL_subname, d);
                    SvCUR_set(PL_lex_stuff, tmp);
                    have_proto = TRUE;
 
@@ -6483,7 +6500,7 @@ Perl_yylex(pTHX)
                    if (!have_name)
                        Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine");
                    else if (*s != ';')
-                       Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, PL_subname);
+                       Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, (void*)PL_subname);
                }
 
 #ifdef PERL_MAD
@@ -6670,7 +6687,7 @@ S_pending_ident(pTHX)
 {
     dVAR;
     register char *d;
-    register I32 tmp = 0;
+    register PADOFFSET tmp = 0;
     /* pit holds the identifier we read and pending_ident is reset */
     char pit = PL_pending_ident;
     PL_pending_ident = 0;
@@ -11077,7 +11094,7 @@ S_scan_inputsymbol(pTHX_ char *start)
        or if it didn't end, or if we see a newline
     */
 
-    if (len >= sizeof PL_tokenbuf)
+    if (len >= (I32)sizeof PL_tokenbuf)
        Perl_croak(aTHX_ "Excessively long <> operator");
     if (s >= end)
        Perl_croak(aTHX_ "Unterminated <> operator");
@@ -11136,7 +11153,7 @@ S_scan_inputsymbol(pTHX_ char *start)
           filehandle
        */
        if (*d == '$') {
-           I32 tmp;
+           PADOFFSET tmp;
 
            /* try to find it in the pad for this block, otherwise find
               add symbol table ops
@@ -12242,13 +12259,13 @@ Perl_yyerror(pTHX_ const char *s)
         PL_multi_end = 0;
     }
     if (PL_in_eval & EVAL_WARNONLY && ckWARN_d(WARN_SYNTAX))
-       Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, msg);
+       Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, (void*)msg);
     else
        qerror(msg);
     if (PL_error_count >= 10) {
        if (PL_in_eval && SvCUR(ERRSV))
            Perl_croak(aTHX_ "%"SVf"%s has too many errors.\n",
-            ERRSV, OutCopFILE(PL_curcop));
+                      (void*)ERRSV, OutCopFILE(PL_curcop));
        else
            Perl_croak(aTHX_ "%s has too many errors.\n",
             OutCopFILE(PL_curcop));
@@ -12392,7 +12409,8 @@ utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
     const I32 count = FILTER_READ(idx+1, sv, maxlen);
     DEBUG_P(PerlIO_printf(Perl_debug_log,
                          "utf16_textfilter(%p): %d %d (%d)\n",
-                         utf16_textfilter, idx, maxlen, (int) count));
+                         FPTR2DPTR(void *, utf16_textfilter),
+                         idx, maxlen, (int) count));
     if (count) {
        U8* tmps;
        I32 newlen;
@@ -12414,7 +12432,8 @@ utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen)
     const I32 count = FILTER_READ(idx+1, sv, maxlen);
     DEBUG_P(PerlIO_printf(Perl_debug_log,
                          "utf16rev_textfilter(%p): %d %d (%d)\n",
-                         utf16rev_textfilter, idx, maxlen, (int) count));
+                         FPTR2DPTR(void *, utf16rev_textfilter),
+                         idx, maxlen, (int) count));
     if (count) {
        U8* tmps;
        I32 newlen;