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 dc94328..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;
@@ -2636,7 +2638,14 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
     /* This API is bad. It should have been using unsigned int for maxlen.
        Not sure if we want to change the API, but if not we should sanity
        check the value here.  */
-    const unsigned int correct_length = maxlen < 0 ? INT_MAX : maxlen;
+    const unsigned int correct_length
+       = maxlen < 0 ?
+#ifdef PERL_MICRO
+       0x7FFFFFFF
+#else
+       INT_MAX
+#endif
+       : maxlen;
 
     if (!PL_rsfp_filters)
        return -1;
@@ -2682,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            */
@@ -3993,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;
@@ -4010,6 +4020,7 @@ Perl_yylex(pTHX)
                        break;
                    }
                }
+               sv = newSVpvn(s, len);
                if (*d == '(') {
                    d = scan_str(d,TRUE,TRUE);
                    if (!d) {
@@ -4020,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));
@@ -4032,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));
@@ -4047,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
@@ -4068,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] != ':')
@@ -5464,7 +5484,7 @@ Perl_yylex(pTHX)
                        PUTBACK;
                        PerlIO_apply_layers(aTHX_ PL_rsfp, NULL,
                                            Perl_form(aTHX_ ":encoding(%"SVf")",
-                                                     name));
+                                                     (void*)name));
                        FREETMPS;
                        LEAVE;
                    }
@@ -5957,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
@@ -6447,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;
 
@@ -6476,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
@@ -6663,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;
@@ -11070,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");
@@ -11129,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
@@ -12235,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));
@@ -12385,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;
@@ -12407,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;