Bug #38673 for Perl-Critic: NamingConventions::ProhibitMixedCaseVars denies $Foo

Jeffrey Thalhammer via RT wrote: Show quoted text
I agree. Show quoted text
It occurred to me that all you need look for is [[:lower:]][[:upper:]] and not bother with [[:upper:]][[:lower:]]. That eliminates the exception for Foo and makes the MixedCase detection logic even simpler. It does, however, cause FOObar to pass so I think that's no good. Then I realized that all you have to do is ignore the first character. Attached is a patch against trunk to fix both MixedCase modules. I've also updated the Subs and Vars tests so they're testing the same names. And I eliminated a mistaken failure of Foo_Bar from Subs which did not appear in Vars. Show quoted text
Sure, I kicked up the fuss I should fix it. I'll make it default to the PBP policy (even if I don't like it) and give it at least an option to follow the perlstyle policy. If I have some more time I'll try to make the individual attributes tweakable. Is there a new Policy writer's tutorial or a similar policy I can crib from? -- Stabbing you in the face for your own good.

--- lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseSubs.pm (/mirror/perlcritic-trunk/Perl-Critic) (revision 60229) +++ lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseSubs.pm (/local/Perl-Critic) (local) @@ -22,7 +22,10 @@ Readonly::Scalar my $UPPER_LOWER => qr/ [[:upper:]] [[:lower:]] /xms; Readonly::Scalar my $LOWER_UPPER => qr/ [[:lower:]] [[:upper:]] /xms; -Readonly::Scalar my $MIXED_RX => qr{ $UPPER_LOWER | $LOWER_UPPER }xmso; +Readonly::Scalar my $MIXED_RX => qr{ + ^.+ # ignore the first character in the name + (?: $UPPER_LOWER | $LOWER_UPPER ) +}xmso; Readonly::Scalar my $DESC => 'Mixed-case subroutine name'; Readonly::Scalar my $EXPL => [ 45, 46 ]; --- lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseVars.pm (/mirror/perlcritic-trunk/Perl-Critic) (revision 60229) +++ lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseVars.pm (/local/Perl-Critic) (local) @@ -24,7 +24,10 @@ Readonly::Scalar my $PACKAGE_RX => qr/ :: /xms; Readonly::Scalar my $UPPER_LOWER => qr/ [[:upper:]] [[:lower:]] /xms; Readonly::Scalar my $LOWER_UPPER => qr/ [[:lower:]] [[:upper:]] /xms; -Readonly::Scalar my $MIXED_RX => qr{ $UPPER_LOWER | $LOWER_UPPER }xmso; +Readonly::Scalar my $MIXED_RX => qr{ + ^.{2,} # ignore the sigil and the first character in the name + (?: $UPPER_LOWER | $LOWER_UPPER ) +}xmso; Readonly::Scalar my $DESC => 'Mixed-case variable name(s)'; Readonly::Scalar my $EXPL => [ 45, 46 ]; --- t/NamingConventions/ProhibitMixedCaseSubs.run (/mirror/perlcritic-trunk/Perl-Critic) (revision 60229) +++ t/NamingConventions/ProhibitMixedCaseSubs.run (/local/Perl-Critic) (local) @@ -1,10 +1,11 @@ ## name Basic failures. -## failures 4 +## failures 5 ## cut +sub fooBar {} sub fooBAR {} sub FooBar {} -sub Foo_Bar {} +sub FooBAR {} sub FOObar {} #----------------------------------------------------------------------------- @@ -18,6 +19,7 @@ sub FOO_bar {} sub Foo::Bar::grok {} sub Class::Encapsulate::_hidden::_hash_overload {} +sub Foo { return "foo" } #----------------------------------------------------------------------------- # Local Variables: --- t/NamingConventions/ProhibitMixedCaseVars.run (/mirror/perlcritic-trunk/Perl-Critic) (revision 60229) +++ t/NamingConventions/ProhibitMixedCaseVars.run (/local/Perl-Critic) (local) @@ -1,11 +1,13 @@ ## name Basic failures, one variable -## failures 4 +## failures 6 ## cut +my $fooBar; my $fooBAR; my ($fooBAR) = 'nuts'; local $FooBar; our ($FooBAR); +my $FOObar; #----------------------------------------------------------------------------- @@ -34,7 +36,7 @@ our (%FOO_BAR, @BAR_FOO); local ($FOO_BAR, %BAR_foo) = @_; my ($foo_bar, $foo); - +my $Foo; #-----------------------------------------------------------------------------

Attached is a patch for a basic Capitalization policy following PBP Chapter 3.6 the best I could. * I didn't try to tackle named arguments. * I don't know how to detect constants. PPI seems to not pick up "Readonly::Scalar my $foo" as a PPI::Statement::Variable. I just allowed any all caps variables. * I tried to keep the Capitalization policy from leaking into the MixedCase policies. Thus fooBar is allowed by the Capitalization policy, since that's how you'd do a "lower case" name in camelCase, but foo_Bar and FooBar are not. * I decided to put them together in only policy, rather than splitting it out like MixedCase is, in anticipation of having a "use the perlstyle capitalization policy" flag. I also... * switched the page numbers for the MixedCase policies back to page 44 which is the Underscore chapter in PBP. * bumped the severity of the MixedCase policies up to $SEVERITY_LOW since camelCase is widely disdained in Perl culture and is easy to detect. -- 87. If the thought of something makes me giggle for longer than 15 seconds, I am to assume that I am not allowed to do it. -- The 213 Things Skippy Is No Longer Allowed To Do In The U.S. Army http://skippyslist.com/list/

--- lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseSubs.pm (revision 60230) +++ lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseSubs.pm (local) @@ -27,12 +27,12 @@ (?: $UPPER_LOWER | $LOWER_UPPER ) }xmso; Readonly::Scalar my $DESC => 'Mixed-case subroutine name'; -Readonly::Scalar my $EXPL => [ 45, 46 ]; +Readonly::Scalar my $EXPL => [ 44 ]; #----------------------------------------------------------------------------- sub supported_parameters { return () } -sub default_severity { return $SEVERITY_LOWEST } +sub default_severity { return $SEVERITY_LOW } sub default_themes { return qw( core pbp cosmetic ) } sub applies_to { return 'PPI::Statement::Sub' } --- lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseVars.pm (revision 60230) +++ lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseVars.pm (local) @@ -29,12 +29,12 @@ (?: $UPPER_LOWER | $LOWER_UPPER ) }xmso; Readonly::Scalar my $DESC => 'Mixed-case variable name(s)'; -Readonly::Scalar my $EXPL => [ 45, 46 ]; +Readonly::Scalar my $EXPL => [ 44 ]; #----------------------------------------------------------------------------- sub supported_parameters { return () } -sub default_severity { return $SEVERITY_LOWEST } +sub default_severity { return $SEVERITY_LOW } sub default_themes { return qw( core pbp cosmetic ) } sub applies_to { return 'PPI::Statement::Variable' } --- lib/Perl/Critic/Policy/NamingConventions/Capitalization.pm (revision 60230) +++ lib/Perl/Critic/Policy/NamingConventions/Capitalization.pm (local) @@ -0,0 +1,171 @@ +############################################################################## +# $URL$ +# $Date$ +# $Author$ +# $Revision$ +############################################################################## + +package Perl::Critic::Policy::NamingConventions::Capitalization; + +use 5.006001; +use strict; +use warnings; + +use Readonly; + +use Perl::Critic::Utils qw{ :severities }; + +use base 'Perl::Critic::Policy'; + +our $VERSION = '1.090'; + +#----------------------------------------------------------------------------- + +Readonly::Scalar my $LOWER_RX => qr/ [[:lower:]] /xms; +Readonly::Scalar my $UPPER_RX => qr/ [[:upper:]] /xms; +Readonly::Scalar my $PACKAGE_RX => qr/ :: /xms; +Readonly::Scalar my $DESC => 'Capitalization'; +Readonly::Scalar my $EXPL => [ 45 ]; + +#----------------------------------------------------------------------------- + +sub supported_parameters { return () } +sub default_severity { return $SEVERITY_LOWEST } +sub default_themes { return qw( core pbp cosmetic ) } + +sub applies_to { + return 'PPI::Statement::Variable', + 'PPI::Statement::Package', + 'PPI::Statement::Sub'; +} + +#----------------------------------------------------------------------------- + +sub violates { + my ( $self, $elem, undef ) = @_; + + my $violates + = $elem->isa("PPI::Statement::Variable") ? _variable_capitalization($elem) + : $elem->isa("PPI::Statement::Package") ? _package_capitalization($elem) + : $elem->isa("PPI::Statement::Sub") ? _sub_capitalization($elem) + : die "Should never reach this point" + ; + + return $self->violation( $DESC, $EXPL, $elem ) if $violates; + return; +} + +sub _variable_capitalization { + my $elem = shift; + + for my $name ( $elem->variables() ) { + # Fully qualified names are exempt because we can't be responsible for + # other people's sybols. + next if $elem->type() eq 'local' && $name =~ m/$PACKAGE_RX/xms; + + # Allow CONSTANTS + next if $name !~ $LOWER_RX; + + # Words in variable names cannot be capitalized unless + # camelCase is in use + return 1 if $name =~ m{ [^[:alpha:]] $UPPER_RX }xmso; + } + + return; +} + +sub _package_capitalization { + my $elem = shift; + my @names = split /::/, $elem->namespace; + + for my $name (@names) { + # Each word should be capitalized. + return 1 unless $name =~ m{ ^ $UPPER_RX }xmso; + } + + return; +} + +sub _sub_capitalization { + my $elem = shift; + my $name = $elem->name; + + # Words in subroutine names cannot be capitalized + # unless camelCase is in use. + return 1 if $name =~ m{ + (?: ^ | [^[:alpha:]] ) + $UPPER_RX + }xmso; + return; +} + +1; + +__END__ + +#----------------------------------------------------------------------------- + +=head1 NAME + +Perl::Critic::Policy::NamingConventions::Capitalization - Distinguish different program components by case. + + +=head1 AFFILIATION + +This Policy is part of the core L<Perl::Critic|Perl::Critic> distribution. + +=head1 DESCRIPTION + +Conway recommends to distinguish different program components by case. + +Normal subroutines, methods and variables are all in lower case. + + my $foo; # ok + my $foo_bar; # ok + sub foo {} # ok + sub foo_bar {} # ok + + my $Foo; # not ok + my $foo_Bar; # not ok + sub Foo {} # not ok + sub foo_Bar {} # not ok + +Package and class names are capitalized. + + package IO::Thing; # ok + package Web::FooBar # ok + + package foo; # not ok + package foo::Bar; # not ok + +Constants are in all-caps. + + Readonly::Scalar my $FOO = 42; # ok + + Readonly::Scalar my $foo = 42; # not ok + +=head1 CONFIGURATION + +This Policy is not configurable except for the standard options. + + +=head1 BUGS + +The policy cannot currently tell that a variable is being declared as +a constant, thus any variable may be made all-caps. + + +=head1 SEE ALSO + +To control use of camelCase see L<Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs|Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs> and L<Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars|Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars>. + +=cut + +# Local Variables: +# mode: cperl +# cperl-indent-level: 4 +# fill-column: 78 +# indent-tabs-mode: nil +# c-indentation-style: bsd +# End: +# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround : --- t/NamingConventions/Capitalization.run (revision 60230) +++ t/NamingConventions/Capitalization.run (local) @@ -0,0 +1,110 @@ +## name Basic Passes +## failures 0 +## cut + +my $foo; +our $bar; +my($foo, $bar) = ("BLEH", "BLEH"); +my @foo; +my %bar; +sub foo {} + +my $foo123; +my $foo123bar; +sub foo123 {} +sub foo123bar {} + +my $fooBar; # camelCase is ok +my $fooBAR; +sub fooBar {} +sub fooBAR {} + +my $CONSTANT; + +package This::SomeThing; +package This; +package This::Thing; +package Acme::12345; +package YYZ; + +#----------------------------------------------------------------------------- + +## name Basic Failures +## failures 14 +## cut + +my $Foo; +our $Bar; +my @Foo; +my %Bar; +sub Foo {} + +my $foo_Bar; +sub foo_Bar {} + +my $FooBar; +sub FooBar {} + +my $foo123Bar; +sub foo123Bar {} + +package pragma; +package Foo::baz; +package baz::FooBar; + +#----------------------------------------------------------------------------- + +## name Combined passes and fails +## failures 2 +## cut + +my($foo, $Bar); +our($Bar, $foo); + +#----------------------------------------------------------------------------- + +## name Variables from other packages should pass +## failures 0 +## cut + +local $Other::Package::Foo; +$Other::Package::Foo; + +#----------------------------------------------------------------------------- + +## name Only cares about declarations +## failures 0 +## cut +Foo(); +$Foo = 42; + +#----------------------------------------------------------------------------- + +## name Constants must be all caps, passes +## failures 0 +## cut + +Readonly::Scalar my $CONSTANT = 23; + +#----------------------------------------------------------------------------- + +## name Constants must be all caps, failures +## TODO Detect whether a scalar is constant or not +## failures 4 +## cut + +Readonly::Scalar my $Foo = 23; +Readonly::Scalar my $foo = 23; +Readonly::Scalar my $fooBAR = 23; +my $CONSTANT = 23; + + +#----------------------------------------------------------------------------- +# Local Variables: +# mode: cperl +# cperl-indent-level: 4 +# fill-column: 78 +# indent-tabs-mode: nil +# c-indentation-style: bsd +# End: +# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :

