This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Avoid accessing free()d memory when calling reset in one thread, after
authorNicholas Clark <nick@ccl4.org>
Fri, 6 Apr 2007 20:57:34 +0000 (20:57 +0000)
committerNicholas Clark <nick@ccl4.org>
Fri, 6 Apr 2007 20:57:34 +0000 (20:57 +0000)
deleting pattern match ops in another thread.

p4raw-id: //depot/perl@30856

embed.fnc
embed.h
op.c
proto.h
t/op/reset.t

index bf8d7a6..99252c2 100644 (file)
--- 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 (file)
--- a/embed.h
+++ b/embed.h
 #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
 #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 (file)
--- 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 (file)
--- 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);
 
index 7a9620f..029161a 100644 (file)
@@ -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;