Change 30068 by [EMAIL PROTECTED] on 2007/01/29 20:23:46
Integrate:
[ 29197]
When code is loaded through an @INC-hook, and when this hook
has set a filename entry in %INC, make sure __FILE__ is set
for this code accordingly to the contents of that %INC entry.
[ 29235]
Change the documentation of the return values of @INC-hooks to match
what is tested to work. (It's a bit confusing that optional values
might appear at the middle, too.)
[ 29236]
Subject: [PATCH t/op/inccode.t] fails under minitest
From: "Robin Barker" <[EMAIL PROTECTED]>
Date: Wed, 8 Nov 2006 15:18:23 -0000
Message-ID: <[EMAIL PROTECTED]>
[ 29584]
Subject: [PATCH blead] Re: [perl #41071] require stringifies code
references in tied @INC
From: Rick Delaney <[EMAIL PROTECTED]>
Date: Fri, 15 Dec 2006 23:28:25 -0500
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#299 integrate
... //depot/maint-5.8/perl/pod/perlfunc.pod#91 integrate
... //depot/maint-5.8/perl/pp_ctl.c#166 integrate
... //depot/maint-5.8/perl/t/op/inccode-tie.t#1 branch
... //depot/maint-5.8/perl/t/op/inccode.t#4 integrate
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#299 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#298~30057~ 2007-01-29 07:55:07.000000000 -0800
+++ perl/MANIFEST 2007-01-29 12:23:46.000000000 -0800
@@ -2799,6 +2799,7 @@
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 [EMAIL PROTECTED]
work
t/op/inc.t See if inc/dec of integers near 32 bit limit
work
t/op/index.t See if index works
==== //depot/maint-5.8/perl/pod/perlfunc.pod#91 (text) ====
Index: perl/pod/perlfunc.pod
--- perl/pod/perlfunc.pod#90~30065~ 2007-01-29 10:52:30.000000000 -0800
+++ perl/pod/perlfunc.pod 2007-01-29 12:23:46.000000000 -0800
@@ -4417,22 +4417,16 @@
walks through @INC and encounters a subroutine, this subroutine gets
called with two parameters, the first being a reference to itself, and the
second the name of the file to be included (e.g. "F<Foo/Bar.pm>"). The
-subroutine should return nothing, or a list of up to 4 values in the
+subroutine should return nothing, or a list of up to three values in the
following order:
=over
=item 1
-A reference to a scalar, containing any initial source code to prepend to
-the file or generator output.
-
-
-=item 2
-
A filehandle, from which the file will be read.
-=item 3
+=item 2
A reference to a subroutine. If there is no file handle, then this subroutine
is expected to generate one line of source code per call, writing the line
@@ -4441,7 +4435,7 @@
with the line as read in C<$_>. Again, return 1 for each valid line, and 0
after all lines have been returned.
-=item 4
+=item 3
Optional state for the subroutine. The state is passed in as C<$_[1]>. A
reference to the subroutine itself is passed in as C<$_[0]>.
==== //depot/maint-5.8/perl/pp_ctl.c#166 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#165~30040~ 2007-01-27 10:56:32.000000000 -0800
+++ perl/pp_ctl.c 2007-01-29 12:23:46.000000000 -0800
@@ -3126,8 +3126,11 @@
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;
SV *loader = dirsv;
if (SvTYPE(SvRV(loader)) == SVt_PVAV
@@ -3155,6 +3158,11 @@
count = call_sv(loader, G_ARRAY);
SPAGAIN;
+ /* Adjust file name if the hook has set an %INC entry */
+ svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
+ if (svp)
+ tryname = SvPVX_const(*svp);
+
if (count > 0) {
int i = 0;
SV *arg;
==== //depot/maint-5.8/perl/t/op/inccode-tie.t#1 (text) ====
Index: perl/t/op/inccode-tie.t
--- /dev/null 2007-01-16 11:55:45.526841103 -0800
+++ perl/t/op/inccode-tie.t 2007-01-29 12:23:46.000000000 -0800
@@ -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';
[EMAIL PROTECTED] = @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";
==== //depot/maint-5.8/perl/t/op/inccode.t#4 (text) ====
Index: perl/t/op/inccode.t
--- perl/t/op/inccode.t#3~28130~ 2006-05-08 13:44:45.000000000 -0700
+++ perl/t/op/inccode.t 2007-01-29 12:23:46.000000000 -0800
@@ -3,11 +3,14 @@
# Tests for the [EMAIL PROTECTED] feature
my $can_fork = 0;
+my $minitest = $ENV{PERL_CORE_MINITEST};
+
BEGIN {
chdir 't' if -d 't';
@INC = qw(. ../lib);
}
-{
+
+if (!$minitest) {
use Config;
if (PerlIO::Layer->find('perlio') && $Config{d_fork} &&
eval 'require POSIX; 1') {
@@ -19,7 +22,7 @@
use File::Spec;
require "test.pl";
-plan(tests => 45 + 14 * $can_fork);
+plan(tests => 45 + !$minitest * (3 + 14 * $can_fork));
my @tempfiles = ();
@@ -197,16 +200,41 @@
$ret ||= do 'abc.pl';
is( $ret, 'abc', 'do "abc.pl" sees return value' );
-pop @INC;
-
-my $filename = $^O eq 'MacOS' ? ':Foo:Foo.pm' : './Foo.pm';
{
- local @INC;
+ my $filename = $^O eq 'MacOS' ? ':Foo:Foo.pm' : './Foo.pm';
+ #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;
+
+pop @INC;
+
+push @INC, sub {
+ my ($cr, $filename) = @_;
+ my $module = $filename; $module =~ s,/,::,g; $module =~ s/\.pm$//;
+ open my $fh, '<', \"package $module; sub complain { warn q() }; \$::file =
__FILE__;"
+ or die $!;
+ $INC{$filename} = "/custom/path/to/$filename";
+ return $fh;
+};
+
+require Publius::Vergilius::Maro;
+is( $INC{'Publius/Vergilius/Maro.pm'},
'/custom/path/to/Publius/Vergilius/Maro.pm', '%INC set correctly');
+is( our $file, '/custom/path/to/Publius/Vergilius/Maro.pm', '__FILE__ set
correctly' );
+{
+ my $warning;
+ local $SIG{__WARN__} = sub { $warning = shift };
+ Publius::Vergilius::Maro::complain();
+ like( $warning, qr{something's wrong at
/custom/path/to/Publius/Vergilius/Maro.pm}, 'warn() reports correct file
source' );
+}
+
+pop @INC;
+
if ($can_fork) {
require PerlIO::scalar;
# This little bundle of joy generates n more recursive use statements,
End of Patch.