Jeffrey Thalhammer via RT wrote: Show quoted text
I figure if you care about how you capitalize one type you're going to care about the rest, so why split it up? I think it will come down to how awkward it is to customize the behavior. Show quoted text
Is it worth differentiating between package variables and file-scoped lexicals? Show quoted text
There's no point in restricting the possible combinations. I've cooked some utility functions to detect whether an element is inside a subroutine which will allow detection of subroutine scoped lexicals. Patch attached. -- If at first you don't succeed--you fail. -- "Portal" demo

--- lib/Perl/Critic/Utils/PPI.pm (revision 60234) +++ lib/Perl/Critic/Utils/PPI.pm (local) @@ -21,6 +21,8 @@ is_ppi_expression_or_generic_statement is_ppi_generic_statement is_ppi_statement_subclass + is_ppi_in_subroutine + is_ppi_subroutine_declaration ); our %EXPORT_TAGS = ( @@ -68,6 +70,40 @@ return $element_class ne 'PPI::Statement'; } +#----------------------------------------------------------------------------- + +sub is_ppi_in_subroutine { + my $elem = shift; + + return unless $elem; + return unless $elem->parent; + + my $insub = 0; + while( $elem = $elem->parent ) { + if( is_ppi_subroutine_declaration($elem) ) { + $insub = 1; + last; + } + } + + return $insub; +} + +#----------------------------------------------------------------------------- + +sub is_ppi_subroutine_declaration { + my $elem = shift; + + return unless $elem; + + return 1 if $elem->isa("PPI::Statement::Sub"); + return 1 if $elem->isa("PPI::Statement") and + $elem->first_element and + $elem->first_element->content eq 'sub'; + return 0; +} + + 1; __END__ @@ -115,6 +151,16 @@ parameter is not L<PPI::Statement|PPI::Statement>. +=item C<is_ppi_subroutine_declaration( $element )> + +Is the $element a named or anonymous subroutine declaration? + + +=item C<is_ppi_in_subroutine( $element )> + +Is the $element inside a subroutine? + + =back --- t/05_utils_ppi.t (revision 60234) +++ t/05_utils_ppi.t (local) @@ -12,7 +12,7 @@ use warnings; use Readonly; -use Test::More tests => 67; +use Test::More tests => 82; #----------------------------------------------------------------------------- @@ -40,6 +40,8 @@ PPI::Statement::Unknown }; + use_ok('PPI::Document'); + use_ok('PPI::Token::Word'); foreach my $class (@PPI_STATEMENT_CLASSES) { use_ok($class); @@ -57,6 +59,8 @@ can_ok('main', 'is_ppi_expression_or_generic_statement'); can_ok('main', 'is_ppi_generic_statement'); can_ok('main', 'is_ppi_statement_subclass'); +can_ok('main', 'is_ppi_in_subroutine'); +can_ok('main', 'is_ppi_subroutine_declaration'); #----------------------------------------------------------------------------- # is_ppi_expression_or_generic_statement tests @@ -269,6 +273,90 @@ } #----------------------------------------------------------------------------- +# is_ppi_subroutine_declaration() tests + +{ + my $test = sub { + my($code, $result) = @_; + my $doc; + my $input; + + $doc = PPI::Document->new(\$code, readonly => 1) if defined $code; + $input = $doc->first_element if defined $doc; + + my $name = defined $code ? $code : "undef"; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + is( + !!is_ppi_subroutine_declaration( $input ), + !!$result, + "is_ppi_subroutine_declaration(): $name" + ); + }; + + $test->('sub {};' => 1); + $test->('sub {}' => 1); + $test->('{}' => 0); + $test->(undef, 0); + $test->('{ sub foo {} }' => 0); + + # These may be controversial. It really depends on what's useful. + $test->('sub foo;' => 1); + $test->('BEGIN {}' => 1); +} + +#----------------------------------------------------------------------------- +# is_ppi_in_subroutine() tests + +{ + my $test = sub { + my($code, $transform, $result) = @_; + my $doc; + my $input; + + $doc = PPI::Document->new(\$code, readonly => 1) if defined $code; + $input = $transform->($doc) if defined $doc; + + my $name = defined $code ? $code : "undef"; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + is( + !!is_ppi_in_subroutine( $input ), + !!$result, + "is_ppi_in_subroutine(): $name" + ); + }; + + $test->(undef, sub {}, 0); + + $test->('my $foo = 42', sub {}, 0); + + $test->('sub foo { my $foo = 42 }', + sub { + my $doc = shift; + $doc->find_first("PPI::Statement::Variable"); + }, + 1 + ); + + $test->('sub { my $foo = 42 };', + sub { + my $doc = shift; + $doc->find_first("PPI::Statement::Variable"); + }, + 1 + ); + + $test->('{ my $foo = 42 };', + sub { + my $doc = shift; + $doc->find_first("PPI::Statement::Variable"); + }, + 0 + ); +} + +#----------------------------------------------------------------------------- # ensure we run true if this test is loaded by # t/05_utils_ppi.t_without_optional_dependencies.t