Make sure that all our check functions reset a possible previous entry in the pointer table. Then, check in ck_entersub that the object op (the first kid after the pushmark) is of a proper type, so that we are pretty sure that its map entry has been either reset or filled.
t/22-bad-mixed.t
t/30-scope.t
t/40-threads.t
t/22-bad-mixed.t
t/30-scope.t
t/40-threads.t
t/91-pod.t
t/92-pod-coverage.t
t/95-portability-files.t
t/99-kwalitee.t
t/91-pod.t
t/92-pod-coverage.t
t/95-portability-files.t
t/99-kwalitee.t
+t/lib/indirect/Test0/Fffff/Vvvvvvv.pm
+t/lib/indirect/Test0/Oooooo/Pppppppp.pm
t/lib/indirect/TestRequired1.pm
t/lib/indirect/TestRequired2.pm
t/lib/indirect/TestRequired1.pm
t/lib/indirect/TestRequired2.pm
#include "ptable.h"
#define ptable_store(T, K, V) ptable_store(aTHX_ (T), (K), (V))
#include "ptable.h"
#define ptable_store(T, K, V) ptable_store(aTHX_ (T), (K), (V))
+#define ptable_delete(T, K) ptable_delete(aTHX_ (T), (K))
#define ptable_clear(T) ptable_clear(aTHX_ (T))
#define ptable_free(T) ptable_free(aTHX_ (T))
#define ptable_clear(T) ptable_clear(aTHX_ (T))
#define ptable_free(T) ptable_free(aTHX_ (T))
return INT2PTR(const char *, SvUVX(val));
}
return INT2PTR(const char *, SvUVX(val));
}
+STATIC void indirect_map_delete(pTHX_ const OP *o) {
+#define indirect_map_delete(O) indirect_map_delete(aTHX_ (O))
+ dMY_CXT;
+
+ ptable_delete(MY_CXT.map, o);
+}
+
/* --- Check functions ----------------------------------------------------- */
STATIC const char *indirect_find(pTHX_ SV *sv, const char *s) {
/* --- Check functions ----------------------------------------------------- */
STATIC const char *indirect_find(pTHX_ SV *sv, const char *s) {
if (indirect_hint()) {
SV *sv = cSVOPo_sv;
if (indirect_hint()) {
SV *sv = cSVOPo_sv;
- if (SvPOK(sv) && (SvTYPE(sv) >= SVt_PV))
+ if (SvPOK(sv) && (SvTYPE(sv) >= SVt_PV)) {
indirect_map_store(o, indirect_find(sv, PL_oldbufptr), sv);
indirect_map_store(o, indirect_find(sv, PL_oldbufptr), sv);
+ indirect_map_delete(o);
- return CALL_FPTR(indirect_old_ck_rv2sv)(aTHX_ o);
+ o = CALL_FPTR(indirect_old_ck_rv2sv)(aTHX_ o);
+
+ indirect_map_delete(o);
+ return o;
}
/* ... ck_padany ........................................................... */
}
/* ... ck_padany ........................................................... */
sv = sv_2mortal(newSVpvn("$", 1));
sv_catpvn_nomg(sv, s, t - s + 1);
indirect_map_store(o, s, sv);
sv = sv_2mortal(newSVpvn("$", 1));
sv_catpvn_nomg(sv, s, t - s + 1);
indirect_map_store(o, s, sv);
+ indirect_map_delete(o);
- return CALL_FPTR(indirect_old_ck_method)(aTHX_ o);
+ o = CALL_FPTR(indirect_old_ck_method)(aTHX_ o);
+
+ indirect_map_delete(o);
+ return o;
}
/* ... ck_entersub ......................................................... */
}
/* ... ck_entersub ......................................................... */
oop = oop->op_sibling;
mop = lop->op_last;
oop = oop->op_sibling;
mop = lop->op_last;
+ if (!oop)
+ goto done;
+
+ switch (oop->op_type) {
+ case OP_CONST:
+ case OP_RV2SV:
+ case OP_PADSV:
+ break;
+ default:
+ goto done;
+ }
+
if (mop->op_type == OP_METHOD)
mop = cUNOPx(mop)->op_first;
else if (mop->op_type != OP_METHOD_NAMED)
if (mop->op_type == OP_METHOD)
mop = cUNOPx(mop)->op_first;
else if (mop->op_type != OP_METHOD_NAMED)
}
#endif /* !ptable_fetch */
}
#endif /* !ptable_fetch */
+STATIC void PTABLE_PREFIX(_delete)(pPTBL_ const ptable * const t, const void * const key) {
+ ptable_ent *const ent = ptable_find(t, key);
+
+ if (ent) {
+ void *val = ent->val;
+ PTABLE_VAL_FREE(val);
+ ent->val = NULL;
+ }
+}
+
#ifndef ptable_split
STATIC void ptable_split(pPTBLMS_ ptable * const t) {
#define ptable_split(T) ptable_split(aPTBLMS_ (T))
#ifndef ptable_split
STATIC void ptable_split(pPTBLMS_ ptable * const t) {
#define ptable_split(T) ptable_split(aPTBLMS_ (T))
--- /dev/null
+#!perl -T
+
+use lib 't/lib';
+
+use Test::More tests => 1;
+
+eval "require indirect::Test0::Oooooo::Pppppppp";
+is($@, '', 'memory reallocation to an uncatched optype');
--- /dev/null
+package indirect::Test0::Fffff::Vvvvvvv;
+
+use warnings;
+use strict;
+
+my $f;
+sub import {
+ my($class, %args) = @_;
+ $f = bless({ x => $args{x}, y => $args{y} }, $class);
+}
+
+1;
--- /dev/null
+package indirect::Test0::Oooooo::Pppppppp;
+
+use strict;
+no indirect ":fatal";
+
+use indirect::Test0::Fffff::Vvvvvvv
+ z => 0,
+ x => sub { },
+ y => sub { };
+
+use indirect::Test0::Fffff::Vvvvvvv
+ t => [xxxx=>qw(xxxxxx xxxxxxx)],
+ x => sub { $_[0]->method };
+
+1;