perltidy -dma somefile.pl >results.txt
-Two types of issues are reported, types B<a> and B<c>:
+Four types of issues are reported, types B<a>, B<o>, B<u>, and B<i>:
=over 4
$self->Fault();
-This may or may not be an error, but it is worth checking.
+This may or may not be an error, but it is worth checking. It might become an
+error in the future if sub C<Fault> starts to access C<$self>.
-=item B<c:> the B<count> of call args differs from a sub definition
+=item B<o:> (B<overcount): the number of call args exceeds the expected number.
-If a sub appears to expect a specific number of args, and is called with
-more or less than this number, then a mismatch will be reported. For example
+=item B<u:> (B<undercount): the number of call args is less than the expected number.
- sub do_something {
+For example
+
+ sub gnab_gib {
my $self=shift;
my ($v1,$v2)=@_;
...
}
- $self->do_something(43);
+ $self->gnab_gib(42);
In this case, the sub is expecting a total of three args (C<$self>, C<$v1>, and
-C<$v2>) but only receives two (C<$self> and C<42>), so a mismatch is reported.
-This is not necessarily an error because the sub may allow for this
-possibility. This sometimes happens as a code evolves to have new
-functionality. But it can be a source of confusion, and it could be an error,
-so it is worth checking.
+C<$v2>) but only receives two (C<$self> and C<42>), so an undercount is
+reported. This is not necessarily an error because the sub may allow for this
+possibility, but it is worth checking. The simple static processing done by perltidy cannot determine which sub args are optional.
+
+=item B<i:> B<indeterminate:> a specific number of expected args for a sub could not be determined, but it is called with a specific number. This issue is reported for the B<--dump-> option but not the B<--warn-> option.
=back
=over 4
=item *
-Checks are only made for subs which appear to unpack call args in an orderly
-manner at the beginning of the sub from C<@_>, directly and/or with C<shift>
-operations.
-
-=item *
-Subs which appear to have no args are not checked. This restriction is
-necessary to avoid false warnings when a sub actually uses args in a
-complex way.
-
-=item *
-Only calls which appear to be to subs defined within the file being
-processed are checked.
+This option works best for subs which unpack call args in an orderly
+manner near the beginning of the sub from C<@_> and/or with C<shift>
+operations. If individual elements of the @_ array are directly
+accessed then the number of sub args is considered indeterminate.
=item *
Sub calls made without parentheses around the args are not checked.
=item *
Anonymous subs and lexical subs (introduced with C<my>) are not checked.
-=back
+=item *
+Only calls which appear to be to subs defined within the file being
+processed are checked. But note that a file may contain multiple packages.
+=back
=item B<Use --warn-mismatched-args to produce a warning for function calls with
args not matching sub declarations>.
-This is similar to the B<-dump> parameter described above
-except that any mismatches are reported in the error file and
-otherwise formatting continues normally. Thus
+This is similar to the B<-dump> parameter described above except that any
+mismatches are reported in the error file and otherwise formatting continues
+normally. Thus
perltidy -wma somefile.pl
-means format F<somefile.pl> and report any mismatched arg errors found.
Several companion controls are available to avoid unwanted error messages:
=over 4
=item *
B<--warn-mismatched-arg-types=s>, or B<-wmat=s>, can be used to
-select specific tests, either type B<a> (arrow test) or B<c> (mismatched counts). Both checks may be requested with B<-wmat='*'> or B<-wmat=1>. This is the default.
+select specific tests, type B<a> (arrow test) or B<o> (overcounts) or B<u> (undercounts). All checks may be requested with B<-wmat='*'> or B<-wmat=1>. This is the default.
-To restrict the check to a specific warning type, set the string equal to the letter of that warning, either B<a> or B<c>. For example
+To restrict the check to a specific warning type, set the string equal to the letter of that warning, any B<a>, B<o>, or B<u>. For example
- perltidy -wmat='c' somefile.pl
+ perltidy -wmat='a o' somefile.pl
-will format F<somefile.pl> and report any call arg count mismatches found but
-will skip checking for arrow-type mismatches.
+will format F<somefile.pl> and report any arrow-type mismatches and overcount mismatches, but will skip undercount mismatches.
=item *
B<--warn-mismatched-arg-exclusion-list>, or B<-wmaxl=string>, can be given to
To illustrate these controls,
- perltidy -wma -wmat='c' -wmaxl='new old' -wmauc=2 somefile.pl
+ perltidy -wma -wmat='o u' -wmaxl='new old' -wmauc=2 somefile.pl
-means format F<somefile.pl> as usual and check for mismatched counts but not
-arrows. Skip checking for any sub named C<new> or C<old>, and only warn of
-undercounts for subs expecting more than 2 args.
+means format F<somefile.pl> as usual and check for mismatched overcounts and
+undercounts but not arrows. Skip checking for any sub named C<new> or C<old>,
+and only warn of undercounts for subs expecting more than 2 args.
=back
return;
} ## end sub parent_sub_seqno
+sub parent_sub_seqno_by_K {
+ my ( $self, $KK ) = @_;
+
+ # Find sequence number of the sub or asub which contains a given token
+ # Given:
+ # $K = index K of a token
+ # Returns:
+ # $seqno of the sub (or asub), or
+ # nothing if no sub found
+ return unless defined($KK);
+
+ my $seqno_sub;
+ my $parent_seqno = $self->parent_seqno_by_K($KK);
+ if ( $self->[_ris_sub_block_]->{$parent_seqno}
+ || $self->[_ris_asub_block_]->{$parent_seqno} )
+ {
+ $seqno_sub = $parent_seqno;
+ }
+ else {
+ $seqno_sub = $self->parent_sub_seqno($parent_seqno);
+ }
+ return $seqno_sub;
+} ## end sub parent_sub_seqno_by_K
+
sub is_in_block_by_i {
my ( $self, $i ) = @_;
# Pull out optional optimization flag. If this is true then there
# may be calls to this sub with args, so we should to do a full
# search of the entire sub if this would cause a -wma warning.
- my $saw_call_with_args = $item->{saw_call_with_args};
+ my $max_arg_count = $item->{max_arg_count};
# Do not count the args if we saw '$_[...'
if ( $self->[_rDOLLAR_underscore_by_sub_seqno_]->{$seqno_block} ) {
return;
}
- #------------------------------------------------------------
- # Otherwise look for =shift; and =@_; within sub block braces
- #------------------------------------------------------------
+ #-------------------------------------------------------------
+ # Main loop: look for =shift; and =@_; within sub block braces
+ #-------------------------------------------------------------
my $seqno = $seqno_block;
my $K_opening = $self->[_K_opening_container_]->{$seqno};
my $K_closing = $self->[_K_closing_container_]->{$seqno};
my $token = $rLL->[$KK]->[_TOKEN_];
if ( $type eq 'i' ) {
- #--------------
# look for '@_'
- #--------------
if ( $token eq '@_' ) {
+
+ # Found '@_': the search will end here
my $level = $rLL->[$KK]->[_LEVEL_];
# Give up upon finding @_ at a lower level
my $token_mm = $rLL->[$K_mm]->[_TOKEN_];
my $seqno_mm = $rLL->[$K_mm]->[_TYPE_SEQUENCE_];
- #-----------------------------------------------
- # RETURN 1: Count args in the list ( ... ) = @_;
- #-----------------------------------------------
+ # Count args in the list ( ... ) = @_;
if ( $seqno_mm && $token_mm eq ')' ) {
$item->{seqno_list} = $seqno_mm;
$item->{is_signature} = 0;
# Give up if we find an indexed ref to $_[..]
elsif ( $token eq '$_' ) {
+
+ # Found $_: currently the search ends at '$_['
+ # TODO: eventually this can be handled
my $Kn = $self->K_next_code($KK);
if ( $Kn && $rLL->[$Kn]->[_TOKEN_] eq '[' ) {
return;
}
}
+ # Give up at something like '&func;'
+ elsif ( substr( $token, 0, 1 ) eq '&' ) {
+ my $Kn = $self->K_next_code($KK);
+ if ( $Kn && $rLL->[$Kn]->[_TOKEN_] ne '(' ) {
+ return;
+ }
+ }
+
else {
# continue search
}
}
elsif ( $is_if_unless{$token} ) {
- # RETURN 2: Optional early return.
+ #-------------------------------
+ # RETURN: Optional early return.
+ #-------------------------------
# Give up and exit at 'if' or 'unless' if we have seen a few
# semicolons following the last 'shift'. The number '2' here
# has been found to work well.
if ( $semicolon_count_after_last_shift > 2 ) {
-
- # FIXME: should also look at call counts
- if ( !$saw_pop_at_underscore
- && $KK >= $K_last_at_underscore )
+ if ( !defined($max_arg_count)
+ || $max_arg_count <= $shift_count )
{
- $item->{shift_count} = $shift_count;
- $item->{self_name} = $self_name;
+
+ if ( !$saw_pop_at_underscore
+ && $KK >= $K_last_at_underscore )
+ {
+ $item->{shift_count} = $shift_count;
+ $item->{self_name} = $self_name;
+ }
+ return;
}
- return;
}
}
else {
my $seqno_test = $rLL->[$KK]->[_TYPE_SEQUENCE_];
- #-------------------------------------------------
- # If we reach a sub declearation within this sub..
- #-------------------------------------------------
+ #---------------------------------------------
+ # Skip past a sub declearation within this sub
+ #---------------------------------------------
if ( $self->[_ris_sub_block_]->{$seqno_test}
|| $self->[_ris_asub_block_]->{$seqno_test} )
{
- # skip past this sub and keep going
my $Kc = $self->[_K_closing_container_]->{$seqno_test};
+ return unless ( $Kc && $Kc > $KK );
$KK = $Kc;
-## if ( !$saw_pop_at_underscore
-## && $KK >= $K_last_at_underscore )
-## {
-## $item->{shift_count} = $shift_count;
-## $item->{self_name} = $self_name;
-## }
-## return;
}
}
}
# see get_here_text.in
next if $token !~ /^ [^<]* << [~]? \' /x;
- my $here_text = EMPTY_STRING; ##BOOGA
+ my $here_text = EMPTY_STRING;
my $ix_line = $rLL->[$KK]->[_LINE_INDEX_];
my $ix_HERE = $ix_HERE_END;
if ( $ix_HERE < $ix_line ) { $ix_HERE = $ix_line }
}
}
- # RETURN 3: End return
- if ( !$saw_pop_at_underscore
- && $KK >= $K_last_at_underscore )
- {
- $item->{shift_count} = $shift_count;
- $item->{self_name} = $self_name;
- }
+ #--------------------------------
+ # the whole file has been scanned
+ #--------------------------------
+ # TODO: handle pure refs to '$['
+ $item->{shift_count} = $shift_count;
+ $item->{self_name} = $self_name;
return;
} ## end sub count_sub_args
# Set flag indicating if args may be expected to allow optimization
my $call_item = $rprelim_call_info->{$key};
- $item->{saw_call_with_args} =
- defined($call_item) && $call_item->{max_arg_count};
+ $item->{max_arg_count} = $call_item->{max_arg_count};
# Add a count of the number of args
$self->count_sub_args($item);
# The current possible checks are indicated by these letters:
# a = both method and non-method calls to a sub
# - even for two subs in a different package
- # c = call arg counts differ from from number expected by a sub
- # - except for undercount if expecting N or less (N=2 or 3 by default)
+ # o = overcount: call arg counts exceed number expected by a sub
+ # u = undercount: call arg counts less than number expected by a sub
+ # - except if expecting N or less (N=4 by default)
+ # i = indeterminate: expected number of args was not determined
# initialize for dump mode
- my $ris_mismatched_call_type = { 'a' => 1, 'c' => 1, 'i' => 1 };
+ my $ris_mismatched_call_type = { 'a' => 1, 'o' => 1, 'u' => 1, 'i' => 1 };
my $mismatched_arg_undercount_cutoff = 0;
my $ris_mismatched_call_excluded_name = {};
my $key_sub = $item->{package} . '::' . $item->{name};
$is_self_call = !$common_hash{$key_sub}->{direct_calls};
}
+
+ # TODO: else see if $caller_name is blessed in this sub
+ # This is a low priority update
}
# Save this method call as either an internal (self) or external call
push @warnings,
{
line_number => $lno,
- letter => 'arrows',
+ letter => 'a',
name => $name,
shift_count => $shift_count,
min_arg_count => $min_arg_count,
if ( !defined($rsub_item) ) {
}
- # issue 'i': subs for which a specific positive arg count
- # could not be determined or is zero.
- elsif ( !$rsub_item->{shift_count} ) {
+ # issue 'i': indeterminate. Could not determine a specific arg count
+ elsif ( !defined( $rsub_item->{shift_count} ) ) {
if ( $ris_mismatched_call_type->{'i'} ) {
my $letter = 'i';
- # skip *:*:* and 0:0:0
+ # skip *:*:* (no disagreement - call counts also indeterminate)
next
if ( $shift_count eq $min_arg_count
&& $shift_count eq $max_arg_count );
- my $note = "indeterminate";
- if ( !defined($shift_count) ) { $shift_count = '*' }
+ my $note = "indeterminate sub arg count";
push @warnings,
{
line_number => $lno,
}
}
- # issue 'c': number of call args differs from sub declaration
- elsif ( $num_over_count || $num_under_count ) {
- if ( $ris_mismatched_call_type->{'c'} ) {
+ # check counts
+ else {
+
+ # issue 'o': overcount
+ if ($num_over_count) {
+ if ( $ris_mismatched_call_type->{'o'} ) {
+
+ my $lines_over_count = stringify_line_range($rover_count);
+ my $total = $num_direct + $num_self;
+ my $note;
+ my $letter = 'o';
+ $note =
+"excess args at $num_over_count of $total calls($lines_over_count)";
+
+ push @warnings,
+ {
+ line_number => $lno,
+ letter => $letter,
+ name => $name,
+ shift_count => $shift_count,
+ min_arg_count => $min_arg_count,
+ max_arg_count => $max_arg_count,
+ note => $note,
+ };
+ }
+ }
+
+ # issue 'u': undercount
+ if ($num_under_count) {
# Skip the warning for small lists with undercount
- if ( $num_over_count
- || $shift_count > $mismatched_arg_undercount_cutoff )
+ if ( $ris_mismatched_call_type->{'u'}
+ && $shift_count >= $mismatched_arg_undercount_cutoff )
{
- my $lines_over_count = stringify_line_range($rover_count);
my $lines_under_count = stringify_line_range($runder_count);
my $total = $num_direct + $num_self;
my $note;
- my $letter = 'count';
- if ( $num_over_count && $num_under_count ) {
- $note =
-"calls with both excess args ($lines_over_count) and missing args($lines_under_count)";
- }
- elsif ($num_over_count) {
- $note =
-"excess args at $num_over_count of $total calls($lines_over_count)";
- }
- else {
- $note =
+ my $letter = 'u';
+ $note =
"missing args at $num_under_count of $total calls($lines_under_count)";
- }
push @warnings,
{
}
}
}
-
- # issue 'e': no mismatch
- else {
- # nothing to do
- }
}
if (@warnings) {
# Specific options:
# a - mismatched arrow operator calls
- # c - call arg count mismatch
+ # o - overcount
+ # u - undercount
# Other controls:
# 0 - none of the above
# * - all of the above
# Example:
- # -wmat='a c' : do check types 'a' and 'c'
- # -wmat='c' : do check type 'c'
+ # -wmat='a o' : do check types 'a' and 'o'
+ # -wmat='u' : do check type 'u'
- my @all_opts = qw(a c);
+ my @all_opts = qw(a o u);
my %is_valid_option;
@is_valid_option{@all_opts} = (1) x scalar(@all_opts);
if ( @opts == 1 ) {
my $opt = $opts[0];
- # Split a single option of bundled letters like 'ac' into 'a c'
+ # Split a single option of bundled letters like 'ao' into 'a o'
# but give a warning because this may not be allowed in the future
if ( length($opt) > 1 ) {
@opts = split //, $opt;
return;
}
else {
- # should be one of a c - catch any error below
+ # should be one of a o u - catch any error below
}
}
projects / perltidy.git / commitdiff