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

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