Make ‘require func()’ work with .pm abs path

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.

diff --git a/pp_ctl.c b/pp_ctl.c
index a9072df..1b0b5f7 100644 (file)
--- 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..4200004 100644 (file)
--- 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.   #