{
dVAR;
dSP;
- if ( PL_op->op_flags & OPf_SPECIAL )
- /* This is a const op added to hold the hints hash for
- pp_entereval. The hash can be modified by the code
- being eval'ed, so we return a copy instead. */
- mXPUSHs((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv));
- else
- /* Normal const. */
- XPUSHs(cSVOP_sv);
+ XPUSHs(cSVOP_sv);
RETURN;
}
{
dVAR; dSP; dTOPss;
const I32 gimme = GIMME_V;
- static const char return_array_to_lvalue_scalar[] = "Can't return array to lvalue scalar context";
- static const char return_hash_to_lvalue_scalar[] = "Can't return hash to lvalue scalar context";
static const char an_array[] = "an ARRAY";
static const char a_hash[] = "a HASH";
const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV;
}
else if (LVRET) {
if (gimme != G_ARRAY)
- Perl_croak(aTHX_ is_pp_rv2av ? return_array_to_lvalue_scalar
- : return_hash_to_lvalue_scalar);
+ goto croak_cant_return;
SETs(sv);
RETURN;
}
}
else if (LVRET) {
if (gimme != G_ARRAY)
- Perl_croak(aTHX_
- is_pp_rv2av ? return_array_to_lvalue_scalar
- : return_hash_to_lvalue_scalar);
+ goto croak_cant_return;
SETs(sv);
RETURN;
}
}
else if (LVRET) {
if (gimme != G_ARRAY)
- Perl_croak(aTHX_
- is_pp_rv2av ? return_array_to_lvalue_scalar
- : return_hash_to_lvalue_scalar);
+ goto croak_cant_return;
SETs(sv);
RETURN;
}
}
}
RETURN;
+
+ croak_cant_return:
+ Perl_croak(aTHX_ "Can't return %s to lvalue scalar context",
+ is_pp_rv2av ? "array" : "hash");
+ RETURN;
}
STATIC void
*(relem++) = sv;
didstore = av_store(ary,i++,sv);
if (magic) {
- if (SvSMAGICAL(sv))
+ if (SvSMAGICAL(sv)) {
+ /* More magic can happen in the mg_set callback, so we
+ * backup the delaymagic for now. */
+ U16 dmbak = PL_delaymagic;
+ PL_delaymagic = 0;
mg_set(sv);
+ PL_delaymagic = dmbak;
+ }
if (!didstore)
sv_2mortal(sv);
}
duplicates += 2;
didstore = hv_store_ent(hash,sv,tmpstr,0);
if (magic) {
- if (SvSMAGICAL(tmpstr))
+ if (SvSMAGICAL(tmpstr)) {
+ U16 dmbak = PL_delaymagic;
+ PL_delaymagic = 0;
mg_set(tmpstr);
+ PL_delaymagic = dmbak;
+ }
if (!didstore)
sv_2mortal(tmpstr);
}
}
else
sv_setsv(sv, &PL_sv_undef);
- SvSETMAGIC(sv);
+
+ if (SvSMAGICAL(sv)) {
+ U16 dmbak = PL_delaymagic;
+ PL_delaymagic = 0;
+ mg_set(sv);
+ PL_delaymagic = dmbak;
+ }
break;
}
}
}
/* should call AUTOLOAD now? */
else {
-try_autoload:
- {
- const bool is_method = cLISTOP->op_last &&
- (cLISTOP->op_last->op_type == OP_METHOD_NAMED ||
- cLISTOP->op_last->op_type == OP_METHOD);
-
+try_autoload:
if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
- is_method)))
+ FALSE)))
{
cv = GvCV(autogv);
}
gv_efullname3(sub_name, gv, NULL);
DIE(aTHX_ "Undefined subroutine &%"SVf" called", SVfARG(sub_name));
}
- }
}
if (!cv)
DIE(aTHX_ "Not a CODE reference");
if (CvDEPTH(cv) == PERL_SUB_DEPTH_WARN && ckWARN(WARN_RECURSION)
&& !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
sub_crush_depth(cv);
-#if 0
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "%p entersub returning %p\n", (void*)thr, (void*)CvSTART(cv)));
-#endif
RETURNOP(CvSTART(cv));
}
else {
}
}
- gv = gv_fetchmethod(stash ? stash : (HV*)packsv, name);
-
- if (!gv) {
- /* This code tries to figure out just what went wrong with
- gv_fetchmethod. It therefore needs to duplicate a lot of
- the internals of that function. We can't move it inside
- Perl_gv_fetchmethod_autoload(), however, since that would
- cause UNIVERSAL->can("NoSuchPackage::foo") to croak, and we
- don't want that.
- */
- const char* leaf = name;
- const char* sep = NULL;
- const char* p;
-
- for (p = name; *p; p++) {
- if (*p == '\'')
- sep = p, leaf = p + 1;
- else if (*p == ':' && *(p + 1) == ':')
- sep = p, leaf = p + 2;
- }
- if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
- /* the method name is unqualified or starts with SUPER:: */
-#ifndef USE_ITHREADS
- if (sep)
- stash = CopSTASH(PL_curcop);
-#else
- bool need_strlen = 1;
- if (sep) {
- packname = CopSTASHPV(PL_curcop);
- }
- else
-#endif
- if (stash) {
- HEK * const packhek = HvNAME_HEK(stash);
- if (packhek) {
- packname = HEK_KEY(packhek);
- packlen = HEK_LEN(packhek);
-#ifdef USE_ITHREADS
- need_strlen = 0;
-#endif
- } else {
- goto croak;
- }
- }
+ gv = gv_fetchmethod_flags(stash ? stash : (HV*)packsv, name,
+ GV_AUTOLOAD | GV_CROAK);
- if (!packname) {
- croak:
- Perl_croak(aTHX_
- "Can't use anonymous symbol table for method lookup");
- }
-#ifdef USE_ITHREADS
- if (need_strlen)
- packlen = strlen(packname);
-#endif
+ assert(gv);
- }
- else {
- /* the method name is qualified */
- packname = name;
- packlen = sep - name;
- }
-
- /* we're relying on gv_fetchmethod not autovivifying the stash */
- if (gv_stashpvn(packname, packlen, 0)) {
- Perl_croak(aTHX_
- "Can't locate object method \"%s\" via package \"%.*s\"",
- leaf, (int)packlen, packname);
- }
- else {
- Perl_croak(aTHX_
- "Can't locate object method \"%s\" via package \"%.*s\""
- " (perhaps you forgot to load \"%.*s\"?)",
- leaf, (int)packlen, packname, (int)packlen, packname);
- }
- }
return isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv;
}