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