Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Blessed scalar refs with threads::shared #8246

Closed
p5pRT opened this issue Dec 13, 2005 · 5 comments
Closed

Blessed scalar refs with threads::shared #8246

p5pRT opened this issue Dec 13, 2005 · 5 comments

Comments

@p5pRT
Copy link

p5pRT commented Dec 13, 2005

Migrated from rt.perl.org#37919 (status was 'resolved')

Searchable as RT37919$

@p5pRT
Copy link
Author

p5pRT commented Dec 13, 2005

From jerry@hedden.us

This is a bug report for perl from jdhedden@​1979.usna.com,
generated with the help of perlbug 1.35 running under perl v5.8.7.


Scalar refs do not retain blessings when stored inside threads​::shared
structures.

I have included a script that demonstrated the problem, and a patch to
correct the problem. I have included output from the demo script both
with and without the patch.

The patch also includes a test file to be added to the Perl test suite.

My hope is that this patch will make it into the 5.8.8 release.

===== Start of blessed_shared_scalar_bug.pl =====

#!/usr/bin/perl

use strict;
use warnings;

use threads;
use threads​::shared;

use Data​::Dumper;

MAIN​:
{
  # Create a shared, blessed scalar reference
  my $scalar = \do{ my $anon = 3 };
  bless($scalar, 'foo');
  threads​::shared​::share($scalar);
  print('Blessed scalar​: ', Dumper($scalar));

  # Create a shared, blessed array reference
  my $array = [];
  bless($array, 'bar');
  threads​::shared​::share($array);
  print('Blessed array​: ', Dumper($array));

  # Create a shared, blessed hash reference
  my $hash = {};
  bless($hash, 'baz');
  threads​::shared​::share($hash);
  print('Blessed hash​: ', Dumper($hash));

  $$array[0] = bless(&threads​::shared​::share({}), 'yin');
  $$array[1] = bless(&threads​::shared​::share([]), 'yang');
  $$array[2] = $scalar;
  $$hash{'hash'} = bless(&threads​::shared​::share({}), 'yin');
  $$hash{'array'} = bless(&threads​::shared​::share([]), 'yang');
  $$hash{'scalar'} = $scalar;

  my $holder = &threads​::shared​::share({});

  $$holder{'array'} = $array;
  $$holder{'hash'} = $hash;
  $$holder{'scalar'} = $scalar;

  print("\nStored shared objects​: ", Dumper($holder));
}

exit(0);

===== Start of script =====

===== Output of demo program without patch =====
# Note that blessings are missing from stored scalar refs

Blessed scalar​: $VAR1 = bless( do{\(my $o = '3')}, 'foo' );
Blessed array​: $VAR1 = bless( [], 'bar' );
Blessed hash​: $VAR1 = bless( {}, 'baz' );

Stored shared objects​: $VAR1 = {
  'scalar' => \'3',
  'hash' => bless( {
  'scalar' => \'3',
  'array' => bless( [], 'yang' ),
  'hash' => bless( {}, 'yin' )
  }, 'baz' ),
  'array' => bless( [
  bless( {}, 'yin' ),
  bless( [], 'yang' ),
  \'3'
  ], 'bar' )
  };

================================================

===== Output of demo program with patch =====
# Note that blessings are retained on stored scalar refs

Blessed scalar​: $VAR1 = bless( do{\(my $o = '3')}, 'foo' );
Blessed array​: $VAR1 = bless( [], 'bar' );
Blessed hash​: $VAR1 = bless( {}, 'baz' );

Stored shared objects​: $VAR1 = {
  'scalar' => bless( do{\(my $o = '3')}, 'foo' ),
  'hash' => bless( {
  'scalar' => bless( do{\(my $o = '3')},
'foo' ),
  'array' => bless( [], 'yang' ),
  'hash' => bless( {}, 'yin' )
  }, 'baz' ),
  'array' => bless( [
  bless( {}, 'yin' ),
  bless( [], 'yang' ),
  bless( do{\(my $o = '3')}, 'foo' )
  ], 'bar' )
  };

=============================================

===== Start of patch =====

