#!/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