From: Steve Hancock Date: Sun, 31 Mar 2024 18:00:54 +0000 (-0700) Subject: extend coding and docs for -dma and -wmat X-Git-Tag: 20240202.04~9 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=c646eac81b02f710c12eaa2037865a8be3055fcc;p=perltidy.git extend coding and docs for -dma and -wmat --- diff --git a/CHANGES.md b/CHANGES.md index 7f565c59..9b0ef674 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,25 @@ ## 2024 02 02.03 + - Add options --dump-mismatched-args (or -dma) and + --warn-mismatched-arg-types=s (or -wmat=s). These options look + for and report instances where the number of args expected by a + sub appear to differ from the number passed to the sub. The -dump + version writes the results for a single file to standard output + and exits: + + perltidy -dma somefile.pl >results.txt + + The -warn version formats as normal but reports any issues as warnings in + the error file: + + perltidy -wmat=1 somefile.pl + + It takes a string parameter which is 1 or '*' to activate all checks. + It may be customized with two additional parameters if necessary to + avoid needless warnings, --warn-mismatched-arg-exclusion-list=s and + --warn-mismatched-arg-count-cutoff=n. These are explained in the manual. + - Add option --valign-wide-equals, or -vwe, for issue git #135. Setting this parameter causes the following assignment operators diff --git a/bin/perltidy b/bin/perltidy index f861a85a..1b5d0a68 100755 --- a/bin/perltidy +++ b/bin/perltidy @@ -5208,7 +5208,8 @@ values to have leading signs placed in their own column. For example: [ 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 = ( @@ -5219,8 +5220,6 @@ The current default alignment is strict left justification: [ 10.9, 10.9, 11 ], ); -In a future release B<-vsn> will become the default. - Some points regarding B<-vsn> are: =over 4 @@ -5242,7 +5241,7 @@ B<-vsnl=N>. This value controls formatting of very long columns of numbers and 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 avoids this problem by not adding extra indentation to a run of more than B lines of unsigned numbers. The default value, B, is set to be a number @@ -6051,6 +6050,103 @@ removed, then C<||> must be changed to C: Otherwise, the C<||> will operate on C<$infile> rather than the return value of C. +=item B + +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 and B: + +=over 4 + +=item B calls made to a sub both with and without the B 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 the B 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 + +=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 + +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 or B. For example + + perltidy -wmat='*' somefile.pl + +will format F 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. This number B 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 to pass without errors. The default +value is B, but this should be reduced if possible. The minimum +possible value of B for a program can be determined by running the +dump version, B<-dma>, on that program. + =back =head2 B diff --git a/dev-bin/perltidy_random_setup.pl b/dev-bin/perltidy_random_setup.pl index 8cea7d46..e29da44e 100755 --- a/dev-bin/perltidy_random_setup.pl +++ b/dev-bin/perltidy_random_setup.pl @@ -860,11 +860,12 @@ EOM 'output-line-ending' => [ 'dos', 'win', 'mac', 'unix' ], 'extended-block-tightness-list' => [ 'k', 't', 'kt' ], - 'interbracket-arrow-style' => [ ']{', ']->{', '][', ']->[', '}[', '}->[', '}{', '}->{'], + 'interbracket-arrow-style' => + [ ']{', ']->{', '][', ']->[', '}[', '}->[', '}{', '}->{' ], - 'warn-variable-types' => [ '0', '1' ], - 'warn-mismatched-call-types' => [ '0', '1' ], - 'warn-mismatched-call-cutoff' => [ 0, 5 ], + 'warn-variable-types' => [ '0', '1' ], + 'warn-mismatched-arg-types' => [ '0', '1' ], + 'warn-mismatched-arg-count-cutoff' => [ 0, 5 ], 'space-backslash-quote' => [ 0, 2 ], 'block-brace-tightness' => [ 0, 2 ], @@ -906,7 +907,7 @@ EOM 'space-signature-paren' => [ 0, 2 ], 'break-after-labels' => [ 0, 2 ], - 'want-call-parens' => [ '&', 'open', 'close' ], + 'want-call-parens' => [ '&', 'open', 'close' ], 'nowant-call-parens' => [ 'pop', 'open' ], 'want-trailing-commas' => [ '0', '*', 'm', 'b', 'h', 'i', ' ' ], diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index 8cabcdcc..c104b796 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -928,7 +928,7 @@ EOM dump-block-summary dump-unusual-variables dump-mixed-call-parens - dump-mismatched-calls + dump-mismatched-args ) ) { @@ -3718,9 +3718,9 @@ sub generate_options { $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', '!' ); @@ -3739,7 +3739,7 @@ sub generate_options { $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', '!' ); @@ -3871,7 +3871,7 @@ sub generate_options { 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 @@ -4030,7 +4030,7 @@ sub generate_options { '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 ], @@ -4638,7 +4638,7 @@ EOM # dump-defaults # dump-integer-option-range # dump-long-names - # dump-mismatched-calls + # dump-mismatched-args # dump-mixed-call-parens # dump-options # dump-profile diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index beeb10ac..ad20f0bd 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -306,6 +306,7 @@ my ( %is_anon_sub_brace_follower, %is_anon_sub_1_brace_follower, %is_other_brace_follower, + %is_kwU, # INITIALIZER: sub check_options $controlled_comma_style, @@ -388,9 +389,9 @@ my ( %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. @@ -896,6 +897,10 @@ BEGIN { 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 @@ -1009,8 +1014,8 @@ sub new { $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_] = {}; @@ -1467,7 +1472,7 @@ sub check_options { initialize_warn_variable_types(); - initialize_warn_mismatched_call_types(); + initialize_warn_mismatched_arg_types(); make_bli_pattern(); @@ -6603,12 +6608,12 @@ EOM 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); } @@ -9651,13 +9656,11 @@ sub dump_mixed_call_parens { 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_]; @@ -9767,10 +9770,6 @@ sub scan_call_parens { 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 = []; #--------------------- @@ -9779,6 +9778,8 @@ sub scan_call_parens { 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? @@ -13275,6 +13276,19 @@ sub package_info_maker { }; } ## 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 ) = @_; @@ -13331,8 +13345,18 @@ sub count_list_args { 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 @@ -13362,6 +13386,28 @@ sub count_list_args { $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 } @@ -13882,8 +13928,8 @@ sub cross_check_call_args { 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 @@ -13893,14 +13939,15 @@ sub cross_check_call_args { # 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 @@ -13931,6 +13978,7 @@ sub cross_check_call_args { $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 @@ -14133,7 +14181,7 @@ sub cross_check_call_args { # 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); @@ -14184,9 +14232,10 @@ sub stringify_line_range { 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"; } @@ -14200,20 +14249,20 @@ sub stringify_line_range { 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); @@ -14264,7 +14313,7 @@ sub initialize_warn_mismatched_call_types { 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\*]$/ ) { @@ -14279,9 +14328,9 @@ sub initialize_warn_mismatched_call_types { 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; @@ -14293,27 +14342,27 @@ sub initialize_warn_mismatched_call_types { } } 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 .= <cross_check_call_args(0); return unless ( $rwarnings && @{$rwarnings} ); @@ -14357,11 +14406,10 @@ EOM 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 ) = @_; @@ -33073,7 +33121,6 @@ sub xlp_tweak { 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; @@ -33131,10 +33178,6 @@ sub xlp_tweak { @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 / : % . | ^ < = > || >= != *= => !~ == && |= .= -= =~ += <= @@ -33648,6 +33691,7 @@ sub xlp_tweak { } # 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' diff --git a/perltidyrc b/perltidyrc index 7f13b57d..e218bdda 100644 --- a/perltidyrc +++ b/perltidyrc @@ -17,7 +17,7 @@ # warn if call arg counts differ from sub definitions # (requires version > 20240202.03) ---warn-mismatched-call-types='*' +--warn-mismatched-arg-types='*' # user-defined subs must have args in parens --want-call-parens='&'