return sv;
}
-/* visit(): call the named function for each non-free SV in the arenas. */
+/* visit(): call the named function for each non-free SV in the arenas
+ * whose flags field matches the flags/mask args. */
STATIC I32
-S_visit(pTHX_ SVFUNC_t f)
+S_visit(pTHX_ SVFUNC_t f, U32 flags, U32 mask)
{
SV* sva;
SV* sv;
for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
svend = &sva[SvREFCNT(sva)];
for (sv = sva + 1; sv < svend; ++sv) {
- if (SvTYPE(sv) != SVTYPEMASK && SvREFCNT(sv)) {
+ if (SvTYPE(sv) != SVTYPEMASK
+ && (sv->sv_flags & mask) == flags
+ && SvREFCNT(sv))
+ {
(FCALL)(aTHX_ sv);
++visited;
}
Perl_sv_report_used(pTHX)
{
#ifdef DEBUGGING
- visit(do_report_used);
+ visit(do_report_used, 0, 0);
#endif
}
(GvCV(sv) && SvOBJECT(GvCV(sv))) )
{
DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv)));
+ SvFLAGS(sv) |= SVf_BREAK;
SvREFCNT_dec(sv);
}
}
Perl_sv_clean_objs(pTHX)
{
PL_in_clean_objs = TRUE;
- visit(do_clean_objs);
+ visit(do_clean_objs, SVf_ROK, SVf_ROK);
#ifndef DISABLE_DESTRUCTOR_KLUDGE
/* some barnacles may yet remain, clinging to typeglobs */
- visit(do_clean_named_objs);
+ visit(do_clean_named_objs, SVt_PVGV, SVTYPEMASK);
#endif
PL_in_clean_objs = FALSE;
}
{
DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) ));
SvFLAGS(sv) |= SVf_BREAK;
+ if (PL_comppad == (AV*)sv) {
+ PL_comppad = Nullav;
+ PL_curpad = Null(SV**);
+ }
SvREFCNT_dec(sv);
}
{
I32 cleaned;
PL_in_clean_all = TRUE;
- cleaned = visit(do_clean_all);
+ cleaned = visit(do_clean_all, 0,0);
PL_in_clean_all = FALSE;
return cleaned;
}
else if (SvPOKp(sv))
sbegin = SvPV(sv, len);
else
- return 1; /* Historic. Wrong? */
+ return SvFLAGS(sv) & (SVf_NOK|SVp_NOK|SVf_IOK|SVp_IOK);
return grok_number(sbegin, len, NULL);
}
}
if (hibit) {
STRLEN len;
- SvOOK_off(sv);
+ (void)SvOOK_off(sv);
s = (U8*)SvPVX(sv);
len = SvCUR(sv) + 1; /* Plus the \0 */
SvPVX(sv) = (char*)bytes_to_utf8((U8*)s, &len);
char *
Perl_sv_pvbyten_force(pTHX_ SV *sv, STRLEN *lp)
{
+ sv_pvn_force(sv,lp);
sv_utf8_downgrade(sv,0);
- return sv_pvn_force(sv,lp);
+ *lp = SvCUR(sv);
+ return SvPVX(sv);
}
/* sv_pvutf8 () is now a macro using Perl_sv_2pv_flags();
char *
Perl_sv_pvutf8n_force(pTHX_ SV *sv, STRLEN *lp)
{
+ sv_pvn_force(sv,lp);
sv_utf8_upgrade(sv);
- return sv_pvn_force(sv,lp);
+ *lp = SvCUR(sv);
+ return SvPVX(sv);
}
/*