diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 2001-03-12 16:04:47 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2001-03-12 16:04:47 +0000 |
commit | c25d0b7a52caad9b2f008c3b2d006f1b669ce5fe (patch) | |
tree | 7a794b96486fbe8f27d0860af1dadc2c79e432aa /t/op/anonsub.t | |
parent | fbc55223e6d0395e342ab066f5b3782517a6f3e1 (diff) | |
download | perl-c25d0b7a52caad9b2f008c3b2d006f1b669ce5fe.tar.gz |
Integrate change #9108 from maintperl to mainline.
fix memory leak in C<sub X { sub {} }> arising from a refcount
loop between the outer sub and the inner prototype anonsub
this also enables closures returned by subroutines that
subsequently get redefined to work without generating coredumps :)
completely removed the free_closures() hack--it shouldn't be
needed anymore
p4raw-link: @9108 on //depot/maint-5.6/perl: 1cf1f64f42eb50a67f2427ff9d6d24023a2b9997
p4raw-id: //depot/perl@9109
p4raw-branched: from //depot/maint-5.6/perl@9107 'branch in'
t/op/anonsub.t
p4raw-integrated: from //depot/maint-5.6/perl@9107 'merge in' sv.c
(@8871..) embed.h (@8886..) pod/perlapi.pod proto.h (@8993..)
embed.pl (@8995..) MANIFEST (@9030..) op.c op.h (@9055..)
pp_ctl.c (@9076..)
Diffstat (limited to 't/op/anonsub.t')
-rwxr-xr-x | t/op/anonsub.t | 93 |
1 files changed, 93 insertions, 0 deletions
diff --git a/t/op/anonsub.t b/t/op/anonsub.t new file mode 100755 index 0000000000..17889d9d2f --- /dev/null +++ b/t/op/anonsub.t @@ -0,0 +1,93 @@ +#!./perl + +chdir 't' if -d 't'; +@INC = '../lib'; +$Is_VMS = $^O eq 'VMS'; +$Is_MSWin32 = $^O eq 'MSWin32'; +$ENV{PERL5LIB} = "../lib" unless $Is_VMS; + +$|=1; + +undef $/; +@prgs = split "\n########\n", <DATA>; +print "1..", scalar @prgs, "\n"; + +$tmpfile = "asubtmp000"; +1 while -f ++$tmpfile; +END { if ($tmpfile) { 1 while unlink $tmpfile; } } + +for (@prgs){ + my $switch = ""; + if (s/^\s*(-\w+)//){ + $switch = $1; + } + my($prog,$expected) = split(/\nEXPECT\n/, $_); + open TEST, ">$tmpfile"; + print TEST "$prog\n"; + close TEST; + my $results = $Is_VMS ? + `MCR $^X "-I[-.lib]" $switch $tmpfile 2>&1` : + $Is_MSWin32 ? + `.\\perl -I../lib $switch $tmpfile 2>&1` : + `./perl $switch $tmpfile 2>&1`; + my $status = $?; + $results =~ s/\n+$//; + # allow expected output to be written as if $prog is on STDIN + $results =~ s/runltmp\d+/-/g; + $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg + $expected =~ s/\n+$//; + if ($results ne $expected) { + print STDERR "PROG: $switch\n$prog\n"; + print STDERR "EXPECTED:\n$expected\n"; + print STDERR "GOT:\n$results\n"; + print "not "; + } + print "ok ", ++$i, "\n"; +} + +__END__ +sub X { + my $n = "ok 1\n"; + sub { print $n }; +} +my $x = X(); +undef &X; +$x->(); +EXPECT +ok 1 +######## +sub X { + my $n = "ok 1\n"; + sub { + my $dummy = $n; # eval can't close on $n without internal reference + eval 'print $n'; + die $@ if $@; + }; +} +my $x = X(); +undef &X; +$x->(); +EXPECT +ok 1 +######## +sub X { + my $n = "ok 1\n"; + eval 'sub { print $n }'; +} +my $x = X(); +die $@ if $@; +undef &X; +$x->(); +EXPECT +ok 1 +######## +sub X; +sub X { + my $n = "ok 1\n"; + eval 'sub Y { my $p = shift; $p->() }'; + die $@ if $@; + Y(sub { print $n }); +} +X(); +EXPECT +ok 1 |