for (i = 0; i <= AvFILL(ar); i++) {
SV * const dirsv = *av_fetch(ar, i, TRUE);
- if (SvTIED_mg((const SV *)ar, PERL_MAGIC_tied))
- mg_get(dirsv);
+ SvGETMAGIC(dirsv);
if (SvROK(dirsv)) {
int count;
SV **svp;
SV *loader = dirsv;
if (SvTYPE(SvRV(loader)) == SVt_PVAV
- && !sv_isobject(loader))
+ && !SvOBJECT(SvRV(loader)))
{
loader = *av_fetch(MUTABLE_AV(SvRV(loader)), 0, TRUE);
+ SvGETMAGIC(loader);
}
Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s",
PUSHs(dirsv);
PUSHs(nsv);
PUTBACK;
+ if (SvGMAGICAL(loader)) {
+ SV *l = sv_newmortal();
+ sv_setsv_nomg(l, loader);
+ loader = l;
+ }
if (sv_isobject(loader))
count = call_method("INC", G_ARRAY);
else
STRLEN dirlen;
if (SvOK(dirsv)) {
- dir = SvPV_const(dirsv, dirlen);
+ dir = SvPV_nomg_const(dirsv, dirlen);
} else {
dir = "";
dirlen = 0;
use strict;
-plan(tests => 62 + !is_miniperl() * (3 + 14 * $can_fork));
+plan(tests => 68 + !is_miniperl() * (3 + 14 * $can_fork));
sub get_temp_fh {
my $f = tempfile();
'require PADTMP passing freed var when @INC has multiple subs';\r
}
+SKIP: {
+ skip ("Not applicable when run from inccode-tie.t", 6) if tied @INC;
+ require Tie::Scalar;
+ package INCtie {
+ sub TIESCALAR { bless \my $foo }
+ sub FETCH { study; our $count++; ${$_[0]} }
+ }
+ local @INC = undef;
+ my $t = tie $INC[0], 'INCtie';
+ my $called;
+ $$t = sub { $called ++; !1 };
+ delete $INC{'foo.pm'}; # in case another test uses foo
+ eval { require foo };
+ is $INCtie::count, 2, # 2nd time for "Can't locate" -- XXX correct?
+ 'FETCH is called once on undef scalar-tied @INC elem';
+ is $called, 1, 'sub in scalar-tied @INC elem is called';
+ () = "$INC[0]"; # force a fetch, so the SV is ROK
+ $INCtie::count = 0;
+ eval { require foo };
+ is $INCtie::count, 2,
+ 'FETCH is called once on scalar-tied @INC elem holding ref';
+ is $called, 2, 'sub in scalar-tied @INC elem holding ref is called';
+ $$t = [];
+ $INCtie::count = 0;
+ eval { require foo };
+ is $INCtie::count, 1,
+ 'FETCH called once on scalar-tied @INC elem returning array';
+ $$t = "string";
+ $INCtie::count = 0;
+ eval { require foo };
+ is $INCtie::count, 2,
+ 'FETCH called once on scalar-tied @INC elem returning string';
+}
+
exit if is_miniperl();