if (!cstash) {
Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
- "Can't locate package %"SVf" for @%"HEKf"::ISA",
+ "Can't locate package %" SVf " for @%" HEKf "::ISA",
SVfARG(linear_sv),
HEKfARG(HvNAME_HEK(stash)));
continue;
return gv;
}
Perl_croak(aTHX_
- "Can't locate object method \"%"UTF8f
- "\" via package \"%"HEKf"\"",
+ "Can't locate object method \"%" UTF8f
+ "\" via package \"%" HEKf "\"",
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
+ "\" via package \"%" SVf "\""
+ " (perhaps you forgot to load \"%" SVf "\"?)",
UTF8fARG(is_utf8, name_end - name, name),
SVfARG(packnamesv), SVfARG(packnamesv));
}
&& (GvCVGEN(gv) || GvSTASH(gv) != stash)
)
Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
- "Use of inherited AUTOLOAD for non-method %"SVf
- "::%"UTF8f"() is deprecated",
+ "Use of inherited AUTOLOAD for non-method %" SVf
+ "::%" UTF8f "() is deprecated. This will be "
+ "fatal in Perl 5.28",
SVfARG(packname),
UTF8fARG(is_utf8, len, name));
PERL_ARGS_ASSERT_PARSE_GV_STASH_NAME;
- if (full_len > 2 && **name == '*' && isIDFIRST_lazy_if(*name + 1, is_utf8)) {
+ if ( full_len > 2
+ && **name == '*'
+ && isIDFIRST_lazy_if_safe(*name + 1, name_end, is_utf8))
+ {
/* accidental stringify on a GV? */
(*name)++;
}
name_cursor++;
*name = name_cursor+1;
if (*name == name_end) {
- if (!*gv)
- *gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE));
+ if (!*gv) {
+ *gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE));
+ if (SvTYPE(*gv) != SVt_PVGV) {
+ gv_init_pvn(*gv, PL_defstash, "main::", 6,
+ GV_ADDMULTI);
+ GvHV(*gv) =
+ MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
+ }
+ }
return TRUE;
}
}
PERL_ARGS_ASSERT_GV_IS_IN_MAIN;
/* If it's an alphanumeric variable */
- if ( len && isIDFIRST_lazy_if(name, is_utf8) ) {
+ if ( len && isIDFIRST_lazy_if_safe(name, name + len, is_utf8) ) {
/* Some "normal" variables are always in main::,
* like INC or STDOUT.
*/
/* diag_listed_as: Variable "%s" is not imported%s */
Perl_ck_warner_d(
aTHX_ packWARN(WARN_MISC),
- "Variable \"%c%"UTF8f"\" is not imported",
+ "Variable \"%c%" UTF8f "\" is not imported",
sv_type == SVt_PVAV ? '@' :
sv_type == SVt_PVHV ? '%' : '$',
UTF8fARG(is_utf8, len, name));
if (GvCVu(*gvp))
Perl_ck_warner_d(
aTHX_ packWARN(WARN_MISC),
- "\t(Did you mean &%"UTF8f" instead?)\n",
+ "\t(Did you mean &%" UTF8f " instead?)\n",
UTF8fARG(is_utf8, len, name)
);
*stash = NULL;
if (add && !PL_in_clean_all) {
GV *gv;
qerror(Perl_mess(aTHX_
- "Global symbol \"%s%"UTF8f
+ "Global symbol \"%s%" UTF8f
"\" requires explicit package name (did you forget to "
- "declare \"my %s%"UTF8f"\"?)",
+ "declare \"my %s%" UTF8f "\"?)",
(sv_type == SVt_PV ? "$"
: sv_type == SVt_PVAV ? "@"
: sv_type == SVt_PVHV ? "%"
case '*': /* $* */
case '#': /* $# */
if (sv_type == SVt_PV)
- /* diag_listed_as: $* is no longer supported */
+ /* diag_listed_as: $* is no longer supported. Its use will be fatal in Perl 5.30 */
Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
- "$%c is no longer supported", *name);
+ "$%c is no longer supported. Its use "
+ "will be fatal in Perl 5.30", *name);
break;
case '\010': /* $^H */
{
require_tie_mod_s(gv, *name, "Tie::Hash::NamedCapture", 0);
} else if (sv_type == SVt_PV) {
if (*name == '*' || *name == '#') {
- /* diag_listed_as: $* is no longer supported */
+ /* diag_listed_as: $# is no longer supported. Its use will be fatal in Perl 5.30 */
Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED,
WARN_SYNTAX),
- "$%c is no longer supported", *name);
+ "$%c is no longer supported. Its use "
+ "will be fatal in Perl 5.30", *name);
}
}
if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
if (add & GV_ADDWARN)
Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
- "Had to create %"UTF8f" unexpectedly",
+ "Had to create %" UTF8f " unexpectedly",
UTF8fARG(is_utf8, name_end-nambeg, nambeg));
gv_init_pvn(gv, stash, name, len, (add & GV_ADDMULTI)|is_utf8);
- if ( isIDFIRST_lazy_if(name, is_utf8) && !ckWARN(WARN_ONCE) )
+ if ( full_len != 0
+ && isIDFIRST_lazy_if_safe(name, name + full_len, is_utf8)
+ && !ckWARN(WARN_ONCE) )
+ {
GvMULTI_on(gv) ;
+ }
/* set up magic where warranted */
if ( gv_magicalize(gv, stash, name, len, sv_type) ) {
)
gv_check(hv); /* nested package */
}
- else if ( *HeKEY(entry) != '_'
- && isIDFIRST_lazy_if(HeKEY(entry), HeUTF8(entry)) ) {
+ else if ( HeKLEN(entry) != 0
+ && *HeKEY(entry) != '_'
+ && isIDFIRST_lazy_if_safe(HeKEY(entry),
+ HeKEY(entry) + HeKLEN(entry),
+ HeUTF8(entry)) )
+ {
const char *file;
gv = MUTABLE_GV(HeVAL(entry));
if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv))
= gv_fetchfile_flags(file, HEK_LEN(GvFILE_HEK(gv)), 0);
#endif
Perl_warner(aTHX_ packWARN(WARN_ONCE),
- "Name \"%"HEKf"::%"HEKf
+ "Name \"%" HEKf "::%" HEKf
"\" used only once: possible typo",
HEKfARG(HvNAME_HEK(stash)),
HEKfARG(GvNAME_HEK(gv)));
PERL_ARGS_ASSERT_NEWGVGEN_FLAGS;
assert(!(flags & ~SVf_UTF8));
- return gv_fetchpv(Perl_form(aTHX_ "%"UTF8f"::_GEN_%ld",
+ return gv_fetchpv(Perl_form(aTHX_ "%" UTF8f "::_GEN_%ld",
UTF8fARG(flags, strlen(pack), pack),
(long)PL_gensym++),
GV_ADD, SVt_PVGV);
const HEK *hvname_hek = HvNAME_HEK(hv);
if (PL_stashcache && hvname_hek) {
DEBUG_o(Perl_deb(aTHX_
- "gp_free clearing PL_stashcache for '%"HEKf"'\n",
+ "gp_free clearing PL_stashcache for '%" HEKf "'\n",
HEKfARG(hvname_hek)));
(void)hv_deletehek(PL_stashcache, hvname_hek, G_DISCARD);
}
GV *ngv = NULL;
SV *gvsv = GvSV(gv);
- DEBUG_o( Perl_deb(aTHX_ "Resolving method \"%"SVf256\
+ DEBUG_o( Perl_deb(aTHX_ "Resolving method \"%" SVf256\
"\" for overloaded \"%s\" in package \"%.256s\"\n",
(void*)GvSV(gv), cp, HvNAME(stash)) );
if (!gvsv || !SvPOK(gvsv)
? gvsv
: newSVpvs_flags("???", SVs_TEMP);
/* diag_listed_as: Can't resolve method "%s" overloading "%s" in package "%s" */
- Perl_croak(aTHX_ "%s method \"%"SVf256
+ Perl_croak(aTHX_ "%s method \"%" SVf256
"\" overloading \"%s\" "\
- "in package \"%"HEKf256"\"",
+ "in package \"%" HEKf256 "\"",
(GvCVGEN(gv) ? "Stub found while resolving"
: "Can't resolve"),
SVfARG(name), cp,
SV *msg;
if (off==-1) off=method;
msg = sv_2mortal(Perl_newSVpvf(aTHX_
- "Operation \"%s\": no method found,%sargument %s%"SVf"%s%"SVf,
+ "Operation \"%s\": no method found,%sargument %s%" SVf "%s%" SVf,
AMG_id2name(method + assignshift),
(flags & AMGf_unary ? " " : "\n\tleft "),
SvAMAGIC(left)?
SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(SvSTASH(SvRV(right)))))):
SVfARG(&PL_sv_no)));
if (use_default_op) {
- DEBUG_o( Perl_deb(aTHX_ "%"SVf, SVfARG(msg)) );
+ DEBUG_o( Perl_deb(aTHX_ "%" SVf, SVfARG(msg)) );
} else {
- Perl_croak(aTHX_ "%"SVf, SVfARG(msg));
+ Perl_croak(aTHX_ "%" SVf, SVfARG(msg));
}
return NULL;
}
#ifdef DEBUGGING
if (!notfound) {
DEBUG_o(Perl_deb(aTHX_
- "Overloaded operator \"%s\"%s%s%s:\n\tmethod%s found%s in package %"SVf"%s\n",
+ "Overloaded operator \"%s\"%s%s%s:\n\tmethod%s found%s in package %" SVf "%s\n",
AMG_id2name(off),
method+assignshift==off? "" :
" (initially \"",
PERL_ARGS_ASSERT_GV_NAME_SET;
if (len > I32_MAX)
- Perl_croak(aTHX_ "panic: gv name too long (%"UVuf")", (UV) len);
+ Perl_croak(aTHX_ "panic: gv name too long (%" UVuf ")", (UV) len);
if (!(flags & GV_ADD) && GvNAME_HEK(gv)) {
unshare_hek(GvNAME_HEK(gv));