view release on metacpan or  search on metacpan

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

    SKIP: {
        skip 'can\'t test globs', 2
            unless eval { b(\*STDOUT)->GP; 1 };

        is_prop \$glob, 'b/GP', \*bar,      '(sanity check)';
        is_prop \$gv,   'b/GP', \*bar,      '...and is the same glob';
    }

    BEGIN { $tests += 5 }

    my $rv = clone \*foo;

    isa_ok  b(\$rv),        $RVc,           'ref to GV cloned';
    ok      b(\$rv)->ROK,                   '...and is ROK';
    isa_ok  b($rv),         'B::GV',        'GV cloned';
    is      $rv,            \*foo,          '...and is copied';

    SKIP: {
        skip 'globs have no magic', 1 unless $has_mg;
        has_mg  $rv,            '*',            '...with magic';
    }
}

#define PERL_MAGIC_arylen	  '#' /* Array length ($#ary) */
{
    BEGIN { $tests += 4 }

    my @ary = qw/a b c/;
    my $mg  = clone \$#ary;

    has_mg      \$#ary,     '#',            '(sanity check)';
    hasnt_mg    $mg,        '#',            '$#ary loses magic';
    is          $$mg,       $#ary,          '...but keeps value';

    $$mg = 5;

    is          $#ary,      2,              '$#ary preserved';
}

#define PERL_MAGIC_pos		  '.' /* pos() lvalue */
{
    BEGIN { $tests += 4 }

    my $str = 'fffgh';
    $str =~ /f*/g;
    my $mg  = clone \pos($str);

    has_mg      \pos($str), '.',            '(sanity check)';
    hasnt_mg    $mg,        '.',            'pos() loses magic';
    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';
        is      $$$rv,          $$rv,       '...correctly';
    }

    BEGIN { $tests += $skip }
}

#define PERL_MAGIC_ext		  '~' /* Available for use by extensions */

BEGIN { plan tests => $tests }