From: Peter Rabbitson Date: Fri, 26 Oct 2012 04:49:18 +0000 (+0200) Subject: Switch to 2-space indent, minor formatting (no code) changes X-Git-Tag: v0.10007~21 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FClass-Accessor-Grouped.git;a=commitdiff_plain;h=ba8c183b7c3d71a5b8fcd936916e80a7b87f7961 Switch to 2-space indent, minor formatting (no code) changes --- diff --git a/Makefile.PL b/Makefile.PL index df5253c..5e947a0 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -26,8 +26,8 @@ test_requires 'Test::Exception' => '0.31'; clean_files "Class-Accessor-Grouped-* t/var"; if (-e 'MANIFEST.SKIP') { - system('pod2text lib/Class/Accessor/Grouped.pm > README'); - realclean_files 'README'; + system('pod2text lib/Class/Accessor/Grouped.pm > README'); + realclean_files 'README'; } auto_install; diff --git a/lib/Class/Accessor/Grouped.pm b/lib/Class/Accessor/Grouped.pm index b9f2bf1..6fdd4ab 100644 --- a/lib/Class/Accessor/Grouped.pm +++ b/lib/Class/Accessor/Grouped.pm @@ -24,48 +24,44 @@ our $USE_XS; # the unless defined is here so that we can override the value # before require/use, *regardless* of the state of $ENV{CAG_USE_XS} $USE_XS = $ENV{CAG_USE_XS} - unless defined $USE_XS; + unless defined $USE_XS; # Yes this method is undocumented # Yes it should be a private coderef like all the rest at the end of this file # No we can't do that (yet) because the DBIC-CDBI compat layer overrides it # %$*@!?&!&#*$!!! sub _mk_group_accessors { - my($self, $maker, $group, @fields) = @_; - my $class = Scalar::Util::blessed $self || $self; + my($self, $maker, $group, @fields) = @_; + my $class = Scalar::Util::blessed $self || $self; - no strict 'refs'; - no warnings 'redefine'; + no strict 'refs'; + no warnings 'redefine'; - # So we don't have to do lots of lookups inside the loop. - $maker = $self->can($maker) unless ref $maker; + # So we don't have to do lots of lookups inside the loop. + $maker = $self->can($maker) unless ref $maker; - foreach (@fields) { - if( $_ eq 'DESTROY' ) { - Carp::carp("Having a data accessor named DESTROY in ". - "'$class' is unwise."); - } + for (@fields) { + if( $_ eq 'DESTROY' ) { + Carp::carp("Having a data accessor named DESTROY in '$class' is unwise."); + } - my ($name, $field) = (ref $_) - ? (@$_) - : ($_, $_) - ; + my ($name, $field) = (ref $_) ? (@$_) : ($_, $_); - my $alias = "_${name}_accessor"; + my $alias = "_${name}_accessor"; - for my $meth ($name, $alias) { + for my $meth ($name, $alias) { - # the maker may elect to not return anything, meaning it already - # installed the coderef for us (e.g. lack of Sub::Name) - my $cref = $self->$maker($group, $field, $meth) - or next; + # the maker may elect to not return anything, meaning it already + # installed the coderef for us (e.g. lack of Sub::Name) + my $cref = $self->$maker($group, $field, $meth) + or next; - my $fq_meth = "${class}::${meth}"; + my $fq_meth = "${class}::${meth}"; - *$fq_meth = Sub::Name::subname($fq_meth, $cref); - #unless defined &{$class."\:\:$field"} - } + *$fq_meth = Sub::Name::subname($fq_meth, $cref); + #unless defined &{$class."\:\:$field"} } + } }; # coderef is setup at the end for clarity @@ -120,10 +116,10 @@ be of the form [ $accessor, $field ]. =cut sub mk_group_accessors { - my ($self, $group, @fields) = @_; + my ($self, $group, @fields) = @_; - $self->_mk_group_accessors('make_group_accessor', $group, @fields); - return; + $self->_mk_group_accessors('make_group_accessor', $group, @fields); + return; } =head2 mk_group_ro_accessors @@ -145,9 +141,9 @@ rather than setting the value. =cut sub mk_group_ro_accessors { - my($self, $group, @fields) = @_; + my($self, $group, @fields) = @_; - $self->_mk_group_accessors('make_group_ro_accessor', $group, @fields); + $self->_mk_group_accessors('make_group_ro_accessor', $group, @fields); } =head2 mk_group_wo_accessors @@ -169,9 +165,9 @@ value rather than getting the value. =cut sub mk_group_wo_accessors { - my($self, $group, @fields) = @_; + my($self, $group, @fields) = @_; - $self->_mk_group_accessors('make_group_wo_accessor', $group, @fields); + $self->_mk_group_accessors('make_group_wo_accessor', $group, @fields); } =head2 get_simple @@ -190,7 +186,7 @@ name passed as an argument. =cut sub get_simple { - return $_[0]->{$_[1]}; + return $_[0]->{$_[1]}; } =head2 set_simple @@ -209,7 +205,7 @@ for the field name passed as an argument. =cut sub set_simple { - return $_[0]->{$_[1]} = $_[2]; + return $_[0]->{$_[1]} = $_[2]; } @@ -232,38 +228,38 @@ instances. =cut sub get_inherited { - my $class; + my $class; - if ( defined( $class = Scalar::Util::blessed $_[0] ) ) { - if (Scalar::Util::reftype $_[0] eq 'HASH') { - return $_[0]->{$_[1]} if exists $_[0]->{$_[1]}; - } - else { - Carp::croak('Cannot get inherited value on an object instance that is not hash-based'); - } + if ( defined( $class = Scalar::Util::blessed $_[0] ) ) { + if (Scalar::Util::reftype $_[0] eq 'HASH') { + return $_[0]->{$_[1]} if exists $_[0]->{$_[1]}; } else { - $class = $_[0]; + Carp::croak('Cannot get inherited value on an object instance that is not hash-based'); } + } + else { + $class = $_[0]; + } - no strict 'refs'; - no warnings 'uninitialized'; + no strict 'refs'; + no warnings 'uninitialized'; - my $cag_slot = '::__cag_'. $_[1]; - return ${$class.$cag_slot} if defined(${$class.$cag_slot}); + my $cag_slot = '::__cag_'. $_[1]; + return ${$class.$cag_slot} if defined(${$class.$cag_slot}); - # we need to be smarter about recalculation, as @ISA (thus supers) can very well change in-flight - my $cur_gen = mro::get_pkg_gen ($class); - if ( $cur_gen != ${$class.'::__cag_pkg_gen__'} ) { - @{$class.'::__cag_supers__'} = $_[0]->get_super_paths; - ${$class.'::__cag_pkg_gen__'} = $cur_gen; - } + # we need to be smarter about recalculation, as @ISA (thus supers) can very well change in-flight + my $cur_gen = mro::get_pkg_gen ($class); + if ( $cur_gen != ${$class.'::__cag_pkg_gen__'} ) { + @{$class.'::__cag_supers__'} = $_[0]->get_super_paths; + ${$class.'::__cag_pkg_gen__'} = $cur_gen; + } - for (@{$class.'::__cag_supers__'}) { - return ${$_.$cag_slot} if defined(${$_.$cag_slot}); - }; + for (@{$class.'::__cag_supers__'}) { + return ${$_.$cag_slot} if defined(${$_.$cag_slot}); + }; - return undef; + return undef; } =head2 set_inherited @@ -287,17 +283,17 @@ hash-based object. =cut sub set_inherited { - if (defined Scalar::Util::blessed $_[0]) { - if (Scalar::Util::reftype $_[0] eq 'HASH') { - return $_[0]->{$_[1]} = $_[2]; - } else { - Carp::croak('Cannot set inherited value on an object instance that is not hash-based'); - }; + if (defined Scalar::Util::blessed $_[0]) { + if (Scalar::Util::reftype $_[0] eq 'HASH') { + return $_[0]->{$_[1]} = $_[2]; } else { - no strict 'refs'; - - return ${$_[0].'::__cag_'.$_[1]} = $_[2]; + Carp::croak('Cannot set inherited value on an object instance that is not hash-based'); }; + } else { + no strict 'refs'; + + return ${$_[0].'::__cag_'.$_[1]} = $_[2]; + }; } =head2 get_component_class @@ -312,17 +308,17 @@ Returns: $value Gets the value of the specified component class. - __PACKAGE__->mk_group_accessors('component_class' => 'result_class'); + __PACKAGE__->mk_group_accessors('component_class' => 'result_class'); - $self->result_class->method(); + $self->result_class->method(); - ## same as - $self->get_component_class('result_class')->method(); + ## same as + $self->get_component_class('result_class')->method(); =cut sub get_component_class { - return $_[0]->get_inherited($_[1]); + return $_[0]->get_inherited($_[1]); }; =head2 set_component_class @@ -338,25 +334,25 @@ Returns: $new_value Inherited accessor that automatically loads the specified class before setting it. This method will die if the specified class could not be loaded. - __PACKAGE__->mk_group_accessors('component_class' => 'result_class'); - __PACKAGE__->result_class('MyClass'); + __PACKAGE__->mk_group_accessors('component_class' => 'result_class'); + __PACKAGE__->result_class('MyClass'); - $self->result_class->method(); + $self->result_class->method(); =cut sub set_component_class { - if ($_[2]) { - local $^W = 0; - require Class::Inspector; - if (Class::Inspector->installed($_[2]) && !Class::Inspector->loaded($_[2])) { - eval "require $_[2]"; + if ($_[2]) { + local $^W = 0; + require Class::Inspector; + if (Class::Inspector->installed($_[2]) && !Class::Inspector->loaded($_[2])) { + eval "require $_[2]"; - Carp::croak("Could not load $_[1] '$_[2]': ", $@) if $@; - }; + Carp::croak("Could not load $_[1] '$_[2]': ", $@) if $@; }; + }; - return $_[0]->set_inherited($_[1], $_[2]); + return $_[0]->set_inherited($_[1], $_[2]); }; =head1 INTERNAL METHODS @@ -372,7 +368,7 @@ inherited from. This is what drives the traversal done by L. =cut sub get_super_paths { - return @{mro::get_linear_isa( ref($_[0]) || $_[0] )}; + return @{mro::get_linear_isa( ref($_[0]) || $_[0] )}; }; =head2 make_group_accessor diff --git a/t/accessors.t b/t/accessors.t index cf219b0..a7f7b00 100644 --- a/t/accessors.t +++ b/t/accessors.t @@ -10,103 +10,103 @@ use B qw/svref_2object/; # 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 AccessorGroupsSubclass; { - my $obj = AccessorGroupsSubclass->new; - my $class = ref $obj; - my $name = 'multiple1'; - my $alias = "_${name}_accessor"; - - my $warned = 0; - local $SIG{__WARN__} = sub { - if (shift =~ /DESTROY/i) { - $warned++; - }; + my $obj = AccessorGroupsSubclass->new; + my $class = ref $obj; + my $name = 'multiple1'; + my $alias = "_${name}_accessor"; + + my $warned = 0; + local $SIG{__WARN__} = sub { + if (shift =~ /DESTROY/i) { + $warned++; }; + }; - no warnings qw/once/; - local *AccessorGroupsSubclass::DESTROY = sub {}; + no warnings qw/once/; + local *AccessorGroupsSubclass::DESTROY = sub {}; - $class->mk_group_accessors('warnings', 'DESTROY'); - ok($warned); + $class->mk_group_accessors('warnings', 'DESTROY'); + ok($warned); }; my $obj = AccessorGroupsSubclass->new; my $test_accessors = { - singlefield => { - is_xs => $use_xs, - has_extra => 1, - }, - runtime_around => { - # even though this accessor is simple it will *not* be XSified - # due to the runtime 'around' - is_xs => 0, - has_extra => 1, - }, - multiple1 => { - }, - multiple2 => { - }, - lr1name => { - custom_field => 'lr1;field', - }, - lr2name => { - custom_field => "lr2'field", - }, + singlefield => { + is_xs => $use_xs, + has_extra => 1, + }, + runtime_around => { + # even though this accessor is simple it will *not* be XSified + # due to the runtime 'around' + is_xs => 0, + has_extra => 1, + }, + 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 $extra = $test_accessors->{$name}{has_extra}; - - can_ok($obj, $name, $alias); - ok(!$obj->can($field)) - if $field ne $name; - - for my $meth ($name, $alias) { - my $cv = svref_2object( $obj->can($meth) ); - is($cv->GV->NAME, $meth, "$meth accessor is named"); - is($cv->GV->STASH->NAME, 'AccessorGroups', "$meth class correct"); - } - - is($obj->$name, undef); - is($obj->$alias, undef); - - # get/set via name - is($obj->$name('a'), 'a'); - is($obj->$name, 'a'); - is($obj->{$field}, $extra ? 'a Extra tackled on' : 'a'); - - # alias gets same as name - is($obj->$alias, 'a'); - - # get/set via alias - is($obj->$alias('b'), 'b'); - is($obj->$alias, 'b'); - is($obj->{$field}, $extra ? 'b Extra tackled on' : 'b'); - - # alias gets same as name - is($obj->$name, 'b'); - - for my $meth ($name, $alias) { - my $cv = svref_2object( $obj->can($meth) ); - is($cv->GV->NAME, $meth, "$meth accessor is named after operations"); - is( - $cv->GV->STASH->NAME, - # XS lazyinstalls install into each caller, not into the original parent - $test_accessors->{$name}{is_xs} ? 'AccessorGroupsSubclass' :'AccessorGroups', - "$meth class correct after operations", - ); - } + my $alias = "_${name}_accessor"; + my $field = $test_accessors->{$name}{custom_field} || $name; + my $extra = $test_accessors->{$name}{has_extra}; + + can_ok($obj, $name, $alias); + ok(!$obj->can($field)) + if $field ne $name; + + for my $meth ($name, $alias) { + my $cv = svref_2object( $obj->can($meth) ); + is($cv->GV->NAME, $meth, "$meth accessor is named"); + is($cv->GV->STASH->NAME, 'AccessorGroups', "$meth class correct"); + } + + is($obj->$name, undef); + is($obj->$alias, undef); + + # get/set via name + is($obj->$name('a'), 'a'); + is($obj->$name, 'a'); + is($obj->{$field}, $extra ? 'a Extra tackled on' : 'a'); + + # alias gets same as name + is($obj->$alias, 'a'); + + # get/set via alias + is($obj->$alias('b'), 'b'); + is($obj->$alias, 'b'); + is($obj->{$field}, $extra ? 'b Extra tackled on' : 'b'); + + # alias gets same as name + is($obj->$name, 'b'); + + for my $meth ($name, $alias) { + my $cv = svref_2object( $obj->can($meth) ); + is($cv->GV->NAME, $meth, "$meth accessor is named after operations"); + is( + $cv->GV->STASH->NAME, + # XS lazyinstalls install into each caller, not into the original parent + $test_accessors->{$name}{is_xs} ? 'AccessorGroupsSubclass' :'AccessorGroups', + "$meth class correct after operations", + ); + } }; # important 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 diff --git a/t/accessors_wo.t b/t/accessors_wo.t index 47463b6..a4bab8e 100644 --- a/t/accessors_wo.t +++ b/t/accessors_wo.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 AccessorGroupsWO; @@ -21,68 +21,68 @@ use AccessorGroupsWO; my $obj = AccessorGroupsWO->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 *AccessorGroupsWO::DESTROY = sub {}; + no warnings qw/once/; + local *AccessorGroupsWO::DESTROY = sub {}; - $obj->mk_group_wo_accessors('warnings', 'DESTROY'); - ok($warned); + $obj->mk_group_wo_accessors('warnings', 'DESTROY'); + 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; - # set via name - is($obj->$name('a'), 'a'); - is($obj->{$field}, 'a'); + # set via name + is($obj->$name('a'), 'a'); + is($obj->{$field}, 'a'); - # alias sets same as name - is($obj->$alias('b'), 'b'); - is($obj->{$field}, 'b'); + # alias sets same as name + is($obj->$alias('b'), 'b'); + is($obj->{$field}, 'b'); - my $wo_regex = $test_accessors->{$name}{is_xs} - ? qr/Usage\:.+$name.*\(self, newvalue\)/ - : qr/cannot access the value of '\Q$field\E'/ - ; + my $wo_regex = $test_accessors->{$name}{is_xs} + ? qr/Usage\:.+$name.*\(self, newvalue\)/ + : qr/cannot access the value of '\Q$field\E'/ + ; - # die on get via name/alias - throws_ok { - $obj->$name; - } $wo_regex; + # die on get via name/alias + throws_ok { + $obj->$name; + } $wo_regex; - throws_ok { - $obj->$alias; - } $wo_regex; + throws_ok { + $obj->$alias; + } $wo_regex; }; # important diff --git a/t/accessors_xs.t b/t/accessors_xs.t index c7f9de4..c5e0984 100644 --- a/t/accessors_xs.t +++ b/t/accessors_xs.t @@ -7,14 +7,14 @@ use Test::More; use lib 't/lib'; BEGIN { - require Class::Accessor::Grouped; - my $xsa_ver = $Class::Accessor::Grouped::__minimum_xsa_version; - eval { - require Class::XSAccessor; - Class::XSAccessor->VERSION ($xsa_ver); - }; - plan skip_all => "Class::XSAccessor >= $xsa_ver not available" - if $@; + require Class::Accessor::Grouped; + my $xsa_ver = $Class::Accessor::Grouped::__minimum_xsa_version; + eval { + require Class::XSAccessor; + Class::XSAccessor->VERSION ($xsa_ver); + }; + plan skip_all => "Class::XSAccessor >= $xsa_ver not available" + if $@; } # rerun the regular 3 tests under XSAccessor diff --git a/t/accessors_xs_cachedwarn.t b/t/accessors_xs_cachedwarn.t index 7b9dfaf..3e3ee1c 100644 --- a/t/accessors_xs_cachedwarn.t +++ b/t/accessors_xs_cachedwarn.t @@ -4,14 +4,14 @@ use Test::More; use lib 't/lib'; BEGIN { - require Class::Accessor::Grouped; - my $xsa_ver = $Class::Accessor::Grouped::__minimum_xsa_version; - eval { - require Class::XSAccessor; - Class::XSAccessor->VERSION ($xsa_ver); - }; - plan skip_all => "Class::XSAccessor >= $xsa_ver not available" - if $@; + require Class::Accessor::Grouped; + my $xsa_ver = $Class::Accessor::Grouped::__minimum_xsa_version; + eval { + require Class::XSAccessor; + Class::XSAccessor->VERSION ($xsa_ver); + }; + plan skip_all => "Class::XSAccessor >= $xsa_ver not available" + if $@; } use AccessorGroupsSubclass; diff --git a/t/basic.t b/t/basic.t index 9e6f302..b606605 100644 --- a/t/basic.t +++ b/t/basic.t @@ -2,8 +2,8 @@ use strict; use warnings; BEGIN { - use lib 't/lib'; - use Test::More tests => 1; + use lib 't/lib'; + use Test::More tests => 1; - use_ok('Class::Accessor::Grouped'); + use_ok('Class::Accessor::Grouped'); }; diff --git a/t/component.t b/t/component.t index d0a5dd8..a86b515 100644 --- a/t/component.t +++ b/t/component.t @@ -11,7 +11,7 @@ is(AccessorGroupsComp->result_class, undef); ## croak on set where class can't be loaded and it's a physical class my $dying = AccessorGroupsComp->new; throws_ok { - $dying->result_class('NotReallyAClass'); + $dying->result_class('NotReallyAClass'); } qr/Could not load result_class 'NotReallyAClass'/; is($dying->result_class, undef); diff --git a/t/inherited.t b/t/inherited.t index 8a3dc02..a2e1567 100644 --- a/t/inherited.t +++ b/t/inherited.t @@ -59,11 +59,11 @@ is(BaseInheritedGroups->basefield, 'All Your Base'); my $dying = NotHashBased->new; throws_ok { - $dying->killme; + $dying->killme; } qr/Cannot get.*is not hash-based/; throws_ok { - $dying->killme('foo'); + $dying->killme('foo'); } qr/Cannot set.*is not hash-based/; # make sure we're get defined items, even 0, '' diff --git a/t/lib/AccessorGroups.pm b/t/lib/AccessorGroups.pm index 3d0685b..a8e3b97 100644 --- a/t/lib/AccessorGroups.pm +++ b/t/lib/AccessorGroups.pm @@ -57,13 +57,13 @@ EOE } sub new { - return bless {}, shift; + return bless {}, shift; }; foreach (qw/multiple listref/) { - no strict 'refs'; - *{"get_$_"} = __PACKAGE__->can('get_simple'); - *{"set_$_"} = __PACKAGE__->can('set_simple'); + no strict 'refs'; + *{"get_$_"} = __PACKAGE__->can('get_simple'); + *{"set_$_"} = __PACKAGE__->can('set_simple'); }; 1; diff --git a/t/lib/AccessorGroupsComp.pm b/t/lib/AccessorGroupsComp.pm index 952a383..950fa87 100644 --- a/t/lib/AccessorGroupsComp.pm +++ b/t/lib/AccessorGroupsComp.pm @@ -6,7 +6,7 @@ use base 'Class::Accessor::Grouped'; __PACKAGE__->mk_group_accessors('component_class', 'result_class'); sub new { - return bless {}, shift; + return bless {}, shift; }; 1; diff --git a/t/lib/AccessorGroupsRO.pm b/t/lib/AccessorGroupsRO.pm index 2765734..1f88a47 100644 --- a/t/lib/AccessorGroupsRO.pm +++ b/t/lib/AccessorGroupsRO.pm @@ -8,12 +8,12 @@ __PACKAGE__->mk_group_ro_accessors('multiple', qw/multiple1 multiple2/); __PACKAGE__->mk_group_ro_accessors('listref', [qw/lr1name lr1;field/], [qw/lr2name lr2'field/]); sub new { - return bless {}, shift; + return bless {}, shift; }; foreach (qw/multiple listref/) { - no strict 'refs'; - *{"get_$_"} = __PACKAGE__->can ('get_simple'); + no strict 'refs'; + *{"get_$_"} = __PACKAGE__->can ('get_simple'); }; 1; diff --git a/t/lib/AccessorGroupsWO.pm b/t/lib/AccessorGroupsWO.pm index 8b4f3a2..2ea6887 100644 --- a/t/lib/AccessorGroupsWO.pm +++ b/t/lib/AccessorGroupsWO.pm @@ -8,12 +8,12 @@ __PACKAGE__->mk_group_wo_accessors('multiple', qw/multiple1 multiple2/); __PACKAGE__->mk_group_wo_accessors('listref', [qw/lr1name lr1;field/], [qw/lr2name lr2'field/]); sub new { - return bless {}, shift; + return bless {}, shift; }; foreach (qw/multiple listref/) { - no strict 'refs'; - *{"set_$_"} = __PACKAGE__->can('set_simple'); + no strict 'refs'; + *{"set_$_"} = __PACKAGE__->can('set_simple'); }; 1; diff --git a/t/lib/BaseInheritedGroups.pm b/t/lib/BaseInheritedGroups.pm index 23f3ff8..14f0d62 100644 --- a/t/lib/BaseInheritedGroups.pm +++ b/t/lib/BaseInheritedGroups.pm @@ -6,7 +6,7 @@ use base 'Class::Accessor::Grouped'; __PACKAGE__->mk_group_accessors('inherited', 'basefield', 'undefined'); sub new { - return bless {}, shift; + return bless {}, shift; }; 1; diff --git a/t/lib/NotHashBased.pm b/t/lib/NotHashBased.pm index 5844a90..f493c7d 100644 --- a/t/lib/NotHashBased.pm +++ b/t/lib/NotHashBased.pm @@ -4,7 +4,7 @@ use warnings; use base 'Class::Accessor::Grouped'; sub new { - return bless [], shift; + return bless [], shift; }; __PACKAGE__->mk_group_accessors('inherited', 'killme'); diff --git a/t/manifest.t b/t/manifest.t index 13e073a..b0e7df0 100644 --- a/t/manifest.t +++ b/t/manifest.t @@ -2,19 +2,19 @@ use strict; use warnings; BEGIN { - use lib 't/lib'; - use Test::More; + use lib 't/lib'; + use Test::More; - plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; + plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; - eval 'use Test::CheckManifest 0.09'; - if($@) { - plan skip_all => 'Test::CheckManifest 0.09 not installed'; - }; + eval 'use Test::CheckManifest 0.09'; + if($@) { + plan skip_all => 'Test::CheckManifest 0.09 not installed'; + }; }; ok_manifest({ - exclude => ['/t/var', '/cover_db'], - filter => [qr/\.(svn|git)/, qr/cover/, qr/Build(.(PL|bat))?/, qr/_build/, qr/\.DS_Store/], - bool => 'or' + exclude => ['/t/var', '/cover_db'], + filter => [qr/\.(svn|git)/, qr/cover/, qr/Build(.(PL|bat))?/, qr/_build/, qr/\.DS_Store/], + bool => 'or' }); diff --git a/t/pod_coverage.t b/t/pod_coverage.t index 35a8a18..d1d34d6 100644 --- a/t/pod_coverage.t +++ b/t/pod_coverage.t @@ -2,20 +2,20 @@ use strict; use warnings; BEGIN { - use lib 't/lib'; - use Test::More; + use lib 't/lib'; + use Test::More; - plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; + plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; - eval 'use Test::Pod::Coverage 1.04'; - plan skip_all => 'Test::Pod::Coverage 1.04' if $@; + eval 'use Test::Pod::Coverage 1.04'; + plan skip_all => 'Test::Pod::Coverage 1.04' if $@; - eval 'use Pod::Coverage 0.14'; - plan skip_all => 'Pod::Coverage 0.14 not installed' if $@; + eval 'use Pod::Coverage 0.14'; + plan skip_all => 'Pod::Coverage 0.14 not installed' if $@; }; my $trustme = { - trustme => [qr/^(g|s)et_component_class$/] + trustme => [qr/^(g|s)et_component_class$/] }; all_pod_coverage_ok($trustme); diff --git a/t/pod_spelling.t b/t/pod_spelling.t index 90d91d5..6c384f9 100644 --- a/t/pod_spelling.t +++ b/t/pod_spelling.t @@ -2,13 +2,13 @@ use strict; use warnings; BEGIN { - use lib 't/lib'; - use Test::More; + use lib 't/lib'; + use Test::More; - plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; + plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; - eval 'use Test::Spelling 0.11'; - plan skip_all => 'Test::Spelling 0.11 not installed' if $@; + eval 'use Test::Spelling 0.11'; + plan skip_all => 'Test::Spelling 0.11 not installed' if $@; }; set_spell_cmd('aspell list'); diff --git a/t/pod_syntax.t b/t/pod_syntax.t index 66f5907..6791d5d 100644 --- a/t/pod_syntax.t +++ b/t/pod_syntax.t @@ -2,13 +2,13 @@ use strict; use warnings; BEGIN { - use lib 't/lib'; - use Test::More; + use lib 't/lib'; + use Test::More; - plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; + plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; - eval 'use Test::Pod 1.00'; - plan skip_all => 'Test::Pod 1.00 not installed' if $@; + eval 'use Test::Pod 1.00'; + plan skip_all => 'Test::Pod 1.00 not installed' if $@; }; all_pod_files_ok(); diff --git a/t/strict.t b/t/strict.t index f02cdab..fb8b401 100644 --- a/t/strict.t +++ b/t/strict.t @@ -2,50 +2,51 @@ use strict; use warnings; BEGIN { - use lib 't/lib'; - use Test::More; - use File::Find; - use File::Basename; + use lib 't/lib'; + use Test::More; + use File::Find; + use File::Basename; - plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; + plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; - eval 'use Test::Strict'; - plan skip_all => 'Test::Strict not installed' if $@; - plan skip_all => 'Need untaint in newer File::Find' if $] <= 5.006; + eval 'use Test::Strict'; + plan skip_all => 'Test::Strict not installed' if $@; + plan skip_all => 'Need untaint in newer File::Find' if $] <= 5.006; }; ## I hope this can go away if Test::Strict or File::Find::Rule ## finally run under -T. Until then, I'm on my own here. ;-) my @files; my %trusted = ( - 'NotReallyAClass.pm' => 1 + 'NotReallyAClass.pm' => 1 ); -find({ wanted => \&wanted, - untaint => 1, - untaint_pattern => qr|^([-+@\w./]+)$|, - untaint_skip => 1, - no_chdir => 1 +find({ + wanted => \&wanted, + untaint => 1, + untaint_pattern => qr|^([-+@\w./]+)$|, + untaint_skip => 1, + no_chdir => 1 }, qw(lib t)); sub wanted { - my $name = $File::Find::name; - my $file = fileparse($name); + my $name = $File::Find::name; + my $file = fileparse($name); - return if $name =~ /TestApp/; + return if $name =~ /TestApp/; - if ($name =~ /\.(pm|pl|t)$/i && !exists($trusted{$file})) { - push @files, $name; - }; + if ($name =~ /\.(pm|pl|t)$/i && !exists($trusted{$file})) { + push @files, $name; + }; }; if (scalar @files) { - plan tests => scalar @files; + plan tests => scalar @files; } else { - plan tests => 1; - fail 'No perl files found for Test::Strict checks!'; + plan tests => 1; + fail 'No perl files found for Test::Strict checks!'; }; foreach (@files) { - strict_ok($_); + strict_ok($_); }; diff --git a/t/style_no_tabs.t b/t/style_no_tabs.t index 6895eb3..0c6986d 100644 --- a/t/style_no_tabs.t +++ b/t/style_no_tabs.t @@ -2,12 +2,12 @@ use strict; use warnings; BEGIN { - use Test::More; + use Test::More; - plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; + plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; - eval 'use Test::NoTabs 0.03'; - plan skip_all => 'Test::NoTabs 0.03 not installed' if $@; + eval 'use Test::NoTabs 0.03'; + plan skip_all => 'Test::NoTabs 0.03 not installed' if $@; }; all_perl_files_ok('lib'); diff --git a/t/warnings.t b/t/warnings.t index b0fcaf5..903837e 100644 --- a/t/warnings.t +++ b/t/warnings.t @@ -2,48 +2,49 @@ use strict; use warnings; BEGIN { - use lib 't/lib'; - use Test::More; - use File::Find; - use File::Basename; + use lib 't/lib'; + use Test::More; + use File::Find; + use File::Basename; - plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; + plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR}; - eval 'use Test::Strict 0.05'; - plan skip_all => 'Test::Strict 0.05 not installed' if $@; - plan skip_all => 'Need untaint in newer File::Find' if $] <= 5.006; + eval 'use Test::Strict 0.05'; + plan skip_all => 'Test::Strict 0.05 not installed' if $@; + plan skip_all => 'Need untaint in newer File::Find' if $] <= 5.006; }; ## I hope this can go away if Test::Strict or File::Find::Rule ## finally run under -T. Until then, I'm on my own here. ;-) my @files; my %trusted = ( - 'NotReallyAClass.pm' => 1 + 'NotReallyAClass.pm' => 1 ); -find({ wanted => \&wanted, - untaint => 1, - untaint_pattern => qr|^([-+@\w./]+)$|, - untaint_skip => 1, - no_chdir => 1 +find({ + wanted => \&wanted, + untaint => 1, + untaint_pattern => qr|^([-+@\w./]+)$|, + untaint_skip => 1, + no_chdir => 1 }, qw(lib t)); sub wanted { - my $name = $File::Find::name; - my $file = fileparse($name); + my $name = $File::Find::name; + my $file = fileparse($name); - return if $name =~ /TestApp/; + return if $name =~ /TestApp/; - if ($name =~ /\.(pm|pl|t)$/i && !exists($trusted{$file})) { - push @files, $name; - }; + if ($name =~ /\.(pm|pl|t)$/i && !exists($trusted{$file})) { + push @files, $name; + }; }; if (scalar @files) { - plan tests => scalar @files; + plan tests => scalar @files; } else { - plan tests => 1; - fail 'No perl files found for Test::Strict checks!'; + plan tests => 1; + fail 'No perl files found for Test::Strict checks!'; }; foreach (@files) {