#include "EXTERN.h"
#define PERL_IN_GV_C
#include "perl.h"
-#include "overload.c"
+#include "overload.inc"
#include "keywords.h"
#include "feature.h"
static const char S_autoload[] = "AUTOLOAD";
-static const STRLEN S_autolen = sizeof(S_autoload)-1;
+#define S_autolen (sizeof("AUTOLOAD")-1)
GV *
Perl_gv_add_by_type(pTHX_ GV *gv, svtype type)
sv_setpvn(GvSV(gv), name, namelen);
#endif
}
- if ((PERLDB_LINE || PERLDB_SAVESRC) && !GvAV(gv))
+ if (PERLDB_LINE_OR_SAVESRC && !GvAV(gv))
hv_magic(GvHVn(gv), GvAVn(gv), PERL_MAGIC_dbfile);
if (tmpbuf != smallbuf)
Safefree(tmpbuf);
If C<gv> is a typeglob whose subroutine entry is a constant sub eligible for
inlining, or C<gv> is a placeholder reference that would be promoted to such
a typeglob, then returns the value returned by the sub. Otherwise, returns
-NULL.
+C<NULL>.
=cut
*/
if (SvTYPE(gv) == SVt_PVGV)
return cv_const_sv(GvCVu(gv));
- return SvROK(gv) && SvTYPE(SvRV(gv)) != SVt_PVAV ? SvRV(gv) : NULL;
+ return SvROK(gv) && SvTYPE(SvRV(gv)) != SVt_PVAV && SvTYPE(SvRV(gv)) != SVt_PVCV ? SvRV(gv) : NULL;
}
GP *
Converts a scalar into a typeglob. This is an incoercible typeglob;
assigning a reference to it will assign to one of its slots, instead of
-overwriting it as happens with typeglobs created by SvSetSV. Converting
-any scalar that is SvOK() may produce unpredictable results and is reserved
+overwriting it as happens with typeglobs created by C<SvSetSV>. Converting
+any scalar that is C<SvOK()> may produce unpredictable results and is reserved
for perl's internal use.
C<gv> is the scalar to be converted.
passed to this function matches the name of the element. If it does not
match, perl's internal bookkeeping will get out of sync.
-C<flags> can be set to SVf_UTF8 if C<name> is a UTF8 string, or
+C<flags> can be set to C<SVf_UTF8> if C<name> is a UTF-8 string, or
the return value of SvUTF8(sv). It can also take the
-GV_ADDMULTI flag, which means to pretend that the GV has been
+C<GV_ADDMULTI> flag, which means to pretend that the GV has been
seen before (i.e., suppress "Used once" warnings).
=for apidoc gv_init
-The old form of gv_init_pvn(). It does not work with UTF8 strings, as it
+The old form of C<gv_init_pvn()>. It does not work with UTF-8 strings, as it
has no flags parameter. If the C<multi> parameter is set, the
-GV_ADDMULTI flag will be passed to gv_init_pvn().
+C<GV_ADDMULTI> flag will be passed to C<gv_init_pvn()>.
=for apidoc gv_init_pv
-Same as gv_init_pvn(), but takes a nul-terminated string for the name
+Same as C<gv_init_pvn()>, but takes a nul-terminated string for the name
instead of separate char * and length parameters.
=for apidoc gv_init_sv
-Same as gv_init_pvn(), but takes an SV * for the name instead of separate
+Same as C<gv_init_pvn()>, but takes an SV * for the name instead of separate
char * and length parameters. C<flags> is currently unused.
=cut
case SVt_PVIO:
Perl_croak(aTHX_ "Cannot convert a reference to %s to typeglob",
sv_reftype(has_constant, 0));
+ break;
default: NOOP;
}
return NULL;
case KEY_chdir:
case KEY_chomp: case KEY_chop: case KEY_defined: case KEY_delete:
- case KEY_each : case KEY_eof : case KEY_exec : case KEY_exists:
- case KEY_keys:
+ case KEY_eof : case KEY_exec: case KEY_exists :
case KEY_lstat:
- case KEY_pop:
- case KEY_push:
- case KEY_shift:
- case KEY_splice: case KEY_split:
+ case KEY_split:
case KEY_stat:
case KEY_system:
case KEY_truncate: case KEY_unlink:
- case KEY_unshift:
- case KEY_values:
ampable = FALSE;
}
if (!gv) {
}
CvGV_set(cv, gv); /* This stops new ATTRSUB from setting CvFILE
from PL_curcop. */
- (void)gv_fetchfile(file);
+ /* XSUBs can't be perl lang/perl5db.pl debugged
+ if (PERLDB_LINE_OR_SAVESRC)
+ (void)gv_fetchfile(file); */
CvFILE(cv) = (char *)file;
/* XXX This is inefficient, as doing things this order causes
a prototype check in newATTRSUB. But we have to do
)) != NULL) {
assert(GvCV(gv) == orig_cv);
if (opnum != OP_VEC && opnum != OP_SUBSTR && opnum != OP_POS
- && opnum != OP_UNDEF)
+ && opnum != OP_UNDEF && opnum != OP_KEYS)
CvLVALUE_off(cv); /* Now *that* was a neat trick. */
}
LEAVE;
GV *
Perl_gv_fetchmeth_sv(pTHX_ HV *stash, SV *namesv, I32 level, U32 flags)
{
- char *namepv;
- STRLEN namelen;
- PERL_ARGS_ASSERT_GV_FETCHMETH_SV;
- namepv = SvPV(namesv, namelen);
- if (SvUTF8(namesv))
- flags |= SVf_UTF8;
- return gv_fetchmeth_pvn(stash, namepv, namelen, level, flags);
+ char *namepv;
+ STRLEN namelen;
+ PERL_ARGS_ASSERT_GV_FETCHMETH_SV;
+ if (LIKELY(SvPOK_nog(namesv))) /* common case */
+ return gv_fetchmeth_internal(stash, namesv, NULL, 0, level, flags);
+ namepv = SvPV(namesv, namelen);
+ if (SvUTF8(namesv)) flags |= SVf_UTF8;
+ return gv_fetchmeth_pvn(stash, namepv, namelen, level, flags);
}
/*
Perl_gv_fetchmeth_pv(pTHX_ HV *stash, const char *name, I32 level, U32 flags)
{
PERL_ARGS_ASSERT_GV_FETCHMETH_PV;
- return gv_fetchmeth_pvn(stash, name, strlen(name), level, flags);
+ return gv_fetchmeth_internal(stash, NULL, name, strlen(name), level, flags);
}
/*
Returns the glob with the given C<name> and a defined subroutine or
C<NULL>. The glob lives in the given C<stash>, or in the stashes
-accessible via @ISA and UNIVERSAL::.
+accessible via C<@ISA> and C<UNIVERSAL::>.
The argument C<level> should be either 0 or -1. If C<level==0>, as a
side-effect creates a glob with the given C<name> in the given C<stash>
which in the case of success contains an alias for the subroutine, and sets
up caching info for this glob.
-The only significant values for C<flags> are GV_SUPER and SVf_UTF8.
+The only significant values for C<flags> are C<GV_SUPER> and C<SVf_UTF8>.
-GV_SUPER indicates that we want to look up the method in the superclasses
+C<GV_SUPER> indicates that we want to look up the method in the superclasses
of the C<stash>.
The
/* NOTE: No support for tied ISA */
-GV *
-Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level, U32 flags)
+PERL_STATIC_INLINE GV*
+S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len, I32 level, U32 flags)
{
GV** gvp;
+ HE* he;
AV* linear_av;
SV** linear_svp;
SV* linear_sv;
CV* cand_cv = NULL;
GV* topgv = NULL;
const char *hvname;
- I32 create = (level >= 0) ? 1 : 0;
+ I32 create = (level >= 0) ? HV_FETCH_LVALUE : 0;
I32 items;
U32 topgen_cmp;
U32 is_utf8 = flags & SVf_UTF8;
- PERL_ARGS_ASSERT_GV_FETCHMETH_PVN;
-
/* UNIVERSAL methods should be callable without a stash */
if (!stash) {
create = 0; /* probably appropriate */
Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
assert(hvname);
- assert(name);
+ assert(name || meth);
DEBUG_o( Perl_deb(aTHX_ "Looking for %smethod %s in package %s\n",
- flags & GV_SUPER ? "SUPER " : "",name,hvname) );
+ flags & GV_SUPER ? "SUPER " : "",
+ name ? name : SvPV_nolen(meth), hvname) );
topgen_cmp = HvMROMETA(stash)->cache_gen + PL_sub_generation;
else cachestash = stash;
/* check locally for a real method or a cache entry */
- gvp = (GV**)hv_fetch(cachestash, name, is_utf8 ? -(I32)len : (I32)len,
- create);
+ he = (HE*)hv_common(
+ cachestash, meth, name, len, (flags & SVf_UTF8) ? HVhek_UTF8 : 0, create, NULL, 0
+ );
+ if (he) gvp = (GV**)&HeVAL(he);
+ else gvp = NULL;
+
if(gvp) {
topgv = *gvp;
have_gv:
assert(topgv);
if (SvTYPE(topgv) != SVt_PVGV)
+ {
+ if (!name)
+ name = SvPV_nomg(meth, len);
gv_init_pvn(topgv, stash, name, len, GV_ADDMULTI|is_utf8);
+ }
if ((cand_cv = GvCV(topgv))) {
/* If genuine method or valid cache entry, use it */
if (!GvCVGEN(topgv) || GvCVGEN(topgv) == topgen_cmp) {
/* Check UNIVERSAL without caching */
if(level == 0 || level == -1) {
- candidate = gv_fetchmeth_pvn(NULL, name, len, 1, flags &~GV_SUPER);
+ candidate = gv_fetchmeth_internal(NULL, meth, name, len, 1,
+ flags &~GV_SUPER);
if(candidate) {
cand_cv = GvCV(candidate);
if (topgv && (GvREFCNT(topgv) == 1) && (CvROOT(cand_cv) || CvXSUB(cand_cv))) {
return 0;
}
+GV *
+Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level, U32 flags)
+{
+ PERL_ARGS_ASSERT_GV_FETCHMETH_PVN;
+ return gv_fetchmeth_internal(stash, NULL, name, len, level, flags);
+}
+
/*
=for apidoc gv_fetchmeth_autoload
/*
=for apidoc gv_fetchmeth_pvn_autoload
-Same as gv_fetchmeth_pvn(), but looks for autoloaded subroutines too.
+Same as C<gv_fetchmeth_pvn()>, but looks for autoloaded subroutines too.
Returns a glob for the subroutine.
For an autoloaded subroutine without a GV, will create a GV even
-if C<level < 0>. For an autoloaded subroutine without a stub, GvCV()
+if C<level < 0>. For an autoloaded subroutine without a stub, C<GvCV()>
of the result may be zero.
-Currently, the only significant value for C<flags> is SVf_UTF8.
+Currently, the only significant value for C<flags> is C<SVf_UTF8>.
=cut
*/
Returns the glob which contains the subroutine to call to invoke the method
on the C<stash>. In fact in the presence of autoloading this may be the
-glob for "AUTOLOAD". In this case the corresponding variable $AUTOLOAD is
+glob for "AUTOLOAD". In this case the corresponding variable C<$AUTOLOAD> is
already setup.
The third parameter of C<gv_fetchmethod_autoload> determines whether
as a prefix of the method name. Note
that if you want to keep the returned glob for a long time, you need to
check for it being "AUTOLOAD", since at the later time the call may load a
-different subroutine due to $AUTOLOAD changing its value. Use the glob
+different subroutine due to C<$AUTOLOAD> changing its value. Use the glob
created as a side effect to do this.
These functions have the same side-effects as C<gv_fetchmeth> with
gv = gv_fetchmeth_pvn(stash, name, nend - name, 0, flags);
if (!gv) {
+ /* This is the special case that exempts Foo->import and
+ Foo->unimport from being an error even if there's no
+ import/unimport subroutine */
if (strEQ(name,"import") || strEQ(name,"unimport"))
gv = MUTABLE_GV(&PL_sv_yes);
else if (autoload)
/* require_tie_mod() internal routine for requiring a module
* that implements the logic of automatic ties like %! and %-
+ * It loads the module and then calls the _tie_it subroutine
+ * with the passed gv as an argument.
*
* The "gv" parameter should be the glob.
* "varpv" holds the name of the var, used for error messages.
* "namesv" holds the module name. Its refcount will be decremented.
- * "methpv" holds the method name to test for to check that things
- * are working reasonably close to as expected.
* "flags": if flag & 1 then save the scalar before loading.
* For the protection of $! to work (it is set by this routine)
* the sv slot must already be magicalized.
*/
-STATIC HV*
-S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methpv,const U32 flags)
+STATIC void
+S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const U32 flags)
{
- HV* stash = gv_stashsv(namesv, 0);
+ const char varname = *varpv; /* varpv might be clobbered by
+ load_module, so save it. For the
+ moment it’s always a single char. */
+ const SV * const target = varname == '[' ? GvSV(gv) : (SV *)GvHV(gv);
PERL_ARGS_ASSERT_REQUIRE_TIE_MOD;
- if (!stash || !(gv_fetchmethod_autoload(stash, methpv, FALSE))) {
+ /* If it is not tied */
+ if (!target || !SvRMAGICAL(target)
+ || !mg_find(target,
+ varname == '[' ? PERL_MAGIC_tiedscalar : PERL_MAGIC_tied))
+ {
+ HV *stash;
+ GV **gvp;
+ dSP;
+
+ ENTER;
+ SAVEFREESV(namesv);
+
+#define HV_FETCH_TIE_FUNC (GV **)hv_fetch(stash, "_tie_it", 7, 0)
+
+ /* Load the module if it is not loaded. */
+ if (!(stash = gv_stashsv(namesv, 0))
+ || !(gvp = HV_FETCH_TIE_FUNC) || !*gvp || !GvCV(*gvp))
+ {
SV *module = newSVsv(namesv);
- char varname = *varpv; /* varpv might be clobbered by load_module,
- so save it. For the moment it's always
- a single char. */
const char type = varname == '[' ? '$' : '%';
-#ifdef DEBUGGING
- dSP;
-#endif
- ENTER;
- SAVEFREESV(namesv);
if ( flags & 1 )
save_scalar(gv);
Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, module, NULL);
if (!stash)
Perl_croak(aTHX_ "panic: Can't use %c%c because %"SVf" is not available",
type, varname, SVfARG(namesv));
- else if (!gv_fetchmethod(stash, methpv))
- Perl_croak(aTHX_ "panic: Can't use %c%c because %"SVf" does not support method %s",
- type, varname, SVfARG(namesv), methpv);
- LEAVE;
+ else if (!(gvp = HV_FETCH_TIE_FUNC) || !*gvp || !GvCV(*gvp))
+ Perl_croak(aTHX_ "panic: Can't use %c%c because %"SVf" does not define _tie_it",
+ type, varname, SVfARG(namesv));
+ }
+ /* Now call the tie function. It should be in *gvp. */
+ assert(gvp); assert(*gvp); assert(GvCV(*gvp));
+ PUSHMARK(SP);
+ XPUSHs((SV *)gv);
+ PUTBACK;
+ call_sv((SV *)*gvp, G_VOID|G_DISCARD);
+ LEAVE;
}
else SvREFCNT_dec_NN(namesv);
- return stash;
}
/*
parameter indicates the length of the C<name>, in bytes. C<flags> is passed
to C<gv_fetchpvn_flags()>, so if set to C<GV_ADD> then the package will be
created if it does not already exist. If the package does not exist and
-C<flags> is 0 (or any other setting that does not create packages) then NULL
+C<flags> is 0 (or any other setting that does not create packages) then C<NULL>
is returned.
Flags may be one of:
GV_NOEXPAND
GV_ADDMG
-The most important of which are probably GV_ADD and SVf_UTF8.
+The most important of which are probably C<GV_ADD> and C<SVf_UTF8>.
Note, use of C<gv_stashsv> instead of C<gv_stashpvn> where possible is strongly
recommended for performance reasons.
tmpgv = gv_fetchpvn_flags(tmpbuf, tmplen, flags, SVt_PVHV);
if (tmpbuf != smallbuf)
Safefree(tmpbuf);
- if (!tmpgv)
+ if (!tmpgv || !isGV_with_GP(tmpgv))
return NULL;
stash = GvHV(tmpgv);
if (!(flags & ~GV_NOADD_MASK) && !stash) return NULL;
Requires one of either namesv or namepv to be non-null.
-See C<gv_stashpvn> for details on "flags".
+See C<L</gv_stashpvn>> for details on "flags".
Note the sv interface is strongly preferred for performance reasons.
/*
=for apidoc gv_stashsv
-Returns a pointer to the stash for a specified package. See C<gv_stashpvn>.
+Returns a pointer to the stash for a specified package. See
+C<L</gv_stashpvn>>.
-Note this interface is strongly preferred over C<gv_stashpvn> for performance reasons.
+Note this interface is strongly preferred over C<gv_stashpvn> for performance
+reasons.
=cut
*/
return TRUE;
}
+/* gv_magicalize only turns on the SVf_READONLY flag, not SVf_PROTECT. So
+ redefine SvREADONLY_on for that purpose. We don’t use it later on in
+ this file. */
+#undef SvREADONLY_on
+#define SvREADONLY_on(sv) (SvFLAGS(sv) |= SVf_READONLY)
+
/* gv_magicalize() is called by gv_fetchpvn_flags when creating
* a new GV.
* Note that it does not insert the GV into the stash prior to
GvMULTI_on(gv);
break;
case 'a':
+ if (stash == PL_debstash && len==4 && strEQ(name2,"rgs")) {
+ GvMULTI_on(gv_AVadd(gv));
+ break;
+ }
case 'b':
if (len == 1 && sv_type == SVt_PV)
GvMULTI_on(gv);
} else
#endif
{
- const char * const name2 = name + 1;
+ const char * name2 = name + 1;
switch (*name) {
case 'A':
if (strEQ(name2, "RGV")) {
case '\027': /* $^WARNING_BITS */
if (strEQ(name2, "ARNING_BITS"))
goto magicalize;
+#ifdef WIN32
+ else if (strEQ(name2, "IN32_SLOPPY_STAT"))
+ goto magicalize;
+#endif
break;
case '1':
case '2':
{
/* Ensures that we have an all-digit variable, ${"1foo"} fails
this test */
- /* This snippet is taken from is_gv_magical */
- const char *end = name + len;
- while (--end > name) {
- if (!isDIGIT(*end))
- return addmg;
- }
- paren = grok_atou(name, NULL);
+ UV uv;
+ if (!grok_atoUV(name, &uv, NULL) || uv > I32_MAX)
+ return addmg;
+ /* XXX why are we using a SSize_t? */
+ paren = (SSize_t)(I32)uv;
goto storeparen;
}
}
/* magicalization must be done before require_tie_mod is called */
if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
- {
- require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
- addmg = FALSE;
- }
+ require_tie_mod(gv, "!", newSVpvs("Errno"), 1);
break;
case '-': /* $- */
SvREADONLY_on(av);
if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
- {
- require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
- addmg = FALSE;
- }
+ require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), 0);
break;
}
case '[': /* $[ */
if ((sv_type == SVt_PV || sv_type == SVt_PVGV)
&& FEATURE_ARYBASE_IS_ENABLED) {
- require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0);
- addmg = FALSE;
+ require_tie_mod(gv,name,newSVpvs("arybase"),0);
}
else goto magicalize;
break;
return addmg;
}
+/* If we do ever start using this later on in the file, we need to make
+ sure we don’t accidentally use the wrong definition. */
+#undef SvREADONLY_on
+
/* This function is called when the stash already holds the GV of the magic
* variable we're looking for, but we need to check that it has the correct
* kind of magic. For example, if someone first uses $! and then %!, the
if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) {
if (*name == '!')
- require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
+ require_tie_mod(gv, "!", newSVpvs("Errno"), 1);
else if (*name == '-' || *name == '+')
- require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
+ require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), 0);
} else if (sv_type == SVt_PV) {
if (*name == '*' || *name == '#') {
/* diag_listed_as: $* is no longer supported */
if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
switch (*name) {
case '[':
- require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0);
+ require_tie_mod(gv,name,newSVpvs("arybase"),0);
break;
#ifdef PERL_SAWAMPERSAND
case '`':
if ( isIDFIRST_lazy_if(name, is_utf8) && !ckWARN(WARN_ONCE) )
GvMULTI_on(gv) ;
- /* First, store the gv in the symtab if we're adding magic,
- * but only for non-empty GVs
- */
#define GvEMPTY(gv) !(GvAV(gv) || GvHV(gv) || GvIO(gv) \
|| GvCV(gv) || (GvSV(gv) && SvOK(GvSV(gv))))
- if ( addmg && !GvEMPTY(gv) ) {
- (void)hv_store(stash,name,len,(SV *)gv,0);
- }
-
/* set up magic where warranted */
if ( gv_magicalize(gv, stash, name, len, addmg, sv_type) ) {
/* See 23496c6 */
gv = NULL;
}
}
+ else
+ /* Not empty; this means gv_magicalize magicalised it. */
+ (void)hv_store(stash,name,len,(SV *)gv,0);
}
if (gv) gv_init_svtype(gv, faking_it ? SVt_PVCV : sv_type);
PERL_ARGS_ASSERT_GV_CHECK;
- if (!HvARRAY(stash))
+ if (!SvOOK(stash))
return;
- assert(SvOOK(stash));
+ assert(HvARRAY(stash));
for (i = 0; i <= (I32) HvMAX(stash); i++) {
const HE *entry;
for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
GV *gv;
HV *hv;
- if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
+ STRLEN keylen = HeKLEN(entry);
+ const char * const key = HeKEY(entry);
+
+ if (keylen >= 2 && key[keylen-2] == ':' && key[keylen-1] == ':' &&
(gv = MUTABLE_GV(HeVAL(entry))) && isGV(gv) && (hv = GvHV(gv)))
{
if (hv != PL_defstash && hv != stash
Somehow gp->gp_hv can end up pointing at freed garbage. */
if (hv && SvTYPE(hv) == SVt_PVHV) {
const HEK *hvname_hek = HvNAME_HEK(hv);
- DEBUG_o(Perl_deb(aTHX_ "gp_free clearing PL_stashcache for '%"HEKf"'\n", HEKfARG(hvname_hek)));
- if (PL_stashcache && hvname_hek)
+ if (PL_stashcache && hvname_hek) {
+ DEBUG_o(Perl_deb(aTHX_
+ "gp_free clearing PL_stashcache for '%"HEKf"'\n",
+ HEKfARG(hvname_hek)));
(void)hv_deletehek(PL_stashcache, hvname_hek, G_DISCARD);
+ }
SvREFCNT_dec(hv);
}
if (io && SvREFCNT(io) == 1 && IoIFP(io)
SvGETMAGIC(arg);
if (SvAMAGIC(arg) && (tmpsv = amagic_call(arg, &PL_sv_undef, method,
- AMGf_noright | AMGf_unary))) {
+ AMGf_noright | AMGf_unary
+ | (flags & AMGf_numarg))))
+ {
if (flags & AMGf_set) {
SETs(tmpsv);
}
if (SvAMAGIC(left) || SvAMAGIC(right)) {
SV * const tmpsv = amagic_call(left, right, method,
- ((flags & AMGf_assign) && opASSIGN ? AMGf_assign: 0));
+ ((flags & AMGf_assign) && opASSIGN ? AMGf_assign: 0)
+ | (flags & AMGf_numarg));
if (tmpsv) {
if (flags & AMGf_set) {
(void)POPs;
case band_amg:
case bor_amg:
case bxor_amg:
+ case sband_amg:
+ case sbor_amg:
+ case sbxor_amg:
if (assign)
force_scalar = 1;
break;
SV* res;
const bool oldcatch = CATCH_GET;
I32 oldmark, nret;
- int gimme = force_scalar ? G_SCALAR : GIMME_V;
+ U8 gimme = force_scalar ? G_SCALAR : GIMME_V;
CATCH_SET(TRUE);
Zero(&myop, 1, BINOP);
PUSHs(newSVpvn_flags(AMG_id2name(method + assignshift),
AMG_id2namelen(method + assignshift), SVs_TEMP));
}
+ else if (flags & AMGf_numarg)
+ PUSHs(&PL_sv_undef);
+ if (flags & AMGf_numarg)
+ PUSHs(&PL_sv_yes);
PUSHs(MUTABLE_SV(cv));
PUTBACK;
oldmark = TOPMARK;
sv_clear((SV*)gv);
SvREFCNT(gv) = 1;
SvFLAGS(gv) = SVt_IV|SVf_ROK|SVprv_PCS_IMPORTED * imported;
+
+ /* See also: 'SET_SVANY_FOR_BODYLESS_IV' in sv.c */
SvANY(gv) = (XPVGV*)((char*)&(gv->sv_u.svu_iv) -
STRUCT_OFFSET(XPVIV, xiv_iv));
SvRV_set(gv, value);
}
/*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
* ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff