From: Steve Hancock Date: Mon, 21 Aug 2023 17:59:43 +0000 (-0700) Subject: make all print filehandles braced X-Git-Tag: 20230701.03~6 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=22539de68193f8eea6484043aa3511baac225421;p=perltidy.git make all print filehandles braced This can now be checked with perlcritic --- diff --git a/.perlcriticrc b/.perlcriticrc index 61d59dd0..88ed59d8 100644 --- a/.perlcriticrc +++ b/.perlcriticrc @@ -187,11 +187,6 @@ max_nests=9 # it as a general rule: [-NamingConventions::Capitalization] -# It would be nice if this option were configurable to skip STDERR and STDOUT -# which are used by perltidy almost exclusively for debug statements. -# I may eventually convert to braced {*STDOUT}, but must skip it for now. -[-InputOutput::RequireBracedFileHandleWithPrint] - # PerlCritic should not suggest this policy for complex sorts because it can # change program behavior when a stable sort has been assumed. And it does not # even make sense for sorts on multiple keys, like this one which got flagged diff --git a/dev-bin/run_convergence_tests.pl.expect b/dev-bin/run_convergence_tests.pl.expect index 1a47deee..8f81fc69 100644 --- a/dev-bin/run_convergence_tests.pl.expect +++ b/dev-bin/run_convergence_tests.pl.expect @@ -9709,7 +9709,9 @@ my $parser = foreach my $name ( - param $query) + param + $query + ) __END__ diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index 876e90a3..7ccab2d6 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -127,7 +127,7 @@ sub AUTOLOAD { our $AUTOLOAD; return if ( $AUTOLOAD =~ /\bDESTROY$/ ); my ( $pkg, $fname, $lno ) = caller(); - print STDERR <{'dump-options'} ) { - print STDOUT $readable_options; + print {*STDOUT} $readable_options; Exit(0); } @@ -2729,7 +2729,7 @@ BLINKER. Output for iteration $iter same as for $saw_md5{$digest}. EOM $stopping_on_error ||= $convergence_log_message; DEVEL_MODE - && print STDERR $convergence_log_message; + && print {*STDERR} $convergence_log_message; $diagnostics_object->write_diagnostics( $convergence_log_message) if $diagnostics_object; @@ -2760,12 +2760,12 @@ EOM # convergence test above is temporarily skipped for # testing. if ( $iteration_of_formatter_convergence < $iter - 1 ) { - print STDERR + print {*STDERR} "STRANGE Early conv in $display_name: Stopping on it=$iter, converged in formatter on $iteration_of_formatter_convergence\n"; } } elsif ( !$stopping_on_error ) { - print STDERR + print {*STDERR} "STRANGE no conv in $display_name: stopping on it=$iter, but not converged in formatter\n"; } } @@ -4799,7 +4799,7 @@ DIE # Debug routine -- this will dump the expansion hash sub dump_short_names { my $rexpansion = shift; - print STDOUT <{$abbrev} }; - print STDOUT "$abbrev --> @list\n"; + print {*STDOUT} "$abbrev --> @list\n"; } return; } ## end sub dump_short_names @@ -5113,14 +5113,14 @@ sub Win_Config_Locs { sub dump_config_file { my ( $rconfig_string, $config_file, $rconfig_file_chatter ) = @_; - print STDOUT "${$rconfig_file_chatter}"; + print {*STDOUT} "${$rconfig_file_chatter}"; if ($rconfig_string) { my @lines = split /^/, ${$rconfig_string}; - print STDOUT "# Dump of file: '$config_file'\n"; - while ( defined( my $line = shift @lines ) ) { print STDOUT $line } + print {*STDOUT} "# Dump of file: '$config_file'\n"; + while ( defined( my $line = shift @lines ) ) { print {*STDOUT} $line } } else { - print STDOUT "# ...no config file found\n"; + print {*STDOUT} "# ...no config file found\n"; } return; } ## end sub dump_config_file @@ -5370,7 +5370,7 @@ EOM sub dump_long_names { my @names = @_; - print STDOUT <$bond_str_2->$bond_str_3\n"; }; @@ -5050,7 +5050,7 @@ EOM DEBUG_BOND && do { my $str = substr( $token, 0, 15 ); $str .= SPACE x ( 16 - length($str) ); - print STDOUT + print {*STDOUT} "BOND: i=$i $str $type $next_nonblank_type depth=$total_nesting_depth strength=$bond_str_1 -> $bond_str_2 -> $bond_str_3 -> $bond_str_4 $bond_str -> $strength \n"; # reset for next pass @@ -6790,12 +6790,12 @@ sub dump_block_summary { # Sort blocks and packages on starting line number my @sorted_lines = sort { $a->[1] <=> $b->[1] } @{$routput_lines}; - print STDOUT + print {*STDOUT} "file,line,line_count,code_lines,type,name,level,max_change,block_count,mccabe_count\n"; foreach my $rline_vars (@sorted_lines) { my $line = join( ",", @{$rline_vars} ) . "\n"; - print STDOUT $line; + print {*STDOUT} $line; } return; } ## end sub dump_block_summary @@ -7571,7 +7571,7 @@ lno\tci\tci_this\tci_next\tlast_type\tlast_tok\ttype\ttok\tseqno\tlevel\tpname\t EOM foreach my $line (@output_lines) { chomp $line; - print STDERR $line, "\n"; + print {*STDOUT} $line, "\n"; } } } @@ -11856,7 +11856,7 @@ EOM { if (DEBUG_WELD) { $Msg .= "RULE 0: Not welding due to sheared inner parens\n"; - print $Msg; + print {*STDOUT} $Msg; } next; } @@ -11886,7 +11886,7 @@ EOM || $iline_ic != $iline_oc ) ) { - if (DEBUG_WELD) { print $msg} + if (DEBUG_WELD) { print {*STDOUT} $msg } next; } @@ -12198,7 +12198,7 @@ EOM if (DEBUG_WELD) { $Msg .= "Not welding due to RULE $do_not_weld_rule\n"; - print $Msg; + print {*STDOUT} $Msg; } # Normally, a broken pair should not decrease indentation of @@ -12219,7 +12219,7 @@ EOM $weld_count_this_start++; if (DEBUG_WELD) { $Msg .= "Starting new weld\n"; - print $Msg; + print {*STDOUT} $Msg; } push @welds, $item; @@ -12239,7 +12239,7 @@ EOM $weld_count_this_start++; if (DEBUG_WELD) { $Msg .= "Extending current weld\n"; - print $Msg; + print {*STDOUT} $Msg; } unshift @{ $welds[-1] }, $inner_seqno; $rK_weld_right->{$Kouter_opening} = $Kinner_opening; @@ -12425,7 +12425,7 @@ sub weld_nested_quotes { = $self->setup_new_weld_measurements( $Kouter_opening, $Kinner_opening ); if ( !$ok_to_weld ) { - if (DEBUG_WELD) { print $msg} + if (DEBUG_WELD) { print {*STDOUT} $msg } next; } @@ -12483,7 +12483,7 @@ sub weld_nested_quotes { if ($do_not_weld) { if (DEBUG_WELD) { $Msg .= "Not Welding QW\n"; - print $Msg; + print {*STDOUT} $Msg; } next; } @@ -12491,7 +12491,7 @@ sub weld_nested_quotes { # OK to weld if (DEBUG_WELD) { $Msg .= "Welding QW\n"; - print $Msg; + print {*STDOUT} $Msg; } $rK_weld_right->{$Kouter_opening} = $Kinner_opening; @@ -13043,7 +13043,7 @@ sub break_before_list_opening_containers { && $rlec_count_by_seqno->{$seqno}; DEBUG_BBX - && print STDOUT + && print {*STDOUT} "BBX: Looking at seqno=$seqno, token = $token with option=$break_option\n"; # -bbx=1 = stable, try to follow input @@ -13085,12 +13085,12 @@ sub break_before_list_opening_containers { if ( !$ok_to_break ) { DEBUG_BBX - && print STDOUT "Not breaking at seqno=$seqno: $Msg\n"; + && print {*STDOUT} "Not breaking at seqno=$seqno: $Msg\n"; next; } DEBUG_BBX - && print STDOUT "OK to break at seqno=$seqno: $Msg\n"; + && print {*STDOUT} "OK to break at seqno=$seqno: $Msg\n"; # Patch: turn off -xci if -bbx=2 and -lp # This fixes cases b1090 b1095 b1101 b1116 b1118 b1121 b1122 @@ -13112,7 +13112,7 @@ sub break_before_list_opening_containers { # sub insert_breaks_before_list_opening_containers $rbreak_before_container_by_seqno->{$seqno} = 1; DEBUG_BBX - && print STDOUT "BBX: ok to break at seqno=$seqno\n"; + && print {*STDOUT} "BBX: ok to break at seqno=$seqno\n"; # -bbxi=0: Nothing more to do if the ci value remains unchanged my $ci_flag = $container_indentation_options{$token}; @@ -13182,7 +13182,7 @@ sub break_before_list_opening_containers { next unless ($rtype_count); my $fat_comma_count = $rtype_count->{'=>'}; DEBUG_BBX - && print STDOUT "BBX: fat comma count=$fat_comma_count\n"; + && print {*STDOUT} "BBX: fat comma count=$fat_comma_count\n"; if ( $fat_comma_count && $fat_comma_count >= 2 ) { $OK = 1 } } @@ -13198,14 +13198,14 @@ sub break_before_list_opening_containers { $self->cumulative_length_before_K($KK); my $excess_length = $length - $maximum_text_length; DEBUG_BBX - && print STDOUT + && print {*STDOUT} "BBX: excess=$excess_length: maximum_text_length=$maximum_text_length, length=$length, ci=$ci\n"; # OK if the net container definitely breaks on length if ( $excess_length > $length_tol ) { $OK = 1; DEBUG_BBX - && print STDOUT "BBX: excess_length=$excess_length\n"; + && print {*STDOUT} "BBX: excess_length=$excess_length\n"; } # Otherwise skip it @@ -13217,7 +13217,7 @@ sub break_before_list_opening_containers { # Part 3: Looks OK: apply -bbx=n and any related -bbxi=n flag #------------------------------------------------------------ - DEBUG_BBX && print STDOUT "BBX: OK to break\n"; + DEBUG_BBX && print {*STDOUT} "BBX: OK to break\n"; # -bbhbi=n # -bbsbi=n @@ -13594,7 +13594,7 @@ sub find_multiline_qw { # shouldn't happen if ( $type ne 'q' ) { - DEVEL_MODE && print STDERR <[$n]; my $iend = $ri_end->[$n]; @@ -19098,9 +19098,9 @@ sub break_equals { foreach my $i ( $ibeg .. $iend ) { $text .= $tokens_to_go[$i]; } - print STDERR "$n ($ibeg:$iend) $text\n"; + print {*STDOUT} "$n ($ibeg:$iend) $text\n"; } - print STDERR "----\n"; + print {*STDOUT} "----\n"; return; } ## end sub Debug_dump_breakpoints @@ -19283,22 +19283,22 @@ sub break_equals { my $num_sections = @{$rsections}; if ( DEBUG_RECOMBINE > 1 ) { - print STDERR < 0 ) { my $max = 0; - print STDERR + print {*STDOUT} "-----\n$num_sections sections found for nmax=$nmax_start\n"; foreach my $sect ( @{$rsections} ) { my ( $nbeg, $nend ) = @{$sect}; my $num = $nend - $nbeg; if ( $num > $max ) { $max = $num } - print STDERR "$nbeg $nend\n"; + print {*STDOUT} "$nbeg $nend\n"; } - print STDERR "max size=$max of $nmax_start lines\n"; + print {*STDOUT} "max size=$max of $nmax_start lines\n"; } # Loop over all sub-sections. Note that we have to work backwards @@ -19487,7 +19487,7 @@ EOM if (DEBUG_RECOMBINE) { my $ratio = sprintf "%0.3f", $rhash->{_num_compares} / $num_pairs; - print STDERR + print {*STDOUT} "exiting recombine_inner_loop with $nmax_last lines, opt=$rhash->{_optimization_on}, starting pairs=$num_pairs, num_compares=$rhash->{_num_compares}, ratio=$ratio\n"; } @@ -19594,7 +19594,7 @@ EOM my $type_ibeg_2 = $types_to_go[$ibeg_2]; DEBUG_RECOMBINE > 1 && do { - print STDERR + print {*STDOUT} "RECOMBINE: ix=$ix iend1=$iend_1 iend2=$iend_2 n=$n nmax=$nmax if=$ibeg_1 type=$type_ibeg_1 =$tokens_to_go[$ibeg_1] next_type=$type_ibeg_2 next_tok=$tokens_to_go[$ibeg_2]\n"; }; @@ -19833,7 +19833,7 @@ EOM if (DEBUG_RECOMBINE) { my $num_compares = $rhash->{_num_compares}; my $pair_count = @ix_list; - print STDERR + print {*STDOUT} "Entering optimization phase at $num_compares compares, pair count = $pair_count\n"; } } @@ -21600,7 +21600,7 @@ sub break_long_lines { } DEBUG_BREAK_LINES - && print STDOUT + && print {*STDOUT} "BREAK: best is i = $i_lowest strength = $lowest_strength;\nReason>> $Msg\n"; $line_count++; @@ -22125,7 +22125,7 @@ sub break_lines_inner_loop { } if ( length($ltok) > 6 ) { $ltok = substr( $ltok, 0, 8 ) } if ( length($rtok) > 6 ) { $rtok = substr( $rtok, 0, 8 ) } - print STDOUT + print {*STDOUT} "BREAK: i=$i_test imax=$imax $types_to_go[$i_test] $next_nonblank_type sp=($leading_spaces) lnext= $summed_lengths_to_go[$i_testp2] str=$strength $ltok $rtok\n"; }; @@ -24532,7 +24532,7 @@ EOM ( int $number_of_fields / 2 ) * $pair_width + ( $number_of_fields % 2 ) * $max_width; - print STDOUT + print {*STDOUT} "SPARSE:cols=$columns commas=$comma_count items:$item_count ids=$identifier_count pairwidth=$pair_width fields=$number_of_fields lines packed: $packed_lines packed_cols=$packed_columns fmtd:$formatted_lines cols /line:$columns_per_line unused:$unused_columns fmtd:$formatted_columns sparsity=$sparsity allow=$max_allowed_sparsity\n"; }; @@ -25432,7 +25432,7 @@ sub set_nobreaks { 0 && do { my ( $a, $b, $c ) = caller(); - print STDOUT + print {*STDOUT} "NOBREAK: forced_breakpoint $forced_breakpoint_count from $a $c with i=$i max=$max_index_to_go type=$types_to_go[$i]\n"; }; @@ -26405,7 +26405,7 @@ EOM DEBUG_LP && do { my $tok_beg = $rLL->[$K_begin_line]->[_TOKEN_]; my $token = $tokens_to_go[$ii]; - print STDERR < ; } ) ] => =~ = == !~ || >= != *= .. && |= .= -= += <= %= ^= &&= ||= //= <=> #; - push @q, ','; - @{Z_test_hash}{@q} = (1) x scalar(@q); + push @qZ, ','; + @{Z_test_hash}{@qZ} = (1) x scalar(@qZ); } sub do_DOLLAR_SIGN { @@ -2762,7 +2762,7 @@ EOM # An identifier followed by '->' is not indirect object; # fixes b1175, b1176. Fix c257: Likewise for other tokens like - # comma, semicolon, closing brace, ... + # comma, semicolon, closing brace, and single space. my ( $next_nonblank_token, $i_next ) = $self->find_next_noncomment_token( $i, $rtokens, $max_token_index ); @@ -5453,7 +5453,7 @@ EOM $rbrace_type->[$brace_depth], $paren_depth, $rparen_type->[$paren_depth], ); - print STDOUT "TOKENIZE:(@debug_list)\n"; + print {*STDOUT} "TOKENIZE:(@debug_list)\n"; }; # We have the next token, $tok. @@ -5903,7 +5903,7 @@ sub operator_expected { my $op_expected = $op_expected_table{$last_nonblank_type}; if ( defined($op_expected) ) { DEBUG_OPERATOR_EXPECTED - && print STDOUT + && print {*STDOUT} "OPERATOR_EXPECTED: Table Lookup; returns $op_expected for last type $last_nonblank_type token $last_nonblank_token\n"; return $op_expected; } @@ -6117,7 +6117,7 @@ sub operator_expected { } DEBUG_OPERATOR_EXPECTED - && print STDOUT + && print {*STDOUT} "OPERATOR_EXPECTED: returns $op_expected for last type $last_nonblank_type token $last_nonblank_token\n"; return $op_expected; @@ -7522,7 +7522,7 @@ EOM } DEBUG_NSCAN && do { - print STDOUT + print {*STDOUT} "NSCAN: returns i=$i, tok=$tok, type=$type, state=$id_scan_state\n"; }; return ( $i, $tok, $type, $id_scan_state ); @@ -8524,9 +8524,9 @@ EOM DEBUG_SCAN_ID && do { my ( $a, $b, $c ) = caller; - print STDOUT + print {*STDOUT} "SCANID: called from $a $b $c with tok, i, state, identifier =$tok_begin, $i_begin, $id_scan_state_begin, $identifier_begin\n"; - print STDOUT + print {*STDOUT} "SCANID: returned with tok, i, state, identifier =$tok, $i, $id_scan_state, $identifier\n"; }; return ( $i, $tok, $type, $id_scan_state, $identifier, @@ -9700,7 +9700,7 @@ sub follow_quoted_string { my $quoted_string = EMPTY_STRING; 0 && do { - print STDOUT + print {*STDOUT} "QUOTE entering with quote_pos = $quote_pos i=$i beginning_tok =$beginning_tok\n"; }; @@ -10034,7 +10034,7 @@ sub show_tokens { foreach my $i ( 0 .. $num - 1 ) { my $len = length( $rtokens->[$i] ); - print STDOUT "$i:$len:$rtoken_map->[$i]:$rtokens->[$i]:\n"; + print {*STDOUT} "$i:$len:$rtoken_map->[$i]:$rtokens->[$i]:\n"; } return; } ## end sub show_tokens diff --git a/lib/Perl/Tidy/VerticalAligner.pm b/lib/Perl/Tidy/VerticalAligner.pm index 0c3e7cb9..080099ad 100644 --- a/lib/Perl/Tidy/VerticalAligner.pm +++ b/lib/Perl/Tidy/VerticalAligner.pm @@ -68,7 +68,7 @@ sub AUTOLOAD { return if ( $AUTOLOAD =~ /\bDESTROY$/ ); my ( $pkg, $fname, $lno ) = caller(); my $my_package = __PACKAGE__; - print STDERR < 0; my $debug_warning = sub { - print STDOUT "VALIGN_DEBUGGING with key $_[0]\n"; + print {*STDOUT} "VALIGN_DEBUGGING with key $_[0]\n"; return; }; @@ -679,7 +679,7 @@ sub valign_input { DEBUG_VALIGN && do { my $nlines = $self->group_line_count(); - print STDOUT + print {*STDOUT} "Entering valign_input: lines=$nlines new #fields= $jmax, leading_count=$leading_space_count, level=$level, group_level=$group_level, level_end=$level_end\n"; }; @@ -954,11 +954,11 @@ sub valign_input { # Some old debugging stuff # -------------------------------------------------------------------- DEBUG_VALIGN && do { - print STDOUT "exiting valign_input fields:"; + print {*STDOUT} "exiting valign_input fields:"; dump_array( @{$rfields} ); - print STDOUT "exiting valign_input tokens:"; + print {*STDOUT} "exiting valign_input tokens:"; dump_array( @{$rtokens} ); - print STDOUT "exiting valign_input patterns:"; + print {*STDOUT} "exiting valign_input patterns:"; dump_array( @{$rpatterns} ); }; @@ -1127,12 +1127,12 @@ sub fix_terminal_ternary { EXPLAIN_TERNARY && do { local $LIST_SEPARATOR = '><'; - print STDOUT "CURRENT FIELDS=<@{$rfields_old}>\n"; - print STDOUT "CURRENT TOKENS=<@{$rtokens_old}>\n"; - print STDOUT "CURRENT PATTERNS=<@{$rpatterns_old}>\n"; - print STDOUT "UNMODIFIED FIELDS=<@{$rfields}>\n"; - print STDOUT "UNMODIFIED TOKENS=<@{$rtokens}>\n"; - print STDOUT "UNMODIFIED PATTERNS=<@{$rpatterns}>\n"; + print {*STDOUT} "CURRENT FIELDS=<@{$rfields_old}>\n"; + print {*STDOUT} "CURRENT TOKENS=<@{$rtokens_old}>\n"; + print {*STDOUT} "CURRENT PATTERNS=<@{$rpatterns_old}>\n"; + print {*STDOUT} "UNMODIFIED FIELDS=<@{$rfields}>\n"; + print {*STDOUT} "UNMODIFIED TOKENS=<@{$rtokens}>\n"; + print {*STDOUT} "UNMODIFIED PATTERNS=<@{$rpatterns}>\n"; }; # handle cases of leading colon on this line @@ -1216,9 +1216,9 @@ sub fix_terminal_ternary { EXPLAIN_TERNARY && do { local $LIST_SEPARATOR = '><'; - print STDOUT "MODIFIED TOKENS=<@tokens>\n"; - print STDOUT "MODIFIED PATTERNS=<@patterns>\n"; - print STDOUT "MODIFIED FIELDS=<@fields>\n"; + print {*STDOUT} "MODIFIED TOKENS=<@tokens>\n"; + print {*STDOUT} "MODIFIED PATTERNS=<@patterns>\n"; + print {*STDOUT} "MODIFIED FIELDS=<@fields>\n"; }; # all ok .. update the arrays @@ -1541,7 +1541,7 @@ sub dump_array { # debug routine to dump array contents local $LIST_SEPARATOR = ')('; - print STDOUT "(@_)\n"; + print {*STDOUT} "(@_)\n"; return; } ## end sub dump_array @@ -1654,7 +1654,7 @@ sub _flush_group_lines { 0 && do { my ( $a, $b, $c ) = caller(); my $nlines = @{$rgroup_lines}; - print STDOUT + print {*STDOUT} "APPEND0: _flush_group_lines called from $a $b $c lines=$nlines, type=$group_type \n"; }; @@ -3409,7 +3409,7 @@ sub compare_patterns { EXPLAIN_COMPARE_PATTERNS && $return_code - && print STDERR "no match because $GoToMsg\n"; + && print {*STDOUT} "no match because $GoToMsg\n"; return ( $return_code, \$GoToMsg ); diff --git a/lib/Perl/Tidy/VerticalAligner/Alignment.pm b/lib/Perl/Tidy/VerticalAligner/Alignment.pm index d3d7a3d6..678b8908 100644 --- a/lib/Perl/Tidy/VerticalAligner/Alignment.pm +++ b/lib/Perl/Tidy/VerticalAligner/Alignment.pm @@ -27,7 +27,7 @@ sub AUTOLOAD { return if ( $AUTOLOAD =~ /\bDESTROY$/ ); my ( $pkg, $fname, $lno ) = caller(); my $my_package = __PACKAGE__; - print STDERR <