1#!/usr/bin/perl
2
3use Test;
4BEGIN { plan tests => 28 }
5
6########################################################################
7
8package MyObject;
9
10use Class::MakeMethods::Template::Inheritable (
11  'Template::Hash:new' => 'new',
12  scalar => [ 'a', 'b' ],
13);
14
15########################################################################
16
17package MyObject::CornedBeef;
18@ISA = 'MyObject';
19
20use Class::MakeMethods::Template::Inheritable (
21  scalar => 'c',
22);
23
24########################################################################
25
26package main;
27
28ok( 1 );
29
30# Constructor: new()
31ok( ref MyObject->can('new') eq 'CODE' );
32
33# Two similar accessors with undefined values
34ok( ref MyObject->can('a') eq 'CODE' );
35ok( ! defined MyObject->a() );
36
37ok( ref MyObject->can('b') eq 'CODE' );
38ok( ! defined MyObject->b() );
39
40# Pass a value to save it in the named slot
41ok( MyObject->a('Foozle') eq 'Foozle' );
42ok( MyObject->a() eq 'Foozle' );
43
44# Instance
45ok( $obj_1 = MyObject->new() );
46ok( ref $obj_1 eq 'MyObject' );
47ok( ref $obj_1->can('a') eq 'CODE' );
48ok( ref $obj_1->can('b') eq 'CODE' );
49
50# Inheritable, but overridable
51ok( $obj_1->a() eq 'Foozle' );
52ok( $obj_1->a('Foible') eq 'Foible' );
53ok( $obj_1->a() eq 'Foible' );
54
55# Class is not affect by change of instance
56ok( MyObject->a() eq 'Foozle' );
57
58# And instances are distinct
59ok( $obj_2 = MyObject->new() );
60ok( $obj_2->a() eq 'Foozle' );
61
62ok( $obj_1->a() eq 'Foible' );
63
64# Pass undef to clear the slot and re-inherit
65ok( ! defined $obj_1->a(undef) );
66ok( $obj_1->a() eq 'Foozle' );
67
68# Subclass inherits values
69ok( MyObject::CornedBeef->a() eq 'Foozle' );
70
71# And instances of subclass also inherit
72ok( $obj_3 = MyObject::CornedBeef->new() );
73ok( $obj_3->a() eq 'Foozle' );
74
75# Change the subclass and you modify it's instances
76ok( MyObject::CornedBeef->a('Flipper') eq 'Flipper' );
77ok( $obj_3->a() eq 'Flipper' );
78
79# Superclass and its instances are still isolated
80ok( MyObject->a() eq 'Foozle' );
81ok( $obj_1->a() eq 'Foozle' );
82
83########################################################################
84
851;
86