#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Clone::Closure qw/clone/;
my $tests;
my $gone;
package Test::Hash;
our @ISA = qw( Clone::Closure );
sub new {
my ($class) = @_;
my $self = {};
bless $self, $class;
}
sub DESTROY {
$gone++;
}
package main;
BEGIN { $tests += 1 }
$gone = 0;
{
my $x = Test::Hash->new();
my $y = $x->clone;
}
is $gone, 2, 'both clone and orig are destroyed';
# benchmarking bug
BEGIN { $tests += 2 }
$gone = 0;
{
my $x = Test::Hash->new();
my $sref = sub { my $y = clone $x };
$sref->();
is $gone, 1, 'clone is destroyed, orig remains';
}
is $gone, 2, 'both are destroyed';
# test for cloning unblessed ref
BEGIN { $tests += 1 }
$gone = 0;
{
my $x = {};
my $y = clone $x;
bless $x, 'Test::Hash';
bless $y, 'Test::Hash';
}
is $gone, 2, 'unblessed {} has correct refcnt';
# test for cloning unblessed ref
BEGIN { $tests += 1 }
$gone = 0;
{
my $x = [];
my $y = clone $x;
bless $x, 'Test::Hash';
bless $y, 'Test::Hash';
}
is $gone, 2, 'unblessed [] has correct refcnt';
BEGIN { plan tests => $tests }