From: Steve Hancock Date: Mon, 4 Sep 2023 22:13:01 +0000 (-0700) Subject: Active two PC Policies X-Git-Tag: 20230701.04~2 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=e19201b21650fd102dfedecbab72ddf47f8843fc;p=perltidy.git Active two PC Policies ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions, and ControlStructures::ProhibitPostfixControls --- diff --git a/.perlcriticrc b/.perlcriticrc index 7655a2ac..4d3fb85f 100644 --- a/.perlcriticrc +++ b/.perlcriticrc @@ -86,10 +86,6 @@ max_nests=9 # of cases where they cannot be avoided. [-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 [-Subroutines::ProhibitManyArgs] @@ -121,7 +117,6 @@ max_characters=250 # These would be okay for most new code, but do not change any debugged regular # expressions without good reason. It is too easy to introduce a subtle error. -# So skip these for now. [-RegularExpressions::RequireDotMatchAnything] [-RegularExpressions::RequireLineBoundaryMatching] @@ -148,8 +143,9 @@ max_characters=250 # The first form highlights the most important thing, a sub call, # and the conditional is just an optimization to skip it if not needed. # The second form buries the important thing in braces, making it harder -# to see what is going on. -[-ControlStructures::ProhibitPostfixControls] +# to see what is going on. So allow postfix 'if' and 'unless'. +[ControlStructures::ProhibitPostfixControls] +allow = if unless # 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. diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 24544b4c..7c95c458 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -4081,7 +4081,6 @@ EOM # NEW_TOKENS must add bond strength rules my %is_good_keyword_breakpoint; - my %is_lt_gt_le_ge; my %is_container_token; my %binary_bond_strength_nospace; @@ -4100,9 +4099,6 @@ EOM @q = qw(if unless while until for foreach); @is_good_keyword_breakpoint{@q} = (1) x scalar(@q); - @q = qw(lt gt le ge); - @is_lt_gt_le_ge{@q} = (1) x scalar(@q); - @q = qw/ ( [ { } ] ) /; @is_container_token{@q} = (1) x scalar(@q); @@ -4349,19 +4345,15 @@ EOM $left_bond_strength{'or'} = VERY_WEAK - 0.02; $left_bond_strength{'err'} = VERY_WEAK - 0.02; $left_bond_strength{'xor'} = VERY_WEAK - 0.01; - $left_bond_strength{'ne'} = NOMINAL; - $left_bond_strength{'lt'} = 0.9 * NOMINAL + 0.1 * STRONG; - $left_bond_strength{'gt'} = 0.9 * NOMINAL + 0.1 * STRONG; - $left_bond_strength{'le'} = 0.9 * NOMINAL + 0.1 * STRONG; - $left_bond_strength{'ge'} = 0.9 * NOMINAL + 0.1 * STRONG; - $left_bond_strength{'eq'} = NOMINAL; - - $right_bond_strength{'and'} = NOMINAL; - $right_bond_strength{'or'} = NOMINAL; - $right_bond_strength{'err'} = NOMINAL; - $right_bond_strength{'xor'} = NOMINAL; - $right_bond_strength{'ne'} = NOMINAL; - $right_bond_strength{'eq'} = NOMINAL; + + @q = qw(ne eq); + @left_bond_strength{@q} = (NOMINAL) x scalar(@q); + + @q = qw(lt gt le ge); + @left_bond_strength{@q} = ( 0.9 * NOMINAL + 0.1 * STRONG ) x scalar(@q); + + @q = qw(and or err xor ne eq); + @right_bond_strength{@q} = (NOMINAL) x scalar(@q); #--------------------------------------------------------------- # Bond Strength BEGIN Section 2. @@ -5187,7 +5179,7 @@ sub bad_pattern { my @words = split /-+/, $string; # allow multiple dashes # we could look for and report possible errors here... - next unless ( @words > 0 ); + next if ( @words <= 0 ); # allow either '-continue' or *-continue' for arbitrary starting type my $start = '*'; @@ -5730,7 +5722,7 @@ EOM # correctly. my ( $rtokens, $rtoken_type, $rtype_sequence, $input_line_no ) = @_; my $jmax = @{$rtokens} - 1; - return unless ( $jmax >= 0 ); + return if ( $jmax < 0 ); foreach my $j ( 0 .. $jmax ) { my $seqno = $rtype_sequence->[$j]; my $token = $rtokens->[$j]; @@ -8006,7 +7998,7 @@ sub find_non_indenting_braces { DEVEL_MODE && Fault("did not get a comment\n"); next; } - next unless ( $Klast > $Kfirst ); # maybe HSC + next if ( $Klast <= $Kfirst ); # maybe HSC my $token_sc = $rLL->[$Klast]->[_TOKEN_]; my $K_m = $Klast - 1; my $type_m = $rLL->[$K_m]->[_TYPE_]; @@ -10337,10 +10329,11 @@ sub K_next_code { my ( $self, $KK, $rLL ) = @_; # return the index K of the next nonblank, non-comment token - return unless ( defined($KK) && $KK >= 0 ); + return if ( !defined($KK) ); + return if ( $KK < 0 ); # use the standard array unless given otherwise - $rLL = $self->[_rLL_] unless ( defined($rLL) ); + $rLL = $self->[_rLL_] if ( !defined($rLL) ); my $Num = @{$rLL}; my $Knnb = $KK + 1; while ( $Knnb < $Num ) { @@ -10367,18 +10360,19 @@ sub K_next_nonblank { # return the index K of the next nonblank token, or # return undef if none - return unless ( defined($KK) && $KK >= 0 ); + return if ( !defined($KK) ); + return if ( $KK < 0 ); # The third arg allows this routine to be used on any array. This is # useful in sub respace_tokens when we are copying tokens from an old $rLL # to a new $rLL array. But usually the third arg will not be given and we # will just use the $rLL array in $self. - $rLL = $self->[_rLL_] unless ( defined($rLL) ); + $rLL = $self->[_rLL_] if ( !defined($rLL) ); my $Num = @{$rLL}; my $Knnb = $KK + 1; - return unless ( $Knnb < $Num ); + return if ( $Knnb >= $Num ); return $Knnb if ( $rLL->[$Knnb]->[_TYPE_] ne 'b' ); - return unless ( ++$Knnb < $Num ); + return if ( ++$Knnb >= $Num ); return $Knnb if ( $rLL->[$Knnb]->[_TYPE_] ne 'b' ); # Backup loop. Very unlikely to get here; it means we have neighboring @@ -10455,14 +10449,14 @@ sub K_previous_nonblank { return; } my $Kpnb = $KK - 1; - return unless ( $Kpnb >= 0 ); + return if ( $Kpnb < 0 ); return $Kpnb if ( $rLL->[$Kpnb]->[_TYPE_] ne 'b' ); - return unless ( --$Kpnb >= 0 ); + return if ( --$Kpnb < 0 ); return $Kpnb if ( $rLL->[$Kpnb]->[_TYPE_] ne 'b' ); # Backup loop. We should not get here unless some routine # slipped repeated blanks into the token stream. - return unless ( --$Kpnb >= 0 ); + return if ( --$Kpnb < 0 ); while ( $Kpnb >= 0 ) { if ( $rLL->[$Kpnb]->[_TYPE_] ne 'b' ) { return $Kpnb } $Kpnb--; @@ -10547,7 +10541,8 @@ sub is_in_list_by_i { # returns true if token at i is contained in a LIST # returns false otherwise my $seqno = $parent_seqno_to_go[$i]; - return unless ( $seqno && $seqno ne SEQ_ROOT ); + return if ( !$seqno ); + return if ( $seqno eq SEQ_ROOT ); if ( $self->[_ris_list_by_seqno_]->{$seqno} ) { return 1; } @@ -10852,12 +10847,11 @@ sub keep_old_line_breaks { # Fix for b1120: only for parens, not braces elsif ( $token eq ')' ) { my $Kn = $self->K_next_nonblank($Kfirst); - next - unless ( defined($Kn) - && $Kn <= $Klast - && $rLL->[$Kn]->[_TYPE_] eq '->' ); + next if ( !defined($Kn) ); + next if ( $Kn > $Klast ); + next if ( $rLL->[$Kn]->[_TYPE_] ne '->' ); my $seqno = $rLL->[$Kfirst]->[_TYPE_SEQUENCE_]; - next unless ($seqno); + next if ( !$seqno ); # Note: in previous versions there was a fix here to avoid # instability between conflicting -bom and -pvt or -pvtc flags. @@ -11225,11 +11219,11 @@ sub find_nested_pairs { if ( $K_outer_closing < $Num && $rLL->[$K_outer_closing]->[_TYPE_] eq 'b' ); - next unless ( $K_outer_closing < $Num ); + next if ( $K_outer_closing >= $Num ); my $outer_seqno = $rLL->[$K_outer_closing]->[_TYPE_SEQUENCE_]; - next unless ($outer_seqno); + next if ( !$outer_seqno ); my $token_outer_closing = $rLL->[$K_outer_closing]->[_TOKEN_]; - next unless ( $is_closing_token{$token_outer_closing} ); + next if ( !$is_closing_token{$token_outer_closing} ); # Simple filter: No commas or semicolons in the outer container my $rtype_count = $self->[_rtype_count_by_seqno_]->{$outer_seqno}; @@ -11240,7 +11234,8 @@ sub find_nested_pairs { # Now we have to check the opening tokens. my $K_outer_opening = $K_opening_container->{$outer_seqno}; my $K_inner_opening = $K_opening_container->{$inner_seqno}; - next unless defined($K_outer_opening) && defined($K_inner_opening); + next if ( !defined($K_outer_opening) ); + next if ( !defined($K_inner_opening) ); my $inner_blocktype = $rblock_type_of_seqno->{$inner_seqno}; my $outer_blocktype = $rblock_type_of_seqno->{$outer_seqno}; @@ -12456,7 +12451,7 @@ sub weld_nested_quotes { my $Kn = $KK + 1; $Kn += 1 if ( $Kn < $Num && $rLL->[$Kn]->[_TYPE_] eq 'b' ); - next unless ( $Kn < $Num ); + next if ( $Kn >= $Num ); my $next_token = $rLL->[$Kn]->[_TOKEN_]; my $next_type = $rLL->[$Kn]->[_TYPE_]; @@ -12776,7 +12771,7 @@ sub mark_short_nested_blocks { # We are only marking nested code blocks, # so check for a previous block on the stack - next unless ( @open_block_stack > 1 ); + next if ( @open_block_stack <= 1 ); # Looks OK, mark this as a short nested block $rshort_nested->{$type_sequence} = 1; @@ -13802,9 +13797,8 @@ EOM # continue up the tree marking parent containers while (1) { $parent_seqno = $self->[_rparent_of_seqno_]->{$parent_seqno}; - last - unless ( defined($parent_seqno) - && $parent_seqno ne SEQ_ROOT ); + last if ( !defined($parent_seqno) ); + last if ( $parent_seqno eq SEQ_ROOT ); $ris_excluded_lp_container->{$parent_seqno} = 1; } } @@ -14963,13 +14957,14 @@ EOM # 0 = never (delete if exist) # 1 = stable (keep unchanged) # 2 = always (insert if missing) - return $rhash_of_desires - unless $rOpts_kgb_size_min > 0 + my $ok = $rOpts_kgb_size_min > 0 && ( $rOpts_kgb_before != 1 || $rOpts_kgb_after != 1 || $rOpts_kgb_inside || $rOpts_kgb_delete ); + return $rhash_of_desires if ( !$ok ); + return; } ## end sub kgb_initialize_options @@ -15099,7 +15094,7 @@ EOM # delete line $i if it is blank my $rlines = $self->[_rlines_]; - return unless ( $i >= 0 && $i < @{$rlines} ); + return if ( $i < 0 || $i >= @{$rlines} ); return if ( $rlines->[$i]->{_line_type} ne 'CODE' ); my $code_type = $rlines->[$i]->{_code_type}; if ( $code_type eq 'BL' ) { $rhash_of_desires->{$i} = 2; } @@ -15237,11 +15232,11 @@ EOM # Opening container must exist and be on this line my $Ko = $self->[_K_opening_container_]->{$parent_seqno}; - return unless ( defined($Ko) && $Ko > $K_first && $Ko <= $K_last ); + return if ( !defined($Ko) || $Ko <= $K_first || $Ko > $K_last ); # Verify that the closing container exists and is on a later line my $Kc = $self->[_K_closing_container_]->{$parent_seqno}; - return unless ( defined($Kc) && $Kc > $K_last ); + return if ( !defined($Kc) || $Kc <= $K_last ); # That's it $K_closing = $Kc; @@ -16526,11 +16521,11 @@ EOM $self->store_token_to_go( $Ktoken_vars, $rtoken_vars ); $self->end_batch() - unless ( - $no_internal_newlines - || ( $rOpts_keep_interior_semicolons - && $Ktoken_vars < $K_last ) - || ( $next_nonblank_token eq '}' ) + if ( + !$no_internal_newlines + && ( !$rOpts_keep_interior_semicolons + || $Ktoken_vars >= $K_last ) + && ( $next_nonblank_token ne '}' ) ); } @@ -16845,8 +16840,8 @@ EOM { if ( !$rbrace_follower ) { $self->end_batch() - unless ( $no_internal_newlines - || $max_index_to_go < 0 ); + if (!$no_internal_newlines + && $max_index_to_go >= 0 ); } } elsif ($rbrace_follower) { @@ -16868,8 +16863,8 @@ EOM } else { $self->end_batch() - unless ( $no_internal_newlines - || $max_index_to_go < 0 ); + if (!$no_internal_newlines + && $max_index_to_go >= 0 ); } $rbrace_follower = undef; @@ -16877,8 +16872,7 @@ EOM else { $self->end_batch() - unless ( $no_internal_newlines - || $max_index_to_go < 0 ); + if ( !$no_internal_newlines && $max_index_to_go >= 0 ); } } ## end treatment of closing block token @@ -17196,11 +17190,11 @@ sub starting_one_line_block { my $seqno = $type_sequence_to_go[$i_start]; return unless ($seqno); my $K_opening = $K_opening_container->{$seqno}; - return unless defined($K_opening); + return if ( !defined($K_opening) ); my $i_opening = $i_start + ( $K_opening - $K_start ); # give up if not on this line - return unless ( $i_opening >= 0 ); + return if ( $i_opening < 0 ); $i_start = $i_opening; # go back one token before the opening paren @@ -17703,7 +17697,8 @@ EOM # - the index of the token after which the break was set, or # - undef if no break was set - return unless ( defined($i) && $i >= 0 ); + return if ( !defined($i) ); + return if ( $i < 0 ); # Back up at a blank so we have a token to examine. # This was added to fix for cases like b932 involving an '=' break. @@ -19139,7 +19134,7 @@ sub break_equals { # my ( $self, $ri_left, $ri_right ) = @_; my $nmax = @{$ri_right} - 1; - return unless ( $nmax >= 2 ); + return if ( $nmax < 2 ); # scan the left ends of first two lines my $tokbeg = EMPTY_STRING; @@ -20439,7 +20434,7 @@ EOM # do not recombine after a comma unless this will # leave just 1 more line - return unless ( $n + 1 >= $nmax ); + return if ( $n + 1 < $nmax ); # do not recombine if there is a change in # indentation depth @@ -20504,31 +20499,30 @@ EOM && !$is_short_quote && !$is_ternary ) { - return - unless ( + my $combine_ok = ( ( # unless we can reduce this to two lines $nmax < $n + 2 - # or three lines, the last with a leading - # semicolon - || ( $nmax == $n + 2 + # or three lines, the last with a leading + # semicolon + || ( $nmax == $n + 2 && $types_to_go[$ibeg_nmax] eq ';' ) - # or the next line ends with a here doc - || $type_iend_2 eq 'h' + # or the next line ends with a here doc + || $type_iend_2 eq 'h' - # or the next line ends in an open paren or - # brace and the break hasn't been forced - # [dima.t] - || ( !$forced_breakpoint_to_go[$iend_1] + # or the next line ends in an open paren or + # brace and the break hasn't been forced + # [dima.t] + || (!$forced_breakpoint_to_go[$iend_1] && $type_iend_2 eq '{' ) ) - # do not recombine if the two lines might align - # well this is a very approximate test for this - && ( + # do not recombine if the two lines might align + # well this is a very approximate test for this + && ( # RT#127633 - the leading tokens are not # operators @@ -20537,8 +20531,10 @@ EOM # or they are different || ( $ibeg_3 >= 0 && $type_ibeg_2 ne $types_to_go[$ibeg_3] ) - ) - ); + ) + ); + + return if ( !$combine_ok ); if ( @@ -20606,8 +20602,7 @@ EOM $summed_lengths_to_go[$ibeg_2]; my $iend_1_minus = max( $ibeg_1, iprev_to_go($iend_1) ); - return - unless ( + my $combine_ok = ( # ... unless there is just one and we can reduce # this to two lines if we do. For example, this @@ -20623,10 +20618,10 @@ EOM # check for 2 lines, not in a long broken '.' chain ( $n == 2 && $n == $nmax && $type_iend_1 ne $type_iend_2 ) - # ... or this would strand a short quote , like this - # "some long quote" . - # "\n"; - || ( + # ... or this would strand a short quote , like this + # "some long quote" . + # "\n"; + || ( $types_to_go[$i_next_nonblank] eq 'Q' && $i_next_nonblank >= $iend_2 - 2 && $token_lengths_to_go[$i_next_nonblank] < @@ -20635,8 +20630,9 @@ EOM # additional constraints to fix c167 && ( $types_to_go[$iend_1_minus] ne 'Q' || $summed_len_2 < $summed_len_1 ) - ) - ); + ) + ); + return if ( !$combine_ok ); } else { ## ok - not a special type @@ -20814,7 +20810,7 @@ EOM && $types_to_go[$ii] eq ':' && $levels_to_go[$ii] == $lev; } - return unless ( $local_count > 1 ); + return if ( $local_count <= 1 ); } $forced_breakpoint_to_go[$iend_1] = 0; } @@ -20827,8 +20823,7 @@ EOM my $summed_len_2 = $summed_lengths_to_go[ $iend_2 + 1 ] - $summed_lengths_to_go[$ibeg_2]; - return - unless ( + my $combine_ok = ( # ... unless there is just one and we can reduce # this to two lines if we do. For example, this @@ -20843,10 +20838,10 @@ EOM ( $n == 2 && $n == $nmax && $type_ibeg_1 ne $type_ibeg_2 ) - # ... or this would strand a short quote , like this - # . "some long quote" - # . "\n"; - || ( + # ... or this would strand a short quote , like this + # . "some long quote" + # . "\n"; + || ( $types_to_go[$i_next_nonblank] eq 'Q' && $i_next_nonblank >= $iend_2 - 1 && $token_lengths_to_go[$i_next_nonblank] < @@ -20865,8 +20860,10 @@ EOM && $n == $nmax && $this_line_is_semicolon_terminated ) ) - ) - ); + ) + ); + + return if ( !$combine_ok ); } # handle leading keyword.. @@ -20874,10 +20871,10 @@ EOM # handle leading "or" if ( $tokens_to_go[$ibeg_2] eq 'or' ) { - return - unless ( + + my $combine_ok = ( $this_line_is_semicolon_terminated - && ( + && ( $type_ibeg_1 eq '}' || ( @@ -20892,12 +20889,14 @@ EOM # then combine everything together && ( $iend_2 - $ibeg_2 <= 7 ) ) - ) - ); + ) + ); + + return if ( !$combine_ok ); #X: RT #81854 $forced_breakpoint_to_go[$iend_1] = 0 - unless ( $old_breakpoint_to_go[$iend_1] ); + if ( !$old_breakpoint_to_go[$iend_1] ); } # handle leading 'and' and 'xor' @@ -21095,7 +21094,7 @@ sub insert_breaks_before_list_opening_containers { return unless %break_before_container_types; my $nmax = @{$ri_right} - 1; - return unless ( $nmax >= 0 ); + return if ( $nmax < 0 ); my $rLL = $self->[_rLL_]; @@ -21108,7 +21107,7 @@ sub insert_breaks_before_list_opening_containers { for my $n ( 0 .. $nmax ) { my $il = $ri_left->[$n]; my $ir = $ri_right->[$n]; - next unless ( $ir > $il ); + next if ( $ir <= $il ); my $Kl = $K_to_go[$il]; my $Kr = $K_to_go[$ir]; my $Kend = $Kr; @@ -21135,11 +21134,11 @@ sub insert_breaks_before_list_opening_containers { } my $token = $rLL->[$Kend]->[_TOKEN_]; - next unless ( $is_opening_token{$token} ); - next unless ( $Kl < $Kend - 1 ); + next if ( !$is_opening_token{$token} ); + next if ( $Kl >= $Kend - 1 ); my $seqno = $rLL->[$Kend]->[_TYPE_SEQUENCE_]; - next unless ( defined($seqno) ); + next if ( !defined($seqno) ); # Use the flag which was previously set next unless ( $rbreak_before_container_by_seqno->{$seqno} ); @@ -21570,7 +21569,7 @@ sub undo_lp_ci { my $max_line = @{$ri_first} - 1; # must be multiple lines - return unless $max_line > $line_open; + return if ( $max_line <= $line_open ); my $lev_start = $levels_to_go[$i_start]; my $ci_start_plus = 1 + $ci_levels_to_go[$i_start]; @@ -23173,16 +23172,19 @@ EOM # break open container... my $i_opening = $opening_structure_index_stack[$dd]; if ( defined($i_opening) && $i_opening >= 0 ) { - $self->set_forced_breakpoint($i_opening) - unless ( + + my $no_break = ( is_unbreakable_container($dd) - # Avoid a break which would place an isolated ' or " - # on a line - || ( $type eq 'Q' + # Avoid a break which would place an isolated ' or " + # on a line + || ( $type eq 'Q' && $i_opening >= $max_index_to_go - 2 && ( $token eq "'" || $token eq '"' ) ) - ); + ); + + $self->set_forced_breakpoint($i_opening) + if ( !$no_break ); } } ## end for ( my $dd = $current_depth...) @@ -26802,7 +26804,7 @@ EOM } $lp_position_predictor -= $deleted_spaces; $spaces_needed -= $deleted_spaces; - last unless ( $spaces_needed > 0 ); + last if ( $spaces_needed <= 0 ); } return; } ## end sub check_for_long_gnu_style_lines @@ -28554,15 +28556,15 @@ sub get_seqno { $ok_comma = $tok_next_next eq $tok_next; } - next - unless ( - $is_assignment{ $types_to_go[$iendm] } - || $ok_comma - || ( $nesting_depth_to_go[$ibegm] < + my $ok_pad = ( + $is_assignment{ $types_to_go[$iendm] } + || $ok_comma + || ( $nesting_depth_to_go[$ibegm] < $nesting_depth_to_go[$ibeg] ) - || ( $types_to_go[$iendm] eq 'k' + || ( $types_to_go[$iendm] eq 'k' && $tokens_to_go[$iendm] eq 'return' ) - ); + ); + next if ( !$ok_pad ); # we will add padding before the first token $ipad = $ibeg; @@ -28647,9 +28649,9 @@ sub get_seqno { # find any unclosed container next - unless ( $type_sequence_to_go[$i] - && defined( $mate_index_to_go[$i] ) - && $mate_index_to_go[$i] > $iend ); + if ( !$type_sequence_to_go[$i] + || !defined( $mate_index_to_go[$i] ) + || $mate_index_to_go[$i] <= $iend ); # find next nonblank token to pad $ipad = $inext_to_go[$i]; @@ -28959,7 +28961,7 @@ sub xlp_tweak { my ( $self, $ri_first, $ri_last ) = @_; # Must be 2 or more lines - return unless ( @{$ri_first} > 1 ); + return if ( @{$ri_first} <= 1 ); # Pull indentation object from start of second line my $ibeg_1 = $ri_first->[1]; diff --git a/lib/Perl/Tidy/IndentationItem.pm b/lib/Perl/Tidy/IndentationItem.pm index 8fbe34fb..85f1a4f2 100644 --- a/lib/Perl/Tidy/IndentationItem.pm +++ b/lib/Perl/Tidy/IndentationItem.pm @@ -124,7 +124,7 @@ sub permanently_decrease_available_spaces { # flag has been set. my $closed = $item->get_closed(); $item->decrease_available_spaces($deleted_spaces) - unless ( $available_spaces == 0 && $closed < 0 ); + if ( $available_spaces != 0 || $closed >= 0 ); $item->decrease_SPACES($deleted_spaces); $item->set_recoverable_spaces(0); diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm index d5e90758..c2b495e8 100644 --- a/lib/Perl/Tidy/Tokenizer.pm +++ b/lib/Perl/Tidy/Tokenizer.pm @@ -994,7 +994,7 @@ sub get_line { $self->[_line_of_text_] = $input_line; - return unless ( defined($input_line) ); + return if ( !defined($input_line) ); my $input_line_number = ++$self->[_last_line_number_]; @@ -1357,9 +1357,11 @@ sub get_line { } else { $line_of_tokens->{_line_type} = 'POD_START'; - $self->warning( + if ( !DEVEL_MODE ) { + $self->warning( "=cut starts a pod section .. this can fool pod utilities.\n" - ) unless (DEVEL_MODE); + ); + } $self->log_numbered_msg("Entering POD section\n"); } } @@ -2182,7 +2184,7 @@ EOM my ( $self, $replacement_text ) = @_; # quick check - return unless ( $replacement_text =~ /<write_logfile_entry( "scanning replacement text for here-doc targets\n"); @@ -2202,7 +2204,7 @@ EOM ); # scan the replacement text - 1 while ( $tokenizer->get_line() ); + while ( $tokenizer->get_line() ) { } # remove any here doc targets my $rht = undef; @@ -3796,7 +3798,7 @@ EOM elsif ( !$here_doc_target ) { $self->warning( 'Use of bare << to mean <<"" is deprecated' . "\n" ) - unless ($here_quote_character); + if ( !$here_quote_character ); } elsif ( $here_doc_target !~ /^[A-Z_]\w+$/ ) { $self->complain( @@ -3840,8 +3842,7 @@ EOM my $self = shift; return - unless ( $i < $max_token_index ) - ; # here-doc not possible if end of line + if ( $i >= $max_token_index ); # here-doc not possible if end of line if ( $expecting != OPERATOR ) { my ( $found_target, $here_doc_target, $here_quote_character, $saw_error ); @@ -6784,14 +6785,13 @@ sub is_balanced_closing_container { # cannot close if there was no opening my $cd_aa = $rcurrent_depth->[$aa]; - return unless ( $cd_aa > 0 ); + return if ( $cd_aa <= 0 ); # check that any other brace types $bb contained within would be balanced for my $bb ( 0 .. @closing_brace_names - 1 ) { next if ( $bb == $aa ); return - unless ( - $rdepth_array->[$aa][$bb][$cd_aa] == $rcurrent_depth->[$bb] ); + if ( $rdepth_array->[$aa][$bb][$cd_aa] != $rcurrent_depth->[$bb] ); } # OK, everything will be balanced @@ -7640,7 +7640,8 @@ EOM sub check_prototype { my ( $proto, $package, $subname ) = @_; - return unless ( defined($package) && defined($subname) ); + return if ( !defined($package) ); + return if ( !defined($subname) ); if ( defined($proto) ) { $proto =~ s/^\s*\(\s*//; $proto =~ s/\s*\)$//; @@ -8771,7 +8772,7 @@ EOM my $seqno = $rcurrent_sequence_number->[BRACE] [ $rcurrent_depth->[BRACE] ]; - $seqno = 1 unless ( defined($seqno) ); + $seqno = 1 if ( !defined($seqno) ); $package = $seqno; if ( $warn_if_lexical{$subname} ) { $self->warning( @@ -8931,9 +8932,11 @@ EOM } else { - $self->warning( + if ( !DEVEL_MODE ) { + $self->warning( "already saw definition of 'sub $subname' in package '$package' at line $lno\n" - ) unless (DEVEL_MODE); + ); + } } } $rsaw_function_definition->{$subname}{$package} = @@ -9042,7 +9045,7 @@ sub find_next_nonblank_token { my $next_nonblank_token = $rtokens->[ ++$i ]; return ( SPACE, $i ) - unless ( defined($next_nonblank_token) && length($next_nonblank_token) ); + if ( !defined($next_nonblank_token) || !length($next_nonblank_token) ); # Quick test for nonblank ascii char. Note that we just have to # examine the first character here. @@ -9961,7 +9964,7 @@ sub follow_quoted_string { # retain backslash unless it hides the beginning or end token $tok = $rtokens->[ ++$i ]; $quoted_string .= '\\' - unless ( $tok eq $end_tok || $tok eq $beginning_tok ); + if ( $tok ne $end_tok && $tok ne $beginning_tok ); } else { ## nothing special diff --git a/lib/Perl/Tidy/VerticalAligner.pm b/lib/Perl/Tidy/VerticalAligner.pm index 1332c577..9fcd525b 100644 --- a/lib/Perl/Tidy/VerticalAligner.pm +++ b/lib/Perl/Tidy/VerticalAligner.pm @@ -704,8 +704,8 @@ sub valign_input { my $line_count = $self->group_line_count(); my $min_lines = $rvertical_tightness_flags->{_vt_min_lines}; my $max_lines = $rvertical_tightness_flags->{_vt_max_lines}; - $min_lines = 0 unless ($min_lines); - $max_lines = 1 unless ($max_lines); + $min_lines = 0 if ( !$min_lines ); + $max_lines = 1 if ( !$max_lines ); if ( ( $line_count >= $min_lines ) && ( $line_count <= $max_lines ) ) { @@ -987,12 +987,12 @@ sub join_hanging_comment { my $rfields = $new_line->{'rfields'}; # the first field must be empty - return 0 unless $rfields->[0] =~ /^\s*$/; + return 0 if ( $rfields->[0] !~ /^\s*$/ ); # the current line must have fewer fields my $maximum_field_index = $old_line->{'jmax'}; return 0 - unless $maximum_field_index > $jmax; + if ( $maximum_field_index <= $jmax ); # looks ok.. my $rpatterns = $new_line->{'rpatterns'}; @@ -1074,13 +1074,13 @@ sub fix_terminal_ternary { $group_level ) = @_; - return unless ($old_line); + return if ( !$old_line ); use constant EXPLAIN_TERNARY => 0; if (%valign_control_hash) { my $align_ok = $valign_control_hash{'?'}; $align_ok = $valign_control_default unless defined($align_ok); - return unless ($align_ok); + return if ( !$align_ok ); } my $jmax = @{$rfields} - 1; @@ -1102,7 +1102,7 @@ sub fix_terminal_ternary { $depth_question = $lev; # depth must be correct - next unless ( $depth_question eq $group_level ); + next if ( $depth_question ne $group_level ); $jquestion = $j; if ( $rfields_old->[ $j + 1 ] =~ /^(\?\s*)/ ) { @@ -1115,7 +1115,7 @@ sub fix_terminal_ternary { last; } } - return unless ( defined($jquestion) ); # shouldn't happen + return if ( !defined($jquestion) ); # shouldn't happen # Now splice the tokens and patterns of the previous line # into the else line to insure a match. Add empty fields @@ -1163,7 +1163,7 @@ sub fix_terminal_ternary { ( $len_colon, $pad_length + $field_length1 - $len_colon ); # change the leading pattern from : to ? - return unless ( $patterns[0] =~ s/^\:/?/ ); + return if ( $patterns[0] !~ s/^\:/?/ ); # install leading tokens and patterns of existing line unshift( @tokens, @{$rtokens_old}[ 0 .. $jquestion ] ); @@ -1181,7 +1181,7 @@ sub fix_terminal_ternary { # : ( $mname = $name . '->' ); else { - return unless ( $jmax > 0 && $tokens[0] ne '#' ); # shouldn't happen + return if ( $jmax <= 0 || $tokens[0] eq '#' ); # shouldn't happen # prepend a leading ? onto the second pattern $patterns[1] = "?b" . $patterns[1]; @@ -1248,21 +1248,21 @@ sub fix_terminal_else { # my ( $old_line, $rfields, $rtokens, $rpatterns, $rfield_lengths ) = @_; - return unless ($old_line); + return if ( !$old_line ); my $jmax = @{$rfields} - 1; - return unless ( $jmax > 0 ); + return if ( $jmax <= 0 ); if (%valign_control_hash) { my $align_ok = $valign_control_hash{'{'}; $align_ok = $valign_control_default unless defined($align_ok); - return unless ($align_ok); + return if ( !$align_ok ); } # check for balanced else block following if/elsif/unless my $rfields_old = $old_line->{'rfields'}; # TBD: add handling for 'case' - return unless ( $rfields_old->[0] =~ /^(if|elsif|unless)\s*$/ ); + return if ( $rfields_old->[0] !~ /^(?:if|elsif|unless)\s*$/ ); # look for the opening brace after the else, and extract the depth my $tok_brace = $rtokens->[0]; @@ -1280,7 +1280,7 @@ sub fix_terminal_else { my $jparen = 0; my $tok_paren = '(' . $depth_brace; my $tok_test = $rtokens_old->[$jparen]; - return unless ( $tok_test eq $tok_paren ); # shouldn't happen + return if ( $tok_test ne $tok_paren ); # shouldn't happen # Now find the opening block brace my ($jbrace); @@ -1291,7 +1291,7 @@ sub fix_terminal_else { last; } } - return unless ( defined($jbrace) ); # shouldn't happen + return if ( !defined($jbrace) ); # shouldn't happen # Now splice the tokens and patterns of the previous line # into the else line to insure a match. Add empty fields @@ -1579,7 +1579,7 @@ sub _flush_comment_lines { my ($self) = @_; my $rgroup_lines = $self->[_rgroup_lines_]; - return unless ( @{$rgroup_lines} ); + return if ( !@{$rgroup_lines} ); my $group_level = $self->[_group_level_]; my $group_maximum_line_length = $self->[_group_maximum_line_length_]; my $leading_space_count = $self->[_comment_leading_space_count_]; @@ -1653,7 +1653,7 @@ sub _flush_group_lines { # Note: only the sign of the jump is needed my $rgroup_lines = $self->[_rgroup_lines_]; - return unless ( @{$rgroup_lines} ); + return if ( !@{$rgroup_lines} ); my $group_type = $self->[_group_type_]; my $group_level = $self->[_group_level_]; @@ -1790,8 +1790,8 @@ sub _flush_group_lines { sub get_rgroup_jrange { - return unless @{$rgroups}; - return unless ( $group_line_count > 0 ); + return if ( !@{$rgroups} ); + return if ( $group_line_count <= 0 ); my ( $jbeg, $jend ) = @{ $rgroups->[-1] }; return ( $jbeg, $jend ); } ## end sub get_rgroup_jrange @@ -1799,8 +1799,8 @@ sub _flush_group_lines { sub end_rgroup { my ($imax_align) = @_; - return unless @{$rgroups}; - return unless ( $group_line_count > 0 ); + return if ( !@{$rgroups} ); + return if ( $group_line_count <= 0 ); my ( $jbeg, $jend ) = @{ pop @{$rgroups} }; push @{$rgroups}, [ $jbeg, $jend, $imax_align ]; @@ -1838,7 +1838,7 @@ sub _flush_group_lines { # emergency reset to prevent sweep_left_to_right from trying to match a # failed terminal else match - return unless @{$rgroups} > 1; + return if ( @{$rgroups} <= 1 ); $rgroups->[-2]->[2] = -1; return; } ## end sub block_penultimate_match @@ -1945,7 +1945,7 @@ EOM my $prev_comment = $rall_lines->[ $jline - 1 ]->{'rfields'}->[-1]; my $side_comment = $new_line->{'rfields'}->[-1]; - end_rgroup(-1) unless ( $side_comment && $prev_comment ); + end_rgroup(-1) if ( !$side_comment || !$prev_comment ); } else { ##ok: continue @@ -2053,7 +2053,8 @@ sub two_line_pad { # Safety check - shouldn't happen return 0 - unless $imax_min < @{$rfield_lengths} && $imax_min < @{$rfield_lengths_m}; + if ( $imax_min >= @{$rfield_lengths} + || $imax_min >= @{$rfield_lengths_m} ); my $lensum_m = 0; my $lensum = 0; @@ -2101,7 +2102,7 @@ sub sweep_left_to_right { # nothing to do if just one group my $ng_max = @{$rgroups} - 1; - return unless ( $ng_max > 0 ); + return if ( $ng_max <= 0 ); #--------------------------------------------------------------------- # Step 1: Loop over groups to find all common leading alignment tokens @@ -2158,7 +2159,7 @@ sub sweep_left_to_right { $line = $rlines->[$jbeg]; $rtokens = $line->{'rtokens'}; $imax = $line->{'jmax'} - 2; - $istop = -1 unless ( defined($istop) ); + $istop = -1 if ( !defined($istop) ); $istop = $imax if ( $istop > $imax ); # Initialize on first group @@ -2192,17 +2193,17 @@ sub sweep_left_to_right { { # We will just align assignments and simple lists - next unless ( $imax_min >= 0 ); + next if ( $imax_min < 0 ); next - unless ( $rtokens->[0] =~ /^=\d/ - || $list_type ); + if ( $rtokens->[0] !~ /^=\d/ + && !$list_type ); # In this case we will limit padding to a short distance. This # is a compromise to keep some vertical alignment but prevent large # gaps, which do not look good for just two lines. my $pad_max = two_line_pad( $rlines->[$jbeg], $rlines->[$jbeg_m], $imax_min ); - next unless ($pad_max); + next if ( !$pad_max ); my $ng_m = $ng - 1; $max_move{"$ng_m"} = $pad_max; $max_move{"$ng"} = $pad_max; @@ -2304,7 +2305,7 @@ sub sweep_left_to_right { my ( $rlines, $rgroups, $rmax_move, $ngb, $nge, $itok, $col_want, $raw_tok ) = @_; - return unless ( defined($ngb) && $nge > $ngb ); + return if ( !defined($ngb) || $nge <= $ngb ); foreach my $ng ( $ngb .. $nge ) { my ( $jbeg, $jend ) = @{ $rgroups->[$ng] }; @@ -2345,7 +2346,7 @@ sub sweep_left_to_right { my ( $itok, $ng_beg, $ng_end, $raw_tok, $lev ) = @{$task}; # Nothing to do for a single group - next unless ( $ng_end > $ng_beg ); + next if ( $ng_end <= $ng_beg ); my $ng_first; # index of the first group of a continuous sequence my $col_want; # the common alignment column of a sequence of groups @@ -2537,7 +2538,7 @@ sub delete_selected_tokens { # remove an unused alignment token(s) to improve alignment chances - return unless ( defined($line_obj) && defined($ridel) && @{$ridel} ); + return if ( !defined($line_obj) || !defined($ridel) || !@{$ridel} ); my $jmax_old = $line_obj->{'jmax'}; my $rfields_old = $line_obj->{'rfields'}; @@ -2754,7 +2755,7 @@ EOM # nothing to do if all lines were hanging side comments my $jmax = @{$rnew_lines} - 1; - return ( $max_lev_diff, $saw_side_comment ) unless ( $jmax >= 0 ); + return ( $max_lev_diff, $saw_side_comment ) if ( $jmax < 0 ); #---------------------------------------------------- # Create a hash of alignment token info for each line @@ -3202,7 +3203,7 @@ sub match_line_pairs { foreach my $item ( @{$rsubgroups} ) { my ( $jbeg, $jend ) = @{$item}; my $nlines = $jend - $jbeg + 1; - next unless ( $nlines > 1 ); + next if ( $nlines <= 1 ); # loop over lines in a subgroup foreach my $jj ( $jbeg .. $jend ) { @@ -3606,7 +3607,7 @@ sub get_line_token_info { sub prune_alignment_tree { my ($rlines) = @_; my $jmax = @{$rlines} - 1; - return unless $jmax > 0; + return if ( $jmax <= 0 ); # Vertical alignment in perltidy is done as an iterative process. The # starting point is to mark all possible alignment tokens ('=', ',', '=>', @@ -3824,7 +3825,7 @@ sub prune_alignment_tree { my $def_current = defined( $token_patterns_current[$depth] ); my $def_next = defined( $token_patterns_next[$depth] ); - last unless ( $def_current || $def_next ); + last if ( !$def_current && !$def_next ); if ( !$def_current || !$def_next || $token_patterns_current[$depth] ne @@ -3900,7 +3901,7 @@ sub prune_alignment_tree { } foreach my $depth ( 0 .. $MAX_DEPTH ) { - last unless (@todo_list); + last if ( !@todo_list ); my @todo_next; foreach my $np (@todo_list) { my ( $jbeg_p, $jend_p, $np_p, $lev_p, $pat_p, $nc_beg_p, $nc_end_p, @@ -4371,13 +4372,13 @@ sub get_extra_leading_spaces { # lines of a list are back together again. #---------------------------------------------------------- - return 0 unless ( @{$rlines} && @{$rgroups} ); + return 0 if ( !@{$rlines} || !@{$rgroups} ); my $object = $rlines->[0]->{'indentation'}; - return 0 unless ( ref($object) ); + return 0 if ( !ref($object) ); my $extra_leading_spaces = 0; my $extra_indentation_spaces_wanted = get_recoverable_spaces($object); - return ($extra_leading_spaces) unless ($extra_indentation_spaces_wanted); + return ($extra_leading_spaces) if ( !$extra_indentation_spaces_wanted ); my $min_spaces = $extra_indentation_spaces_wanted; if ( $min_spaces > 0 ) { $min_spaces = 0 } @@ -4460,7 +4461,7 @@ sub is_good_side_comment_column { # '$num5' is the number of comments in the first 5 lines after the first # comment. It is needed to keep a compact group of side comments from # being influenced by a more distant side comment. - $num5 = 1 unless ($num5); + $num5 = 1 if ( !$num5 ); # Some values: @@ -4572,7 +4573,7 @@ sub align_side_comments { my $line = $rlines->[$jj]; my $jmax = $line->{'jmax'}; my $sc_len = $line->{'rfield_lengths'}->[$jmax]; - next unless ($sc_len); + next if ( !$sc_len ); $num5++; } @@ -4841,7 +4842,7 @@ sub combine_fields { # First delete the unwanted tokens my $jmax_old = $line_0->{'jmax'}; my @idel = ( $imax_align + 1 .. $jmax_old - 2 ); - return unless (@idel); + return if ( !@idel ); # Get old alignments before any changes are made my @old_alignments = @{ $line_0->{'ralignments'} };