Skip to content

Commit

Permalink
[perl #120657] Fix require PADTMP when @inc=(sub{},sub{})
Browse files Browse the repository at this point in the history
It was passing a freed scalar to subsequent subs, breaking
Test::Without::Module:

sub fake_module {
    my (undef,$module_file) = @_;
    !1
}
unshift @inc, (\&fake_module)x2;
require "${\'whatever'}";
__END__
panic: attempt to copy freed scalar 7fe8d0829820 to 7fe8d082a0f0 at - line 3.

Obviously, doing:

    SAVETMPS;
    ...
    nsv = sv_newmortal();
    ...
    FREETMPS; # free all tmps created since SAVETMPS

inside a loop that only assigns to nsv the first time through will
cause nsv to point to a freed scalar on subsequent iterations.

It was stupid of me to make that mistake in commit 9ffd39a to
begin with.

The extra file name SV here will simply have to last until the
require call finishes, something I was trying to avoid by putting it
after SAVETMPS.
  • Loading branch information
Father Chrysostomos committed Jan 4, 2014
1 parent a76c354 commit 901ee10
Show file tree
Hide file tree
Showing 2 changed files with 18 additions and 3 deletions.
5 changes: 3 additions & 2 deletions pp_ctl.c
Expand Up @@ -3833,12 +3833,13 @@ PP(pp_require)
tryname = SvPVX_const(namesv);
tryrsfp = NULL;

ENTER_with_name("call_INC");
SAVETMPS;
if (SvPADTMP(nsv)) {
nsv = sv_newmortal();
SvSetSV_nosteal(nsv,sv);
}

ENTER_with_name("call_INC");
SAVETMPS;
EXTEND(SP, 2);

PUSHMARK(SP);
Expand Down
16 changes: 15 additions & 1 deletion t/op/inccode.t
Expand Up @@ -21,7 +21,7 @@ unless (is_miniperl()) {

use strict;

plan(tests => 61 + !is_miniperl() * (3 + 14 * $can_fork));
plan(tests => 62 + !is_miniperl() * (3 + 14 * $can_fork));

sub get_temp_fh {
my $f = tempfile();
Expand Down Expand Up @@ -267,6 +267,20 @@ is $_||$@, "are temps freed prematurely?",
"are temps freed prematurely when returned from inc filters?";
shift @INC;

# [perl #120657]
sub fake_module {
my (undef,$module_file) = @_;
!1
}
{
local @INC = @INC;
unshift @INC, (\&fake_module)x2;
eval { require "${\'bralbalhablah'}" };
like $@, qr/^Can't locate/,
'require PADTMP passing freed var when @INC has multiple subs';
}


exit if is_miniperl();

SKIP: {
Expand Down

0 comments on commit 901ee10

Please sign in to comment.