Clone-Closure

 view release on metacpan or  search on metacpan

lib/Clone/Closure.pm  view on Meta::CPAN

=item *

weakrefs

Beware cloning weakrefs: cloning a reference also clones the object it
refers to, and if there are no strong refs to this new object it will
self-destruct before C<clone> returns. For example,

    my $sv  = 5;
    my $ref = \$sv;
    weaken $ref;
    my $clone = clone $ref;

will result in $clone being C<undef>, as the new clone of $sv has no
(strong) referents. As weakrefs are normally used to break loops in
self-referential structures, this should not happen often.

=item *

custom magic (C<U>, C<u>, and C<~> magics)

lib/Clone/Closure.xs  view on Meta::CPAN

#ifndef CvWEAKOUTSIDE_on
            {
                CV *old = CvOUTSIDE(new_sv);
                SvREFCNT_dec(old);
                TRACE_SV("ref", "outside", old);
            }
#endif
            CvOUTSIDE(new_sv) = clone;
#ifdef CvWEAKOUTSIDE_on
            TRACE_SV("weaken", name, new_sv);
            TRACE_SV("outside", name, clone);
            CvWEAKOUTSIDE_on(new_sv);
#else
            SvREFCNT_inc(clone);
            TRACE_SV("clone", "outside", clone);
#endif

            pad_clone(SEEN, (CV *)val_sv, (CV *)new_sv);
        }
        else if (can_copy) {

lib/Clone/Closure.xs  view on Meta::CPAN

        TRACE_SV("ref", "RV", ref);

        SvROK_on(clone);
        SvRV(clone) = sv_clone(SEEN, SvRV(ref));

        if (sv_isobject(ref)) {
            sv_bless(clone, SvSTASH(SvRV(ref)));
        }

        if (SvWEAKREF(ref)) {
            TRACE_SV("weaken", "RV", clone);
            sv_rvweaken(clone);
        }

        TRACE_SV("clone", "RV", clone);
    }

    if (SvREADONLY(ref))
        SvREADONLY_on(clone);

    TRACE_SV("clone", "SV", clone);
    return clone;

ppport.h  view on Meta::CPAN

sv_pvutf8n_force||5.006000|
sv_pvutf8n||5.006000|
sv_pvutf8||5.006000|
sv_pv||5.006000|
sv_recode_to_utf8||5.007003|
sv_reftype|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p
sv_setpvf_mg_nocontext|||pvn
sv_setpvf_mg|5.006000|5.004000|pv
sv_setpvf_nocontext|||vn
sv_setpvf||5.004000|v
sv_setpviv_mg||5.008001|

t/06mg.t  view on Meta::CPAN

    is          $$mg,       pos($str),      '...but keeps value';

    $$mg = 0;

    is          pos($str),  3,              'pos() preserved';
}

#define PERL_MAGIC_backref	  '<' /* for weak ref data */
SKIP: {
    my $skip;
    eval 'use Scalar::Util qw/weaken isweak/; 1'
        or skip 'no weakrefs', $skip;

    {
        BEGIN { $skip += 5 }
        
        # we need to have a real ref to the referent in the cloned
        # structure, otherwise it destructs.

        my $sv    = 5;
        my $weak  = [\$sv, \$sv];
        weaken($weak->[0]);
        my $type  = blessed b \$weak->[0];
        my $rv   = clone $weak;

        isa_ok  b(\$rv->[0]),   $type,      'weakref cloned';
        ok      b(\$rv->[0])->ROK,          '...and a reference';
        ok      isweak($rv->[0]),           '...preserving isweak';
        isnt    $rv->[0],       \$sv,       '...not copied';
        is      ${$rv->[0]},    5,          '...correctly';
    }

    {
        BEGIN { $skip += 6 }

        my $weak = [5, undef];
        $weak->[1] = \$weak->[0];
        weaken($weak->[1]);

        my $type = blessed b \$weak->[0];
        my $rv   = clone $weak;

        isa_ok  b(\$rv->[0]),   $type,      'weak referent cloned';
        isnt    \$rv->[0],      \$weak->[0],    '...not copied';
        ok      isweak($rv->[1]),           '...preserving isweak';
        has_mg  \$weak->[0],    '<',        '(sanity check)';
        has_mg  \$rv->[0],      '<',        '...with magic';
        is      $rv->[0],       5,          '...correctly';
    }

    {
        BEGIN { $skip += 8 }

        my $circ;
        $circ    = \$circ;
        weaken($circ);
        my $type = blessed b \$circ;
        my $rv   = clone \$circ;

        isa_ok  b($rv),         $type,      'weak circular ref cloned';
        ok      b(\$rv)->ROK,               '...and a reference';
        ok      b($rv)->ROK,                '...to a reference';
        has_mg  \$circ,         '<',        '(sanity check)';
        has_mg  $rv,            '<',        '...with magic';
        ok      isweak($$rv),               '...preserving isweak';
        isnt    $$rv,           \$circ,     '...not copied';

t/07magic.t  view on Meta::CPAN

use warnings;

use Test::More;
use Data::Dumper;
use Clone::Closure qw/clone/;

my $tests;

BEGIN { $tests += 1 }
SKIP: {
    eval "use Scalar::Util qw( weaken ); 1";
    skip "Scalar::Util not installed", 1 if $@;

    my $x = { a => "worked\n" }; 
    my $y = $x;
    weaken($y);
    my $z = clone $x;
    is Dumper($x), Dumper($z), 'cloned weak reference';
}

## RT 21859: Clone::Closure segfault (isolated example)
BEGIN { $tests += 1 }
SKIP: {
    my $string = "HDDR-WD-250JS";
    eval {
      use utf8;