summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2011-05-11 09:27:08 -0400
committerJesse Vincent <jesse@bestpractical.com>2011-05-11 09:27:08 -0400
commiteb70bb4a400e88a66c7e10414a2d52b5da4cfd1f (patch)
treeb5e019d7ba8dbc4d42c5c65ec4a5732e3073cc4a
parentee2a35bad5a5ebcb37410d5f0510bf4d13daf466 (diff)
downloadperl-5.14.0-RC3.tar.gz
Make ‘require func()’ work with .pm abs pathv5.14.0-RC3
As of commit 282b29ee485, 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: + SV *const pmcsv = sv_mortalcopy(name); 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) sub-routine, 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.
-rw-r--r--pp_ctl.c3
-rw-r--r--t/comp/require.t16
2 files changed, 17 insertions, 2 deletions
diff --git a/pp_ctl.c b/pp_ctl.c
index a9072dfe1d..1b0b5f706b 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 d4ca56c077..4200004113 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 +259,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. #