[ID 20000414.001] Attempt to free non-existent shared string andunreferenced scalar

This is a bug report for perl from pdoru@kappa.ro,
generated with the help of perlbug 1.26 running under perl 5.00503.


-----------------------------------------------------------------
[Please enter your report here]

While palying with the objects in perl, i've got some strange messages about 
Attempt to free non-existent shared string
and
Attempt to free unreferenced scalar

The 2 messages are linked together, I either get both or none. This is no 
random thing, but if i make some small changes aparently not related the 
warnings disappear :-)))

I've tryed to make a short program that produce the same warnings. But while 
doing it i've got another problem: 'Deep recursion ....'

I've tested them on Linux 2.2x, and this is the result:
- perl 5.005_03: both scripts do kind of the same thing (just 'Attempt to free' warns)
- perl 5.005_57: a_deep_recursion script end with SIGSEGV 
- perl 5.005_61: works as on 5.005_03
- perl 5.6.0: a_deep_recursion generates the 'deep recursion' warning then SIGSEGV

on 5.005_57, the a_deep_recursion script apear to go recursive for few levels 
and then crash.  it also give me a LOT or warnings (and stack dumps because of carp)
But on 5.6.0 it takes a LOT more levels of recursion more to get SIGSEGV and 
does not produce warnings.	

on 5.005_03 both scripts do the same thing, that is generate the 
'Attempt to free' warnings and exist.

I think that the problem is:
- undef %OBJECTS will cause DESTROY() on the object
- but the %OBJECTS still exists and is valid but somehow is marked as freed ?!?!
- DESTROY() will attempt to re-delete the entry but it is probably already
marked as deleted, so a warning is generated.

- i have no idea why i get the deep_recursion. it just happened while i was 
wrinting the example script for this email, so i decided to report it also.


This is quite hard to produce. if i delete the 'my $xx' from the the main script
the warns will disapear. is something wrong with my coding style ? but anyway
i shouldn't see internal-data-consistency-failure like warnings :-))))


Best regards,
------
Doru Petrescu
KappaNet - Software Engineer
E-mail: pdoru@kappa.ro		 LINUX - the choice of the GNU generation



########### script 1: a_attempt_to_free ###################

#!/usr/bin/perl -w
use Data::Dumper;
use Carp;
BEGIN {
   $SIG{__WARN__} = sub { Carp::cluck(@_); print "\n\n"; };
   $SIG{__DIE__}  = sub { Carp::confess(@_); print "\n\n"; };

   $|=1; open(STDERR, ">&STDOUT"); select STDERR; $|=1; select STDOUT;
}
select STDERR;


my ($xx, $yy);
$xx = TEST->new('object1');
$yy = TEST->new('object1');

exit;
#########################################
package TEST;
use Data::Dumper;
use Carp;

%OBJECTS = ();
sub new {
   my ($class, $name) = @_;
   my $obj = { name => $name };

   return $OBJECTS{$name} if (exists $OBJECTS{$name});
   
   $OBJECTS{$name} = bless($obj, $class);
   return $OBJECTS{$name};
}
sub DESTROY {
#   print Dumper \%OBJECTS;

   my ($self) = @_;
   my $name = $self->{name};
   warn "DESTROYing($name) = $self\n";

   delete $OBJECTS{ $name };
   print "DESTROYed($name) = $self\n";
#   print Dumper $self;
}
sub DESTROY_all {
   undef %OBJECTS;
}
END { &TEST::DESTROY_all(); }

########### script 1 ends here ###########################
##########################################################


############### script 2: a_deep_recursion ################

#!/usr/bin/perl -w
use Data::Dumper;
use Carp;
BEGIN {
   $SIG{__WARN__} = sub { Carp::cluck(@_); print "\n\n"; };
   $SIG{__DIE__}  = sub { Carp::confess(@_); print "\n\n"; };

   $|=1; open(STDERR, ">&STDOUT"); select STDERR; $|=1; select STDOUT;
}
select STDERR;


my ($xx, $yy);
$xx = TEST->new('object1');
$yy = TEST->new('object1');

exit;
#########################################
package TEST;
use Data::Dumper;
use Carp;

%OBJECTS = ();
sub new {
   my ($class, $name) = @_;
   my $obj = { name => $name };

   return $OBJECTS{$name} if (exists $OBJECTS{$name});
   
   $OBJECTS{$name} = bless($obj, $class);
   return $OBJECTS{$name};
}
sub DESTROY {
   print Dumper \%OBJECTS;

   my ($self) = @_;
   my $name = $self->{name};
   warn "DESTROYing($name) = $self\n";

   delete $OBJECTS{ $name };
   print "DESTROYed($name) = $self\n";
#   print Dumper $self;
}
sub DESTROY_all {
   undef %OBJECTS;
}
END { &TEST::DESTROY_all(); }

#################### script 2 ends here ####################
############################################################


[Please do not change anything below this line]
-----------------------------------------------------------------

---
Site configuration information for perl 5.00503:

Configured by root at Sun Jul 18 14:58:08 CDT 1999.

Summary of my perl5 (5.0 patchlevel 5 subversion 3) configuration:
  Platform:
    osname=linux, osvers=2.2.6, archname=i386-linux
    uname='linux xyzzy 2.2.6 #2 wed jun 16 15:23:52 cdt 1999 i686 unknown '
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef useperlio=undef d_sfio=undef
  Compiler:
    cc='cc', optimize='-O2', gccversion=egcs-2.91.66 19990314/Linux (egcs-1.1.2 release)
    cppflags='-Dbool=char -DHAS_BOOL -I/usr/local/include'
    ccflags ='-Dbool=char -DHAS_BOOL -I/usr/local/include'
    stdchar='char', d_stdstdio=undef, usevfork=false
    intsize=4, longsize=4, ptrsize=4, doublesize=8
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    alignbytes=4, usemymalloc=n, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /shlib /lib /usr/lib
    libs=-lnsl -lndbm -lgdbm -ldb -ldl -lm -lc -lposix -lcrypt
    libc=, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
    cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    

---
@INC for perl 5.00503:
    /usr/lib/perl5/i386-linux
    /usr/lib/perl5
    /usr/lib/perl5/site_perl/i386-linux
    /usr/lib/perl5/site_perl
    .

---
Environment for perl 5.00503:
    HOME=/home/pdoru
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH=/usr/local/qt/lib
    LOGDIR (unset)
    PATH=/home/pdoru/bin:/usr/local/qt/bin:/usr/local/bin:/usr/local/sbin:/bin:/sbin:/usr/bin:/usr/sbin:/usr/X11R6/bin:/usr/games:/usr/local/mysql/bin:/usr/local/arts/bin:.:/opt/kde/bin
    PERL_BADLANG (unset)
    SHELL=/bin/bash

• [ID 20000414.001] Attempt to free non-existent shared string andunreferenced scalar by Doru Petrescu