memleak in optimizer

	Message-Id: <199906231516.QAA23851@crypt.compulink.co.uk>

p4raw-id: //depot/perl@3634

diff --git a/embed.h b/embed.h
index 0871c6f..cc005cb 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -731,6 +731,7 @@
 #if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT)
 #define list_assignment                S_list_assignment
 #define bad_type               S_bad_type
+#define cop_free               S_cop_free
 #define modkids                        S_modkids
 #define no_bareword_allowed    S_no_bareword_allowed
 #define no_fh_allowed          S_no_fh_allowed
@@ -986,6 +987,7 @@
 #define ck_require             Perl_ck_require
 #define ck_rfun                        Perl_ck_rfun
 #define ck_rvconst             Perl_ck_rvconst
+#define ck_sassign             Perl_ck_sassign
 #define ck_scmp                        Perl_ck_scmp
 #define ck_select              Perl_ck_select
 #define ck_shift               Perl_ck_shift
@@ -2039,6 +2041,7 @@
 #if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT)
 #define list_assignment(a)     S_list_assignment(aTHX_ a)
 #define bad_type(a,b,c,d)      S_bad_type(aTHX_ a,b,c,d)
+#define cop_free(a)            S_cop_free(aTHX_ a)
 #define modkids(a,b)           S_modkids(aTHX_ a,b)
 #define no_bareword_allowed(a) S_no_bareword_allowed(aTHX_ a)
 #define no_fh_allowed(a)       S_no_fh_allowed(aTHX_ a)
@@ -2293,6 +2296,7 @@
 #define ck_require(a)          Perl_ck_require(aTHX_ a)
 #define ck_rfun(a)             Perl_ck_rfun(aTHX_ a)
 #define ck_rvconst(a)          Perl_ck_rvconst(aTHX_ a)
+#define ck_sassign(a)          Perl_ck_sassign(aTHX_ a)
 #define ck_scmp(a)             Perl_ck_scmp(aTHX_ a)
 #define ck_select(a)           Perl_ck_select(aTHX_ a)
 #define ck_shift(a)            Perl_ck_shift(aTHX_ a)
@@ -4027,6 +4031,8 @@
 #define list_assignment                S_list_assignment
 #define S_bad_type             CPerlObj::S_bad_type
 #define bad_type               S_bad_type
+#define S_cop_free             CPerlObj::S_cop_free
+#define cop_free               S_cop_free
 #define S_modkids              CPerlObj::S_modkids
 #define modkids                        S_modkids
 #define S_no_bareword_allowed  CPerlObj::S_no_bareword_allowed
@@ -4489,6 +4495,8 @@
 #define ck_rfun                        Perl_ck_rfun
 #define Perl_ck_rvconst                CPerlObj::Perl_ck_rvconst
 #define ck_rvconst             Perl_ck_rvconst
+#define Perl_ck_sassign                CPerlObj::Perl_ck_sassign
+#define ck_sassign             Perl_ck_sassign
 #define Perl_ck_scmp           CPerlObj::Perl_ck_scmp
 #define ck_scmp                        Perl_ck_scmp
 #define Perl_ck_select         CPerlObj::Perl_ck_select

diff --git a/embed.pl b/embed.pl
index ed7f3e4..f6a0cc0 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1523,6 +1523,7 @@ s |void   |restore_magic  |void *p
 #if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT)
 s      |I32    |list_assignment|OP *o
 s      |void   |bad_type       |I32 n|char *t|char *name|OP *kid
+s      |void   |cop_free       |COP *cop
 s      |OP*    |modkids        |OP *o|I32 type
 s      |void   |no_bareword_allowed|OP *o
 s      |OP*    |no_fh_allowed  |OP *o

diff --git a/objXSUB.h b/objXSUB.h
index d91f84d..ec66e5f 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -3509,6 +3509,10 @@
 #define Perl_ck_rvconst                pPerl->Perl_ck_rvconst
 #undef  ck_rvconst
 #define ck_rvconst             Perl_ck_rvconst
+#undef  Perl_ck_sassign
+#define Perl_ck_sassign                pPerl->Perl_ck_sassign
+#undef  ck_sassign
+#define ck_sassign             Perl_ck_sassign
 #undef  Perl_ck_scmp
 #define Perl_ck_scmp           pPerl->Perl_ck_scmp
 #undef  ck_scmp

diff --git a/op.c b/op.c
index e1d6976..d9e78f7 100644 (file)
--- a/op.c
+++ b/op.c
@@ -686,10 +686,7 @@ Perl_op_free(pTHX_ OP *o)
        break;
     case OP_NEXTSTATE:
     case OP_DBSTATE:
-       Safefree(cCOPo->cop_label);
-       SvREFCNT_dec(cCOPo->cop_filegv);
-       if (cCOPo->cop_warnings != WARN_NONE && cCOPo->cop_warnings != WARN_ALL)
-           SvREFCNT_dec(cCOPo->cop_warnings);
+       cop_free((COP*)o);
        break;
     case OP_CONST:
        SvREFCNT_dec(cSVOPo->op_sv);
@@ -730,6 +727,15 @@ Perl_op_free(pTHX_ OP *o)
 }
 
 STATIC void
+S_cop_free(pTHX_ COP* cop)
+{
+    Safefree(cop->cop_label);
+    SvREFCNT_dec(cop->cop_filegv);
+    if (cop->cop_warnings != WARN_NONE && cop->cop_warnings != WARN_ALL)
+       SvREFCNT_dec(cop->cop_warnings);
+}
+
+STATIC void
 S_null(pTHX_ OP *o)
 {
     if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
@@ -1678,7 +1684,7 @@ Perl_scope(pTHX_ OP *o)
                o->op_ppaddr = PL_ppaddr[OP_SCOPE];
                kid = ((LISTOP*)o)->op_first;
                if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
-                   SvREFCNT_dec(((COP*)kid)->cop_filegv);
+                   cop_free((COP*)kid);
                    null(kid);
                }
            }

diff --git a/proto.h b/proto.h
index 7fa6424..d7f4423 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -740,6 +740,7 @@ STATIC void S_restore_magic(pTHX_ void *p);
 #if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT)
 STATIC I32     S_list_assignment(pTHX_ OP *o);
 STATIC void    S_bad_type(pTHX_ I32 n, char *t, char *name, OP *kid);
+STATIC void    S_cop_free(pTHX_ COP *cop);
 STATIC OP*     S_modkids(pTHX_ OP *o, I32 type);
 STATIC void    S_no_bareword_allowed(pTHX_ OP *o);
 STATIC OP*     S_no_fh_allowed(pTHX_ OP *o);