void
sv_report_used(void)
{
- visit(do_report_used);
+ visit(FUNC_NAME_TO_PTR(do_report_used));
}
STATIC void
STATIC void
do_clean_named_objs(SV *sv)
{
- if (SvTYPE(sv) == SVt_PVGV && GvSV(sv))
- do_clean_objs(GvSV(sv));
+ if (SvTYPE(sv) == SVt_PVGV) {
+ if ( SvOBJECT(GvSV(sv)) ||
+ GvAV(sv) && SvOBJECT(GvAV(sv)) ||
+ GvHV(sv) && SvOBJECT(GvHV(sv)) ||
+ GvIO(sv) && SvOBJECT(GvIO(sv)) ||
+ GvCV(sv) && SvOBJECT(GvCV(sv)) )
+ {
+ DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv));)
+ SvREFCNT_dec(sv);
+ }
+ else if (GvSV(sv))
+ do_clean_objs(GvSV(sv));
+ }
}
#endif
{
in_clean_objs = TRUE;
#ifndef DISABLE_DESTRUCTOR_KLUDGE
- visit(do_clean_named_objs);
+ visit(FUNC_NAME_TO_PTR(do_clean_named_objs));
#endif
- visit(do_clean_objs);
+ visit(FUNC_NAME_TO_PTR(do_clean_objs));
in_clean_objs = FALSE;
}
sv_clean_all(void)
{
in_clean_all = TRUE;
- visit(do_clean_all);
+ visit(FUNC_NAME_TO_PTR(do_clean_all));
in_clean_all = FALSE;
}
Safefree((void *)sva);
}
+ if (nice_chunk)
+ Safefree(nice_chunk);
+ nice_chunk = Nullch;
+ nice_chunk_size = 0;
sv_arenaroot = 0;
sv_root = 0;
}
return TRUE;
}
-#ifdef DEBUGGING
char *
sv_peek(SV *sv)
{
+#ifdef DEBUGGING
SV *t = sv_newmortal();
STRLEN prevlen;
int unref = 0;
sv_catpv(t, ")");
}
return SvPV(t, na);
+#else /* DEBUGGING */
+ return "";
+#endif /* DEBUGGING */
}
-#endif
int
sv_backoff(register SV *sv)
case SVt_PVHV: s = "HASH"; break;
case SVt_PVCV: s = "CODE"; break;
case SVt_PVGV: s = "GLOB"; break;
- case SVt_PVFM: s = "FORMLINE"; break;
+ case SVt_PVFM: s = "FORMAT"; break;
case SVt_PVIO: s = "IO"; break;
default: s = "UNKNOWN"; break;
}
switch (stype) {
case SVt_NULL:
- (void)SvOK_off(dstr);
- return;
+ if (dtype != SVt_PVGV) {
+ (void)SvOK_off(dstr);
+ return;
+ }
+ break;
case SVt_IV:
if (dtype != SVt_IV && dtype < SVt_PVIV) {
if (dtype < SVt_IV)
if (dtype < SVt_PVNV)
sv_upgrade(dstr, SVt_PVNV);
break;
-
case SVt_PVAV:
case SVt_PVHV:
case SVt_PVCV:
SvFAKE_on(dstr); /* can coerce to non-glob */
}
/* ahem, death to those who redefine active sort subs */
- else if (curstack == sortstack
+ else if (curstackinfo->si_type == SI_SORT
&& GvCV(dstr) && sortcop == CvSTART(GvCV(dstr)))
croak("Can't redefine active sort subroutine %s",
GvNAME(dstr));
goto glob_assign;
}
}
- if (dtype < stype)
- sv_upgrade(dstr, stype);
+ if (stype == SVt_PVLV)
+ SvUPGRADE(dstr, SVt_PVNV);
+ else
+ SvUPGRADE(dstr, stype);
}
sflags = SvFLAGS(sstr);
if (!GvCVGEN((GV*)dstr) &&
(CvROOT(cv) || CvXSUB(cv)))
{
+ SV *const_sv = cv_const_sv(cv);
+ bool const_changed = TRUE;
+ if(const_sv)
+ const_changed = sv_cmp(const_sv,
+ op_const_sv(CvSTART((CV*)sref),
+ Nullcv));
/* ahem, death to those who redefine
* active sort subs */
- if (curstack == sortstack &&
+ if (curstackinfo->si_type == SI_SORT &&
sortcop == CvSTART(cv))
croak(
"Can't redefine active sort subroutine %s",
GvENAME((GV*)dstr));
- if (cv_const_sv(cv))
- warn("Constant subroutine %s redefined",
- GvENAME((GV*)dstr));
- else if (dowarn)
- warn("Subroutine %s redefined",
- GvENAME((GV*)dstr));
+ if (dowarn || (const_changed && const_sv)) {
+ if (!(CvGV(cv) && GvSTASH(CvGV(cv))
+ && HvNAME(GvSTASH(CvGV(cv)))
+ && strEQ(HvNAME(GvSTASH(CvGV(cv))),
+ "autouse")))
+ warn(const_sv ?
+ "Constant subroutine %s redefined"
+ : "Subroutine %s redefined",
+ GvENAME((GV*)dstr));
+ }
}
cv_ckproto(cv, (GV*)dstr,
SvPOK(sref) ? SvPVX(sref) : Nullch);
SvIVX(dstr) = SvIVX(sstr);
}
else {
- (void)SvOK_off(dstr);
+ if (dtype == SVt_PVGV) {
+ if (dowarn)
+ warn("Undefined value assigned to typeglob");
+ }
+ else
+ (void)SvOK_off(dstr);
}
SvTAINT(dstr);
}
}
SV *
-#ifdef LEAKTEST
-newSV(I32 x, STRLEN len)
-#else
newSV(STRLEN len)
-#endif
{
register SV *sv;
register char *midend;
register char *bigend;
register I32 i;
+ STRLEN curlen;
+
if (!bigstr)
croak("Can't modify non-existent substring");
- SvPV_force(bigstr, na);
+ SvPV_force(bigstr, curlen);
+ if (offset + len > curlen) {
+ SvGROW(bigstr, offset+len+1);
+ Zero(SvPVX(bigstr)+curlen, offset+len-curlen, char);
+ SvCUR_set(bigstr, offset+len);
+ }
i = littlelen - len;
if (i > 0) { /* string might grow */
void
sv_clear(register SV *sv)
{
+ HV* stash;
assert(sv);
assert(SvREFCNT(sv) == 0);
if (defstash) { /* Still have a symbol table? */
djSP;
GV* destructor;
- HV* stash;
SV tmpref;
Zero(&tmpref, 1, SV);
destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
if (destructor) {
ENTER;
+ PUSHSTACK(SI_DESTROY);
SvRV(&tmpref) = SvREFCNT_inc(sv);
EXTEND(SP, 2);
PUSHMARK(SP);
perl_call_sv((SV*)GvCV(destructor),
G_DISCARD|G_EVAL|G_KEEPERR);
SvREFCNT(sv)--;
+ POPSTACK();
LEAVE;
}
} while (SvOBJECT(sv) && SvSTASH(sv) != stash);
}
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
mg_free(sv);
+ stash = NULL;
switch (SvTYPE(sv)) {
case SVt_PVIO:
if (IoIFP(sv) != PerlIO_stdin() &&
case SVt_PVGV:
gp_free((GV*)sv);
Safefree(GvNAME(sv));
- SvREFCNT_dec(GvSTASH(sv));
+ /* cannot decrease stash refcount yet, as we might recursively delete
+ ourselves when the refcnt drops to zero. Delay SvREFCNT_dec
+ of stash until current sv is completely gone.
+ -- JohnPC, 27 Mar 1998 */
+ stash = GvSTASH(sv);
/* FALL THROUGH */
case SVt_PVLV:
case SVt_PVMG:
break;
case SVt_PVGV:
del_XPVGV(SvANY(sv));
- break;
+ /* code duplication for increased performance. */
+ SvFLAGS(sv) &= SVf_BREAK;
+ SvFLAGS(sv) |= SVTYPEMASK;
+ /* decrease refcount of the stash that owns this GV, if any */
+ if (stash)
+ SvREFCNT_dec(stash);
+ return; /* not break, SvFLAGS reset already happened */
case SVt_PVBM:
del_XPVBM(SvANY(sv));
break;
return sv;
}
-#ifdef I_STDARG
SV *
newSVpvf(const char* pat, ...)
-#else
-/*VARARGS0*/
-SV *
-newSVpvf(pat, va_alist)
-const char *pat;
-va_dcl
-#endif
{
register SV *sv;
va_list args;
SvANY(sv) = 0;
SvREFCNT(sv) = 1;
SvFLAGS(sv) = 0;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
return sv;
if (!*s) { /* reset ?? searches */
for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
- pm->op_pmflags &= ~PMf_USED;
+ pm->op_pmdynflags &= ~PMdf_USED;
}
return;
}
case SVt_PVHV: return "HASH";
case SVt_PVCV: return "CODE";
case SVt_PVGV: return "GLOB";
- case SVt_PVFM: return "FORMLINE";
+ case SVt_PVFM: return "FORMAT";
default: return "UNKNOWN";
}
}
SvFAKE_off(sv);
if (GvGP(sv))
gp_free((GV*)sv);
+ if (GvSTASH(sv)) {
+ SvREFCNT_dec(GvSTASH(sv));
+ GvSTASH(sv) = Nullhv;
+ }
sv_unmagic(sv, '*');
Safefree(GvNAME(sv));
GvMULTI_off(sv);
SvSETMAGIC(sv);
}
-#ifdef I_STDARG
void
sv_setpvf(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_setpvf(sv, pat, va_alist)
- SV *sv;
- const char *pat;
- va_dcl
-#endif
{
va_list args;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
}
-#ifdef I_STDARG
void
sv_setpvf_mg(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_setpvf_mg(sv, pat, va_alist)
- SV *sv;
- const char *pat;
- va_dcl
-#endif
{
va_list args;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
SvSETMAGIC(sv);
}
-#ifdef I_STDARG
void
sv_catpvf(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_catpvf(sv, pat, va_alist)
- SV *sv;
- const char *pat;
- va_dcl
-#endif
{
va_list args;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
}
-#ifdef I_STDARG
void
sv_catpvf_mg(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_catpvf_mg(sv, pat, va_alist)
- SV *sv;
- const char *pat;
- va_dcl
-#endif
{
va_list args;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
SvSETMAGIC(sv);
switch (base) {
unsigned dig;
case 16:
+ if (!uv)
+ alt = FALSE;
p = (c == 'X') ? "0123456789ABCDEF" : "0123456789abcdef";
do {
dig = uv & 15;
break;
}
elen = (ebuf + sizeof ebuf) - eptr;
- if (has_precis && precis > elen)
- zeros = precis - elen;
+ if (has_precis) {
+ if (precis > elen)
+ zeros = precis - elen;
+ else if (precis == 0 && elen == 1 && *eptr == '0')
+ elen = 0;
+ }
break;
/* FLOATING POINT */
}
}
-#ifdef DEBUGGING
void
sv_dump(SV *sv)
{
+#ifdef DEBUGGING
SV *d = sv_newmortal();
char *s;
U32 flags;
case SVt_PVGV:
PerlIO_printf(Perl_debug_log, " NAME = \"%s\"\n", GvNAME(sv));
PerlIO_printf(Perl_debug_log, " NAMELEN = %ld\n", (long)GvNAMELEN(sv));
- PerlIO_printf(Perl_debug_log, " STASH = \"%s\"\n", HvNAME(GvSTASH(sv)));
+ PerlIO_printf(Perl_debug_log, " STASH = \"%s\"\n",
+ SvTYPE(GvSTASH(sv)) == SVt_PVHV ? HvNAME(GvSTASH(sv)) : "(deleted)");
PerlIO_printf(Perl_debug_log, " GP = 0x%lx\n", (long)GvGP(sv));
PerlIO_printf(Perl_debug_log, " SV = 0x%lx\n", (long)GvSV(sv));
PerlIO_printf(Perl_debug_log, " REFCNT = %ld\n", (long)GvREFCNT(sv));
PerlIO_printf(Perl_debug_log, " FLAGS = 0x%lx\n", (long)IoFLAGS(sv));
break;
}
+#endif /* DEBUGGING */
}
-#else
-void
-sv_dump(SV *sv)
-{
-}
-#endif
-
-
-
-
projects / p5sagit/p5-mst-13.2.git / blobdiff