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; }