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::More tests => 10;
use Test::Exception;

use Class::Monadic qw(:all);

{
	package T;

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

	sub clone{
		my($self) = @_;

		bless { %{$self} }, ref $self;
	}

	package Tx;

	package X;

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

my $t = T->new(foo => 42);

monadic($t)->add_method(pi => sub{ 3.14 });
monadic($t)->add_field(age => qr/^\d+$/);
monadic($t)->inject_base('Tx');

$t->set_age(10);

my $x = $t->clone;
isa_ok $x, 'T';
isa_ok $x, 'Tx' or do{
	require Data::Dumper;
	diag(Data::Dumper::Dumper(monadic($x)));
};

can_ok $x, 'pi';
can_ok $x, 'get_age';

is $x->pi, 3.14;

is $x->get_age, 10;
$t->set_age(12);
is $x->get_age, 10;


my $z = X->new;
monadic($t)->bless($z);

isa_ok $z, 'X';
isa_ok $z, 'Tx';

ok(!$z->isa('T')) or do{
	require Data::Dumper;
	diag(Data::Dumper::Dumper(monadic($z)));
};