From 18d5addaea6bbec730aa54a2d157dd7e10d51526 Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Fri, 1 Sep 2023 17:29:35 -0700 Subject: [PATCH] activate ControlStructures::ProhibitUnlessBlocks, part 3 --- .perlcriticrc | 25 ++++----- lib/Perl/Tidy.pm | 41 +++++++------- lib/Perl/Tidy/Formatter.pm | 108 +++++++++++++++++++------------------ 3 files changed, 85 insertions(+), 89 deletions(-) diff --git a/.perlcriticrc b/.perlcriticrc index 4d1edd25..a24e1f1e 100644 --- a/.perlcriticrc +++ b/.perlcriticrc @@ -33,8 +33,7 @@ verbose = %f: [%p] %m at line %l, column %c.\n # sure if this can be avoided. [-Subroutines::ProhibitNestedSubs] -# Make adjustment so that we don't require arg unpacking for very short -# (possibly time-critical) subs. +# Make an exception for very short (possibly time-critical) subs. [Subroutines::RequireArgUnpacking] short_subroutine_statements = 2 @@ -57,8 +56,8 @@ short_subroutine_statements = 2 # supported, this restriction can be deleted [-Variables::RequireLocalizedPunctuationVars] -# sub 'backup_method_copy' in Perl::Tidy.pm has about 25 lines between open -# and close, largely comments, so set the limit a bit higher. +# Set the line limit a bit higher for sub 'backup_method_copy' in Perl::Tidy.pm +# which has about 25 lines between open and close, largely comments. [InputOutput::RequireBriefOpen] lines=30 @@ -88,6 +87,7 @@ max_nests=9 [-ControlStructures::ProhibitCascadingIfElse] # This is a reasonable starting point but does not work well as a rigid rule. +# So we have to turn it off. [-ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions] # This is a good general policy but not always possible in time-critical subs @@ -107,8 +107,7 @@ max_nests=9 max_characters=250 # A problem with ReqireExtendedFormatting is that it makes things needlessly -# complex when matching things like line feeds and carriage returns. So -# skip this. +# complex when matching things like line feeds and carriage returns. [-RegularExpressions::RequireExtendedFormatting] #-------------------------------------------------------------- @@ -152,13 +151,6 @@ max_characters=250 # to see what is going on. [-ControlStructures::ProhibitPostfixControls] -# Sometimes an unless statement is clearer than an if block, so why not use -# it? For example, I might prefer the first of these: -# return unless ($everything_is_ok); -# vs. -# return if (!$everything_is_ok); -[-ControlStructures::ProhibitUnlessBlocks] - # This is a good general idea but has to be turned off because there are many # cases where a number has been explained in a comment or is obvious. [-ValuesAndExpressions::ProhibitMagicNumbers] @@ -182,7 +174,8 @@ max_characters=250 # you have a comparison of the form $b->[*] <=> $a->[*]. So skip this. [-BuiltinFunctions::ProhibitReverseSortBlock] -# There are too many of these in perltidy to change, and they seem fine. +# There are too many of these in perltidy to change, and they seem fine +# and not worth the effort of changing. [-RegularExpressions::ProhibitEscapedMetacharacters] # As the documentation says, this policy is not for everyone @@ -195,8 +188,8 @@ max_characters=250 # So skip this: [-ValuesAndExpressions::ProhibitInterpolationOfLiterals] -# These have been checked and are correct as written. So this policy -# has to be turned off. +# The cases flagged by this policy are correct as written. We have to +# skip this. [-ValuesAndExpressions::RequireInterpolationOfMetachars] # Disagree: parens can add clarity and may even be essential, for example in diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index 51810b4d..873153c7 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -361,7 +361,7 @@ EOM my @parts = @_; # use File::Spec if we can - unless ($missing_file_spec) { + if ( !$missing_file_spec ) { return File::Spec->catfile(@parts); } @@ -617,7 +617,7 @@ EOM my ($key) = @_; my $hash_ref = $input_hash{$key}; if ( defined($hash_ref) ) { - unless ( ref($hash_ref) eq 'HASH' ) { + if ( ref($hash_ref) ne 'HASH' ) { my $what = ref($hash_ref); my $but_is = $what ? "but is ref to $what" : "but is not a reference"; @@ -719,7 +719,7 @@ EOM # validate dump_options_type if ( defined($dump_options) ) { - unless ( defined($dump_options_type) ) { + if ( !defined($dump_options_type) ) { $dump_options_type = 'perltidyrc'; } if ( $dump_options_type ne 'perltidyrc' @@ -915,7 +915,7 @@ EOM $rOpts->{'encode-output-strings'} ? 'eos' : 'neos'; # be sure we have a valid output format - unless ( exists $default_file_extension{ $rOpts->{'format'} } ) { + if ( !exists $default_file_extension{ $rOpts->{'format'} } ) { my $formats = join SPACE, sort map { "'" . $_ . "'" } keys %default_file_extension; my $fmt = $rOpts->{'format'}; @@ -1184,7 +1184,7 @@ sub backup_method_copy { my $backup_file = $input_file . $backup_extension; - unless ( -f $input_file ) { + if ( !-f $input_file ) { # no real file to backup .. # This shouldn't happen because of numerous preliminary checks @@ -1327,7 +1327,7 @@ sub backup_method_move { my $backup_name = $input_file . $backup_extension; - unless ( -f $input_file ) { + if ( !-f $input_file ) { # oh, oh, no real file to backup .. # shouldn't happen because of numerous preliminary checks @@ -1915,7 +1915,7 @@ sub process_all_files { else { $fileroot = $input_file; $display_name = $input_file; - unless ( -e $input_file ) { + if ( !-e $input_file ) { # file doesn't exist - check for a file glob if ( $input_file =~ /([\?\*\[\{])/ ) { @@ -1939,7 +1939,7 @@ sub process_all_files { next; } - unless ( -f $input_file ) { + if ( !-f $input_file ) { Warn("skipping file: $input_file: not a regular file\n"); next; } @@ -1948,7 +1948,7 @@ sub process_all_files { # If for example a source file got clobbered somehow, # the old .tdy or .bak files might still exist so we # shouldn't overwrite them with zero length files. - unless ( -s $input_file ) { + if ( !-s $input_file ) { Warn("skipping file: $input_file: Zero size\n"); next; } @@ -1965,7 +1965,7 @@ sub process_all_files { next; } - unless ( ( -T $input_file ) || $rOpts->{'force-read-binary'} ) { + if ( !-T $input_file && !$rOpts->{'force-read-binary'} ) { Warn("skipping file: $input_file: Non-text (override with -f)\n" ); next; @@ -1997,15 +1997,14 @@ sub process_all_files { my ( $base, $old_path ) = fileparse($fileroot); my $new_path = $rOpts->{'output-path'}; - unless ( -d $new_path ) { - unless ( mkdir $new_path, 0777 ) { - Die("unable to create directory $new_path: $OS_ERROR\n" - ); - } + if ( !-d $new_path ) { + mkdir( $new_path, 0777 ) + or + Die("unable to create directory $new_path: $OS_ERROR\n"); } my $path = $new_path; $fileroot = catfile( $path, $base ); - unless ($fileroot) { + if ( !$fileroot ) { Die(<{'format'}\n"); } - unless ($formatter) { + if ( !$formatter ) { Die("Unable to continue with $rOpts->{'format'} formatting\n"); } @@ -4108,7 +4107,7 @@ sub _process_command_line { local @ARGV = (); # do not load the defaults if we are just dumping perltidyrc - unless ( $dump_options_type eq 'perltidyrc' ) { + if ( $dump_options_type ne 'perltidyrc' ) { for my $i ( @{$rdefaults} ) { push @ARGV, "--" . $i } } if ( !GetOptions( \%Opts, @{$roption_string} ) ) { @@ -4161,7 +4160,7 @@ sub _process_command_line { } } } - unless ( -e $config_file ) { + if ( !-e $config_file ) { Warn( "cannot find file given with -pro=$config_file: $OS_ERROR\n" ); @@ -4208,7 +4207,7 @@ sub _process_command_line { #---------------------------------------- # read any .perltidyrc configuration file #---------------------------------------- - unless ($saw_ignore_profile) { + if ( !$saw_ignore_profile ) { # resolve possible conflict between $perltidyrc_stream passed # as call parameter to perltidy and -pro=filename on command @@ -4939,7 +4938,7 @@ sub Win_OS_Type { # If $os is undefined, the above code is out of date. Suggested updates # are welcome. - unless ( defined $os ) { + if ( !defined($os) ) { $os = EMPTY_STRING; # Deactivated this message 20180322 because it was needlessly diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index e3eb5ffe..9005df4a 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -1511,7 +1511,7 @@ EOM # implement outdenting preferences for keywords %outdent_keyword = (); my @okw = split_words( $rOpts->{'outdent-keyword-list'} ); - unless (@okw) { + if ( !@okw ) { @okw = qw(next last redo goto return); # defaults } @@ -1531,7 +1531,7 @@ EOM if ( defined($kpit_value) && $kpit_value != 1 ) { my @kpit = split_words( $rOpts->{'keyword-paren-inner-tightness-list'} ); - unless (@kpit) { + if ( !@kpit ) { @kpit = qw(if elsif unless while until for foreach); # defaults } @@ -4969,13 +4969,13 @@ EOM # for leading '.' align all but 'short' quotes; the idea # is to not place something like "\n" on a single line. if ( $right_key eq '.' ) { - unless ( - $last_nonblank_type eq '.' - && ( $token_length <= - $rOpts_short_concatenation_item_length ) - && ( !$is_closing_token{$token} ) - ) - { + + my $is_short_quote = $last_nonblank_type eq '.' + && ( $token_length <= + $rOpts_short_concatenation_item_length ) + && !$is_closing_token{$token}; + + if ( !$is_short_quote ) { $bias{$right_key} += $delta_bias; } } @@ -5223,7 +5223,7 @@ sub dump_cuddled_block_list { $flags .= "-ce" if ( $rOpts->{'cuddled-else'} ); $flags .= " -cbl='$cuddled_string'"; - unless ( $rOpts->{'cuddled-else'} ) { + if ( !$rOpts->{'cuddled-else'} ) { $flags .= "\nNote: You must specify -ce to generate a cuddled hash"; } @@ -5276,7 +5276,7 @@ sub make_static_block_comment_pattern { sub make_format_skipping_pattern { my ( $opt_name, $default ) = @_; my $param = $rOpts->{$opt_name}; - unless ($param) { $param = $default } + if ( !$param ) { $param = $default } $param =~ s/^\s*//; if ( $param !~ /^#/ ) { Die("ERROR: the $opt_name parameter '$param' must begin with '#'\n"); @@ -6450,9 +6450,9 @@ sub find_selected_packages { # returns a list of all selected package statements in a file my @package_list; - unless ( $rdump_block_types->{'*'} - || $rdump_block_types->{'package'} - || $rdump_block_types->{'class'} ) + if ( !$rdump_block_types->{'*'} + && !$rdump_block_types->{'package'} + && !$rdump_block_types->{'class'} ) { return \@package_list; } @@ -7943,7 +7943,7 @@ sub find_non_indenting_braces { } my $rK_range = $line_of_tokens->{_rK_range}; my ( $Kfirst, $Klast ) = @{$rK_range}; - unless ( defined($Kfirst) && $rLL->[$Klast]->[_TYPE_] eq '#' ) { + if ( !defined($Kfirst) || $rLL->[$Klast]->[_TYPE_] ne '#' ) { # shouldn't happen DEVEL_MODE && Fault("did not get a comment\n"); @@ -8008,7 +8008,7 @@ EOM my $rK_range = $line_of_tokens->{_rK_range}; my ( $Kfirst, $Klast ) = @{$rK_range}; - unless ( defined($Kfirst) && $rLL->[$Klast]->[_TYPE_] eq '#' ) { + if ( !defined($Kfirst) || $rLL->[$Klast]->[_TYPE_] ne '#' ) { if (DEVEL_MODE) { my $lno = $ix + 1; Fault(<[$Kprev]->[_TYPE_]; my $type_pp = 'b'; if ( $Kprev >= 0 ) { $type_pp = $rLL->[ $Kprev - 1 ]->[_TYPE_] } - unless ( - $type_prev =~ /^[\,\.\;]/ - || $type_prev =~ /^[=\{\[\(\L]/ - && ( $type_pp eq 'b' || $type_pp eq '}' || $type_first eq 'k' ) - || $type_first =~ /^[=\,\.\;\{\[\(\L]/ - || $type_first eq '||' - || ( - $type_first eq 'k' - && ( $token_first eq 'if' - || $token_first eq 'or' ) - ) - ) - { + + my $is_good_location = + + $type_prev =~ /^[\,\.\;]/ + || ( $type_prev =~ /^[=\{\[\(\L]/ + && ( $type_pp eq 'b' || $type_pp eq '}' || $type_first eq 'k' ) ) + || $type_first =~ /^[=\,\.\;\{\[\(\L]/ + || $type_first eq '||' + || ( + $type_first eq 'k' + && ( $token_first eq 'if' + || $token_first eq 'or' ) + ); + + if ( !$is_good_location ) { $msg = "Skipping weld: poor break with -lp and ci at type_first='$type_first' type_prev='$type_prev' type_pp=$type_pp\n"; $new_weld_ok = 0; @@ -16084,18 +16086,20 @@ EOM #-------------------------------------------- if ( $self->[_save_logfile_] ) { + my $guessed_indentation_level = + $line_of_tokens->{_guessed_indentation_level}; + # Compare input/output indentation except for: # - hanging side comments # - continuation lines (have unknown leading blank space) # - and lines which are quotes (they may have been outdented) - my $guessed_indentation_level = - $line_of_tokens->{_guessed_indentation_level}; + my $exception = + $CODE_type eq 'HSC' + || $rtok_first->[_CI_LEVEL_] > 0 + || $guessed_indentation_level == 0 + && $rtok_first->[_TYPE_] eq 'Q'; - unless ( $CODE_type eq 'HSC' - || $rtok_first->[_CI_LEVEL_] > 0 - || $guessed_indentation_level == 0 - && $rtok_first->[_TYPE_] eq 'Q' ) - { + if ( !$exception ) { my $input_line_number = $line_of_tokens->{_line_number}; $self->compare_indentation_levels( $K_first, $guessed_indentation_level, $input_line_number ); @@ -16318,7 +16322,7 @@ EOM # } else ... if ($rbrace_follower) { my $token = $rtoken_vars->[_TOKEN_]; - unless ( $rbrace_follower->{$token} ) { + if ( !$rbrace_follower->{$token} ) { $self->end_batch() if ( $max_index_to_go >= 0 ); } $rbrace_follower = undef; @@ -16467,7 +16471,7 @@ EOM { # but only if allowed - unless ($nobreak_BEFORE_BLOCK) { + if ( !$nobreak_BEFORE_BLOCK ) { # since we already stored this token, we must unstore it $self->unstore_token_to_go(); @@ -16715,7 +16719,7 @@ EOM elsif ( ( $next_nonblank_token_type eq 'b' ) && $rOpts_add_newlines ) { - unless ($rbrace_follower) { + if ( !$rbrace_follower ) { $self->end_batch() unless ( $no_internal_newlines || $max_index_to_go < 0 ); @@ -17105,7 +17109,7 @@ sub starting_one_line_block { if ( substr( $block_type, -2, 2 ) eq '()' ) { $stripped_block_type = substr( $block_type, 0, -2 ); } - unless ( $tokens_to_go[$i_start] eq $stripped_block_type ) { + if ( $tokens_to_go[$i_start] ne $stripped_block_type ) { return; } } @@ -17119,7 +17123,7 @@ sub starting_one_line_block { if ( $types_to_go[$i_start] eq 'b' ) { $i_start++; } - unless ( $tokens_to_go[$i_start] eq $block_type ) { + if ( $tokens_to_go[$i_start] ne $block_type ) { return; } } @@ -18576,7 +18580,7 @@ sub lookup_opening_indentation { $nline = 0 if ( $i_opening < $ri_start->[$nline] ); # find the correct line - unless ( $i_opening > $ri_last->[-1] ) { + if ( $i_opening <= $ri_last->[-1] ) { while ( $i_opening > $ri_last->[$nline] ) { $nline++; } } @@ -18673,7 +18677,7 @@ sub pad_array_to_go { # Nesting depths are set to be >=0 in sub write_line, so it should # not be possible to get here unless the code has a bracing error # which leaves a closing brace with zero nesting depth. - unless ( get_saw_brace_error() ) { + if ( !get_saw_brace_error() ) { if (DEVEL_MODE) { Fault(<set_forced_breakpoint($icomma); } } @@ -24524,7 +24528,7 @@ EOM # NOTE: we should really use the true break count here, # which can be greater if there are large terms and # little space, but usually this will work well enough. - unless ($must_break_open) { + if ( !$must_break_open ) { if ( $break_count <= 1 ) { ${$rdo_not_break_apart} = 1; @@ -24622,7 +24626,7 @@ EOM $ri_ragged_break_list ); ++$break_count if ($use_separate_first_term); - unless ($must_break_open_container) { + if ( !$must_break_open_container ) { if ( $break_count <= 1 ) { ${$rdo_not_break_apart} = 1; } @@ -25338,7 +25342,7 @@ sub get_maximum_fields_wanted { $total_variation_2 = $total_variation_2[0] + $total_variation_2[1]; my $factor = ( $item_count > 10 ) ? 1 : ( $item_count > 5 ) ? 0.75 : 0; - unless ( $total_variation_2 < $factor * $total_variation_1 ) { + if ( $total_variation_2 >= $factor * $total_variation_1 ) { $number_of_fields_best = 1; } } @@ -30517,9 +30521,9 @@ sub set_vertical_tightness_flags { min( $ovt, $self->[_rmax_vertical_tightness_]->{$seqno} ); } - unless ( - $ovt < 2 - && ( $nesting_depth_to_go[ $iend_next + 1 ] != + if ( + $ovt >= 2 + || ( $nesting_depth_to_go[ $iend_next + 1 ] == $nesting_depth_to_go[$ibeg_next] ) ) { -- 2.39.5