From fdca908d2bac5551abeb366bb0ce8d63cb1d727f Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Thu, 28 Apr 2022 19:17:02 -0700 Subject: [PATCH] convert C-style for loops to foreach --- .perlcriticrc | 5 ++-- lib/Perl/Tidy/Formatter.pm | 44 +++++++++++++++++--------------- lib/Perl/Tidy/HtmlWriter.pm | 2 +- lib/Perl/Tidy/VerticalAligner.pm | 44 ++++++++++++++++---------------- 4 files changed, 48 insertions(+), 47 deletions(-) diff --git a/.perlcriticrc b/.perlcriticrc index 0a750a35..dd1b2f7b 100644 --- a/.perlcriticrc +++ b/.perlcriticrc @@ -9,9 +9,8 @@ severity = 4 # in the Tokenizer.pm module [-Variables::RequireInitializationForLocalVars] -# C-style for loops are essential when working with multiple indexed -# arrays -[-ControlStructures::ProhibitCStyleForLoops] +# C-style for loops are avoided now because profiling shows them to be very slow +# [-ControlStructures::ProhibitCStyleForLoops] # There is a stringy eval in Formatter.pm which is essential. [-BuiltinFunctions::ProhibitStringyEval] diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index ed5321e1..62bb761f 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -981,7 +981,7 @@ sub check_token_array { # when the DEVEL_MODE flag is set, so this Fault will only occur # during code development. my $rLL = $self->[_rLL_]; - for ( my $KK = 0 ; $KK < @{$rLL} ; $KK++ ) { + foreach my $KK ( 0 .. @{$rLL} - 1 ) { my $nvars = @{ $rLL->[$KK] }; if ( $nvars != _NVARS ) { my $NVARS = _NVARS; @@ -2794,7 +2794,9 @@ sub set_whitespace_flags { { my $level = $rLL->[$j]->[_LEVEL_]; my $jp = $j; - for ( my $inc = 1 ; $inc < 10 ; $inc++ ) { + ## NOTE: we might use the KNEXT variable to avoid this loop + ## but profiling shows that little would be saved + foreach my $inc ( 1 .. 9 ) { $jp++; last if ( $jp > $jmax ); last if ( $rLL->[$jp]->[_LEVEL_] != $level ); # b1236 @@ -7604,7 +7606,7 @@ sub resync_lines_and_tokens { # blank spaces). It must have set a bad old line index. if ( DEVEL_MODE && defined($Klimit) ) { my $iline = $rLL->[0]->[_LINE_INDEX_]; - for ( my $KK = 1 ; $KK <= $Klimit ; $KK++ ) { + foreach my $KK ( 1 .. $Klimit ) { my $iline_last = $iline; $iline = $rLL->[$KK]->[_LINE_INDEX_]; if ( $iline < $iline_last ) { @@ -8570,7 +8572,7 @@ sub setup_new_weld_measurements { my $iline_prev = $rLL->[$Kprev]->[_LINE_INDEX_]; my $rK_range = $rlines->[$iline_prev]->{_rK_range}; my ( $Kfirst, $Klast ) = @{$rK_range}; - for ( my $KK = $Kref - 1 ; $KK >= $Kfirst ; $KK-- ) { + foreach my $KK ( reverse( $Kfirst .. $Kref - 1 ) ) { next if ( $rLL->[$KK]->[_TYPE_] eq 'b' ); $Kref = $KK; last; @@ -8748,7 +8750,7 @@ sub weld_nested_containers { my %no_weld_to_one_line_container; if ($rOpts_line_up_parentheses) { ##foreach ( keys %opening_vertical_tightness ) { - foreach ( '(' ) { + foreach ('(') { if ( $opening_vertical_tightness{$_} == 2 ) { $no_weld_to_one_line_container{$_} = 1; } @@ -9155,8 +9157,8 @@ EOM } # DO-NOT-WELD RULE 2B: Turn off welding to a *one-line container for* an - # opening token which uses both -lp indentation and -vt=2. See issues - # b1338, b1339. Also see related issue b1183 involving welds and -vt>0. + # opening token which uses both -lp indentation and -vt=2. See issue + # b1338. Also see related issue b1183 involving welds and -vt>0. if ( !$do_not_weld_rule && %no_weld_to_one_line_container && $iline_io == $iline_ic @@ -9358,7 +9360,7 @@ EOM if ( $dlevel != 0 ) { my $Kstart = $Kinner_opening; my $Kstop = $Kinner_closing; - for ( my $KK = $Kstart ; $KK <= $Kstop ; $KK++ ) { + foreach my $KK ( $Kstart .. $Kstop ) { $rLL->[$KK]->[_LEVEL_] += $dlevel; } @@ -10431,7 +10433,7 @@ sub extended_ci { my $space = $available_space{$seqno_top}; my $length = $rLL->[$KLAST]->[_CUMULATIVE_LENGTH_]; my $count = 0; - for ( my $Kt = $KLAST + 1 ; $Kt < $KNEXT ; $Kt++ ) { + foreach my $Kt ( $KLAST + 1 .. $KNEXT - 1 ) { # But do not include tokens which might exceed the line length # and are not in a list. @@ -11761,7 +11763,7 @@ EOM push @subgroup, scalar @group; my $kbeg = 1; my $kend = @subgroup - 1; - for ( my $k = $kbeg ; $k <= $kend ; $k++ ) { + foreach my $k ( $kbeg .. $kend ) { # index j runs through all keywords found my $j_b = $subgroup[ $k - 1 ]; @@ -14648,7 +14650,7 @@ EOM # Walk backwards from the end and # set break at any closing block braces at the same level. # But quit if we are not in a chain of blocks. - for ( my $i = $max_index_to_go - 1 ; $i >= 0 ; $i-- ) { + foreach my $i ( reverse( 0 .. $max_index_to_go - 1 ) ) { last if ( $levels_to_go[$i] < $lev ); # stop at a lower level next if ( $levels_to_go[$i] > $lev ); # skip past higher level @@ -15526,7 +15528,7 @@ sub break_equals { # now make a list of all new break points my @insert_list; - for ( my $i = $ir - 1 ; $i > $il ; $i-- ) { + foreach my $i ( reverse( $il + 1 .. $ir - 1 ) ) { my $type = $types_to_go[$i]; if ( $is_assignment{$type} && $nesting_depth_to_go[$i] eq $depth_beg ) @@ -16930,7 +16932,7 @@ sub insert_final_ternary_breaks { my $i_question = $mate_index_to_go[$i_first_colon]; if ( $i_question > 0 ) { my @insert_list; - for ( my $ii = $i_question - 1 ; $ii >= 0 ; $ii -= 1 ) { + foreach my $ii ( reverse( 0 .. $i_question - 1 ) ) { my $token = $tokens_to_go[$ii]; my $type = $types_to_go[$ii]; @@ -18487,7 +18489,7 @@ EOM { my $ibreak = -1; my $obp_count = 0; - for ( my $ii = $i_first_comma - 1 ; $ii >= 0 ; $ii -= 1 ) { + foreach my $ii ( reverse( 0 .. $i_first_comma - 1 ) ) { if ( $old_breakpoint_to_go[$ii] ) { $obp_count++; last if ( $obp_count > 1 ); @@ -19637,7 +19639,7 @@ EOM #------------------------------------------- # set breaks for any unfinished lists .. - for ( my $dd = $current_depth ; $dd >= $minimum_depth ; $dd-- ) { + foreach my $dd ( reverse( $minimum_depth .. $current_depth ) ) { $interrupted_list[$dd] = 1; $has_broken_sublist[$dd] = 1 if ( $dd < $current_depth ); @@ -19748,7 +19750,7 @@ sub find_token_starting_list { # at the previous nonblank. This makes the result insensitive # to the flag --space-function-paren, and similar. # previous loop: for ( my $j = $im1 ; $j >= 0 ; $j-- ) { - for ( my $j = $iprev_nb ; $j >= 0 ; $j-- ) { + foreach my $j ( reverse( 0 .. $iprev_nb ) ) { if ( $is_key_type{ $types_to_go[$j] } ) { # fix for b1211 @@ -23527,7 +23529,7 @@ sub get_seqno { # : eval($_) ? 1 # : 0; - # be sure levels agree (do not indent after an indented 'if') + # be sure levels agree (never indent after an indented 'if') next if ( $levels_to_go[$ibeg] ne $levels_to_go[$ibeg_next] ); @@ -23640,7 +23642,7 @@ sub get_seqno { # find interior token to pad if necessary if ( !defined($ipad) ) { - for ( my $i = $ibeg ; ( $i < $iend ) && !$ipad ; $i++ ) { + foreach my $i ( $ibeg .. $iend - 1 ) { # find any unclosed container next @@ -23649,9 +23651,9 @@ sub get_seqno { # find next nonblank token to pad $ipad = $inext_to_go[$i]; - last if ( $ipad > $iend ); + last if $ipad; } - last unless $ipad; + last if ( !$ipad || $ipad > $iend ); } # We cannot pad the first leading token of a file because @@ -26230,7 +26232,7 @@ sub set_vertical_tightness_flags { # loop to examine characters one-by-one, RIGHT to LEFT and # build a balancing ending, LEFT to RIGHT. - for ( my $pos = length($csc) - 1 ; $pos >= 0 ; $pos-- ) { + foreach my $pos ( reverse( 0 .. length($csc) - 1 ) ) { my $char = substr( $csc, $pos, 1 ); diff --git a/lib/Perl/Tidy/HtmlWriter.pm b/lib/Perl/Tidy/HtmlWriter.pm index c33a2c3b..63ceedff 100644 --- a/lib/Perl/Tidy/HtmlWriter.pm +++ b/lib/Perl/Tidy/HtmlWriter.pm @@ -1271,7 +1271,7 @@ sub markup_tokens { my $rlast_level = $self->{_rlast_level}; my $rpackage_stack = $self->{_rpackage_stack}; - for ( my $j = 0 ; $j < @{$rtoken_type} ; $j++ ) { + foreach my $j ( 0 .. @{$rtoken_type} - 1 ) { $type = $rtoken_type->[$j]; $token = $rtokens->[$j]; $level = $rlevels->[$j]; diff --git a/lib/Perl/Tidy/VerticalAligner.pm b/lib/Perl/Tidy/VerticalAligner.pm index a0f54cf8..2a9e7cf9 100644 --- a/lib/Perl/Tidy/VerticalAligner.pm +++ b/lib/Perl/Tidy/VerticalAligner.pm @@ -1892,7 +1892,7 @@ sub two_line_pad { my $lensum_m = 0; my $lensum = 0; - for ( my $i = 0 ; $i <= $imax_min ; $i++ ) { + foreach my $i ( 0 .. $imax_min ) { $lensum_m += $rfield_lengths_m->[$i]; $lensum += $rfield_lengths->[$i]; } @@ -1905,7 +1905,7 @@ sub two_line_pad { $patterns_match = 1; my $rpatterns_m = $line_m->get_rpatterns(); my $rpatterns = $line->get_rpatterns(); - for ( my $i = 0 ; $i <= $imax_min ; $i++ ) { + foreach my $i ( 0 .. $imax_min ) { my $pat = $rpatterns->[$i]; my $pat_m = $rpatterns_m->[$i]; if ( $pat ne $pat_m ) { $patterns_match = 0; last } @@ -2397,7 +2397,7 @@ EOM # Loop to either copy items or concatenate fields and patterns my $jmin_del; - for ( my $j = 0 ; $j < $jmax_old ; $j++ ) { + foreach my $j ( 0 .. $jmax_old - 1 ) { my $token = $rtokens_old->[$j]; my $field = $rfields_old->[ $j + 1 ]; my $field_length = $rfield_lengths_old->[ $j + 1 ]; @@ -2643,7 +2643,7 @@ EOM # compare each line pair and record matches my $rtok_hash = {}; my $nr = 0; - for ( my $jl = 0 ; $jl < $jmax ; $jl++ ) { + foreach my $jl ( 0 .. $jmax - 1 ) { my $nl = $nr; $nr = 0; my $jr = $jl + 1; @@ -2711,7 +2711,7 @@ EOM # find subgroups my @subgroups; push @subgroups, [ 0, $jmax ]; - for ( my $jl = 0 ; $jl < $jmax ; $jl++ ) { + foreach my $jl ( 0 .. $jmax - 1 ) { if ( $rnew_lines->[$jl]->get_end_group() ) { $subgroups[-1]->[1] = $jl; push @subgroups, [ $jl + 1, $jmax ]; @@ -2759,7 +2759,7 @@ EOM my %token_line_count; if ( $nlines > 2 ) { - for ( my $jj = $jbeg ; $jj <= $jend ; $jj++ ) { + foreach my $jj ( $jbeg .. $jend ) { my %seen; my $line = $rnew_lines->[$jj]; my $rtokens = $line->get_rtokens(); @@ -3087,7 +3087,7 @@ sub delete_null_alignments { ); # Note that we are skipping the token at i=0 - for ( my $i = 1 ; $i <= $imax_match ; $i++ ) { + foreach my $i ( 1 .. $imax_match ) { # do not delete a token which requires padding to align next if ( $rneed_pad->[$i] ); @@ -3119,7 +3119,7 @@ sub delete_null_alignments { my $nlines = $jend - $jbeg + 1; next unless ( $nlines > 2 ); - for ( my $jj = $jbeg ; $jj <= $jend ; $jj++ ) { + foreach my $jj ( $jbeg .. $jend ) { my $line = $rnew_lines->[$jj]; $rtokens = $line->get_rtokens(); $rfield_lengths = $line->get_rfield_lengths(); @@ -3134,7 +3134,7 @@ sub delete_null_alignments { # see if all tokens of this line match the current group my $match; if ( $imax == $imax_match ) { - for ( my $i = 0 ; $i <= $imax ; $i++ ) { + foreach my $i ( 0 .. $imax ) { my $tok = $rtokens->[$i]; my $tok_match = $rtokens_match->[$i]; last if ( $tok ne $tok_match ); @@ -3289,7 +3289,7 @@ sub match_line_pairs { next unless ( $nlines > 1 ); # loop over lines in a subgroup - for ( my $jj = $jbeg ; $jj <= $jend ; $jj++ ) { + foreach my $jj ( $jbeg .. $jend ) { $line_m = $line; $rtokens_m = $rtokens; @@ -3336,7 +3336,7 @@ sub match_line_pairs { if ($ci_jump) { $imax_min = -1 } my $i_nomatch = $imax_min + 1; - for ( my $i = 0 ; $i <= $imax_min ; $i++ ) { + foreach my $i ( 0 .. $imax_min ) { my $tok = $rtokens->[$i]; my $tok_m = $rtokens_m->[$i]; if ( $tok ne $tok_m ) { @@ -3353,7 +3353,7 @@ sub match_line_pairs { ################## else { my $i_nomatch = $imax_min + 1; - for ( my $i = 0 ; $i <= $imax_min ; $i++ ) { + foreach my $i ( 0 .. $imax_min ) { my $tok = $rtokens->[$i]; my $tok_m = $rtokens_m->[$i]; if ( $tok ne $tok_m ) { @@ -3430,7 +3430,7 @@ sub get_line_token_info { # $$d{"hours"} = [ "h", "hr", "hrs", "hour", "hours" ]; my @all_token_info; my $all_monotonic = 1; - for ( my $jj = 0 ; $jj < @{$rlines} ; $jj++ ) { + foreach my $jj ( 0 .. @{$rlines} - 1 ) { my ($line) = $rlines->[$jj]; my $rtokens = $line->get_rtokens(); my $last_lev; @@ -3450,7 +3450,7 @@ sub get_line_token_info { } my $rline_values = []; - for ( my $jj = 0 ; $jj < @{$rlines} ; $jj++ ) { + foreach my $jj ( 0 .. @{$rlines} - 1 ) { my ($line) = $rlines->[$jj]; my $rtokens = $line->get_rtokens(); @@ -3739,7 +3739,7 @@ sub prune_alignment_tree { ###################################################### # Prune Tree Step 2. Loop to form the tree of matches. ###################################################### - for ( my $jp = 0 ; $jp <= $jmax ; $jp++ ) { + foreach my $jp ( 0 .. $jmax ) { # working with two adjacent line indexes, 'm'=minus, 'p'=plus my $jm = $jp - 1; @@ -3818,7 +3818,7 @@ sub prune_alignment_tree { # can find the children. We store the range of children nodes ($nc_beg, # $nc_end) of each parent with two additional indexes in the orignal array. # These will be undef if no children. - for ( my $depth = $MAX_DEPTH ; $depth > 0 ; $depth-- ) { + foreach my $depth ( reverse( 1 .. $MAX_DEPTH ) ) { next unless defined( $match_tree[$depth] ); my $nc_max = @{ $match_tree[$depth] } - 1; my $np_now; @@ -3868,7 +3868,7 @@ sub prune_alignment_tree { @todo_list = ( 0 .. @{ $match_tree[0] } - 1 ); } - for ( my $depth = 0 ; $depth <= $MAX_DEPTH ; $depth++ ) { + foreach my $depth ( 0 .. $MAX_DEPTH ) { last unless (@todo_list); my @todo_next; foreach my $np (@todo_list) { @@ -3935,7 +3935,7 @@ sub prune_alignment_tree { my @idel; my $rtokens = $line->get_rtokens(); my $imax = @{$rtokens} - 2; - for ( my $i = 0 ; $i <= $imax ; $i++ ) { + foreach my $i ( 0 .. $imax ) { my $tok = $rtokens->[$i]; my ( $raw_tok, $lev, $tag, $tok_count ) = decode_alignment_token($tok); @@ -4057,7 +4057,7 @@ sub Dump_tree_groups { my $j0_eq_pad; my $j0_max_pad = 0; - for ( my $j = 0 ; $j < $jmax_1 - 1 ; $j++ ) { + foreach my $j ( 0 .. $jmax_1 - 2 ) { my ( $raw_tok, $lev, $tag, $tok_count ) = decode_alignment_token( $rtokens_1->[$j] ); if ( $raw_tok && $lev == $group_level ) { @@ -4525,7 +4525,7 @@ sub align_side_comments { # Count $num5 = number of comments in the 5 lines after the first comment # This is an important factor in a decision formula my $num5 = 1; - for ( my $jj = $j_sc_beg + 1 ; $jj < @{$rlines} ; $jj++ ) { + foreach my $jj ( $j_sc_beg + 1 .. @{$rlines} - 1 ) { my $ldiff = $jj - $j_sc_beg; last if ( $ldiff > 5 ); my $line = $rlines->[$jj]; @@ -4550,7 +4550,7 @@ sub align_side_comments { # Loop over passes my $max_comment_column = $last_side_comment_column; - for ( my $PASS = 1 ; $PASS <= $MAX_PASS ; $PASS++ ) { + foreach my $PASS ( 1 .. $MAX_PASS ) { # If there are two passes, then on the last pass make the old column # equal to the largest of the group. This will result in the comments @@ -4638,7 +4638,7 @@ sub align_side_comments { my $j_sc_last; my $ng_last = $todo[-1]; my ( $jbeg, $jend ) = @{ $rgroups->[$ng_last] }; - for ( my $jj = $jend ; $jj >= $jbeg ; $jj-- ) { + foreach my $jj ( reverse( $jbeg .. $jend ) ) { my $line = $rlines->[$jj]; my $jmax = $line->get_jmax(); if ( $line->get_rfield_lengths()->[$jmax] ) { -- 2.39.5