New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
[PATCH] Serious regression in 5.14: require func() #11329
Comments
From @cpansproutThis is in response to <nntp://nntp.perl.org/87k4dy9pl2.fsf@biokovo.herceg.de>. Sorry to spoil the excitement on the eve of the release, but I really think this needs to be fixed. ‘require func()’ does not work if the path is absolute and ends with .pm, and there is no .pmc file. The patch attached hereto fixes that. I *think* the test is portable, but it might be safer just to apply the fix for now, and leave the test till later (unless we can get it tested on VMS and Windows). Flags: Site configuration information for perl 5.14.0: Configured by sprout at Thu May 5 13:28:18 PDT 2011. Summary of my perl5 (revision 5 version 14 subversion 0) configuration: Locally applied patches: @INC for perl 5.14.0: Environment for perl 5.14.0: |
From @cpansproutFrom: Father Chrysostomos <sprout@cpan.org> Make ‘require func()’ work with .pm abs path As of commit 282b29e, pp_requires passes an SV to S_doopen_pm, instead of char*/length pair. That commit also used sv_mortalcopy() to copy the sv when trying out a .pmc extension: When the path is absolute, the sv passed to S_doopen_pm is the very sv that was passed to require. If it was returned from a (non-lvalue) subroutine, it will be marked TEMP, so the buffer gets stolen. After the .pmc file is discovered to be nonexistent, S_doopen_pm then uses its original sv to open the .pm file. But the buffer has been stolen, so it’s trying to open undef, which fais. In the mean time, pp_require still has a pointer to the stolen buffer, which now has a .pmc extenion, it blithely reports that the .pmc file cannot be found, not realising that its string has changed out from under it. (Actually, if the file name were just the right length, it could be reallocated and we could end up with a crash.) This patch copies the sv more kindly. Inline Patchdiff --git a/pp_ctl.c b/pp_ctl.c
index a9072df..1b0b5f7 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3467,9 +3467,10 @@ S_doopen_pm(pTHX_ SV *name)
PERL_ARGS_ASSERT_DOOPEN_PM;
if (namelen > 3 && memEQs(p + namelen - 3, 3, ".pm")) {
- SV *const pmcsv = sv_mortalcopy(name);
+ SV *const pmcsv = sv_newmortal();
Stat_t pmcstat;
+ SvSetSV_nosteal(pmcsv,name);
sv_catpvn(pmcsv, "c", 1);
if (PerlLIO_stat(SvPV_nolen_const(pmcsv), &pmcstat) >= 0)
diff --git a/t/comp/require.t b/t/comp/require.t
index d4ca56c..069fe88 100644
--- a/t/comp/require.t
+++ b/t/comp/require.t
@@ -22,7 +22,7 @@ krunch.pm krunch.pmc whap.pm whap.pmc);
my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/;
-my $total_tests = 50;
+my $total_tests = 51;
if ($Is_EBCDIC || $Is_UTF8) { $total_tests -= 3; }
print "1..$total_tests\n";
@@ -223,7 +223,8 @@ EOT
my $simple = ++$i;
my $pmc_older = ++$i;
my $pmc_dies = ++$i;
- if ($ccflags =~ /(?:^|\s)-DPERL_DISABLE_PMC\b/) {
+ my $pmc_off = $ccflags =~ /(?:^|\s)-DPERL_DISABLE_PMC\b/;
+ if ($pmc_off) {
print "# .pmc files are ignored, so test that\n";
write_file_not_thing('krunch.pmc', '.pmc', $pmc_older);
write_file('urkkk.pm', qq(print "ok $simple\n"));
@@ -259,6 +260,20 @@ EOT
}
}
+# Test "require func()" with abs path when there is no .pmc file.
+++$::i;
+require Cwd;
+require File::Spec::Functions;
+eval {
+ CORE::require(File::Spec::Functions::catfile(Cwd::getcwd(),"bleah.pm"));
+};
+if ($@ =~ /^This is an expected error/) {
+ print "ok $i\n";
+} else {
+ print "not ok $i\n";
+}
+
+
##########################################
# What follows are UTF-8 specific tests. #
# Add generic tests before this point. # |
From @cpansproutOn Tue May 10 21:47:52 2011, sprout wrote:
Here’s a better version of the patch. In the first, I forgot to undo a |
From @cpansproutFrom: Father Chrysostomos <sprout@cpan.org> Make ‘require func()’ work with .pm abs path As of commit 282b29e, pp_requires passes an SV to S_doopen_pm, instead of char*/length pair. That commit also used sv_mortalcopy() to copy the sv when trying out a .pmc extension: When the path is absolute, the sv passed to S_doopen_pm is the very sv that was passed to require. If it was returned from a (non-lvalue) subroutine, it will be marked TEMP, so the buffer gets stolen. After the .pmc file is discovered to be nonexistent, S_doopen_pm then uses its original sv to open the .pm file. But the buffer has been stolen, so it’s trying to open undef, which fais. In the mean time, pp_require still has a pointer to the stolen buffer, which now has a .pmc extenion, it blithely reports that the .pmc file cannot be found, not realising that its string has changed out from under it. (Actually, if the file name were just the right length, it could be reallocated and we could end up with a crash.) This patch copies the sv more kindly. Inline Patchdiff --git a/pp_ctl.c b/pp_ctl.c
index a9072df..1b0b5f7 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3467,9 +3467,10 @@ S_doopen_pm(pTHX_ SV *name)
PERL_ARGS_ASSERT_DOOPEN_PM;
if (namelen > 3 && memEQs(p + namelen - 3, 3, ".pm")) {
- SV *const pmcsv = sv_mortalcopy(name);
+ SV *const pmcsv = sv_newmortal();
Stat_t pmcstat;
+ SvSetSV_nosteal(pmcsv,name);
sv_catpvn(pmcsv, "c", 1);
if (PerlLIO_stat(SvPV_nolen_const(pmcsv), &pmcstat) >= 0)
diff --git a/t/comp/require.t b/t/comp/require.t
index d4ca56c..069fe88 100644
--- a/t/comp/require.t
+++ b/t/comp/require.t
@@ -22,7 +22,7 @@ krunch.pm krunch.pmc whap.pm whap.pmc);
my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/;
-my $total_tests = 50;
+my $total_tests = 51;
if ($Is_EBCDIC || $Is_UTF8) { $total_tests -= 3; }
print "1..$total_tests\n";
@@ -259,6 +260,20 @@ EOT
}
}
+# Test "require func()" with abs path when there is no .pmc file.
+++$::i;
+require Cwd;
+require File::Spec::Functions;
+eval {
+ CORE::require(File::Spec::Functions::catfile(Cwd::getcwd(),"bleah.pm"));
+};
+if ($@ =~ /^This is an expected error/) {
+ print "ok $i\n";
+} else {
+ print "not ok $i\n";
+}
+
+
##########################################
# What follows are UTF-8 specific tests. #
# Add generic tests before this point. # |
From [Unknown Contact. See original ticket]On Tue May 10 21:47:52 2011, sprout wrote:
Here’s a better version of the patch. In the first, I forgot to undo a |
@cpansprout - Status changed from 'new' to 'open' |
From @cpansproutOn Tue May 10 21:50:15 2011, sprout wrote:
Er, third try. I’m in too much of a hurry *and* I’m falling asleep. :-) |
From @cpansproutFrom: Father Chrysostomos <sprout@cpan.org> Make ‘require func()’ work with .pm abs path As of commit 282b29e, pp_requires passes an SV to S_doopen_pm, That commit also used sv_mortalcopy() to copy the sv when trying out a When the path is absolute, the sv passed to S_doopen_pm is the very sv After the .pmc file is discovered to be nonexistent, S_doopen_pm then In the mean time, pp_require still has a pointer to the stolen buffer, This patch copies the sv more kindly. Inline Patchdiff --git a/pp_ctl.c b/pp_ctl.c
index a9072df..1b0b5f7 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3467,9 +3467,10 @@ S_doopen_pm(pTHX_ SV *name)
PERL_ARGS_ASSERT_DOOPEN_PM;
if (namelen > 3 && memEQs(p + namelen - 3, 3, ".pm")) {
- SV *const pmcsv = sv_mortalcopy(name);
+ SV *const pmcsv = sv_newmortal();
Stat_t pmcstat;
+ SvSetSV_nosteal(pmcsv,name);
sv_catpvn(pmcsv, "c", 1);
if (PerlLIO_stat(SvPV_nolen_const(pmcsv), &pmcstat) >= 0)
diff --git a/t/comp/require.t b/t/comp/require.t
index d4ca56c..069fe88 100644
--- a/t/comp/require.t
+++ b/t/comp/require.t
@@ -22,7 +22,7 @@ krunch.pm krunch.pmc whap.pm whap.pmc);
my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/;
-my $total_tests = 50;
+my $total_tests = 51;
if ($Is_EBCDIC || $Is_UTF8) { $total_tests -= 3; }
print "1..$total_tests\n";
@@ -259,6 +260,20 @@ EOT
}
}
+# Test "require func()" with abs path when there is no .pmc file.
+++$::i;
+require Cwd;
+require File::Spec::Functions;
+eval {
+ CORE::require(File::Spec::Functions::catfile(Cwd::getcwd(),"bleah.pm"));
+};
+if ($@ =~ /^This is an expected error/) {
+ print "ok $i\n";
+} else {
+ print "not ok $i\n";
+}
+
+
##########################################
# What follows are UTF-8 specific tests. #
# Add generic tests before this point. # |
From [Unknown Contact. See original ticket]On Tue May 10 21:50:15 2011, sprout wrote:
Er, third try. I’m in too much of a hurry *and* I’m falling asleep. :-) |
From @cpansproutOn Tue May 10 21:53:41 2011, sprout wrote:
Applied as eb70bb4. |
@cpansprout - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#90296 (status was 'resolved')
Searchable as RT90296$
The text was updated successfully, but these errors were encountered: