Ressurect change 27824, which plugs a resource leak in uncalled code.

[p5sagit/p5-mst-13.2.git] / toke.c

diff --git a/toke.c b/toke.c
index 562a36c..23f801e 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -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            */
@@ -5482,7 +5484,7 @@ Perl_yylex(pTHX)
                        PUTBACK;
                        PerlIO_apply_layers(aTHX_ PL_rsfp, NULL,
                                            Perl_form(aTHX_ ":encoding(%"SVf")",
-                                                     name));
+                                                     (void*)name));
                        FREETMPS;
                        LEAVE;
                    }
@@ -5962,6 +5964,7 @@ Perl_yylex(pTHX)
 
        case KEY_our:
        case KEY_my:
+       case KEY_state:
            PL_in_my = tmp;
            s = SKIPSPACE1(s);
            if (isIDFIRST_lazy_if(s,UTF)) {
@@ -6469,7 +6472,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;
 
@@ -6498,7 +6501,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
@@ -6710,7 +6713,8 @@ S_pending_ident(pTHX)
         }
         else {
             if (strchr(PL_tokenbuf,':'))
-                yyerror(Perl_form(aTHX_ PL_no_myglob,PL_tokenbuf));
+                yyerror(Perl_form(aTHX_ PL_no_myglob,
+                           PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf));
 
             yylval.opval = newOP(OP_PADANY, 0);
             yylval.opval->op_targ = allocmy(PL_tokenbuf);
@@ -6828,7 +6832,7 @@ S_pending_ident(pTHX)
 I32
 Perl_keyword (pTHX_ const char *name, I32 len)
 {
-  dVAR;
+    dVAR;
   switch (len)
   {
     case 1: /* 5 tokens of length 1 */
@@ -7735,46 +7739,46 @@ Perl_keyword (pTHX_ const char *name, I32 len)
           switch (name[1])
           {
             case 'a':
-            switch (name[2])
-            {
-              case 'i':
-                if (name[3] == 't')
-                {                                 /* wait       */
-                  return -KEY_wait;
-                }
+              switch (name[2])
+              {
+                case 'i':
+                  if (name[3] == 't')
+                  {                               /* wait       */
+                    return -KEY_wait;
+                  }
 
-                goto unknown;
+                  goto unknown;
 
-              case 'r':
-                if (name[3] == 'n')
-                {                                 /* warn       */
-                  return -KEY_warn;
-                }
+                case 'r':
+                  if (name[3] == 'n')
+                  {                               /* warn       */
+                    return -KEY_warn;
+                  }
 
-                goto unknown;
+                  goto unknown;
 
-              default:
-                goto unknown;
-            }
+                default:
+                  goto unknown;
+              }
 
             case 'h':
               if (name[2] == 'e' &&
                   name[3] == 'n')
               {                                   /* when       */
                 return (FEATURE_IS_ENABLED("switch") ? KEY_when : 0);
-          }
+              }
 
-          goto unknown;
+              goto unknown;
 
-        default:
-          goto unknown;
-      }
+            default:
+              goto unknown;
+          }
 
         default:
           goto unknown;
       }
 
-    case 5: /* 38 tokens of length 5 */
+    case 5: /* 39 tokens of length 5 */
       switch (name[0])
       {
         case 'B':
@@ -7831,13 +7835,13 @@ Perl_keyword (pTHX_ const char *name, I32 len)
           {
             case 'l':
               if (name[2] == 'e' &&
-              name[3] == 's' &&
-              name[4] == 's')
-          {                                       /* bless      */
-            return -KEY_bless;
-          }
+                  name[3] == 's' &&
+                  name[4] == 's')
+              {                                   /* bless      */
+                return -KEY_bless;
+              }
 
-          goto unknown;
+              goto unknown;
 
             case 'r':
               if (name[2] == 'e' &&
@@ -8134,14 +8138,29 @@ Perl_keyword (pTHX_ const char *name, I32 len)
               goto unknown;
 
             case 't':
-              if (name[2] == 'u' &&
-                  name[3] == 'd' &&
-                  name[4] == 'y')
-              {                                   /* study      */
-                return KEY_study;
-              }
+              switch (name[2])
+              {
+                case 'a':
+                  if (name[3] == 't' &&
+                      name[4] == 'e')
+                  {                               /* state      */
+                    return (FEATURE_IS_ENABLED("state") ? KEY_state : 0);
+                  }
 
-              goto unknown;
+                  goto unknown;
+
+                case 'u':
+                  if (name[3] == 'd' &&
+                      name[4] == 'y')
+                  {                               /* study      */
+                    return KEY_study;
+                  }
+
+                  goto unknown;
+
+                default:
+                  goto unknown;
+              }
 
             default:
               goto unknown;
@@ -8800,17 +8819,17 @@ Perl_keyword (pTHX_ const char *name, I32 len)
 
                   case 'i':
                     if (name[4] == 'n' &&
-                  name[5] == 'e' &&
-                  name[6] == 'd')
-              {                                   /* defined    */
-                return KEY_defined;
-              }
+                        name[5] == 'e' &&
+                        name[6] == 'd')
+                    {                             /* defined    */
+                      return KEY_defined;
+                    }
 
-              goto unknown;
+                    goto unknown;
 
-            default:
-              goto unknown;
-          }
+                  default:
+                    goto unknown;
+                }
               }
 
               goto unknown;
@@ -12257,13 +12276,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));
@@ -12407,7 +12426,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;
@@ -12429,7 +12449,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;