From: Jonathan Stowe <gellyfish@gellyfish.com>
Date: Wed, 9 Jan 2002 19:37:38 +0000 (+0000)
Subject: Re: [PATCH pp_sys.c] Fix segfault in dbmclose in DESTROY (was Re: [ID 20020104.007... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a6fc07845cf1c4e7456b10205d547b9171229c94;p=p5sagit%2Fp5-mst-13.2.git

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
---

diff --git a/t/run/kill_perl.t b/t/run/kill_perl.t
index e36be37..ca982d1 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