diff -r -c -N perl-5.8.7-orig/ext/threads/shared/shared.xs
perl-5.8.7-patched/ext/threads/shared/shared.xs
*** perl-5.8.7-orig/ext/threads/shared/shared.xs Tue Dec 13 15​:51​:49
2005
--- perl-5.8.7-patched/ext/threads/shared/shared.xs Tue Dec 13 16​:43​:30
2005
***************
*** 378,383 ****
--- 378,390 ----
  &sharedsv_scalar_vtbl, (char *)data, 0);
  mg->mg_flags |= (MGf_COPY|MGf_DUP);
  SvREFCNT_inc(ssv);
+ if(SvOBJECT(ssv)) {
+ STRLEN len;
+ char* stash_ptr = SvPV((SV*) SvSTASH(ssv), len);
+ HV* stash = gv_stashpvn(stash_ptr, len, TRUE);
+ SvOBJECT_on(sv);
+ SvSTASH_set(sv, (HV*)SvREFCNT_inc(stash));
+ }
  }
  break;
  }
diff -r -c -N perl-5.8.7-orig/ext/threads/shared/t/blessed.t
perl-5.8.7-patched/ext/threads/shared/t/blessed.t
*** perl-5.8.7-orig/ext/threads/shared/t/blessed.t Wed Dec 31 19​:00​:00
1969
--- perl-5.8.7-patched/ext/threads/shared/t/blessed.t Tue Dec 13
17​:33​:07 2005
***************
*** 0 ****
--- 1,134 ----
+ use warnings;
+
+ BEGIN {
+ # chdir 't' if -d 't';
+ # push @​INC ,'../lib';
+ require Config; import Config;
+ unless ($Config{'useithreads'}) {
+ print "1..0 # Skip​: no useithreads\n";
+ exit 0;
+ }
+ }
+
+
+ sub ok {
+ my ($id, $ok, $name) = @​_;
+
+ $name = '' unless defined $name;
+ # You have to do it this way or VMS will get confused.
+ print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
+
+ printf "# Failed test at line %d\n", (caller)[2] unless $ok;
+
+ return $ok;
+ }
+
+ sub skip {
+ my ($id, $ok, $name) = @​_;
+ print "ok $id # skip _thrcnt - $name \n";
+ }
+
+ use ExtUtils​::testlib;
+ use strict;
+ BEGIN { print "1..36\n" };
+ use threads;
+ use threads​::shared;
+
+ my ($hobj, $aobj, $sobj) : shared;
+
+ $hobj = &share({});
+ $aobj = &share([]);
+ my $sref = \do{ my $x };
+ share($sref);
+ $sobj = $sref;
+
+ threads->new(sub {
+ # Bless objects
+ bless $hobj, 'foo';
+ bless $aobj, 'bar';
+ bless $sobj, 'baz';
+
+ # Add data to objects
+ $$aobj[0] = bless(&share({}), 'yin');
+ $$aobj[1] = bless(&share([]), 'yang');
+ $$aobj[2] = $sobj;
+
+ $$hobj{'hash'} = bless(&share({}), 'yin');
+ $$hobj{'array'} = bless(&share([]), 'yang');
+ $$hobj{'scalar'} = $sobj;
+
+ $$sobj = 3;
+
+ # Test objects in child thread
+ ok(1, ref($hobj) eq 'foo', "hash blessing does work");
+ ok(2, ref($aobj) eq 'bar', "array blessing does
work");
+ ok(3, ref($sobj) eq 'baz', "scalar blessing does
work");
+ ok(4, $$sobj eq '3', "scalar contents okay");
+
+ ok(5, ref($$aobj[0]) eq 'yin', "blessed hash in
array");
+ ok(6, ref($$aobj[1]) eq 'yang', "blessed array in
array");
+ ok(7, ref($$aobj[2]) eq 'baz', "blessed scalar in
array");
+ ok(8, ${$$aobj[2]} eq '3', "blessed scalar in array
contents");
+
+ ok(9, ref($$hobj{'hash'}) eq 'yin', "blessed hash in
hash");
+ ok(10, ref($$hobj{'array'}) eq 'yang', "blessed array
in hash");
+ ok(11, ref($$hobj{'scalar'}) eq 'baz', "blessed scalar
in hash");
+ ok(12, ${$$hobj{'scalar'}} eq '3', "blessed scalar in
hash contents");
+
+ })->join;
+
+ # Test objects in parent thread
+ ok(13, ref($hobj) eq 'foo', "hash blessing does work");
+ ok(14, ref($aobj) eq 'bar', "array blessing does work");
+ ok(15, ref($sobj) eq 'baz', "scalar blessing does work");
+ ok(16, $$sobj eq '3', "scalar contents okay");
+
+ ok(17, ref($$aobj[0]) eq 'yin', "blessed hash in array");
+ ok(18, ref($$aobj[1]) eq 'yang', "blessed array in array");
+ ok(19, ref($$aobj[2]) eq 'baz', "blessed scalar in array");
+ ok(20, ${$$aobj[2]} eq '3', "blessed scalar in array contents");
+
+ ok(21, ref($$hobj{'hash'}) eq 'yin', "blessed hash in hash");
+ ok(22, ref($$hobj{'array'}) eq 'yang', "blessed array in hash");
+ ok(23, ref($$hobj{'scalar'}) eq 'baz', "blessed scalar in hash");
+ ok(24, ${$$hobj{'scalar'}} eq '3', "blessed scalar in hash contents");
+
+ threads->new(sub {
+ # Rebless objects
+ bless $hobj, 'oof';
+ bless $aobj, 'rab';
+ bless $sobj, 'zab';
+
+ my $data = $$aobj[0];
+ bless $data, 'niy';
+ $$aobj[0] = $data;
+ $data = $$aobj[1];
+ bless $data, 'gnay';
+ $$aobj[1] = $data;
+
+ $data = $$hobj{'hash'};
+ bless $data, 'niy';
+ $$hobj{'hash'} = $data;
+ $data = $$hobj{'array'};
+ bless $data, 'gnay';
+ $$hobj{'array'} = $data;
+
+ $$sobj = 'test';
+ })->join;
+
+ # Test reblessing
+ ok(25, ref($hobj) eq 'oof', "hash reblessing does work");
+ ok(26, ref($aobj) eq 'rab', "array reblessing does work");
+ ok(27, ref($sobj) eq 'zab', "scalar reblessing does work");
+ ok(28, $$sobj eq 'test', "scalar contents okay");
+
+ ok(29, ref($$aobj[0]) eq 'niy', "reblessed hash in array");
+ ok(30, ref($$aobj[1]) eq 'gnay', "reblessed array in array");
+ ok(31, ref($$aobj[2]) eq 'zab', "reblessed scalar in array");
+ ok(32, ${$$aobj[2]} eq 'test', "reblessed scalar in array contents");
+
+ ok(33, ref($$hobj{'hash'}) eq 'niy', "reblessed hash in hash");
+ ok(34, ref($$hobj{'array'}) eq 'gnay', "reblessed array in hash");
+ ok(35, ref($$hobj{'scalar'}) eq 'zab', "reblessed scalar in hash");
+ ok(36, ${$$hobj{'scalar'}} eq 'test', "reblessed scalar in hash
contents");
+

===== End of patch =====



Flags​:
  category=core
  severity=medium


Site configuration information for perl v5.8.7​:

Configured by Jerry at Tue Dec 13 16​:04​:13 EST 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)

@p5pRT
Copy link
Author

p5pRT commented Dec 14, 2005

From @iabyn

On Tue, Dec 13, 2005 at 03​:11​:20PM -0800, Jerry D. Hedden wrote​:

Scalar refs do not retain blessings when stored inside threads​::shared
structures.

I have included a script that demonstrated the problem, and a patch to
correct the problem. I have included output from the demo script both
with and without the patch.

Thanks, applied as changes 26350 and 26351

--
Hofstadter's Law​: It always takes longer than you expect, even when you
take into account Hofstadter's Law.

@p5pRT
Copy link
Author

p5pRT commented Dec 14, 2005

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

@p5pRT
Copy link
Author

p5pRT commented Dec 14, 2005

From guest@guest.guest.xxxxxxxx

In the POD for threads​::shared, it states​:

C<bless> is not supported on shared references. In the current version,
C<bless> will only bless the thread local reference and the blessing
will not propagate to the other threads. This is expected to be
implemented in a future version of Perl.

Should this now be removed?

@p5pRT
Copy link
Author

p5pRT commented May 27, 2006

@iabyn - Status changed from 'open' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant