deleting pattern match ops in another thread.
p4raw-id: //depot/perl@30856
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
#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)
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;
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)
{
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);
{
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;