X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Faccessors_ro.t;h=741d79d923bd5a6a677f7dfad834bc4f5bfa246f;hb=ba8c183b7c3d71a5b8fcd936916e80a7b87f7961;hp=79413ffa7d0a18e2997977f0589c3a6a3a5456e6;hpb=ad0ed975f7023237ac91802e5da9ab4f30c7661d;p=p5sagit%2FClass-Accessor-Grouped.git diff --git a/t/accessors_ro.t b/t/accessors_ro.t index 79413ff..741d79d 100644 --- a/t/accessors_ro.t +++ b/t/accessors_ro.t @@ -10,10 +10,10 @@ use lib 't/lib'; # things my $use_xs; BEGIN { - $Class::Accessor::Grouped::USE_XS = 0 - unless defined $Class::Accessor::Grouped::USE_XS; - $ENV{CAG_USE_XS} = 1; - $use_xs = $Class::Accessor::Grouped::USE_XS; + $Class::Accessor::Grouped::USE_XS = 0 + unless defined $Class::Accessor::Grouped::USE_XS; + $ENV{CAG_USE_XS} = 1; + $use_xs = $Class::Accessor::Grouped::USE_XS; }; use AccessorGroupsRO; @@ -21,75 +21,75 @@ use AccessorGroupsRO; my $obj = AccessorGroupsRO->new; { - my $warned = 0; + my $warned = 0; - local $SIG{__WARN__} = sub { - if (shift =~ /DESTROY/i) { - $warned++; - }; + local $SIG{__WARN__} = sub { + if (shift =~ /DESTROY/i) { + $warned++; }; + }; - no warnings qw/once/; - local *AccessorGroupsRO::DESTROY = sub {}; + no warnings qw/once/; + local *AccessorGroupsRO::DESTROY = sub {}; - $obj->mk_group_ro_accessors('warnings', 'DESTROY'); + $obj->mk_group_ro_accessors('warnings', 'DESTROY'); - ok($warned); + ok($warned); }; my $test_accessors = { - singlefield => { - is_xs => $use_xs, - }, - multiple1 => { - }, - multiple2 => { - }, - lr1name => { - custom_field => 'lr1;field', - }, - lr2name => { - custom_field => "lr2'field", - }, + singlefield => { + is_xs => $use_xs, + }, + multiple1 => { + }, + multiple2 => { + }, + lr1name => { + custom_field => 'lr1;field', + }, + lr2name => { + custom_field => "lr2'field", + }, }; for my $name (sort keys %$test_accessors) { - my $alias = "_${name}_accessor"; - my $field = $test_accessors->{$name}{custom_field} || $name; + my $alias = "_${name}_accessor"; + my $field = $test_accessors->{$name}{custom_field} || $name; - can_ok($obj, $name, $alias); + can_ok($obj, $name, $alias); - ok(!$obj->can($field)) - if $field ne $name; + ok(!$obj->can($field)) + if $field ne $name; - is($obj->$name, undef); - is($obj->$alias, undef); + is($obj->$name, undef); + is($obj->$alias, undef); - # get via name - $obj->{$field} = 'a'; - is($obj->$name, 'a'); + # get via name + $obj->{$field} = 'a'; + is($obj->$name, 'a'); - # alias gets same as name - is($obj->$alias, 'a'); + # alias gets same as name + is($obj->$alias, 'a'); - my $ro_regex = $test_accessors->{$name}{is_xs} - ? qr/Usage\:.+$name.*\(self\)/ - : qr/cannot alter the value of '\Q$field\E'/ - ; + my $ro_regex = $test_accessors->{$name}{is_xs} + ? qr/Usage\:.+$name.*\(self\)/ + : qr/cannot alter the value of '\Q$field\E'/ + ; - # die on set via name/alias - throws_ok { - $obj->$name('b'); - } $ro_regex; + # die on set via name/alias + throws_ok { + $obj->$name('b'); + } $ro_regex; - throws_ok { - $obj->$alias('b'); - } $ro_regex; + throws_ok { + $obj->$alias('b'); + } $ro_regex; - # value should be unchanged - is($obj->$name, 'a'); - is($obj->$alias, 'a'); + # value should be unchanged + is($obj->$name, 'a'); + is($obj->$alias, 'a'); }; #important