The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -w

use strict;
use Test::Requires qw(Test::LeakTrace);
use Test::More;
use warnings FATAL => 'all';

use Data::Clone;

{
    package MyBase;

    sub new {
        my $class = shift;
        return bless {@_}, $class;
    }

    package MyNoclonable;
    our @ISA = qw(MyBase);

    package MyClonable;
    use Data::Clone;
    our @ISA = qw(MyBase);

    package MyCustomClonable;
    use Data::Clone qw(data_clone);
    our @ISA = qw(MyBase);

    sub clone {
        my $cloned = data_clone(@_);
        $cloned->{bar} = 42;
        return $cloned;
    }

    package FatalClonable;
    use Data::Clone qw(data_clone);
    our @ISA = qw(MyBase);

    sub clone {
        my $cloned = data_clone(@_);
        die 'FATAL';
    }
}

no_leaks_ok {
    my $o = [ 42 ];
    my $c = clone($o);
} or die "Memory leaked";

no_leaks_ok {
    local $Data::Clone::ObjectCallback = sub{ $_[0] };
    my $o = MyNoclonable->new(foo => 10);
    my $c = clone($o);
};

no_leaks_ok {
    my $o = MyClonable->new(foo => 20);
    my $c = clone($o);
};

no_leaks_ok {
    my $o = MyCustomClonable->new(foo => 30);
    my $c = clone($o);
};

no_leaks_ok {
    my $o = MyCustomClonable->new(foo => MyClonable->new(bar => 42));
    my $c = clone($o);
};

no_leaks_ok {
    my $o = FatalClonable->new(value => MyClonable->new(foo => 50));
    eval{ clone($o) };
} 'fatal in clone()';

done_testing;