* that implements the logic of automatical ties like %! and %-
*
* The "gv" parameter should be the glob.
- * "varpv" holds the name of the var, used for error messages
- * "namesv" holds the module name
+ * "varpv" holds the name of the var, used for error messages.
+ * "namesv" holds the module name. Its refcount will be decremented.
* "methpv" holds the method name to test for to check that things
- * are working reasonably close to as expected
- * "flags" if flag & 1 then save the scalar before loading.
+ * are working reasonably close to as expected.
+ * "flags": if flag & 1 then save the scalar before loading.
* For the protection of $! to work (it is set by this routine)
* the sv slot must already be magicalized.
*/
{
dVAR;
HV* stash = gv_stashsv(namesv, 0);
-
+
if (!stash || !(gv_fetchmethod(stash, methpv))) {
- SV *module = newSVsv(namesv);
+ SV *module = newSVsv(namesv);
+ char varname = *varpv; /* varpv might be clobbered by load_module,
+ so save it. For the moment it's always
+ a single char. */
dSP;
- PUTBACK;
ENTER;
if ( flags & 1 )
- save_scalar(gv);
- Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, module, NULL);
+ save_scalar(gv);
+ PUSHSTACKi(PERLSI_MAGIC);
+ Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, module, NULL);
+ POPSTACK;
LEAVE;
SPAGAIN;
stash = gv_stashsv(namesv, 0);
if (!stash)
- Perl_croak( aTHX_ "panic: Can't use %%%s because %"SVf" is not available",
- varpv, SVfARG(module));
- else if (!gv_fetchmethod(stash, methpv))
- Perl_croak( aTHX_ "panic: Can't use %%%s because %"SVf" does not support method %s",
- varpv, SVfARG(module), methpv);
+ Perl_croak(aTHX_ "panic: Can't use %%%c because %"SVf" is not available",
+ varname, SVfARG(namesv));
+ else if (!gv_fetchmethod(stash, methpv))
+ Perl_croak(aTHX_ "panic: Can't use %%%c because %"SVf" does not support method %s",
+ varname, SVfARG(namesv), methpv);
}
+ SvREFCNT_dec(namesv);
return stash;
}
if (add) {
GvMULTI_on(gv);
gv_init_sv(gv, sv_type);
- if (sv_type == SVt_PVHV && len == 1 ) {
+ if (len == 1 && (sv_type == SVt_PVHV || sv_type == SVt_PVGV)) {
if (*name == '!')
require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
- else
- if (*name == '-' || *name == '+')
- require_tie_mod(gv, name, newSVpvs("re::Tie::Hash::NamedCapture"), "FETCH", 0);
-
- }
+ else if (*name == '-' || *name == '+')
+ require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "FETCH", 0);
+ }
}
return gv;
} else if (no_init) {
goto magicalize;
case '!':
- GvMULTI_on(gv);
+ GvMULTI_on(gv);
/* If %! has been used, automatically load Errno.pm. */
sv_magic(GvSVn(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
/* magicalization must be done before require_tie_mod is called */
- if (sv_type == SVt_PVHV)
+ if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
break;
case '+':
GvMULTI_on(gv); /* no used once warnings here */
{
- bool plus = (*name == '+');
- SV *stashname = newSVpvs("re::Tie::Hash::NamedCapture");
AV* const av = GvAVn(gv);
- HV *const hv = GvHVn(gv);
- HV *const hv_tie = newHV();
- SV *tie = newRV_noinc((SV*)hv_tie);
+ SV* const avc = (*name == '+') ? (SV*)av : NULL;
- sv_bless(tie, gv_stashsv(stashname,GV_ADD));
- hv_magic(hv, (GV*)tie, PERL_MAGIC_tied);
- sv_magic((SV*)av, (plus ? (SV*)av : NULL), PERL_MAGIC_regdata, NULL, 0);
+ sv_magic((SV*)av, avc, PERL_MAGIC_regdata, NULL, 0);
sv_magic(GvSVn(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
-
- if (plus)
+ if (avc)
SvREADONLY_on(GvSVn(gv));
- else
- Perl_hv_store(aTHX_ hv_tie, STR_WITH_LEN("all"), newSViv(1), 0);
-
- SvREADONLY_on(hv);
- SvREADONLY_on(tie);
SvREADONLY_on(av);
-
- if (sv_type == SVt_PVHV)
- require_tie_mod(gv, name, stashname, "FETCH", 0);
- else
- SvREFCNT_dec(stashname);
- break;
+ if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
+ require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "FETCH", 0);
+
+ break;
}
case '*':
case '#':
{
SV * const sv = GvSVn(gv);
if (!sv_derived_from(PL_patchlevel, "version"))
- upg_version(PL_patchlevel);
+ upg_version(PL_patchlevel, TRUE);
GvSV(gv) = vnumify(PL_patchlevel);
SvREADONLY_on(GvSV(gv));
SvREFCNT_dec(sv);