From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 6 Apr 2007 20:57:34 +0000 (+0000)
Subject: Avoid accessing free()d memory when calling reset in one thread, after
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bfd0ff222f043bea86c0b0e7700eeab47f675d46;p=p5sagit%2Fp5-mst-13.2.git

Avoid accessing free()d memory when calling reset in one thread, after
deleting pattern match ops in another thread.

p4raw-id: //depot/perl@30856
---

diff --git a/embed.fnc b/embed.fnc
index bf8d7a6..99252c2 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1196,6 +1196,7 @@ pR	|OP*	|ck_unpack	|NN OP *o
 sRn	|bool	|is_handle_constructor|NN const OP *o|I32 numargs
 sR	|I32	|is_list_assignment|NULLOK const OP *o
 s	|void	|forget_pmop	|NN PMOP *const o|U32 flags
+s	|void	|find_and_forget_pmops	|NN OP *o
 s	|void	|cop_free	|NN COP *cop
 s	|OP*	|modkids	|NULLOK OP *o|I32 type
 s	|OP*	|scalarboolean	|NN OP *o
diff --git a/embed.h b/embed.h
index 7a44131..71ccb4d 100644
--- a/embed.h
+++ b/embed.h
@@ -1193,6 +1193,7 @@
 #define is_handle_constructor	S_is_handle_constructor
 #define is_list_assignment	S_is_list_assignment
 #define forget_pmop		S_forget_pmop
+#define find_and_forget_pmops	S_find_and_forget_pmops
 #define cop_free		S_cop_free
 #define modkids			S_modkids
 #define scalarboolean		S_scalarboolean
@@ -3431,6 +3432,7 @@
 #define is_handle_constructor	S_is_handle_constructor
 #define is_list_assignment(a)	S_is_list_assignment(aTHX_ a)
 #define forget_pmop(a,b)	S_forget_pmop(aTHX_ a,b)
+#define find_and_forget_pmops(a)	S_find_and_forget_pmops(aTHX_ a)
 #define cop_free(a)		S_cop_free(aTHX_ a)
 #define modkids(a,b)		S_modkids(aTHX_ a,b)
 #define scalarboolean(a)	S_scalarboolean(aTHX_ a)
diff --git a/op.c b/op.c
index b00164c..e0be444 100644
--- a/op.c
+++ b/op.c
@@ -428,9 +428,13 @@ Perl_op_free(pTHX_ OP *o)
 	    OP_REFCNT_LOCK;
 	    refcnt = OpREFCNT_dec(o);
 	    OP_REFCNT_UNLOCK;
-	    if (refcnt)
+	    if (refcnt) {
+		/* Need to find and remove any pattern match ops from the list
+		   we maintain for reset().  */
+		find_and_forget_pmops(o);
 		return;
 	    }
+	    }
 	    break;
 	default:
 	    break;
@@ -652,6 +656,25 @@ S_forget_pmop(pTHX_ PMOP *const o, U32 flags)
 	PmopSTASH_free(o);
 }
 
+STATIC void
+S_find_and_forget_pmops(pTHX_ OP *o)
+{
+    if (o->op_flags & OPf_KIDS) {
+        OP *kid = cUNOPo->op_first;
+	while (kid) {
+	    switch (kid->op_type) {
+	    case OP_SUBST:
+	    case OP_PUSHRE:
+	    case OP_MATCH:
+	    case OP_QR:
+		forget_pmop((PMOP*)kid, 0);
+	    }
+	    find_and_forget_pmops(kid);
+	    kid = kid->op_sibling;
+	}
+    }
+}
+
 void
 Perl_op_null(pTHX_ OP *o)
 {
diff --git a/proto.h b/proto.h
index 79e6eec..436fa79 100644
--- a/proto.h
+++ b/proto.h
@@ -3243,6 +3243,9 @@ STATIC I32	S_is_list_assignment(pTHX_ const OP *o)
 STATIC void	S_forget_pmop(pTHX_ PMOP *const o, U32 flags)
 			__attribute__nonnull__(pTHX_1);
 
+STATIC void	S_find_and_forget_pmops(pTHX_ OP *o)
+			__attribute__nonnull__(pTHX_1);
+
 STATIC void	S_cop_free(pTHX_ COP *cop)
 			__attribute__nonnull__(pTHX_1);
 
diff --git a/t/op/reset.t b/t/op/reset.t
index 7a9620f..029161a 100644
--- a/t/op/reset.t
+++ b/t/op/reset.t
@@ -70,8 +70,6 @@ SKIP:
 {
     eval {require threads; 1} or
 	skip "No threads", 4;
-    local $::TODO
-	= "Currently performs a read from free()d memory, and may crash";
     foreach my $eight ('/', '?') {
 	foreach my $nine ('/', '?') {
 	    my $copy = $prog;