From c38a65302a7e2e2ea9b8748d368c87d573add6fd Mon Sep 17 00:00:00 2001 From: Rick Delaney Date: Fri, 15 Dec 2006 18:28:25 -0500 Subject: [PATCH] Re: [perl #41071] require stringifies code references in tied @INC Message-ID: <20061216042825.GB23501@localhost.localdomain> p4raw-id: //depot/perl@29584 --- MANIFEST | 1 + pp_ctl.c | 2 ++ t/op/inccode-tie.t | 15 +++++++++++++++ t/op/inccode.t | 4 +++- 4 files changed, 21 insertions(+), 1 deletion(-) create mode 100644 t/op/inccode-tie.t diff --git a/MANIFEST b/MANIFEST index c976d90..0a36e7f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3513,6 +3513,7 @@ t/op/hashassign.t See if hash assignments work t/op/hash.t See if the complexity attackers are repelled t/op/hashwarn.t See if warnings for bad hash assignments work t/op/inccode.t See if coderefs work in @INC +t/op/inccode-tie.t See if tie to @INC works t/op/incfilter.t See if the source filters in coderef-in-@INC work t/op/inc.t See if inc/dec of integers near 32 bit limit work t/op/index.t See if index works diff --git a/pp_ctl.c b/pp_ctl.c index 11554c9..36f0963 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3150,6 +3150,8 @@ PP(pp_require) for (i = 0; i <= AvFILL(ar); i++) { SV * const dirsv = *av_fetch(ar, i, TRUE); + if (SvTIED_mg((SV*)ar, PERL_MAGIC_tied)) + mg_get(dirsv); if (SvROK(dirsv)) { int count; SV **svp; diff --git a/t/op/inccode-tie.t b/t/op/inccode-tie.t new file mode 100644 index 0000000..43388dd --- /dev/null +++ b/t/op/inccode-tie.t @@ -0,0 +1,15 @@ +#!./perl + +# Calls all tests in op/inccode.t after tying @INC first. + +use Tie::Array; +my @orig_INC = @INC; +tie @INC, 'Tie::StdArray'; +@INC = @orig_INC; +for my $file ('./op/inccode.t', './t/op/inccode.t', ':op:inccode.t') { + if (-r $file) { + do $file; + exit; + } +} +die "Cannot find ./op/inccode.t or ./t/op/inccode.t\n"; diff --git a/t/op/inccode.t b/t/op/inccode.t index a64716b..268d4f4 100644 --- a/t/op/inccode.t +++ b/t/op/inccode.t @@ -202,10 +202,12 @@ is( $ret, 'abc', 'do "abc.pl" sees return value' ); { my $filename = $^O eq 'MacOS' ? ':Foo:Foo.pm' : './Foo.pm'; - local @INC; + #local @INC; # local fails on tied @INC + my @old_INC = @INC; # because local doesn't work on tied arrays @INC = sub { $filename = 'seen'; return undef; }; eval { require $filename; }; is( $filename, 'seen', 'the coderef sees fully-qualified pathnames' ); + @INC = @old_INC; } exit if $minitest; -- 2.7.4