summaryrefslogtreecommitdiff
path: root/t/run
diff options
context:
space:
mode:
authorJonathan Stowe <gellyfish@gellyfish.com>2002-01-09 19:37:38 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2002-01-09 21:25:19 +0000
commita6fc07845cf1c4e7456b10205d547b9171229c94 (patch)
tree05346caa2ba94298dd49c1bb2c1b9a89aa3d2358 /t/run
parent15272685321a1d817e718f8bbfc43bbedd9f4460 (diff)
downloadperl-a6fc07845cf1c4e7456b10205d547b9171229c94.tar.gz
Re: [PATCH pp_sys.c] Fix segfault in dbmclose in DESTROY (was Re: [ID 20020104.007] coredump on dbmclose)
Message-ID: <Pine.LNX.4.33.0201091924020.21574-100000@orpheus.gellyfish.com> p4raw-id: //depot/perl@14158
Diffstat (limited to 't/run')
-rw-r--r--t/run/kill_perl.t33
1 files changed, 33 insertions, 0 deletions
diff --git a/t/run/kill_perl.t b/t/run/kill_perl.t
index e36be37eb6..ca982d1070 100644
--- a/t/run/kill_perl.t
+++ b/t/run/kill_perl.t
@@ -834,3 +834,36 @@ print "after: $$s\n";
EXPECT
before: c
after: c
+######## [ID 20020104.007] "coredump on dbmclose"
+package Foo;
+eval { dbmclose %h }; # not all places have dbm* functions
+if ($@) {
+ print "ok\n";
+ exit 0;
+}
+package Foo;
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ bless($self,$class);
+ my %LT;
+ dbmopen(%LT, "dbmtest", 0666) ||
+ die "Can't open dbmtest because of $!\n";
+ $self->{'LT'} = \%LT;
+ return $self;
+}
+sub DESTROY {
+ my $self = shift;
+ dbmclose(%{$self->{'LT'}});
+ return 1;
+}
+package main;
+$test = Foo->new(); # must be package var
+END
+{
+ 1 while unlink <dbmtest.*>;
+ print "ok\n";
+}
+EXPECT
+ok