SvFAKE_on(dstr); /* can coerce to non-glob */
}
-#ifdef GV_UNIQUE_CHECK
- if (GvUNIQUE((const GV *)dstr)) {
- Perl_croak(aTHX_ "%s", PL_no_modify);
- }
-#endif
-
if(GvGP(MUTABLE_GV(sstr))) {
/* If source has method cache entry, clear it */
if(GvCVGEN(sstr)) {
PERL_ARGS_ASSERT_GLOB_ASSIGN_REF;
-#ifdef GV_UNIQUE_CHECK
- if (GvUNIQUE((const GV *)dstr)) {
- Perl_croak(aTHX_ "%s", PL_no_modify);
- }
-#endif
-
if (intro) {
GvINTRO_off(dstr); /* one-shot flag */
GvLINE(dstr) = CopLINE(PL_curcop);
&& ((flags & SV_COW_SHARED_HASH_KEYS)
? (!((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
&& (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
- && SvTYPE(sstr) >= SVt_PVIV))
+ && SvTYPE(sstr) >= SVt_PVIV && SvTYPE(sstr) != SVt_PVFM))
: 1)
#endif
) {
}
#ifdef PERL_OLD_COPY_ON_WRITE
if (!isSwipe) {
- /* I believe I should acquire a global SV mutex if
- it's a COW sv (not a shared hash key) to stop
- it going un copy-on-write.
- If the source SV has gone un copy on write between up there
- and down here, then (assert() that) it is of the correct
- form to make it copy on write again */
if ((sflags & (SVf_FAKE | SVf_READONLY))
!= (SVf_FAKE | SVf_READONLY)) {
SvREADONLY_on(sstr);
SvCUR_set(dstr, cur);
SvREADONLY_on(dstr);
SvFAKE_on(dstr);
- /* Relesase a global SV mutex. */
}
else
{ /* Passes the swipe test. */
#ifdef PERL_OLD_COPY_ON_WRITE
if (SvREADONLY(sv)) {
- /* At this point I believe I should acquire a global SV mutex. */
if (SvFAKE(sv)) {
const char * const pvx = SvPVX_const(sv);
const STRLEN len = SvLEN(sv);
}
else if (IN_PERL_RUNTIME)
Perl_croak(aTHX_ "%s", PL_no_modify);
- /* At this point I believe that I can drop the global SV mutex. */
}
#else
if (SvREADONLY(sv)) {
stash = SvSTASH(sv);
destructor = StashHANDLER(stash,DESTROY);
if (destructor
+ /* A constant subroutine can have no side effects, so
+ don't bother calling it. */
+ && !CvCONST(destructor)
/* Don't bother calling an empty destructor */
&& (CvISXSUB(destructor)
|| CvSTART(destructor)->op_next->op_type != OP_LEAVESUB))
#ifdef PERL_OLD_COPY_ON_WRITE
else if (SvPVX_const(sv)) {
if (SvIsCOW(sv)) {
- /* I believe I need to grab the global SV mutex here and
- then recheck the COW status. */
if (DEBUG_C_TEST) {
PerlIO_printf(Perl_debug_log, "Copy on write: clear\n");
sv_dump(sv);
unshare_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv)));
}
- /* And drop it here. */
SvFAKE_off(sv);
} else if (SvLEN(sv)) {
Safefree(SvPVX_const(sv));
if (args) {
eptr = va_arg(*args, char*);
if (eptr)
-#ifdef MACOS_TRADITIONAL
- /* On MacOS, %#s format is used for Pascal strings */
- if (alt)
- elen = *eptr++;
- else
-#endif
elen = strlen(eptr);
else {
eptr = (char *)nullstr;
ptr_table_store(PL_ptr_table, gp, ret);
/* clone */
- ret->gp_refcnt = 0; /* must be before any other dups! */
+ /* ret->gp_refcnt must be 0 before any other dups are called. We're relying
+ on Newxz() to do this for us. */
ret->gp_sv = sv_dup_inc(gp->gp_sv, param);
ret->gp_io = io_dup_inc(gp->gp_io, param);
ret->gp_form = cv_dup_inc(gp->gp_form, param);
break;
case SVt_PVGV:
- if (GvUNIQUE((const GV *)sstr)) {
- NOOP; /* Do sharing here, and fall through */
- }
case SVt_PVIO:
case SVt_PVFM:
case SVt_PVHV:
LvTARG(dstr) = sv_dup_inc(LvTARG(dstr), param);
case SVt_PVGV:
if(isGV_with_GP(sstr)) {
- if (GvNAME_HEK(dstr))
- GvNAME_HEK(dstr) = hek_dup(GvNAME_HEK(dstr), param);
+ GvNAME_HEK(dstr) = hek_dup(GvNAME_HEK(dstr), param);
/* Don't call sv_add_backref here as it's going to be
created as part of the magic cloning of the symbol
table. */
SvFLAGS(dstr) |= SVf_OOK;
hvname = saux->xhv_name;
- daux->xhv_name = hvname ? hek_dup(hvname, param) : hvname;
+ daux->xhv_name = hek_dup(hvname, param);
daux->xhv_riter = saux->xhv_riter;
daux->xhv_eiter = saux->xhv_eiter
CvROOT(dstr) = OpREFCNT_inc(CvROOT(dstr));
OP_REFCNT_UNLOCK;
if (CvCONST(dstr) && CvISXSUB(dstr)) {
- CvXSUBANY(dstr).any_ptr = GvUNIQUE(CvGV(dstr)) ?
- SvREFCNT_inc(CvXSUBANY(dstr).any_ptr) :
+ CvXSUBANY(dstr).any_ptr =
sv_dup_inc((const SV *)CvXSUBANY(dstr).any_ptr, param);
}
/* don't dup if copying back - CvGV isn't refcounted, so the