#!/usr/bin/perl
use Test;
BEGIN {
eval q{ local $SIG{__DIE__}; require Attribute::Handlers; 1 };
if ( $@ ) {
plan( tests => 1 );
print "Skipping test on this platform (no Attribute::Handlers).\n";
ok( 1 );
exit 0;
}
}
BEGIN { plan tests => 19 }
########################################################################
package MyObject;
use Class::MakeMethods::Attribute 'Standard::Hash';
sub new :MakeMethod('new');
sub a :MakeMethod('scalar');
sub b :MakeMethod('scalar');
########################################################################
package MyObject::CornedBeef;
use base 'MyObject';
sub c :MakeMethod('scalar');
########################################################################
package main;
ok( 1 );
# Constructor: new()
ok( ref MyObject->can('new') eq 'CODE' );
ok( $obj_1 = MyObject->new() );
ok( ref $obj_1 eq 'MyObject' );
# Two similar accessors with undefined values
ok( ref $obj_1->can('a') eq 'CODE' );
ok( ! defined $obj_1->a() );
ok( ref $obj_1->can('b') eq 'CODE' );
ok( ! defined $obj_1->b() );
# Pass a value to save it in the named slot
ok( $obj_1->a('Foo') eq 'Foo' );
ok( $obj_1->a() eq 'Foo' );
# Pass undef to clear the slot
ok( ! defined $obj_1->a(undef) );
ok( ! defined $obj_1->a() );
# Constructor accepts list of key-value pairs to intialize with
ok( $obj_2 = MyObject->new( a => 'Bar', b => 'Baz' ) );
ok( $obj_2->a() eq 'Bar' and $obj_2->b() eq 'Baz' );
# Copy instances by calling new() on them
ok( $obj_3 = $obj_2->new( b => 'Bowling' ) );
ok( $obj_2->a() eq 'Bar' and $obj_2->b() eq 'Baz' ); # Original is unchanged
ok( $obj_3->a() eq 'Bar' and $obj_3->b() eq 'Bowling' );
# Basic subclasses work as expected
ok( $obj_4 = MyObject::CornedBeef->new( a => 'Foo', b => 'Bar', c => 'Baz' ) );
ok( $obj_4->a() eq 'Foo' and $obj_4->b() eq 'Bar' and $obj_4->c() eq 'Baz' );
1;
syntax highlighted by Code2HTML, v. 0.9.1