summaryrefslogtreecommitdiff
path: root/t/op/anonsub.t
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2001-03-12 16:04:47 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2001-03-12 16:04:47 +0000
commitc25d0b7a52caad9b2f008c3b2d006f1b669ce5fe (patch)
tree7a794b96486fbe8f27d0860af1dadc2c79e432aa /t/op/anonsub.t
parentfbc55223e6d0395e342ab066f5b3782517a6f3e1 (diff)
downloadperl-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-xt/op/anonsub.t93
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