From olly@survex.com

Created by olly@survex.com

"perldoc perlmod" says​:

  Like "CLONE", "CLONE_SKIP" is called once per package; however, it is
  called just before cloning starts, and in the context of the parent
  thread. If it returns a true value, then no objects of that class will
  be cloned; or rather, they will be copied as unblessed, undef values.

But in my tests, the copies are unblessed, but aren't undef. Here's a
simple example​:

## Class.pm​:

package Class;

use strict;

sub CLONE_SKIP { 1 }

sub new { bless {} }

1;

## cloneskip.pl​:

#!/usr/bin/perl -W
use strict;
use Class;
use threads;

my $obj = Class->new();

sub check_obj {
  my $where = shift;
  print "$where​: ref(\$obj) = ".ref($obj)."\n";
  print "$where​: defined(\$obj) = ".defined($obj)."\n\n";
}

check_obj("main");
my $thread1 = threads->create(sub { check_obj("thread"); 1; } );
$thread1->join();
check_obj("main");

Output from "perl clone_skip.pl"​:

main​: ref($obj) = Class
main​: defined($obj) = 1

thread​: ref($obj) = SCALAR
thread​: defined($obj) = 1

main​: ref($obj) = Class
main​: defined($obj) = 1

The documentation leads me to expect the third and fourth non-blank lines
should be​:

thread​: ref($obj) =
thread​: defined($obj) =

as that is what I get if I change cloneskip.pl to do this​:

my $thread1 = threads->create(sub { $obj = undef; check_obj("thread"); 1; } );

The documented behaviour seems sensible, so I think the bug here is in the
implementation rather than the documentation.

Cheers,
  Olly

Flags:
    category=core
    severity=low

Site configuration information for perl v5.8.8:

Configured by Debian Project at Fri Sep 28 22:34:35 GMT 2007.

Summary of my perl5 (revision 5 version 8 subversion 8) configuration:
  Platform:
    osname=linux, osvers=2.6.15.7, archname=x86_64-linux-gnu-thread-multi
    uname='linux yellow 2.6.15.7 #1 smp sun sep 23 13:51:52 utc 2007 x86_64 gnulinux '
    config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=x86_64-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.8 -Darchlib=/usr/lib/perl/5.8 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.8.8 -Dsitearch=/usr/local/lib/perl/5.8.8 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Uusesfio -Uusenm -Duseshrplib -Dlibperl=libperl.so.5.8.8 -Dd_dosuid -des'
    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=define uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include'
    ccversion='', gccversion='4.1.3 20070831 (prerelease) (Ubuntu 4.1.2-16ubuntu1)', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
    perllibs=-ldl -lm -lpthread -lc -lcrypt
    libc=/lib/libc-2.6.1.so, so=so, useshrplib=true, libperl=libperl.so.5.8.8
    gnulibc_version='2.6.1'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.8.8:
    /etc/perl
    /usr/local/lib/perl/5.8.8
    /usr/local/share/perl/5.8.8
    /usr/lib/perl5
    /usr/share/perl5
    /usr/lib/perl/5.8
    /usr/share/perl/5.8
    /usr/local/lib/site_perl
    /usr/local/lib/perl/5.8.7
    /usr/local/share/perl/5.8.7
    /usr/local/lib/perl/5.8.4
    /usr/local/share/perl/5.8.4
    .


Environment for perl v5.8.8:
    HOME=/home/olly
    LANG=en_GB.UTF-8
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/bin/X11:/usr/games
    PERL_BADLANG (unset)
    SHELL=/bin/bash

From @iabyn

On Tue, Oct 30, 2007 at 07​:40​:27PM -0700, Olly Betts wrote​:

"perldoc perlmod" says​:

Like "CLONE"\, "CLONE\_SKIP" is called once per package; however\, it is
called just before cloning starts\, and in the context of the parent
thread\. If it returns a true value\, then no objects of that class will
be cloned; or rather\, they will be copied as unblessed\, undef values\.

But in my tests, the copies are unblessed, but aren't undef. Here's a
simple example​:

The documentation is ambiguous, but the current behaviour of perl is as
designed. References are cloned, but in the child thread they are
references to undefined scalars rather than blessed hashes or whatever; eg

  use threads;
  sub CLONE_SKIP {1}
  my $x = bless {};
  use Data​::Dumper;
  print Dumper $x;
  threads->new(sub { print Dumper $x })->join;

gives​:

  $VAR1 = bless( {}, 'main' );
  $VAR1 = \undef;

However, looking at the code I noticed that there *is* a bug, in that the
flags of the new undef scalar aren't zeroed (they're the same as the
parent object), so the change below fixes that and tries to improve the
documentation​:

Change 32213 by davem@​davem-pigeon on 2007/11/02 23​:59​:27

  [perl #47045] CLONE_SKIP doesn't result in undef copies
  clarify the documentation on CLONE_SKIP, and ensure that the
  undef value has all its flags cleared

Affected files ...

... //depot/perl/pod/perlmod.pod#42 edit
... //depot/perl/sv.c#1438 edit

Differences ...

==== //depot/perl/pod/perlmod.pod#42 (text) ====

@​@​ -581,6 +581,9 @​@​
called just before cloning starts, and in the context of the parent
thread. If it returns a true value, then no objects of that class will
be cloned; or rather, they will be copied as unblessed, undef values.
+For example​: if in the parent there are two references to a single blessed
+hash, then in the child there will be two references to a single undefined
+scalar value instead.
This provides a simple mechanism for making a module threadsafe; just add
C<sub CLONE_SKIP { 1 }> at the top of the class, and C<DESTROY()> will be
now only be called once per object. Of course, if the child thread needs

==== //depot/perl/sv.c#1438 (text) ====

@​@​ -10048,8 +10048,7 @​@​

  /* don't clone objects whose class has asked us not to */
  if (SvOBJECT(sstr) && ! (SvFLAGS(SvSTASH(sstr)) & SVphv_CLONEABLE)) {
- SvFLAGS(dstr) &= ~SVTYPEMASK;
- SvOBJECT_off(dstr);
+ SvFLAGS(dstr) = 0;
  return dstr;
  }

--
Technology is dominated by two types of people​: those who understand what
they do not manage, and those who manage what they do not understand.

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

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