Skip to content

Commit eb70bb4

Browse files
Father Chrysostomosobra
Father Chrysostomos
authored andcommitted
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: + 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.
1 parent ee2a35b commit eb70bb4

File tree

2 files changed

+17
-2
lines changed

2 files changed

+17
-2
lines changed

pp_ctl.c

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3467,9 +3467,10 @@ S_doopen_pm(pTHX_ SV *name)
34673467
PERL_ARGS_ASSERT_DOOPEN_PM;
34683468

34693469
if (namelen > 3 && memEQs(p + namelen - 3, 3, ".pm")) {
3470-
SV *const pmcsv = sv_mortalcopy(name);
3470+
SV *const pmcsv = sv_newmortal();
34713471
Stat_t pmcstat;
34723472

3473+
SvSetSV_nosteal(pmcsv,name);
34733474
sv_catpvn(pmcsv, "c", 1);
34743475

34753476
if (PerlLIO_stat(SvPV_nolen_const(pmcsv), &pmcstat) >= 0)

t/comp/require.t

Lines changed: 15 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ krunch.pm krunch.pmc whap.pm whap.pmc);
2222

2323
my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
2424
my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/;
25-
my $total_tests = 50;
25+
my $total_tests = 51;
2626
if ($Is_EBCDIC || $Is_UTF8) { $total_tests -= 3; }
2727
print "1..$total_tests\n";
2828

@@ -259,6 +259,20 @@ EOT
259259
}
260260
}
261261

262+
# Test "require func()" with abs path when there is no .pmc file.
263+
++$::i;
264+
require Cwd;
265+
require File::Spec::Functions;
266+
eval {
267+
CORE::require(File::Spec::Functions::catfile(Cwd::getcwd(),"bleah.pm"));
268+
};
269+
if ($@ =~ /^This is an expected error/) {
270+
print "ok $i\n";
271+
} else {
272+
print "not ok $i\n";
273+
}
274+
275+
262276
##########################################
263277
# What follows are UTF-8 specific tests. #
264278
# Add generic tests before this point. #

0 commit comments

Comments
 (0)