#define new_SV() sv = (SV*)safemalloc(sizeof(SV))
#define del_SV(p) free((char*)p)
+void
+sv_add_arena(ptr, size, flags)
+char* ptr;
+U32 size;
+U32 flags;
+{
+ if (!(flags & SVf_FAKE))
+ free(ptr);
+}
+
#else
#define new_SV() \
} \
else \
sv = more_sv();
-#endif
static SV*
new_sv()
SV* p;
{
if (debug & 32768) {
+ SV* sva;
SV* sv;
SV* svend;
int ok = 0;
- for (sv = sv_arenaroot; sv; sv = (SV *) SvANY(svend)) {
- svend = &sv[1008 / sizeof(SV)];
+ for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
+ sv = sva + 1;
+ svend = &sva[SvREFCNT(sva)];
if (p >= sv && p < svend)
ok = 1;
}
#endif
-static SV*
-more_sv()
+void
+sv_add_arena(ptr, size, flags)
+char* ptr;
+U32 size;
+U32 flags;
{
+ SV* sva = (SV*)ptr;
register SV* sv;
register SV* svend;
- sv_root = (SV*)safemalloc(1012);
- sv = sv_root;
- Zero(sv, 1012, char);
- svend = &sv[1008 / sizeof(SV) - 1];
+ Zero(sva, size, char);
+
+ /* The first SV in an arena isn't an SV. */
+ SvANY(sva) = (void *) sv_arenaroot; /* ptr to next arena */
+ SvREFCNT(sva) = size / sizeof(SV); /* number of SV slots */
+ SvFLAGS(sva) = flags; /* FAKE if not to be freed */
+
+ sv_arenaroot = sva;
+ sv_root = sva + 1;
+
+ svend = &sva[SvREFCNT(sva) - 1];
+ sv = sva + 1;
while (sv < svend) {
SvANY(sv) = (void *)(SV*)(sv + 1);
SvFLAGS(sv) = SVTYPEMASK;
sv++;
}
SvANY(sv) = 0;
- sv++;
- SvANY(sv) = (void *) sv_arenaroot;
- sv_arenaroot = sv_root;
+ SvFLAGS(sv) = SVTYPEMASK;
+}
+
+static SV*
+more_sv()
+{
+ sv_add_arena(safemalloc(1008), 1008, 0);
return new_sv();
}
+#endif
void
sv_report_used()
{
+ SV* sva;
SV* sv;
register SV* svend;
- for (sv = sv_arenaroot; sv; sv = (SV *) SvANY(sv)) {
- svend = &sv[1008 / sizeof(SV)];
+ for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
+ sv = sva + 1;
+ svend = &sva[SvREFCNT(sva)];
while (sv < svend) {
if (SvTYPE(sv) != SVTYPEMASK) {
fprintf(stderr, "****\n");
void
sv_clean_objs()
{
+ SV* sva;
register SV* sv;
register SV* svend;
SV* rv;
- for (sv = sv_arenaroot; sv; sv = (SV *) SvANY(sv)) {
- svend = &sv[1008 / sizeof(SV)];
+ for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
+ sv = sva + 1;
+ svend = &sva[SvREFCNT(sva)];
while (sv < svend) {
if (SvROK(sv) && SvOBJECT(rv = SvRV(sv))) {
DEBUG_D((fprintf(stderr, "Cleaning object ref:\n "),
void
sv_clean_all()
{
+ SV* sva;
register SV* sv;
register SV* svend;
- for (sv = sv_arenaroot; sv; sv = (SV *) SvANY(sv)) {
- svend = &sv[1008 / sizeof(SV)];
+ for (sva = sv_arenaroot; sva; sva = (SV*) SvANY(sva)) {
+ sv = sva + 1;
+ svend = &sva[SvREFCNT(sva)];
while (sv < svend) {
if (SvTYPE(sv) != SVTYPEMASK) {
DEBUG_D((fprintf(stderr, "Cleaning loops:\n "), sv_dump(sv));)
}
}
+void
+sv_free_arenas()
+{
+ SV* sva;
+ SV* svanext;
+
+ /* Free arenas here, but be careful about fake ones. (We assume
+ contiguity of the fake ones with the corresponding real ones.) */
+
+ for (sva = sv_arenaroot; sva; sva = svanext) {
+ svanext = (SV*) SvANY(sva);
+ while (svanext && SvFAKE(svanext))
+ svanext = (SV*) SvANY(svanext);
+
+ if (!SvFAKE(sva))
+ Safefree(sva);
+ }
+}
+
static XPVIV*
new_xiv()
{
magic = 0;
stash = 0;
del_XPV(SvANY(sv));
+ if (mt <= SVt_IV)
+ mt = SVt_PVIV;
+ else if (mt == SVt_NV)
+ mt = SVt_PVNV;
break;
case SVt_PVIV:
nv = 0.0;
break;
case SVt_PVCV:
SvANY(sv) = new_XPVCV();
+ Zero(SvANY(sv), 1, XPVCV);
SvPVX(sv) = pv;
SvCUR(sv) = cur;
SvLEN(sv) = len;
SvNVX(sv) = nv;
SvMAGIC(sv) = magic;
SvSTASH(sv) = stash;
- CvSTASH(sv) = 0;
- CvSTART(sv) = 0;
- CvROOT(sv) = 0;
- CvXSUB(sv) = 0;
- CvXSUBANY(sv).any_ptr = 0;
- CvFILEGV(sv) = 0;
- CvDEPTH(sv) = 0;
- CvPADLIST(sv) = 0;
- CvOLDSTYLE(sv) = 0;
break;
case SVt_PVGV:
SvANY(sv) = new_XPVGV();
break;
case SVt_PVFM:
SvANY(sv) = new_XPVFM();
+ Zero(SvANY(sv), 1, XPVFM);
SvPVX(sv) = pv;
SvCUR(sv) = cur;
SvLEN(sv) = len;
SvNVX(sv) = nv;
SvMAGIC(sv) = magic;
SvSTASH(sv) = stash;
- FmLINES(sv) = 0;
break;
case SVt_PVIO:
SvANY(sv) = new_XPVIO();
+ Zero(SvANY(sv), 1, XPVIO);
SvPVX(sv) = pv;
SvCUR(sv) = cur;
SvLEN(sv) = len;
SvNVX(sv) = nv;
SvMAGIC(sv) = magic;
SvSTASH(sv) = stash;
- IoIFP(sv) = 0;
- IoOFP(sv) = 0;
- IoDIRP(sv) = 0;
- IoLINES(sv) = 0;
- IoPAGE(sv) = 0;
IoPAGE_LEN(sv) = 60;
- IoLINES_LEFT(sv)= 0;
- IoTOP_NAME(sv) = 0;
- IoTOP_GV(sv) = 0;
- IoFMT_NAME(sv) = 0;
- IoFMT_GV(sv) = 0;
- IoBOTTOM_NAME(sv)= 0;
- IoBOTTOM_GV(sv) = 0;
- IoSUBPROCESS(sv)= 0;
- IoTYPE(sv) = 0;
- IoFLAGS(sv) = 0;
break;
}
SvFLAGS(sv) &= ~SVTYPEMASK;
mg_get(sv);
if (SvIOKp(sv))
return SvIVX(sv);
- if (SvNOKp(sv))
- return I_V(SvNVX(sv));
+ if (SvNOKp(sv)) {
+ if (SvNVX(sv) < 0.0)
+ return I_V(SvNVX(sv));
+ else
+ return (IV) U_V(SvNVX(sv));
+ }
if (SvPOKp(sv) && SvLEN(sv)) {
if (dowarn && !looks_like_number(sv))
not_a_number(sv);
return (IV)atol(SvPVX(sv));
}
- return 0;
+ if (!SvROK(sv)) {
+ return 0;
+ }
}
if (SvTHINKFIRST(sv)) {
if (SvROK(sv)) {
return (IV)SvRV(sv);
}
if (SvREADONLY(sv)) {
- if (SvNOK(sv))
- return I_V(SvNVX(sv));
- if (SvPOK(sv) && SvLEN(sv)) {
+ if (SvNOKp(sv)) {
+ if (SvNVX(sv) < 0.0)
+ return I_V(SvNVX(sv));
+ else
+ return (IV) U_V(SvNVX(sv));
+ }
+ if (SvPOKp(sv) && SvLEN(sv)) {
if (dowarn && !looks_like_number(sv))
not_a_number(sv);
return (IV)atol(SvPVX(sv));
sv_upgrade(sv, SVt_PVNV);
break;
}
- if (SvNOK(sv))
- SvIVX(sv) = I_V(SvNVX(sv));
- else if (SvPOK(sv) && SvLEN(sv)) {
+ if (SvNOKp(sv)) {
+ if (SvNVX(sv) < 0.0)
+ SvIVX(sv) = I_V(SvNVX(sv));
+ else
+ SvIVX(sv) = (IV) U_V(SvNVX(sv));
+ }
+ else if (SvPOKp(sv) && SvLEN(sv)) {
if (dowarn && !looks_like_number(sv))
not_a_number(sv);
SvIVX(sv) = (IV)atol(SvPVX(sv));
if (SvNOKp(sv))
return SvNVX(sv);
if (SvPOKp(sv) && SvLEN(sv)) {
- if (dowarn && !SvIOK(sv) && !looks_like_number(sv))
+ if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
not_a_number(sv);
return atof(SvPVX(sv));
}
if (SvIOKp(sv))
return (double)SvIVX(sv);
- return 0;
+ if (!SvROK(sv)) {
+ return 0;
+ }
}
if (SvTHINKFIRST(sv)) {
if (SvROK(sv)) {
return (double)(unsigned long)SvRV(sv);
}
if (SvREADONLY(sv)) {
- if (SvPOK(sv) && SvLEN(sv)) {
- if (dowarn && !SvIOK(sv) && !looks_like_number(sv))
+ if (SvPOKp(sv) && SvLEN(sv)) {
+ if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
not_a_number(sv);
return atof(SvPVX(sv));
}
- if (SvIOK(sv))
+ if (SvIOKp(sv))
return (double)SvIVX(sv);
if (dowarn)
warn(warn_uninit);
}
else if (SvTYPE(sv) < SVt_PVNV)
sv_upgrade(sv, SVt_PVNV);
- if (SvIOK(sv) &&
- (!SvPOK(sv) || !strchr(SvPVX(sv),'.') || !looks_like_number(sv)))
+ if (SvIOKp(sv) &&
+ (!SvPOKp(sv) || !strchr(SvPVX(sv),'.') || !looks_like_number(sv)))
{
SvNVX(sv) = (double)SvIVX(sv);
}
- else if (SvPOK(sv) && SvLEN(sv)) {
- if (dowarn && !SvIOK(sv) && !looks_like_number(sv))
+ else if (SvPOKp(sv) && SvLEN(sv)) {
+ if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
not_a_number(sv);
SvNVX(sv) = atof(SvPVX(sv));
}
Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
goto tokensave;
}
- *lp = 0;
- return "";
+ if (!SvROK(sv)) {
+ *lp = 0;
+ return "";
+ }
}
if (SvTHINKFIRST(sv)) {
if (SvROK(sv)) {
return s;
}
if (SvREADONLY(sv)) {
- if (SvIOK(sv)) {
- (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
+ if (SvNOKp(sv)) {
+ Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
goto tokensave;
}
- if (SvNOK(sv)) {
- Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
+ if (SvIOKp(sv)) {
+ (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
goto tokensave;
}
if (dowarn)
}
if (!SvUPGRADE(sv, SVt_PV))
return 0;
- if (SvNOK(sv)) {
+ if (SvNOKp(sv)) {
if (SvTYPE(sv) < SVt_PVNV)
sv_upgrade(sv, SVt_PVNV);
SvGROW(sv, 28);
s--;
#endif
}
- else if (SvIOK(sv)) {
+ else if (SvIOKp(sv)) {
if (SvTYPE(sv) < SVt_PVIV)
sv_upgrade(sv, SVt_PVIV);
SvGROW(sv, 11);
stype = SvTYPE(sstr);
dtype = SvTYPE(dstr);
+ if (dtype == SVt_PVGV && (SvFLAGS(dstr) & SVf_FAKE)) {
+ sv_unglob(dstr); /* so fake GLOB won't perpetuate */
+ sv_setpvn(dstr, "", 0);
+ (void)SvPOK_only(dstr);
+ dtype = SvTYPE(dstr);
+ }
+
#ifdef OVERLOAD
SvAMAGIC_off(dstr);
#endif /* OVERLOAD */
if (dtype < SVt_PVNV)
sv_upgrade(dstr, SVt_PVNV);
break;
+
+ case SVt_PVLV:
+ sv_upgrade(dstr, SVt_PVNV);
+ break;
+
+ case SVt_PVAV:
+ case SVt_PVHV:
+ case SVt_PVCV:
+ case SVt_PVFM:
+ case SVt_PVIO:
+ if (op)
+ croak("Bizarre copy of %s in %s", sv_reftype(sstr, 0),
+ op_name[op->op_type]);
+ else
+ croak("Bizarre copy of %s", sv_reftype(sstr, 0));
+ break;
+
case SVt_PVGV:
if (dtype <= SVt_PVGV) {
- if (dtype < SVt_PVGV) {
+ if (dtype == SVt_PVGV)
+ GvFLAGS(sstr) |= GVf_IMPORTED;
+ else {
char *name = GvNAME(sstr);
STRLEN len = GvNAMELEN(sstr);
sv_upgrade(dstr, SVt_PVGV);
SvFAKE_on(dstr); /* can coerce to non-glob */
}
(void)SvOK_off(dstr);
- if (!GvAV(sstr))
- gv_AVadd(sstr);
- if (!GvHV(sstr))
- gv_HVadd(sstr);
- if (!GvIO(sstr))
- gv_IOadd(sstr);
if (GvGP(dstr))
gp_free(dstr);
GvGP(dstr) = gp_ref(GvGP(sstr));
SvTAINT(dstr);
GvFLAGS(dstr) &= ~GVf_INTRO; /* one-shot flag */
+ SvMULTI_on(dstr);
return;
}
/* FALL THROUGH */
case SVt_PVCV:
if (intro)
SAVESPTR(GvCV(dstr));
- else
- dref = (SV*)GvCV(dstr);
- GvFLAGS(dstr) |= GVf_IMPORTED;
+ else {
+ CV* cv = GvCV(dstr);
+ if (cv) {
+ dref = (SV*)cv;
+ if (dowarn && sref != dref &&
+ !GvCVGEN((GV*)dstr) &&
+ (CvROOT(cv) || CvXSUB(cv)) )
+ warn("Subroutine %s redefined",
+ GvENAME((GV*)dstr));
+ SvFAKE_on(cv);
+ }
+ }
GvCV(dstr) = (CV*)sref;
break;
default:
GvSV(dstr) = sref;
break;
}
+ if (dref != sref)
+ GvFLAGS(dstr) |= GVf_IMPORTED; /* crude */
if (dref)
SvREFCNT_dec(dref);
if (intro)
register char *ptr;
register STRLEN len;
{
+ assert(len >= 0);
if (SvTHINKFIRST(sv)) {
if (SvREADONLY(sv) && curcop != &compiling)
croak(no_modify);
register STRLEN len;
{
STRLEN tlen;
- char *s;
+ char *junk;
- s = SvPV_force(sv, tlen);
+ junk = SvPV_force(sv, tlen);
SvGROW(sv, tlen + len + 1);
+ if (ptr == junk)
+ ptr = SvPVX(sv);
Move(ptr,SvPVX(sv)+tlen,len,char);
SvCUR(sv) += len;
*SvEND(sv) = '\0';
{
register STRLEN len;
STRLEN tlen;
- char *s;
+ char *junk;
if (!ptr)
return;
- s = SvPV_force(sv, tlen);
+ junk = SvPV_force(sv, tlen);
len = strlen(ptr);
SvGROW(sv, tlen + len + 1);
+ if (ptr == junk)
+ ptr = SvPVX(sv);
Move(ptr,SvPVX(sv)+tlen,len+1,char);
SvCUR(sv) += len;
(void)SvPOK_only(sv); /* validate pointer */
if (SvREADONLY(sv) && curcop != &compiling && !strchr("gB", how))
croak(no_modify);
- if (SvMAGICAL(sv)) {
- if (SvMAGIC(sv) && mg_find(sv, how))
+ if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) {
+ if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
+ if (how == 't')
+ mg->mg_len |= 1;
return;
+ }
}
else {
if (!SvUPGRADE(sv, SVt_PVMG))
mg->mg_moremagic = SvMAGIC(sv);
SvMAGIC(sv) = mg;
- if (obj == sv || how == '#')
+ if (!obj || obj == sv || how == '#')
mg->mg_obj = obj;
else {
mg->mg_obj = SvREFCNT_inc(obj);
break;
case 't':
mg->mg_virtual = &vtbl_taint;
+ mg->mg_len = 1;
break;
case 'U':
mg->mg_virtual = &vtbl_uvar;
case '.':
mg->mg_virtual = &vtbl_pos;
break;
- case '~': /* reserved for extensions but multiple extensions may clash */
+ case '~': /* Reserved for use by extensions not perl internals. */
+ /* Useful for attaching extension internal data to perl vars. */
+ /* Note that multiple extensions may clash if magical scalars */
+ /* etc holding private data from one are passed to another. */
+ SvRMAGICAL_on(sv);
break;
default:
croak("Don't know how to handle magic of type '%c'", how);
PUSHMARK(SP);
PUSHs(&ref);
PUTBACK;
- perl_call_sv((SV*)destructor, G_DISCARD|G_EVAL);
+ perl_call_sv((SV*)destructor, G_DISCARD|G_EVAL|G_KEEPERR);
+ del_XRV(SvANY(&ref));
}
LEAVE;
}
+ else
+ SvREFCNT_dec(SvSTASH(sv));
if (SvOBJECT(sv)) {
SvOBJECT_off(sv); /* Curse the object. */
if (SvTYPE(sv) != SVt_PVIO)
Safefree(IoFMT_NAME(sv));
Safefree(IoBOTTOM_NAME(sv));
/* FALL THROUGH */
- case SVt_PVFM:
case SVt_PVBM:
goto freescalar;
case SVt_PVCV:
+ case SVt_PVFM:
cv_undef((CV*)sv);
goto freescalar;
case SVt_PVHV:
sv_len(sv)
register SV *sv;
{
- char *s;
+ char *junk;
STRLEN len;
if (!sv)
if (SvGMAGICAL(sv))
len = mg_len(sv);
else
- s = SvPV(sv, len);
+ junk = SvPV(sv, len);
return len;
}
I32 append;
{
register char *bp; /* we're going to steal some values */
+#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
register I32 cnt; /* from the stdio struct and put EVERYTHING */
register STDCHAR *ptr; /* in the innermost loop into registers */
- register I32 newline = rschar;/* (assuming >= 6 registers) */
- I32 i;
STRLEN bpx;
I32 shortbuffered;
+#endif
+ register I32 newline = rschar;/* (assuming >= 6 registers) */
+ I32 i;
if (SvTHINKFIRST(sv)) {
if (SvREADONLY(sv) && curcop != &compiling)
}
} while (i != EOF);
}
-#ifdef USE_STD_STDIO /* Here is some breathtakingly efficient cheating */
- cnt = fp->_cnt; /* get count into register */
+#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
+ /* Here is some breathtakingly efficient cheating */
+ cnt = FILE_cnt(fp); /* get count into register */
(void)SvPOK_only(sv); /* validate pointer */
if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
if (cnt > 80 && SvLEN(sv) > append) {
else
shortbuffered = 0;
bp = SvPVX(sv) + append; /* move these two too to registers */
- ptr = fp->_ptr;
+ ptr = FILE_ptr(fp);
for (;;) {
screamer:
if (cnt > 0) {
}
}
- if (shortbuffered) { /* oh well, must extend */
+ if (shortbuffered) { /* oh well, must extend */
cnt = shortbuffered;
shortbuffered = 0;
bpx = bp - SvPVX(sv); /* prepare for possible relocation */
continue;
}
- fp->_cnt = cnt; /* deregisterize cnt and ptr */
- fp->_ptr = ptr;
+ FILE_cnt(fp) = cnt; /* deregisterize cnt and ptr */
+ FILE_ptr(fp) = ptr;
i = _filbuf(fp); /* get more characters */
- cnt = fp->_cnt;
- ptr = fp->_ptr; /* reregisterize cnt and ptr */
+ cnt = FILE_cnt(fp);
+ ptr = FILE_ptr(fp); /* reregisterize cnt and ptr */
- bpx = bp - SvPVX(sv); /* prepare for possible relocation */
+ if (i == EOF) /* all done for ever? */
+ goto thats_really_all_folks;
+
+ bpx = bp - SvPVX(sv); /* prepare for possible relocation */
SvCUR_set(sv, bpx);
SvGROW(sv, bpx + cnt + 2);
- bp = SvPVX(sv) + bpx; /* reconstitute our pointer */
+ bp = SvPVX(sv) + bpx; /* reconstitute our pointer */
if (i == newline) { /* all done for now? */
*bp++ = i;
goto thats_all_folks;
}
- else if (i == EOF) /* all done for ever? */
- goto thats_really_all_folks;
*bp++ = i; /* now go back to screaming loop */
}
thats_all_folks:
if (rslen > 1 && (bp - SvPVX(sv) < rslen || bcmp(bp - rslen, rs, rslen)))
- goto screamer; /* go back to the fray */
+ goto screamer; /* go back to the fray */
thats_really_all_folks:
if (shortbuffered)
cnt += shortbuffered;
- fp->_cnt = cnt; /* put these back or we're in trouble */
- fp->_ptr = ptr;
+ FILE_cnt(fp) = cnt; /* put these back or we're in trouble */
+ FILE_ptr(fp) = ptr;
*bp = '\0';
SvCUR_set(sv, bp - SvPVX(sv)); /* set length */
-#else /* !USE_STD_STDIO */ /* The big, slow, and stupid way */
-
+#else /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */
+ /*The big, slow, and stupid way */
{
char buf[8192];
register char * bpe = buf + sizeof(buf) - 3;
}
}
-#endif /* USE_STD_STDIO */
+#endif /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */
if (rspara) {
while (i != EOF) {
return;
}
if (!(flags & SVp_POK) || !*SvPVX(sv)) {
- if (!SvUPGRADE(sv, SVt_NV))
- return;
+ if ((flags & SVTYPEMASK) < SVt_PVNV)
+ sv_upgrade(sv, SVt_NV);
SvNVX(sv) = 1.0;
(void)SvNOK_only(sv);
return;
return;
}
if (!(flags & SVp_POK)) {
- if (!SvUPGRADE(sv, SVt_NV))
- return;
+ if ((flags & SVTYPEMASK) < SVt_PVNV)
+ sv_upgrade(sv, SVt_NV);
SvNVX(sv) = -1.0;
(void)SvNOK_only(sv);
return;
*st = GvESTASH(gv);
fix_gv:
if (lref && !GvCV(gv)) {
- sv = NEWSV(704,0);
- gv_efullname(sv, gv);
- newSUB(savestack_ix,
- newSVOP(OP_CONST, 0, sv),
+ SV *tmpsv;
+ ENTER;
+ tmpsv = NEWSV(704,0);
+ gv_efullname(tmpsv, gv);
+ newSUB(start_subparse(),
+ newSVOP(OP_CONST, 0, tmpsv),
+ Nullop,
Nullop);
+ LEAVE;
+ if (!GvCV(gv))
+ croak("Unable to create sub named \"%s\"", SvPV(sv,na));
}
return GvCV(gv);
}
*lp = SvCUR(sv);
}
else {
- if (SvTYPE(sv) > SVt_PVLV) {
- if (SvFAKE(sv))
+ if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) {
+ if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) {
sv_unglob(sv);
+ s = SvPVX(sv);
+ *lp = SvCUR(sv);
+ }
else
croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
op_name[op->op_type]);
}
- s = sv_2pv(sv, lp);
+ else
+ s = sv_2pv(sv, lp);
if (s != SvPVX(sv)) { /* Almost, but not quite, sv_setpvn() */
STRLEN len = *lp;
SvSTASH(ref) = (HV*)SvREFCNT_inc(stash);
#ifdef OVERLOAD
+ SvAMAGIC_off(sv);
if (Gv_AMG(stash)) {
SvAMAGIC_on(sv);
}
gp_free(sv);
sv_unmagic(sv, '*');
Safefree(GvNAME(sv));
+ SvMULTI_off(sv);
SvFLAGS(sv) &= ~SVTYPEMASK;
SvFLAGS(sv) |= SVt_PVMG;
}
SvRV(sv) = 0;
SvROK_off(sv);
- SvREFCNT_dec(rv);
+ if (SvREFCNT(rv) != 1 || SvREADONLY(rv))
+ SvREFCNT_dec(rv);
+ else
+ sv_2mortal(rv); /* Schedule for freeing later */
}
#ifdef DEBUGGING
fprintf(stderr, " FILL = %ld\n", (long)AvFILL(sv));
fprintf(stderr, " MAX = %ld\n", (long)AvMAX(sv));
fprintf(stderr, " ARYLEN = 0x%lx\n", (long)AvARYLEN(sv));
- if (AvREAL(sv))
- fprintf(stderr, " FLAGS = (REAL)\n");
- else
- fprintf(stderr, " FLAGS = ()\n");
+ flags = AvFLAGS(sv);
+ d = tmpbuf;
+ if (flags & AVf_REAL) strcat(d, "REAL,");
+ if (flags & AVf_REIFY) strcat(d, "REIFY,");
+ if (flags & AVf_REUSED) strcat(d, "REUSED,");
+ if (*d)
+ d[strlen(d)-1] = '\0';
+ fprintf(stderr, " FLAGS = (%s)\n", d);
break;
case SVt_PVHV:
fprintf(stderr, " ARRAY = 0x%lx\n",(long)HvARRAY(sv));
fprintf(stderr, " FILEGV = 0x%lx\n", (long)CvFILEGV(sv));
fprintf(stderr, " DEPTH = %ld\n", (long)CvDEPTH(sv));
fprintf(stderr, " PADLIST = 0x%lx\n", (long)CvPADLIST(sv));
+ fprintf(stderr, " OUTSIDE = 0x%lx\n", (long)CvOUTSIDE(sv));
if (type == SVt_PVFM)
fprintf(stderr, " LINES = %ld\n", (long)FmLINES(sv));
break;
projects / p5sagit/p5-mst-13.2.git / blobdiff