#!/usr/bin/perl

use strict;
use warnings;

use Carp qw(verbose);

use threads;
use threads::shared;


=begin email

Dear list,

while playing with ithreads and shared data structures, perl crashed.

(Perl 5.8.4 and 5.8.2 on FreeBSD 5.2 with ithreads, perl -V in the attached 
example code; also tested with Perl 5.8.4 and 5.8.0 on Linux 2.4.)


Attached is a test script, which crashes when using shared data.
This is the data structure which I want to implement and share between
different threads,so that every thread can access and modify this data:

my $dummy_unshared = 
   {
   arrayref    => 
      [
         { foo => "bar 1" },
         { foo => "bar 2" },
         { foo => "bar 3" },
      ]
   };


When starting a new Thread for each element in the array and adding or 
changing the corresponding hash, perl crashes. The thread must be detached
or joined.

It is not neccessary to pass the hashref to the thread or access the data
inside the thread.

   foreach my $hashref (@{ $dummy->{arrayref} }) 
      {
      # The following line causes perl to crash, when the data structure 
      # is shared
      $hashref->{status} = "some text";
      
      # start and detach thread
      threads->new(\&thread)->detach; 
      
      }

I realised that the address of the hashref in 
direct access is different to hashref access, but the values in the
data structure look like they are correct.

   print "Direct access:     $dummy->{arrayref}[$i]\n";
   print "Access by hashref: $hashref\n";
 
   # The following line let perl crash, when the data structure is shared
   $hashref->{status} = "some text $i";
   
   print "Dump if direct access:",  Dumper($dummy->{arrayref}[$i]);
   print "Dump of hashref access:", Dumper($hashref);
   print "Complete dummy: ",        Dumper($dummy);

The result:

--- SNIP -----------

Direct access:     HASH(0x80640a8)
Access by hashref: HASH(0x811d390)

Dump if direct access:$VAR1 = {
          'foo' => 'bar 1',
          'status' => 'some text 0'
        };
Dump of hashref access:$VAR1 = {
          'foo' => 'bar 1',
          'status' => 'some text 0'
        };
Complete dummy: $VAR1 = {
          'arrayref' => [
                          {
                            'foo' => 'bar 1',
                            'status' => 'some text 0'
                          },
                          {
                            'foo' => 'bar 2'
                          },
                          {
                            'foo' => 'bar 3'
                          }
                        ]
        };
Direct access:     HASH(0x80640a8)
Access by hashref: HASH(0x811d818)

Bus error (core dumped)

--- SNAP ----------


Because different timing, the crash occures every time at a different 
position.


Is this a bug in perl or in the script?!?


Thank you!


Ciao
  Alvar


=cut


# build a dummy data structure

# at first some unshared data:

my $dummy_2 =                 # unshared dummy; change it for other test
   {
   arrayref    => 
      [
         { foo => "bar 1" },
         { foo => "bar 2" },
         { foo => "bar 3" },
      ]
   };


# The same as shared:

my %hash1 : shared = (foo => "bar 1");
my %hash2 : shared = (foo => "bar 2");
my %hash3 : shared = (foo => "bar 3");

my @array : shared = (\%hash1, \%hash2, \%hash3 );

my $dummy  = { arrayref => \@array };


use Data::Dumper;

print "shared Data: ", Dumper($dummy);
print "reference data: ", Dumper($dummy_2);

#
# OK, now let's crash perl :-(
#

my $i=0;
foreach my $hashref (@{ $dummy->{arrayref} }) 
   {
   # When the data structure is shared, the following two references
   # have different addresses.
   # If not shared, then the addresses are the same
   print "Direct access:     $dummy->{arrayref}[$i]\n";
   print "Access by hashref: $hashref\n\n";
   
   # The following line let perl crash, when the data structure is shared
   $hashref->{status} = "some text $i";
   
   # print "Dump if direct access:",  Dumper($dummy->{arrayref}[$i]);
   # print "Dump of hashref access:", Dumper($hashref);
   # print "Complete dummy: ",        Dumper($dummy);
   
   # The following doesn't crash, but gives the same result
   # $dummy->{arrayref}[$i]{status} = "some text";              
   
   # start and detach thread
   threads->new(\&thread)->detach; 
   
   $i++;
   }

threads->yield while 1;


sub thread
   {
   
   # even if the thread does nothing at all, perl crashes
   
   # print "I am in the thread!";
   # threads->yield while 1;
   
   }   

 
 
 __END__
 
 =head1 perl -V
 
 /perl -V
Summary of my perl5 (revision 5 version 8 subversion 4) configuration:
  Platform:
    osname=freebsd, osvers=5.2-current, archname=i386-freebsd-thread-multi
    uname='freebsd kenny.intern.delirium-arts.de 5.2-current freebsd 5.2-current #1: wed apr 21 01:43:45 cest 2004 root@kenny.intern.delirium-arts.de:usrobjusrsrcsyskenny i386 '
    config_args='-de -Dusethreads -Dprefix=/usr/local/vrnet/perl -Doptimize=-O3 -march=pentium3'
    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=undef use64bitall=undef uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -I/usr/local/include',
    optimize='-O3 -march=pentium3',
    cppflags='-DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -I/usr/local/include'
    ccversion='', gccversion='3.3.3 [FreeBSD] 20031106', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags ='-Wl,-E  -L/usr/local/lib'
    libpth=/usr/lib /usr/local/lib
    libs=-lgdbm -lm -lcrypt -lutil -lc_r
    perllibs=-lm -lcrypt -lutil -lc_r
    libc=, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
    cccdlflags='-DPIC -fPIC', lddlflags='-shared  -L/usr/local/lib'


Characteristics of this binary (from libperl): 
  Compile-time options: MULTIPLICITY USE_ITHREADS USE_LARGE_FILES PERL_IMPLICIT_CONTEXT
  Built under freebsd
  Compiled at May 16 2004 22:39:56
  %ENV:
    PERLLIB="/home/alvar/workspace/Server/"
  @INC:
    /home/alvar/workspace/Server/
    /usr/local/vrnet/perl/lib/5.8.4/i386-freebsd-thread-multi
    /usr/local/vrnet/perl/lib/5.8.4
    /usr/local/vrnet/perl/lib/site_perl/5.8.4/i386-freebsd-thread-multi
    /usr/local/vrnet/perl/lib/site_perl/5.8.4
    /usr/local/vrnet/perl/lib/site_perl
    .
 =cut