[ 10.9, 10.9, 11 ],
);
-The current default alignment is strict left justification:
+The default is B<-vsn>. This can be turned off to get is strict left
+justification:
# perltidy -nvsn
my @correct = (
[ 10.9, 10.9, 11 ],
);
-In a future release B<-vsn> will become the default.
-
Some points regarding B<-vsn> are:
=over 4
should not normally need to be changed. To see its purpose, consider a very
long column of just unsigned numbers, say 1000 lines. If we add a single
negative number, it is undesirable to move all of the other numbers over by one
-space. This would create many lines of file differences but not really improve
+space. This could create many lines of file differences but not really improve
the appearance when a local section of the table was viewed. The number B<N>
avoids this problem by not adding extra indentation to a run of more than B<N>
lines of unsigned numbers. The default value, B<N=20>, is set to be a number
Otherwise, the C<||> will operate on C<$infile> rather than the return value of
C<open>.
+=item B<Use --dump-mismatched-args to find function calls with args not matching sub declarations>
+
+The parameter B<--dump-mismatched-args>, or B<-dma>, causes perltidy to
+examine the definitions of subroutines in a file, and calls to those subs,
+and report any apparent differences. Like all B<--dump> commands, it
+writes its report to standard output and exits immediately. For example
+
+ perltidy -dma somefile.pl >results.txt
+
+Two types of issues are reported, types B<a> and B<c>:
+
+=over 4
+
+=item B<a:> calls made to a sub both with and without the B<arrow> operator
+
+For example the following two lines would be reported as a mismatch:
+
+ Fault();
+
+and
+
+ $self->Fault();
+
+This may or may not be an error, but it is worth checking.
+
+=item B<c:> the B<count> of call args differs from a sub definition
+
+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
+
+ sub do_something {
+ my $self=shift;
+ my ($v1,$v2)=@_;
+ ...
+ }
+
+ $self->do_something(43);
+
+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.
+
+=back
+
+B<Some Limitations:>
+
+=over 4
+
+=item *
+Only sub definitions within the file being processed are checked. Anonymous subs and lexical subs (introduced with 'my') are not currently checked.
+
+=item *
+The number of arguments expected by a sub is determined by scanning the initial
+lines of the sub for extractions from C<@_>. If args are extracted or used in
+later code, then that sub will be skipped, or the analysis could be in error.
+
+=item *
+Only calls which appear to be to subs defined within the file are checked.
+
+=item *
+Sub calls made without parentheses around the args are not checked.
+
+=back
+
+=item B<Use --warn-mismatched-arg-types=s to produce a warning for function calls with args not matching sub declarations>
+
+The parameter B<--warn-mismatched-arg-types=s>, or B<-wmat=s>, can be used to
+produce a warning message when perltidy formats a file and certain of the above
+mismatchs is detected during formatting. Both checks may be requested with
+B<-wmat='*'> or B<-wmat=1>.
+
+The default is not to do any of these checks, which can also be indicated with B<-wmat=0>.
+
+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
+
+ perltidy -wmat='*' somefile.pl
+
+will format F<somefile.pl> and report any call arg mismatches found.
+
+A companion control parameter B<--warn-mismatched-arg-exclusion-list>, or
+B<-wmaxl=string>, can be given to skip the warning checks for a list of
+subroutine names.
+
+Another control parameter B<--warn-mismatched-arg-cutoff-count=n>, or
+B<-wmacc=n>, can be used to avoid warnings when the identified number of args
+passed to a sub is less than the number of args expected by the sub, and both
+are less than or equal to B<n>. This number B<n> is the number of
+args from the point of view of the sub definition, so an object passed
+with an arrow operator counts as one arg. Many programs will need to
+use a small integer value for B<n> to pass without errors. The default
+value is B<n=4>, but this should be reduced if possible. The minimum
+possible value of B<n> for a program can be determined by running the
+dump version, B<-dma>, on that program.
+
=back
=head2 B<Working with MakeMaker, AutoLoader and SelfLoader>
dump-block-summary
dump-unusual-variables
dump-mixed-call-parens
- dump-mismatched-calls
+ dump-mismatched-args
)
)
{
$add_option->( 'want-call-parens', 'wcp', '=s' );
$add_option->( 'nowant-call-parens', 'nwcp', '=s' );
- $add_option->( 'warn-mismatched-call-types', 'wmct', '=s' );
- $add_option->( 'warn-mismatched-call-cutoff', 'wmcc', '=i' );
- $add_option->( 'warn-mismatched-call-exclusion-list', 'wmcxl', '=s' );
+ $add_option->( 'warn-mismatched-arg-types', 'wmat', '=s' );
+ $add_option->( 'warn-mismatched-arg-count-cutoff', 'wmacc', '=i' );
+ $add_option->( 'warn-mismatched-arg-exclusion-list', 'wmaxl', '=s' );
$add_option->( 'add-interbracket-arrows', 'aia', '!' );
$add_option->( 'delete-interbracket-arrows', 'dia', '!' );
$add_option->( 'dump-defaults', 'ddf', '!' );
$add_option->( 'dump-integer-option-range', 'dior', '!' );
$add_option->( 'dump-long-names', 'dln', '!' );
- $add_option->( 'dump-mismatched-calls', 'dmc', '!' );
+ $add_option->( 'dump-mismatched-args', 'dma', '!' );
$add_option->( 'dump-mixed-call-parens', 'dmcp', '!' );
$add_option->( 'dump-options', 'dop', '!' );
$add_option->( 'dump-profile', 'dpro', '!' );
maximum-unexpected-errors=0
memoize
minimum-space-to-comment=4
- warn-mismatched-call-cutoff=4
+ warn-mismatched-arg-count-cutoff=4
nobrace-left-and-indent
nocuddled-else
nodelete-old-whitespace
'maximum-line-length' => [ 0, undef ],
'maximum-unexpected-errors' => [ 0, undef ],
'minimum-space-to-comment' => [ 0, undef ],
- 'warn-mismatched-call-cutoff' => [ 0, undef ],
+ 'warn-mismatched-arg-count-cutoff' => [ 0, undef ],
'one-line-block-nesting' => [ 0, 1 ],
'one-line-block-semicolons' => [ 0, 2 ],
'paren-tightness' => [ 0, 2 ],
# dump-defaults
# dump-integer-option-range
# dump-long-names
- # dump-mismatched-calls
+ # dump-mismatched-args
# dump-mixed-call-parens
# dump-options
# dump-profile
%is_anon_sub_brace_follower,
%is_anon_sub_1_brace_follower,
%is_other_brace_follower,
+ %is_kwU,
# INITIALIZER: sub check_options
$controlled_comma_style,
%warn_variable_types,
%is_warn_variable_excluded_name,
- # INITIALIZER: sub initialize_warn_mismatched_call_types
- %warn_mismatched_call_types,
- %is_warn_mismatched_call_excluded_name,
+ # INITIALIZER: sub initialize_warn_mismatched_arg_types
+ %warn_mismatched_arg_types,
+ %is_warn_mismatched_arg_excluded_name,
# regex patterns for text identification.
# Most can be configured by user parameters.
push @obf, ',';
@is_other_brace_follower{@obf} = (1) x scalar(@obf);
+ # 'k'=builtin keyword, 'U'=user defined sub, 'w'=unknown bareword
+ @q = qw( k w U );
+ @is_kwU{@q} = (1) x scalar(@q);
+
} ## end BEGIN
{ ## begin closure to count instances
$self->[_ris_asub_block_] = {};
$self->[_ris_sub_block_] = {};
- # Variables for --warn-mismatched-call-types and
- # --dump-mismatched-calls
+ # Variables for --warn-mismatched-arg-types and
+ # --dump-mismatched-args
$self->[_rK_package_list_] = [];
$self->[_rsub_call_paren_info_by_seqno_] = {};
$self->[_rK_sub_by_seqno_] = {};
initialize_warn_variable_types();
- initialize_warn_mismatched_call_types();
+ initialize_warn_mismatched_arg_types();
make_bli_pattern();
if ( %warn_variable_types
&& $self->[_logger_object_] );
- $self->warn_mismatched_calls()
- if ( $rOpts->{'warn-mismatched-call-types'}
+ $self->warn_mismatched_args()
+ if ( $rOpts->{'warn-mismatched-arg-types'}
&& $self->[_logger_object_] );
- if ( $rOpts->{'dump-mismatched-calls'} ) {
- $self->dump_mismatched_calls();
+ if ( $rOpts->{'dump-mismatched-args'} ) {
+ $self->dump_mismatched_args();
Exit(0);
}
and cmp continue do else elsif eq ge gt le lt ne not or xor );
@skip_keywords{@q} = (1) x scalar(@q);
- # Types which will be checked:
- # 'k'=builtin keyword, 'U'=user defined sub, 'w'=unknown bareword
- my %is_kwU = ( 'k' => 1, 'w' => 1, 'U' => 1 );
-
my %call_counts;
foreach my $KK ( 0 .. @{$rLL} - 1 ) {
+ # Types which will be checked:
+ # 'k'=builtin keyword, 'U'=user defined sub, 'w'=unknown bareword
next unless ( $is_kwU{ $rLL->[$KK]->[_TYPE_] } );
my $type = $rLL->[$KK]->[_TYPE_];
return unless (%call_paren_style);
my $opt_name = 'want-call-parens';
- # Types which will be checked:
- # 'k'=builtin keyword, 'U'=user defined sub, 'w'=unknown bareword
- my %is_kwU = ( 'k' => 1, 'w' => 1, 'U' => 1 );
-
my $rwarnings = [];
#---------------------
my $rLL = $self->[_rLL_];
foreach my $KK ( 0 .. @{$rLL} - 1 ) {
+ # Types which will be checked:
+ # 'k'=builtin keyword, 'U'=user defined sub, 'w'=unknown bareword
next unless ( $is_kwU{ $rLL->[$KK]->[_TYPE_] } );
# Are we looking for this word?
};
} ## end sub package_info_maker
+use constant DEBUG_COUNT => 0;
+
+# A missing paren after these does not indicate a parenless function with
+# multiple call args. See also %skip_keywords in sub dump_mixed_call_parens.
+my %is_non_function_call_keyword;
+
+BEGIN {
+ my @q = qw(my our local state
+ and cmp continue do else elsif eq ge gt le lt ne not or xor
+ undef defined length ord delete scalar );
+ @is_non_function_call_keyword{@q} = (1) x scalar(@q);
+}
+
sub count_list_args {
my ( $self, $rarg_list ) = @_;
if ( $type eq 'i' || $type eq 't' ) {
my $sigil = substr( $token, 0, 1 );
- # Give up if we find list sigils
- if ( $sigil eq '%' || $sigil eq '@' ) { return }
+ # Give up if we find list sigils not preceded by 'scalar'
+ if ( $sigil eq '%' || $sigil eq '@' ) {
+ my $K_last = $self->K_previous_code($KK);
+ if ( defined($K_last) ) {
+ my $type_last = $rLL->[$K_last]->[_TYPE_];
+ my $token_last = $rLL->[$K_last]->[_TOKEN_];
+ next if ( $type_last eq 'k' && $token_last eq 'scalar' );
+ next if ( $type_last eq '+' );
+ next if ( $type_last eq q{\\} );
+ }
+ return;
+ }
elsif ($sigil eq '$'
&& !$is_signature
$arg_count++;
}
+ # give up at a paren-less call
+ elsif ( $is_kwU{$type} ) {
+ next if ( $type eq 'k' && $is_non_function_call_keyword{$token} );
+ my $Kn = $self->K_next_code($KK);
+ next unless defined($Kn);
+ my $token_Kn = $rLL->[$Kn]->[_TOKEN_];
+ next
+ if ( $token_Kn eq '('
+ || $token_Kn eq ')'
+ || $token_Kn eq '=>'
+ || $token_Kn eq '->'
+ || $token_Kn eq ',' );
+
+ if (DEBUG_COUNT) {
+ my $lno = $rLL->[$KK]->[_LINE_INDEX_] + 1;
+ my $input_stream_name = get_input_stream_name();
+ print {*STDERR}
+"DEBUG_COUNT: file $input_stream_name line=$lno type=$type tok=$token token_Kn=$token_Kn\n";
+ }
+ return;
+ }
+
else {
# continue search
}
my ( $self, $warn_mode ) = @_;
# Input parameter:
- # $warn_mode = true for --warn-mismatched-call-types
- # $warn_mode = false for --dump-mismatched-calls
+ # $warn_mode = true for --warn-mismatched-arg-types
+ # $warn_mode = false for --dump-mismatched-args
# The current possible checks are indicated by these letters:
# a = both method and non-method calls to a sub
# initialize for dump mode
my $ris_mismatched_call_type = { 'a' => 1, 'c' => 1 };
- my $mismatched_call_cutoff = 0;
+ my $mismatched_arg_count_cutoff = 0;
my $ris_mismatched_call_excluded_name = {};
if ($warn_mode) {
- $ris_mismatched_call_type = \%warn_mismatched_call_types;
- $mismatched_call_cutoff = $rOpts->{'warn-mismatched-call-cutoff'};
+ $ris_mismatched_call_type = \%warn_mismatched_arg_types;
+ $mismatched_arg_count_cutoff =
+ $rOpts->{'warn-mismatched-arg-count-cutoff'};
$ris_mismatched_call_excluded_name =
- \%is_warn_mismatched_call_excluded_name;
+ \%is_warn_mismatched_arg_excluded_name;
}
# hardwired name exclusions
$self->update_sub_call_paren_info($rpackage_lookup_list);
# Names commonly used like '$self'. This list will be augmented as we go.
+ # NOTE: This is not currently used but might be in the future.
my %self_names = ( '$self' => 1, '$class' => 1 );
# Hash to combine info for subs and calls
# Skip the warning for small lists with undercount
my $expect = $num_self ? $shift_count : $shift_count + 1;
if ( $num_over_count
- || $expect > $mismatched_call_cutoff )
+ || $expect > $mismatched_arg_count_cutoff )
{
my $lines_over_count = stringify_line_range($rover_count);
my $lines_under_count = stringify_line_range($runder_count);
my ($rcalls) = @_;
my $string = EMPTY_STRING;
if ( $rcalls && @{$rcalls} ) {
- my $num = @{$rcalls};
- my $lno_beg = $rcalls->[0]->{line_number};
- my $lno_end = $rcalls->[-1]->{line_number};
+ my @sorted = sort { $a <=> $b } @{$rcalls};
+ my $num = @sorted;
+ my $lno_beg = $sorted[0]->{line_number};
+ my $lno_end = $sorted[-1]->{line_number};
if ( $num == 1 ) {
$string = "line $lno_beg";
}
return $string;
} ## end sub stringify_line_range
-sub initialize_warn_mismatched_call_types {
+sub initialize_warn_mismatched_arg_types {
# Initialization for:
- # --warn-mismatched-call-types=s and
- # --warn-mismatched-call-exclusion-list=s
- %warn_mismatched_call_types = ();
- %is_warn_mismatched_call_excluded_name = ();
+ # --warn-mismatched-arg-types=s and
+ # --warn-mismatched-arg-exclusion-list=s
+ %warn_mismatched_arg_types = ();
+ %is_warn_mismatched_arg_excluded_name = ();
# Note: coding here is similar to sub initialize_warn_variable_types
#-----------------------------------
- # Parse --warn-mismatched-call-types
+ # Parse --warn-mismatched-arg-types
#-----------------------------------
- my $wmct_key = 'warn-mismatched-call-types';
+ my $wmct_key = 'warn-mismatched-arg-types';
my $wmct_option = $rOpts->{$wmct_key};
return unless ($wmct_option);
my $msg = EMPTY_STRING;
foreach my $opt (@opts) {
if ( $is_valid_option{$opt} ) {
- $warn_mismatched_call_types{$opt} = 1;
+ $warn_mismatched_arg_types{$opt} = 1;
}
else {
if ( $opt =~ /^[01\*]$/ ) {
if ($msg) { Die($msg) }
#--------------------------------------------
- # Parse --warn-mismatched-call-exclusion-list
+ # Parse --warn-mismatched-arg-exclusion-list
#--------------------------------------------
- my $wmcxl_key = 'warn-mismatched-call-exclusion-list';
+ my $wmcxl_key = 'warn-mismatched-arg-exclusion-list';
my $excluded_names = $rOpts->{$wmcxl_key};
if ($excluded_names) {
$excluded_names =~ s/,/ /g;
}
}
if ($err_msg) { Die($err_msg) }
- @is_warn_mismatched_call_excluded_name{@xl} = (1) x scalar(@xl);
+ @is_warn_mismatched_arg_excluded_name{@xl} = (1) x scalar(@xl);
}
return;
-} ## end sub initialize_warn_mismatched_call_types
+} ## end sub initialize_warn_mismatched_arg_types
-sub warn_mismatched_calls {
+sub warn_mismatched_args {
my ($self) = @_;
- # process a --warn-mismatched-call-types command
+ # process a --warn-mismatched-arg-types command
# additional control parameters are:
- # - mismatched-call-exclusion-list
+ # - mismatched-arg-exclusion-list
# - warn-mismatched-call-count-cutoff
- my $wmc_key = 'warn-mismatched-call-types';
- my $wmc_option = $rOpts->{$wmc_key};
+ my $wma_key = 'warn-mismatched-arg-types';
+ my $wma_option = $rOpts->{$wma_key};
my $rwarnings = $self->cross_check_call_args(1);
return unless ( $rwarnings && @{$rwarnings} );
- my $output_string = "Begin scan for --$wmc_key=$wmc_option\n";
+ my $output_string = "Begin scan for --$wma_key=$wma_option\n";
$output_string .= <<EOM;
Line:Mismatch:Name:#args:Min:Max: note
EOM
$output_string .=
"$lno:$letter:$name:$shift_count:$min_arg_count:$max_arg_count: $note\n";
}
- $output_string .= "End scan for --$wmc_key=$wmc_option:\n";
+ $output_string .= "End scan for --$wma_key=$wma_option:\n";
warning($output_string);
return;
-} ## end sub warn_mismatched_calls
+} ## end sub warn_mismatched_args
-sub dump_mismatched_calls {
+sub dump_mismatched_args {
my ($self) = @_;
- # process a --dump-mismatched-calls command
+ # process a --dump-mismatched-args command
my $rwarnings = $self->cross_check_call_args(0);
return unless ( $rwarnings && @{$rwarnings} );
my $max_arg_count = $item->{max_arg_count};
$output_string .=
"$lno:$letter:$name:$shift_count:$min_arg_count:$max_arg_count: $note\n";
- $output_string .= "$lno:$letter:$name: $note\n";
}
print {*STDOUT} $output_string;
return;
-} ## end sub dump_mismatched_calls
+} ## end sub dump_mismatched_args
sub check_for_old_break {
my ( $self, $KK, $rkeep_break_hash, $rbreak_hash ) = @_;
my %operator_map;
my %is_k_w_n_C_bang;
my %is_my_local_our;
- my %is_kwU;
my %is_use_like;
my %is_binary_type;
my %is_binary_keyword;
@q = qw( use );
@is_use_like{@q} = (1) x scalar(@q);
- # leading token types which may be used to make a container name
- @q = qw( k w U );
- @is_kwU{@q} = (1) x scalar(@q);
-
# token types which prevent using leading word as a container name
@q = qw(
x / : % . | ^ < = > || >= != *= => !~ == && |= .= -= =~ += <=
}
# The container name is only built of certain types:
+ # 'k'=builtin keyword, 'U'=user defined sub, 'w'=unknown bareword
last if ( !$is_kwU{$type} );
# Normally it is made of one word, but two words for 'use'
projects / perltidy.git / commitdiff