From jerry@hedden.us

This is a bug report for perl from jerry@​hedden.us,
generated with the help of perlbug 1.35 running under perl v5.8.7.

I am the author of the module Objects​::InsideOut. That module supports
the
sharing of objects between threads using threads​::shared. A user
reported a
bug against my module (http​://rt.cpan.org/NoAuth/Bug.html?id=15560) that
I
traced down to being related to the order in which Perl destroys
entities
during global cleanup.

Object​::InsideOut keeps track of any objects created using a shared
hash.
When an object is destroyed (i.e., no longer used in any thread), its
entry is
removed from that hash. The bug is that the shared hash is being
destroyed
before all the objects are destroyed. As a result, when the object
destructor
tries to access the hash, a fatal error (or a core dump) occurs.

One trouble I had in reporting this is that the bug occurs
intermittently. It
all depends on the order in which entities are cleaned up. The code
below
fails on my current version of Perl (5.8 maint) under Cygwin. If I
modify the
code by removing some of the unused code, then the bug goes away.

The sequence of events for this code starts with​:

1. A new object is created. The object ID and thread ID (= 0 for main
thread) are added to the shared hash called %SHARED.

2. A new thread is created. The CLONE subroutine is called to add the
new
thread ID (= 1) to the object's entry in %SHARED.

3. The thread exits and ->join()s with the main thread. Global cleanup
begins.

The output from the code (which is below, following the code) indicates
what
follows​:

4. The object's destructor is called as part of the cleanup for the
main
thread. (At this point the %SHARED hash still exists.) The thread ID
(= 0)
is removed from the object's entry in the %SHARED hash.

5. The %SHARED hash is destroyed.

6. The object's destructor is called as part of the cleanup for the
child
thread. When the destructor code tries to access the %SHARED hash, a
fatal
error occurs!

There does not seem to be any workaround for this bug. It is not
possible to
detect the destruction of the %SHARED hash inside the object's
destructor
without triggering the bug.

My (albeit ignorant) thought on how to fix this bug would be to modify
the
global destruction phase to first go through the 'heap' and destroy all
objects, and then go through the 'heap' again and destroy anything else.

##### CODE #####

use strict;
use warnings;

use threads;
use threads​::shared;

package Object​::InsideOut; {

my %SHARED;
threads​::shared​::share(%SHARED);

my $THREAD_ID = 0;

my $OBJ_ID = 1;

sub new
{
  my $thing = shift;
  my $class = ref($thing) || $thing;

  my $self = \(my $scalar);
  $$self = $OBJ_ID++;
  bless($self, $class);
  threads​::shared​::share($self);

  lock(%SHARED);
  if (! exists($SHARED{$class})) {
  $SHARED{$class} = &threads​::shared​::share({});
  }
  $SHARED{$class}{$$self} = &threads​::shared​::share([]);
  push(@​{$SHARED{$class}{$$self}}, $THREAD_ID);

  return ($self);
}

sub DESTROY
{
  my $self = $_[0];
  my $class = ref($self);

print(STDERR "Checking that the \%SHARED hash still exists in thread
$THREAD_ID\n");
print(STDERR "\tHere are its keys​: ", keys(%SHARED), "\n");

  lock(%SHARED);

  my $tid = pop(@​{$SHARED{$class}{$$self}});

  while ($tid != $THREAD_ID) {
  unshift(@​{$SHARED{$class}{$$self}}, $tid);
  $tid = pop(@​{$SHARED{$class}{$$self}});
  }

  if (@​{$SHARED{$class}{$$self}}) {
  return;
  }

  delete($SHARED{$class}{$$self});
}

sub CLONE
{
  if ($_[0] ne __PACKAGE__) {
  return;
  }

  $THREAD_ID = threads->tid();

  lock(%SHARED);

  for my $class (keys(%SHARED)) {
  for my $oid (keys(%{$SHARED{$class}})) {
  push(@​{$SHARED{$class}{$oid}}, $THREAD_ID);
  }
  }
}

# IGNORE ALL THIS
  sub create_RESTRICTED
  {
  my ($package, $method, $code) = @​_;
  return sub { return; };
  }

  CHECK { my $x = 0; }
  sub import { no strict 'refs'; }
  sub create_PRIVATE { return; }
  sub create_HIDDEN { return; }
  sub MODIFY_CODE_ATTRIBUTES { return; }
  sub INITIALIZE { return; }
  sub set_sharing { return; }
  sub is_sharing { return; }
}

# IGNORE THIS
package Object​::InsideOut​::IGNORE; {
  sub dummy { return; }
}

package My​::Obj; {
  @​My​::Obj​::ISA = 'Object​::InsideOut';
}

package main;

my $obj = My​::Obj->new();

my $thr = threads->create(sub { return; });
$thr->join();

##### OUTPUT #####

Checking that the %SHARED hash still exists in thread 0
  Here are its keys​: My​::Obj
Checking that the %SHARED hash still exists in thread 1
  (in cleanup) Can't call method "FIRSTKEY" on an undefined value
at bug.pl line 44 during global destruction.

Flags​:
  category=core
  severity=high

Site configuration information for perl v5.8.7​:

Configured by Jerry at Mon Oct 24 08​:03​:53 EDT 2005.

Summary of my perl5 (revision 5 version 8 subversion 7) configuration​:
  Platform​:
  osname=cygwin, osvers=1.5.18(0.13242),
archname=cygwin-thread-multi-64int
  uname='cygwin_nt-5.0 pn100-01-1-123s 1.5.18(0.13242) 2005-07-02
20​:30 i686 unknown unknown cygwin '
  config_args='-de -Duse64bitint -Dusethreads -Uusemymalloc -A
define​:optimize=-O3 -pipe -frename-registers -fomit-frame-pointer
-march=pentium4 -mfpmath=sse -mmmx -msse -msse2 -A
define​:ld=/usr/local/bin/ld2'
  hint=recommended, useposix=true, d_sigaction=define
  usethreads=define use5005threads=undef useithreads=define
usemultiplicity=define
  useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
  use64bitint=define use64bitall=undef uselongdouble=undef
  usemymalloc=n, bincompat5005=undef
  Compiler​:
  cc='gcc', ccflags ='-DPERL_USE_SAFE_PUTENV -fno-strict-aliasing
-pipe -Wdeclaration-after-statement -I/usr/local/include',
  optimize='-O3 -pipe -frename-registers -fomit-frame-pointer
-march=pentium4 -mfpmath=sse -mmmx -msse -msse2',
  cppflags='-DPERL_USE_SAFE_PUTENV -fno-strict-aliasing -pipe
-Wdeclaration-after-statement -I/usr/local/include'
  ccversion='', gccversion='3.4.4 (cygming special) (gdc 0.12, using
dmd 0.125)', gccosandvers=''
  intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
  d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
  ivtype='long long', ivsize=8, nvtype='double', nvsize=8,
Off_t='off_t', lseeksize=8
  alignbytes=8, prototype=define
  Linker and Libraries​:
  ld='/usr/local/bin/ld2', ldflags =' -s -L/usr/local/lib'
  libpth=/usr/local/lib /usr/lib /lib
  libs=-lgdbm -ldb -lcrypt -lgdbm_compat
  perllibs=-lcrypt -lgdbm_compat
  libc=/usr/lib/libc.a, so=dll, useshrplib=true, libperl=libperl.a
  gnulibc_version=''
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' -s'
  cccdlflags=' ', lddlflags=' -s -L/usr/local/lib'

Locally applied patches​:

@​INC for perl v5.8.7​:
  /usr/local/lib/perl5/5.8/cygwin
  /usr/local/lib/perl5/5.8
  /usr/local/lib/perl5/site_perl/5.8/cygwin
  /usr/local/lib/perl5/site_perl/5.8
  /usr/local/lib/perl5/vendor_perl/5.8/cygwin
  /usr/local/lib/perl5/vendor_perl/5.8
  .

Environment for perl v5.8.7​:
  CYGWIN=server ntsec forkchunk​:32768
  HOME=/home/jhedden
  LANG=C
  LANGUAGE=C
  LC_ALL=C
  LD_LIBRARY_PATH (unset)
  LOGDIR (unset)
 
PATH=/home/jhedden/bin​:/usr/local/bin​:/usr/bin​:/bin​:/usr/X11R6/bin​:/c/MinGW/bin​:/c/Perl/bin/​:/c/djgpp/bin​:/c/Program
Files/WiX​:/c/Program Files/nant-0.85-rc3/bin​:/c/Program
Files/apache-ant-1.6.3/bin​:/c/j2sdk1.4.2_08/bin​:/c/Program
Files/Documentum/Shared​:/c/blp/API​:/c/oracle/ora92/bin​:/c/Program
Files/Oracle/jre/1.3.1/bin​:/c/Program
Files/Oracle/jre/1.1.8/bin​:/c/WINNT/system32​:/c/WINNT​:/c/WINNT/system32/WBEM​:/c/Program
Files/cvsnt​:/usr/local/lib​:.
  PERLIO=perlio
  PERL_BADLANG (unset)
  SHELL (unset)

From @iabyn

On Tue, Nov 08, 2005 at 10​:23​:58AM -0800, Jerry D. Hedden wrote​:

##### OUTPUT #####

Checking that the %SHARED hash still exists in thread 0
Here are its keys​: My​::Obj
Checking that the %SHARED hash still exists in thread 1
(in cleanup) Can't call method "FIRSTKEY" on an undefined value
at bug.pl line 44 during global destruction.

This happens because shared arrays and hashes (due to their
implementation) happen to be both an object and be tied. What is happening
is that during global destruction, the tied object is getting freed before
the hash object. Note that perl does indeed free objects before ordinary
values, but in this case they are both objects, so which gets freed first
is just down to luck. In your case it was only happening in the child
thread because of the order in which things happened to get copied into
that child.

The issue can be duplicated without threads in the following code​:

  #!/usr/bin/perl
  use warnings;

  sub T​::TIEHASH​: { bless [], 'T' }
  sub X​::DESTROY { my @​x = keys %{$_[0]} }

  tie %h, 'T';
  eval q{$x = \%h; bless $x, 'X'};

which gives​:

  Name "main​::h" used only once​: possible typo at /tmp/d1 line 7.
  (in cleanup) Can't call method "FIRSTKEY" on an undefined value at /tmp/d1 line 5 during global destruction.

Note that the eval is used to ensure that the ref to the blessed hash is
created *after* the ref to the blessed tie object, so that they get freed in
the wrong order.

I don't think there's anything we realistically can do to the perl
interpeter to fix this :-(

--
Fire extinguisher (n) a device for holding open fire doors.

The RT System itself - Status changed from 'new' to 'open'

From @cpansprout

On Tue Nov 08 17​:50​:07 2005, davem@​iabyn.com wrote​:

On Tue, Nov 08, 2005 at 10​:23​:58AM -0800, Jerry D. Hedden wrote​:

##### OUTPUT #####

Checking that the %SHARED hash still exists in thread 0
Here are its keys​: My​::Obj
Checking that the %SHARED hash still exists in thread 1
(in cleanup) Can't call method "FIRSTKEY" on an undefined
value
at bug.pl line 44 during global destruction.

This happens because shared arrays and hashes (due to their
implementation) happen to be both an object and be tied. What is
happening
is that during global destruction, the tied object is getting freed
before
the hash object. Note that perl does indeed free objects before
ordinary
values, but in this case they are both objects, so which gets freed
first
is just down to luck. In your case it was only happening in the child
thread because of the order in which things happened to get copied
into
that child.

The issue can be duplicated without threads in the following code​:

\#\!/usr/bin/perl
use warnings;

sub T​::TIEHASH​: \{ bless \[\]\, 'T' \}
sub X​::DESTROY \{ my @​x = keys %\{$\_\[0\]\} \}

tie %h\, 'T';
eval q\{$x = \\%h; bless $x\, 'X'\};

which gives​:

Name "main​::h" used only once​: possible typo at /tmp/d1 line 7\.
    \(in cleanup\) Can't call method "FIRSTKEY" on an undefined value

at /tmp/d1 line 5 during global destruction.

Note that the eval is used to ensure that the ref to the blessed hash
is
created *after* the ref to the blessed tie object, so that they get
freed in
the wrong order.

I don't think there's anything we realistically can do to the perl
interpeter to fix this :-(

Could we solve it with an extra refcount for the mg_obj, as there is for
backref arrays?