This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[patch] ptr_table_store
[perl5.git]
/
sv.c
diff --git
a/sv.c
b/sv.c
index
ed40f68
..
4f38159
100644
(file)
--- a/
sv.c
+++ b/
sv.c
@@
-4461,16
+4461,20
@@
Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
/* Some magic sontains a reference loop, where the sv and object refer to
each other. To prevent a reference loop that would prevent such
objects being freed, we look for such loops and if we find one we
/* Some magic sontains a reference loop, where the sv and object refer to
each other. To prevent a reference loop that would prevent such
objects being freed, we look for such loops and if we find one we
- avoid incrementing the object refcount. */
+ avoid incrementing the object refcount.
+
+ Note we cannot do this to avoid self-tie loops as intervening RV must
+ have its REFCNT incremented to keep it in existence - instead we could
+ special case them in sv_free() -- NI-S
+
+ */
if (!obj || obj == sv ||
how == PERL_MAGIC_arylen ||
how == PERL_MAGIC_qr ||
(SvTYPE(obj) == SVt_PVGV &&
(GvSV(obj) == sv || GvHV(obj) == (HV*)sv || GvAV(obj) == (AV*)sv ||
GvCV(obj) == (CV*)sv || GvIOp(obj) == (IO*)sv ||
if (!obj || obj == sv ||
how == PERL_MAGIC_arylen ||
how == PERL_MAGIC_qr ||
(SvTYPE(obj) == SVt_PVGV &&
(GvSV(obj) == sv || GvHV(obj) == (HV*)sv || GvAV(obj) == (AV*)sv ||
GvCV(obj) == (CV*)sv || GvIOp(obj) == (IO*)sv ||
- GvFORM(obj) == (CV*)sv)) ||
- (how == PERL_MAGIC_tiedscalar &&
- SvROK(obj) && (SvRV(obj) == sv || GvIO(SvRV(obj)) == (IO*)sv)))
+ GvFORM(obj) == (CV*)sv)))
{
mg->mg_obj = obj;
}
{
mg->mg_obj = obj;
}
@@
-8753,7
+8757,6
@@
Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldv, void *newv)
for (tblent = *otblent; tblent; i=0, tblent = tblent->next) {
if (tblent->oldval == oldv) {
tblent->newval = newv;
for (tblent = *otblent; tblent; i=0, tblent = tblent->next) {
if (tblent->oldval == oldv) {
tblent->newval = newv;
- tbl->tbl_items++;
return;
}
}
return;
}
}
@@
-8855,10
+8858,10
@@
char *PL_watch_pvx;
/* attempt to make everything in the typeglob readonly */
STATIC SV *
/* attempt to make everything in the typeglob readonly */
STATIC SV *
-S_gv_share(pTHX_ SV *sstr)
+S_gv_share(pTHX_ SV *sstr
, CLONE_PARAMS *param
)
{
GV *gv = (GV*)sstr;
{
GV *gv = (GV*)sstr;
- SV *sv = &
PL_
sv_no; /* just need SvREADONLY-ness */
+ SV *sv = &
param->proto_perl->I
sv_no; /* just need SvREADONLY-ness */
if (GvIO(gv) || GvFORM(gv)) {
GvUNIQUE_off(gv); /* GvIOs cannot be shared. nor can GvFORMs */
if (GvIO(gv) || GvFORM(gv)) {
GvUNIQUE_off(gv); /* GvIOs cannot be shared. nor can GvFORMs */
@@
-8868,7
+8871,7
@@
S_gv_share(pTHX_ SV *sstr)
}
else {
/* CvPADLISTs cannot be shared */
}
else {
/* CvPADLISTs cannot be shared */
- if (!CvXSUB(GvCV(gv))) {
+ if (!
SvREADONLY(GvCV(gv)) && !
CvXSUB(GvCV(gv))) {
GvUNIQUE_off(gv);
}
}
GvUNIQUE_off(gv);
}
}
@@
-9049,9
+9052,10
@@
Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
case SVt_PVGV:
if (GvUNIQUE((GV*)sstr)) {
SV *share;
case SVt_PVGV:
if (GvUNIQUE((GV*)sstr)) {
SV *share;
- if ((share = gv_share(sstr))) {
+ if ((share = gv_share(sstr
, param
))) {
del_SV(dstr);
dstr = share;
del_SV(dstr);
dstr = share;
+ ptr_table_store(PL_ptr_table, sstr, dstr);
#if 0
PerlIO_printf(Perl_debug_log, "sv_dup: sharing %s::%s\n",
HvNAME(GvSTASH(share)), GvNAME(share));
#if 0
PerlIO_printf(Perl_debug_log, "sv_dup: sharing %s::%s\n",
HvNAME(GvSTASH(share)), GvNAME(share));
@@
-9754,6
+9758,7
@@
perl_clone_using(PerlInterpreter *proto_perl, UV flags,
# endif /* DEBUGGING */
#endif /* PERL_IMPLICIT_SYS */
param->flags = flags;
# endif /* DEBUGGING */
#endif /* PERL_IMPLICIT_SYS */
param->flags = flags;
+ param->proto_perl = proto_perl;
/* arena roots */
PL_xiv_arenaroot = NULL;
/* arena roots */
PL_xiv_arenaroot = NULL;