/* pp_ctl.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
char* msg = SvPVx(ERRSV, n_a);
SV *nsv = cx->blk_eval.old_namesv;
(void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv),
- &PL_sv_undef, 0);
+ &PL_sv_placeholder, 0);
DIE(aTHX_ "%sCompilation failed in require",
*msg ? msg : "Unknown error\n");
}
char *label;
int do_dump = (PL_op->op_type == OP_DUMP);
static char must_have_label[] = "goto must have label";
- AV *oldav = Nullav;
label = 0;
if (PL_op->op_flags & OPf_STACKED) {
SV** mark;
I32 items = 0;
I32 oldsave;
+ bool reified = 0;
retry:
if (!CvROOT(cv) && !CvXSUB(cv)) {
Copy(AvARRAY(av), SP + 1, items, SV*);
SvREFCNT_dec(GvAV(PL_defgv));
GvAV(PL_defgv) = cx->blk_sub.savearray;
+ CLEAR_ARGARRAY(av);
/* abandon @_ if it got reified */
if (AvREAL(av)) {
- oldav = av; /* delay until return */
+ reified = 1;
+ SvREFCNT_dec(av);
av = newAV();
av_extend(av, items-1);
AvFLAGS(av) = AVf_REIFY;
PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av);
}
- else
- CLEAR_ARGARRAY(av);
}
else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */
AV* av;
/* Now do some callish stuff. */
SAVETMPS;
- /* For reified @_, delay freeing till return from new sub */
- if (oldav)
- SAVEFREESV((SV*)oldav);
SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
if (CvXSUB(cv)) {
+ if (reified) {
+ I32 index;
+ for (index=0; index<items; index++)
+ sv_2mortal(SP[-index]);
+ }
#ifdef PERL_XSUB_OLDSTYLE
if (CvOLDSTYLE(cv)) {
I32 (*fp3)(int,int,int);
Copy(mark,AvARRAY(av),items,SV*);
AvFILLp(av) = items - 1;
assert(!AvREAL(av));
+ if (reified) {
+ /* transfer 'ownership' of refcnts to new @_ */
+ AvREAL_on(av);
+ AvREIFY_off(av);
+ }
while (items--) {
if (*mark)
SvTEMP_off(*mark);
}
}
-#ifdef PERL_FLEXIBLE_EXCEPTIONS
-STATIC void *
-S_docatch_body(pTHX_ va_list args)
-{
- return docatch_body();
-}
-#endif
-
STATIC void *
S_docatch_body(pTHX)
{
retop = cxstack[cxstack_ix].blk_eval.retop;
cxstack[cxstack_ix].blk_eval.retop = Nullop;
-#ifdef PERL_FLEXIBLE_EXCEPTIONS
- redo_body:
- CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body));
-#else
JMPENV_PUSH(ret);
-#endif
switch (ret) {
case 0:
-#ifndef PERL_FLEXIBLE_EXCEPTIONS
redo_body:
docatch_body();
-#endif
break;
case 3:
/* die caught by an inner eval - continue inner loop */
char* msg = SvPVx(ERRSV, n_a);
SV *nsv = cx->blk_eval.old_namesv;
(void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv),
- &PL_sv_undef, 0);
+ &PL_sv_placeholder, 0);
DIE(aTHX_ "%sCompilation failed in require",
*msg ? msg : "Unknown error\n");
}
if (!sv_derived_from(PL_patchlevel, "version"))
(void *)upg_version(PL_patchlevel);
if ( vcmp(sv,PL_patchlevel) > 0 )
- DIE(aTHX_ "Perl v%_ required--this is only v%_, stopped",
+ DIE(aTHX_ "Perl v%"SVf" required--this is only v%"SVf", stopped",
vstringify(sv), vstringify(PL_patchlevel));
RETPUSHYES;
DIE(aTHX_ "Null filename used");
TAINT_PROPER("require");
if (PL_op->op_type == OP_REQUIRE &&
- (svp = hv_fetch(GvHVn(PL_incgv), name, len, 0))) {
- if (*svp != &PL_sv_undef)
+ (svp = hv_fetch_flags(GvHVn(PL_incgv), name, len, 0,
+ HV_FETCH_WANTPLACEHOLDERS)))
+ {
+ if (*svp != &PL_sv_placeholder)
RETPUSHYES;
else
DIE(aTHX_ "Compilation failed in require");
else
return FALSE;
}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * vim: shiftwidth=4:
+*/