memleak in optimizer

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

p4raw-id: //depot/perl@3634

5 files changed, 25 insertions, 5 deletions

diff --git a/embed.h b/embed.h
index 0871c6f34a..cc005cbacc 100644
--- 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 ed7f3e45b5..f6a0cc021f 100755
--- 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 d91f84d0ee..ec66e5f1c3 100644
--- 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 e1d697695a..d9e78f7aba 100644
--- 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 7fa642405b..d7f4423c54 100644
--- 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);