} else {
what = type == SVt_PVAV ? "array" : "scalar";
}
- /* diag_listed_as: Bad symbol for filehandle */
Perl_croak(aTHX_ "Bad symbol for %s", what);
}
if (!isGV(gv))
gv_init_pvn(gv, CvSTASH(cv), HEK_KEY(CvNAME_HEK(cv)),
HEK_LEN(CvNAME_HEK(cv)),
- SVf_UTF8 * !!HEK_UTF8(CvNAME_HEK(cv)));
+ SVf_UTF8 * cBOOL(HEK_UTF8(CvNAME_HEK(cv))));
if (!CvNAMED(cv)) { /* gv_init took care of it */
assert (SvANY(cv)->xcv_gv_u.xcv_gv == gv);
return gv;
}
/*
-=for apidoc gv_fetchmeth
+=for apidoc gv_fetchmeth
+=for apidoc_item gv_fetchmeth_pv
+=for apidoc_item gv_fetchmeth_pvn
+=for apidoc_item gv_fetchmeth_sv
-Like L</gv_fetchmeth_pvn>, but lacks a flags parameter.
+These each look for a glob with name C<name>, containing a defined subroutine,
+returning the GV of that glob if found, or C<NULL> if not.
-=for apidoc gv_fetchmeth_sv
+C<stash> is always searched (first), unless it is C<NULL>.
-Exactly like L</gv_fetchmeth_pvn>, but takes the name string in the form
-of an SV instead of a string/length pair.
+If C<stash> is NULL, or was searched but nothing was found in it, and the
+C<GV_SUPER> bit is set in C<flags>, stashes accessible via C<@ISA> are searched
+next. Searching is conducted according to L<C<MRO> order|perlmroapi>.
+
+Finally, if no matches were found so far, and the C<GV_NOUNIVERSAL> flag in
+C<flags> is not set, C<UNIVERSAL::> is searched.
+
+The argument C<level> should be either 0 or -1. If -1, the function will
+return without any side effects or caching. If 0, the function makes sure
+there is a glob named C<name> in C<stash>, creating one if necessary.
+The subroutine slot in the glob will be set to any subroutine found in the
+C<stash> and C<SUPER::> search, hence caching any C<SUPER::> result. Note that
+subroutines found in C<UNIVERSAL::> are not cached.
+
+The GV returned from these may be a method cache entry, which is not visible to
+Perl code. So when calling C<call_sv>, you should not use the GV directly;
+instead, you should use the method's CV, which can be obtained from the GV with
+the C<GvCV> macro.
+
+The only other significant value for C<flags> is C<SVf_UTF8>, indicating that
+C<name> is to be treated as being encoded in UTF-8.
+
+Plain C<gv_fetchmeth> lacks a C<flags> parameter, hence always searches in
+C<stash>, then C<UNIVERSAL::>, and C<name> is never UTF-8. Otherwise it is
+exactly like C<gv_fetchmeth_pvn>.
+
+The other forms do have a C<flags> parameter, and differ only in how the glob
+name is specified.
+
+In C<gv_fetchmeth_pv>, C<name> is a C language NUL-terminated string.
+
+In C<gv_fetchmeth_pvn>, C<name> points to the first byte of the name, and an
+additional parameter, C<len>, specifies its length in bytes. Hence, the name
+may contain embedded-NUL characters.
+
+In C<gv_fetchmeth_sv>, C<*name> is an SV, and the name is the PV extracted from
+that, using L</C<SvPV>>. If the SV is marked as being in UTF-8, the extracted
+PV will also be.
+
+=for apidoc Amnh||GV_SUPER
=cut
*/
return gv_fetchmeth_pvn(stash, namepv, namelen, level, flags);
}
-/*
-=for apidoc gv_fetchmeth_pv
-
-Exactly like L</gv_fetchmeth_pvn>, but takes a nul-terminated string
-instead of a string/length pair.
-
-=cut
-*/
GV *
Perl_gv_fetchmeth_pv(pTHX_ HV *stash, const char *name, I32 level, U32 flags)
return gv_fetchmeth_internal(stash, NULL, name, strlen(name), level, flags);
}
-/*
-=for apidoc gv_fetchmeth_pvn
-
-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 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 C<GV_SUPER>, C<GV_NOUNIVERSAL>, and
-C<SVf_UTF8>.
-
-C<GV_SUPER> indicates that we want to look up the method in the superclasses
-of the C<stash>.
-
-C<GV_NOUNIVERSAL> indicates that we do not want to look up the method in
-the stash accessible by C<UNIVERSAL::>.
-
-The
-GV returned from C<gv_fetchmeth> may be a method cache entry, which is not
-visible to Perl code. So when calling C<call_sv>, you should not use
-the GV directly; instead, you should use the method's CV, which can be
-obtained from the GV with the C<GvCV> macro.
-
-=for apidoc Amnh||GV_SUPER
-
-=cut
-*/
-
/* NOTE: No support for tied ISA */
PERL_STATIC_INLINE GV*
} else {
Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
"While trying to resolve method call %.*s->%.*s()"
- " can not locate package \"%" SVf "\" yet it is mentioned in @%.*s::ISA"
- " (perhaps you forgot to load \"%" SVf "\"?)",
+ " can not locate package %" SVf_QUOTEDPREFIX " yet it is mentioned in @%.*s::ISA"
+ " (perhaps you forgot to load %" SVf_QUOTEDPREFIX "?)",
(int) hvnamelen, hvname,
(int) len, name,
SVfARG(linear_sv),
return gv;
}
Perl_croak(aTHX_
- "Can't locate object method \"%" UTF8f
- "\" via package \"%" HEKf "\"",
+ "Can't locate object method %" UTF8f_QUOTEDPREFIX ""
+ " via package %" HEKf_QUOTEDPREFIX,
UTF8fARG(is_utf8, name_end - name, name),
HEKfARG(HvNAME_HEK(stash)));
}
}
Perl_croak(aTHX_
- "Can't locate object method \"%" UTF8f
- "\" via package \"%" SVf "\""
- " (perhaps you forgot to load \"%" SVf "\"?)",
+ "Can't locate object method %" UTF8f_QUOTEDPREFIX ""
+ " via package %" SVf_QUOTEDPREFIX ""
+ " (perhaps you forgot to load %" SVf_QUOTEDPREFIX "?)",
UTF8fARG(is_utf8, name_end - name, name),
SVfARG(packnamesv), SVfARG(packnamesv));
}
return gv;
}
+
+/*
+=for apidoc gv_autoload_pv
+=for apidoc_item gv_autoload_pvn
+=for apidoc_item gv_autoload_sv
+
+These each search for an C<AUTOLOAD> method, returning NULL if not found, or
+else returning a pointer to its GV, while setting the package
+L<C<$AUTOLOAD>|perlobj/AUTOLOAD> variable to C<name> (fully qualified). Also,
+if found and the GV's CV is an XSUB, the CV's PV will be set to C<name>, and
+its stash will be set to the stash of the GV.
+
+Searching is done in L<C<MRO> order|perlmroapi>, as specified in
+L</C<gv_fetchmeth>>, beginning with C<stash> if it isn't NULL.
+
+The forms differ only in how C<name> is specified.
+
+In C<gv_autoload_pv>, C<namepv> is a C language NUL-terminated string.
+
+In C<gv_autoload_pvn>, C<name> points to the first byte of the name, and an
+additional parameter, C<len>, specifies its length in bytes. Hence, C<*name>
+may contain embedded-NUL characters.
+
+In C<gv_autoload_sv>, C<*namesv> is an SV, and the name is the PV extracted
+from that using L</C<SvPV>>. If the SV is marked as being in UTF-8, the
+extracted PV will also be.
+
+=cut
+*/
+
GV*
Perl_gv_autoload_sv(pTHX_ HV *stash, SV* namesv, U32 flags)
{
stash = NULL;
}
else
- packname = sv_2mortal(newSVhek(HvNAME_HEK(stash)));
+ packname = newSVhek_mortal(HvNAME_HEK(stash));
if (flags & GV_SUPER) sv_catpvs(packname, "::SUPER");
}
if (!(gv = gv_fetchmeth_pvn(stash, S_autoload, S_autolen, FALSE,
UTF8fARG(is_utf8, len, name));
if (CvISXSUB(cv)) {
- /* Instead of forcing the XSUB do another lookup for $AUTOLOAD
+ /* Instead of forcing the XSUB to do another lookup for $AUTOLOAD
* and split that value on the last '::', pass along the same data
* via the SvPVX field in the CV, and the stash in CvSTASH.
*
* Due to an unfortunate accident of history, the SvPVX field
- * serves two purposes. It is also used for the subroutine's pro-
- * type. Since SvPVX has been documented as returning the sub name
- * for a long time, but not as returning the prototype, we have
- * to preserve the SvPVX AUTOLOAD behaviour and put the prototype
+ * serves two purposes. It is also used for the subroutine's
+ * prototype. Since SvPVX has been documented as returning the sub
+ * name for a long time, but not as returning the prototype, we have to
+ * preserve the SvPVX AUTOLOAD behaviour and put the prototype
* elsewhere.
*
* We put the prototype in the same allocated buffer, but after
=for apidoc Amnh||GV_ADDMG
=for apidoc Amnh||GV_ADDMULTI
=for apidoc Amnh||GV_ADDWARN
-=for apidoc Amnh||GV_NOADD_NOINIT
=for apidoc Amnh||GV_NOINIT
+=for apidoc Amnh||GV_NOADD_NOINIT
=for apidoc Amnh||GV_NOTQUAL
=for apidoc Amnh||GV_NO_SVGMAGIC
=for apidoc Amnh||SVf_UTF8
}
/*
-=for apidoc gv_fullname3
-=for apidoc_item gv_fullname4
-=for apidoc_item gv_efullname3
+=for apidoc gv_efullname3
=for apidoc_item gv_efullname4
+=for apidoc_item gv_fullname3
+=for apidoc_item gv_fullname4
Place the full package name of C<gv> into C<sv>. The C<gv_e*> forms return
instead the effective package name (see L</HvENAME>).
}
}
else sv_catpvs(sv,"__ANON__::");
- sv_catsv(sv,sv_2mortal(newSVhek(GvNAME_HEK(gv))));
+ sv_catsv(sv,newSVhek_mortal(GvNAME_HEK(gv)));
}
void
PERL_ARGS_ASSERT_GV_CHECK;
- if (!SvOOK(stash))
+ if (!HvHasAUX(stash))
return;
assert(HvARRAY(stash));
(gv = MUTABLE_GV(HeVAL(entry))) && isGV(gv) && (hv = GvHV(gv)))
{
if (hv != PL_defstash && hv != stash
- && !(SvOOK(hv)
+ && !(HvHasAUX(hv)
&& (HvAUX(hv)->xhv_aux_flags & HvAUXf_SCAN_STASH))
)
gv_check(hv); /* nested package */
HvAUX(stash)->xhv_aux_flags &= ~HvAUXf_SCAN_STASH;
}
+/*
+=for apidoc newGVgen
+=for apidoc_item newGVgen_flags
+
+Create a new, guaranteed to be unique, GV in the package given by the
+NUL-terminated C language string C<pack>, and return a pointer to it.
+
+For C<newGVgen> or if C<flags> in C<newGVgen_flags> is 0, C<pack> is to be
+considered to be encoded in Latin-1. The only other legal C<flags> value is
+C<SVf_UTF8>, which indicates C<pack> is to be considered to be encoded in
+UTF-8.
+
+=cut
+*/
+
GV *
Perl_newGVgen_flags(pTHX_ const char *pack, U32 flags)
{
return 0;
}
-/* Updates and caches the CV's */
-/* Returns:
- * 1 on success and there is some overload
- * 0 if there is no overload
- * -1 if some error occurred and it couldn't croak
- */
+/*
+=for apidoc Gv_AMupdate
+
+Recalculates overload magic in the package given by C<stash>.
+
+Returns:
+
+=over
+
+=item 1 on success and there is some overload
+
+=item 0 if there is no overload
+
+=item -1 if some error occurred and it couldn't croak (because C<destructing>
+is true).
+
+=back
+
+=cut
+*/
int
Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
filled = 1;
}
- assert(SvOOK(stash));
+ assert(HvHasAUX(stash));
/* initially assume the worst */
HvAUX(stash)->xhv_aux_flags &= ~HvAUXf_NO_DEREF;
return FALSE;
}
+/*
+=for apidoc amagic_deref_call
+
+Perform C<method> overloading dereferencing on C<ref>, returning the
+dereferenced result. C<method> must be one of the dereference operations given
+in F<overload.h>.
+
+If overloading is inactive on C<ref>, returns C<ref> itself.
+
+=cut
+*/
+
SV *
Perl_amagic_deref_call(pTHX_ SV *ref, int method) {
SV *tmpsv = NULL;
return ref;
/* return quickly if none of the deref ops are overloaded */
stash = SvSTASH(SvRV(ref));
- assert(SvOOK(stash));
+ assert(HvHasAUX(stash));
if (HvAUX(stash)->xhv_aux_flags & HvAUXf_NO_DEREF)
return ref;
return TRUE;
}
+/*
+=for apidoc amagic_call
+
+Perform the overloaded (active magic) operation given by C<method>.
+C<method> is one of the values found in F<overload.h>.
+
+C<flags> affects how the operation is performed, as follows:
+
+=over
+
+=item C<AMGf_noleft>
+
+C<left> is not to be used in this operation.
+
+=item C<AMGf_noright>
+
+C<right> is not to be used in this operation.
+
+=item C<AMGf_unary>
+
+The operation is done only on just one operand.
+
+=item C<AMGf_assign>
+
+The operation changes one of the operands, e.g., $x += 1
+
+=back
+
+=cut
+*/
+
SV*
Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
{
#ifdef DEBUGGING
fl = 1,
#endif
- cv = cvp[off=method])))) {
+ cv = cvp[off=method]))))
+ {
lr = -1; /* Call method for left argument */
} else {
if (cvp && amtp->fallback > AMGfallNEVER && flags & AMGf_unary) {
"in overloaded package ":
"has no overloaded magic",
SvAMAGIC(left)?
- SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(SvSTASH(SvRV(left)))))):
+ SVfARG(newSVhek_mortal(HvNAME_HEK(SvSTASH(SvRV(left))))):
SVfARG(&PL_sv_no),
SvAMAGIC(right)?
",\n\tright argument in overloaded package ":
? ""
: ",\n\tright argument has no overloaded magic"),
SvAMAGIC(right)?
- SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(SvSTASH(SvRV(right)))))):
+ SVfARG(newSVhek_mortal(HvNAME_HEK(SvSTASH(SvRV(right))))):
SVfARG(&PL_sv_no)));
if (use_default_op) {
DEBUG_o( Perl_deb(aTHX_ "%" SVf, SVfARG(msg)) );
flags & AMGf_unary? "" :
lr==1 ? " for right argument": " for left argument",
flags & AMGf_unary? " for argument" : "",
- stash ? SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash)))) : SVfARG(newSVpvs_flags("null", SVs_TEMP)),
+ stash ? SVfARG(newSVhek_mortal(HvNAME_HEK(stash))) : SVfARG(newSVpvs_flags("null", SVs_TEMP)),
fl? ",\n\tassignment variant used": "") );
}
#endif
}
}
+/*
+=for apidoc gv_name_set
+
+Set the name for GV C<gv> to C<name> which is C<len> bytes long. Thus it may
+contain embedded NUL characters.
+
+If C<flags> contains C<SVf_UTF8>, the name is treated as being encoded in
+UTF-8; otherwise not.
+
+=cut
+*/
+
void
Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags)
{
} else if (GvMULTI(gv) && cv && SvREFCNT(cv) == 1 &&
!SvOBJECT(cv) && !SvMAGICAL(cv) && !SvREADONLY(cv) &&
CvSTASH(cv) == stash && !CvNAMED(cv) && CvGV(cv) == gv &&
- CvCONST(cv) && !CvMETHOD(cv) && !CvLVALUE(cv) && !CvUNIQUE(cv) &&
+ CvCONST(cv) && !CvNOWARN_AMBIGUOUS(cv) && !CvLVALUE(cv) && !CvUNIQUE(cv) &&
!CvNODEBUG(cv) && !CvCLONE(cv) && !CvCLONED(cv) && !CvANON(cv) &&
(namehek = GvNAME_HEK(gv)) &&
(gvp = hv_fetchhek(stash, namehek, 0)) &&
*gvp == (SV*)gv) {
SV *value = SvREFCNT_inc(CvXSUBANY(cv).any_ptr);
- const bool imported = !!GvIMPORTED_CV(gv);
+ const bool imported = cBOOL(GvIMPORTED_CV(gv));
SvREFCNT(gv) = 0;
sv_clear((SV*)gv);
SvREFCNT(gv) = 1;
https://perl5.git.perl.org / perl5.git / blobdiff