1use strict; 2use warnings; 3use Test::More tests => 19; 4 5package Ray; 6use base qw(Class::Data::Accessor); 7Ray->mk_classaccessors('Ubu'); 8Ray->mk_classaccessor(DataFile => '/etc/stuff/data'); 9 10package Gun; 11use base qw(Ray); 12Gun->Ubu('Pere'); 13 14package Suitcase; 15use base qw(Gun); 16Suitcase->DataFile('/etc/otherstuff/data'); 17 18package main; 19 20foreach my $class (qw/Ray Gun Suitcase/) { 21 can_ok $class => 22 qw/mk_classaccessor Ubu _Ubu_accessor DataFile _DataFile_accessor/; 23} 24 25# Test that superclasses effect children. 26is +Gun->Ubu, 'Pere', 'Ubu in Gun'; 27is +Suitcase->Ubu, 'Pere', "Inherited into children"; 28is +Ray->Ubu, undef, "But not set in parent"; 29 30# Set value with data 31is +Ray->DataFile, '/etc/stuff/data', "Ray datafile"; 32is +Gun->DataFile, '/etc/stuff/data', "Inherited into gun"; 33is +Suitcase->DataFile, '/etc/otherstuff/data', "Different in suitcase"; 34 35# Now set the parent 36ok +Ray->DataFile('/tmp/stuff'), "Set data in parent"; 37is +Ray->DataFile, '/tmp/stuff', " - it sticks"; 38is +Gun->DataFile, '/tmp/stuff', "filters down to unchanged children"; 39is +Suitcase->DataFile, '/etc/otherstuff/data', "but not to changed"; 40 41 42my $obj = bless {}, 'Gun'; 43eval { $obj->mk_classaccessor('Ubu') }; 44ok $@ =~ /^mk_classaccessor\(\) is a class method, not an object method/, 45"Can't create classaccessor for an object"; 46 47is $obj->DataFile, "/tmp/stuff", "But objects can access the data"; 48 49is $obj->DataFile("/tmp/morestuff"), "/tmp/morestuff", 50 "And they can set their own copy"; 51 52is +Gun->DataFile, "/tmp/stuff", "But it doesn't touch the value on the class"; 53 54 55{ 56 my $warned = 0; 57 58 local $SIG{__WARN__} = sub { 59 if (shift =~ /DESTROY/i) { 60 $warned++; 61 }; 62 }; 63 64 Ray->mk_classaccessor('DESTROY'); 65 66 ok($warned, 'Warn when creating DESTROY'); 67 68 # restore non-accessorized DESTROY 69 no warnings; 70 *Ray::DESTROY = sub {}; 71}; 72 73eval { 74 $obj->mk_classaccessor('foo'); 75}; 76like($@, qr{not an object method}, 'Die when used as an object method'); 77 78