The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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 }