{
const char * const origname = name;
const char * const name_end = name + len;
- const char *nend;
- const char *nsplit = NULL;
+ const char *last_separator = NULL;
GV* gv;
HV* ostash = stash;
SV *const error_report = MUTABLE_SV(stash);
if (SvTYPE(stash) < SVt_PVHV)
stash = NULL;
else {
- /* The only way stash can become NULL later on is if nsplit is set,
+ /* The only way stash can become NULL later on is if last_separator is set,
which in turn means that there is no need for a SVt_PVHV case
the error reporting code. */
}
- for (nend = name; *nend || nend != name_end; nend++) {
- if (*nend == '\'') {
- nsplit = nend;
- name = nend + 1;
- }
- else if (*nend == ':' && *(nend + 1) == ':') {
- nsplit = nend++;
- name = nend + 1;
- }
+ {
+ /* check if the method name is fully qualified or
+ * not, and separate the package name from the actual
+ * method name.
+ *
+ * leaves last_separator pointing to the beginning of the
+ * last package separator (either ' or ::) or 0
+ * if none was found.
+ *
+ * leaves name pointing at the beginning of the
+ * method name.
+ */
+ const char *name_cursor = name;
+ const char * const name_em1 = name_end - 1; /* name_end minus 1 */
+ for (name_cursor = name; name_cursor < name_end ; name_cursor++) {
+ if (*name_cursor == '\'') {
+ last_separator = name_cursor;
+ name = name_cursor + 1;
+ }
+ else if (name_cursor < name_em1 && *name_cursor == ':' && name_cursor[1] == ':') {
+ last_separator = name_cursor++;
+ name = name_cursor + 1;
+ }
+ }
}
- if (nsplit) {
- if ((nsplit - origname) == 5 && memEQ(origname, "SUPER", 5)) {
+
+ /* did we find a separator? */
+ if (last_separator) {
+ if ((last_separator - origname) == 5 && memEQ(origname, "SUPER", 5)) {
/* ->SUPER::method should really be looked up in original stash */
stash = CopSTASH(PL_curcop);
flags |= GV_SUPER;
DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
origname, HvENAME_get(stash), name) );
}
- else if ((nsplit - origname) >= 7 &&
- strnEQ(nsplit - 7, "::SUPER", 7)) {
+ else if ((last_separator - origname) >= 7 &&
+ strnEQ(last_separator - 7, "::SUPER", 7)) {
/* don't autovifify if ->NoSuchStash::SUPER::method */
- stash = gv_stashpvn(origname, nsplit - origname - 7, is_utf8);
+ stash = gv_stashpvn(origname, last_separator - origname - 7, is_utf8);
if (stash) flags |= GV_SUPER;
}
else {
/* don't autovifify if ->NoSuchStash::method */
- stash = gv_stashpvn(origname, nsplit - origname, is_utf8);
+ stash = gv_stashpvn(origname, last_separator - origname, is_utf8);
}
ostash = stash;
}
else {
SV* packnamesv;
- if (nsplit) {
- packnamesv = newSVpvn_flags(origname, nsplit - origname,
+ if (last_separator) {
+ packnamesv = newSVpvn_flags(origname, last_separator - origname,
SVs_TEMP | is_utf8);
} else {
packnamesv = error_report;
}
}
+/* add a require_tie_mod_s - the _s suffix is similar to pvs type suffixes,
+ * IOW it means we do STR_WITH_LEN() ourselves and the user should pass in
+ * a true string WITHOUT a len.
+ */
+#define require_tie_mod_s(gv, varname, name, flags) \
+ S_require_tie_mod(aTHX_ gv, varname, STR_WITH_LEN(name), flags)
+
/*
=for apidoc gv_stashpv
sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len);
- /* magicalization must be done before require_tie_mod is called */
+ /* magicalization must be done before require_tie_mod_s is called */
if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
- require_tie_mod(gv, '!', "Errno", 5, 1);
+ require_tie_mod_s(gv, '!', "Errno", 1);
break;
- case '-': /* $- */
- case '+': /* $+ */
+ case '-': /* $-, %-, @- */
+ case '+': /* $+, %+, @+ */
GvMULTI_on(gv); /* no used once warnings here */
{
AV* const av = GvAVn(gv);
SvREADONLY_on(av);
if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
- require_tie_mod(gv, *name, "Tie::Hash::NamedCapture",23,0);
+ require_tie_mod_s(gv, *name, "Tie::Hash::NamedCapture",0);
break;
}
case '[': /* $[ */
if ((sv_type == SVt_PV || sv_type == SVt_PVGV)
&& FEATURE_ARYBASE_IS_ENABLED) {
- require_tie_mod(gv,'[',"arybase",7,0);
+ require_tie_mod_s(gv,'[',"arybase",0);
}
else goto magicalize;
break;
if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) {
if (*name == '!')
- require_tie_mod(gv, '!', "Errno", 5, 1);
+ require_tie_mod_s(gv, '!', "Errno", 1);
else if (*name == '-' || *name == '+')
- require_tie_mod(gv, *name, "Tie::Hash::NamedCapture", 23, 0);
+ 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 */
if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
switch (*name) {
case '[':
- require_tie_mod(gv,'[',"arybase",7,0);
+ require_tie_mod_s(gv,'[',"arybase",0);
break;
#ifdef PERL_SAWAMPERSAND
case '`':