STATIC char
S_grok_bslash_c(pTHX_ const char source, const bool utf8, const bool output_warning)
{
U8 result;
if (utf8) {
/* Trying to deprecate non-ASCII usages. This construct has never
* worked for a utf8 variant. So, even though are accepting non-ASCII
* Latin1 in 5.14, no need to make them work under utf8 */
if (! isASCII(source)) {
Perl_croak(aTHX_ "Character following \"\\c\" must be ASCII");
}
}
result = toCTRL(source);
if (! isASCII(source)) {
Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
"Character following \"\\c\" must be ASCII");
}
else if (! isCNTRL(result) && output_warning) {
if (source == '{') {
Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
"\"\\c{\" is deprecated and is more clearly written as \";\"");
}
else {
U8 clearer[3];
U8 i = 0;
if (! isALNUM(result)) {
clearer[i++] = '\\';
}
clearer[i++] = result;
clearer[i++] = '\0';
Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
"\"\\c%c\" is more clearly written simply as \"%s\"",
source,
clearer);
}
}
return result;
}
GV*
Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
{
char autoload[] = "AUTOLOAD";
STRLEN autolen = sizeof(autoload)-1;
GV* gv;
CV* cv;
HV* varstash;
GV* vargv;
SV* varsv;
char *packname = "";
if (len == autolen && strnEQ(name, autoload, autolen))
return Nullgv;
if (stash) {
if (SvTYPE(stash) < SVt_PVHV) {
packname = SvPV_nolen((SV*)stash);
stash = Nullhv;
}
else {
packname = HvNAME(stash);
}
}
if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE)))
return Nullgv;
cv = GvCV(gv);
if (!(CvROOT(cv) || CvXSUB(cv)))
return Nullgv;
/*
* Inheriting AUTOLOAD for non-methods works ... for now.
*/
if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX) && !method &&
(GvCVGEN(gv) || GvSTASH(gv) != stash))
Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
"Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
packname, (int)len, name);
if (CvXSUB(cv)) {
/* rather than lookup/init $AUTOLOAD here
* only to have the XSUB do another lookup for $AUTOLOAD
* and split that value on the last '::',
* pass along the same data via some unused fields in the CV
*/
CvSTASH(cv) = stash;
SvPVX(cv) = (char *)name; /* cast to lose constness warning */
SvCUR(cv) = len;
return gv;
}
/*
* Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
* The subroutine's original name may not be "AUTOLOAD", so we don't
* use that, but for lack of anything better we will use the sub's
* original package to look up $AUTOLOAD.
*/
varstash = GvSTASH(CvGV(cv));
vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE);
ENTER;
if (!isGV(vargv))
gv_init(vargv, varstash, autoload, autolen, FALSE);
LEAVE;
varsv = GvSV(vargv);
sv_setpv(varsv, packname);
sv_catpvn(varsv, "::", 2);
sv_catpvn(varsv, name, len);
SvTAINTED_off(varsv);
return gv;
}
