diff options
| author | Jonathan Stowe <gellyfish@gellyfish.com> | 2002-01-09 19:37:38 +0000 |
|---|---|---|
| committer | Jarkko Hietaniemi <jhi@iki.fi> | 2002-01-09 21:25:19 +0000 |
| commit | a6fc07845cf1c4e7456b10205d547b9171229c94 (patch) | |
| tree | 05346caa2ba94298dd49c1bb2c1b9a89aa3d2358 | |
| parent | 15272685321a1d817e718f8bbfc43bbedd9f4460 (diff) | |
| download | perl-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
| -rw-r--r-- | t/run/kill_perl.t | 33 |
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 |