[p5sagit/p5-mst-13.2.git] / ext / Object-Accessor / t / 01_Object-Accessor-Subclassed.t

BEGIN { chdir 't' if -d 't' };

use strict;
use lib '../lib';
use Test::More 'no_plan';
use Data::Dumper;

my $Class   = 'Object::Accessor';
my $MyClass = 'My::Class';
my $Acc     = 'foo';

use_ok($Class);

### establish another package that subclasses our own
{   package My::Class;
    use base 'Object::Accessor';
}    

my $Object  = $MyClass->new;

### check the object
{   ok( $Object,                "Object created" );
    isa_ok( $Object,            $MyClass );
    isa_ok( $Object,            $Class );
}    

### create an accessor 
{   ok( $Object->mk_accessors( $Acc ),
                                "Accessor '$Acc' created" );
    ok( $Object->can( $Acc ),   "   Object can '$Acc'" );
    ok( $Object->$Acc(1),       "   Objects '$Acc' set" );
    ok( $Object->$Acc(),        "   Objects '$Acc' retrieved" );
}    
    
### check if we do the right thing when we call an accessor that's
### not a defined function in the base class, and not an accessors 
### in the object either
{   my $sub = eval { $MyClass->can( $$ ); };

    ok( !$sub,                  "No sub from non-existing function" );
    ok( !$@,                    "   Code handled it gracefully" );
}    

### check if a method called on a class, that's not actually there
### doesn't get confused as an object call;
{   eval { $MyClass->$$ };

    ok( $@,                     "Calling '$$' on '$MyClass' dies" );
    like( $@, qr/from somewhere else/,
                                "   Dies with an informative message" );
}
Commit	Line	Data
0bbb0bd4	1	BEGIN { chdir 't' if -d 't' };
	2
	3	use strict;
	4	use lib '../lib';
	5	use Test::More 'no_plan';
	6	use Data::Dumper;
	7
	8	my $Class = 'Object::Accessor';
	9	my $MyClass = 'My::Class';
	10	my $Acc = 'foo';
	11
	12	use_ok($Class);
	13
	14	### establish another package that subclasses our own
	15	{ package My::Class;
	16	use base 'Object::Accessor';
	17	}
	18
	19	my $Object = $MyClass->new;
	20
	21	### check the object
	22	{ ok( $Object, "Object created" );
	23	isa_ok( $Object, $MyClass );
	24	isa_ok( $Object, $Class );
	25	}
	26
	27	### create an accessor
	28	{ ok( $Object->mk_accessors( $Acc ),
	29	"Accessor '$Acc' created" );
	30	ok( $Object->can( $Acc ), " Object can '$Acc'" );
	31	ok( $Object->$Acc(1), " Objects '$Acc' set" );
	32	ok( $Object->$Acc(), " Objects '$Acc' retrieved" );
	33	}
	34
	35	### check if we do the right thing when we call an accessor that's
	36	### not a defined function in the base class, and not an accessors
	37	### in the object either
	38	{ my $sub = eval { $MyClass->can( $$ ); };
	39
	40	ok( !$sub, "No sub from non-existing function" );
	41	ok( !$@, " Code handled it gracefully" );
	42	}
	43
	44	### check if a method called on a class, that's not actually there
	45	### doesn't get confused as an object call;
	46	{ eval { $MyClass->$$ };
	47
	48	ok( $@, "Calling '$$' on '$MyClass' dies" );
	49	like( $@, qr/from somewhere else/,
	50	" Dies with an informative message" );
	51	}