From fde76174305b804c24b326dc1c816b7a1b13c73a Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Tue, 10 May 2022 15:23:34 -0700 Subject: [PATCH] switch to use English + other minor code cleanups --- lib/Perl/Tidy.pm | 88 ++++++++++++++++---------------- lib/Perl/Tidy/Debugger.pm | 3 +- lib/Perl/Tidy/Diagnostics.pm | 3 +- lib/Perl/Tidy/Formatter.pm | 87 ++++++++++++++++++++----------- lib/Perl/Tidy/HtmlWriter.pm | 19 ++++--- lib/Perl/Tidy/Logger.pm | 6 ++- lib/Perl/Tidy/Tokenizer.pm | 72 +++++++++++++++++++------- lib/Perl/Tidy/VerticalAligner.pm | 13 ++--- 8 files changed, 181 insertions(+), 110 deletions(-) diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index 5a297021..fc40e147 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -62,6 +62,7 @@ use warnings; use strict; use Exporter; use Carp; +use English qw( -no_match_vars ); use Digest::MD5 qw(md5_hex); use Perl::Tidy::Debugger; use Perl::Tidy::DevNull; @@ -77,7 +78,7 @@ use Perl::Tidy::LineSource; use Perl::Tidy::Logger; use Perl::Tidy::Tokenizer; use Perl::Tidy::VerticalAligner; -local $| = 1; +local $OUTPUT_AUTOFLUSH = 1; # this can be turned on for extra checking during development use constant DEVEL_MODE => 0; @@ -237,7 +238,7 @@ EOM $fh = $New->( $filename, $mode ); if ( !$fh ) { - Warn("Couldn't open file:$filename in mode:$mode : $!\n"); + Warn("Couldn't open file:$filename in mode:$mode : $ERRNO\n"); } else { @@ -286,7 +287,7 @@ sub find_input_line_ending { binmode $fh; my $buf; read( $fh, $buf, 1024 ); - close $fh; + close $fh || return $ending; if ( $buf && $buf =~ /([\012\015]+)/ ) { my $test = $1; @@ -315,7 +316,7 @@ sub find_input_line_ending { BEGIN { eval { require File::Spec }; - $missing_file_spec = $@; + $missing_file_spec = $EVAL_ERROR; } sub catfile { @@ -338,7 +339,7 @@ sub find_input_line_ending { my $test_file = $path . $name; my ( $test_name, $test_path ) = fileparse($test_file); return $test_file if ( $test_name eq $name ); - return if ( $^O eq 'VMS' ); + return if ( $OSNAME eq 'VMS' ); # this should work at least for Windows and Unix: $test_file = $path . '/' . $name; @@ -511,7 +512,7 @@ sub perltidy { local *STDERR = *STDERR; if ( my @bad_keys = grep { !exists $defaults{$_} } keys %input_hash ) { - local $" = ')('; + local $LIST_SEPARATOR = ')('; my @good_keys = sort keys %defaults; @bad_keys = sort @bad_keys; confess <{'output-path'}; unless ( -d $new_path ) { unless ( mkdir $new_path, 0777 ) { - Die("unable to create directory $new_path: $!\n"); + Die("unable to create directory $new_path: $ERRNO\n"); } } my $path = $new_path; @@ -1134,9 +1135,7 @@ EOM } # Case 3. guess input stream encoding if requested - elsif ($rOpts_character_encoding eq 'guess' - || $rOpts_character_encoding eq 'GUESS' ) - { + elsif ( lc($rOpts_character_encoding) eq 'guess' ) { # The guessing strategy is simple: use Encode::Guess to guess # an encoding. If and only if the guess is utf8, try decoding and @@ -1163,7 +1162,7 @@ EOM else { eval { $buf = $decoder->decode($buf_in); }; - if ($@) { + if ($EVAL_ERROR) { $encoding_log_message .= <{'use-unicode-gcstring'} ) { + $loaded_unicode_gcstring = !$EVAL_ERROR; + if ( $EVAL_ERROR && $rOpts->{'use-unicode-gcstring'} ) { Warn(<new_tmpfile() - or Die("cannot open temp file for -b option: $!\n"); + or Die("cannot open temp file for -b option: $ERRNO\n"); $output_name = $display_name; } else { @@ -1394,7 +1393,7 @@ EOM ( $fh_tee, my $tee_filename ) = Perl::Tidy::streamhandle( $tee_file, 'w', $is_encoded_data ); if ( !$fh_tee ) { - Warn("couldn't open TEE file $tee_file: $!\n"); + Warn("couldn't open TEE file $tee_file: $ERRNO\n"); } } @@ -1837,7 +1836,7 @@ EOM Encode::encode( "UTF-8", $destination_buffer, Encode::FB_CROAK | Encode::LEAVE_SRC ); }; - if ($@) { + if ($EVAL_ERROR) { Warn( "Error attempting to encode output string ref; encoding not done\n" @@ -1903,7 +1902,7 @@ EOM if ( -f $backup_name ) { unlink($backup_name) or Die( -"unable to remove previous '$backup_name' for -b option; check permissions: $!\n" +"unable to remove previous '$backup_name' for -b option; check permissions: $ERRNO\n" ); } @@ -1911,12 +1910,12 @@ EOM # we use copy for symlinks, move for regular files if ( -l $input_file ) { File::Copy::copy( $input_file, $backup_name ) - or Die("File::Copy failed trying to backup source: $!"); + or Die("File::Copy failed trying to backup source: $ERRNO"); } else { rename( $input_file, $backup_name ) or Die( -"problem renaming $input_file to $backup_name for -b option: $!\n" +"problem renaming $input_file to $backup_name for -b option: $ERRNO\n" ); } $ifname = $backup_name; @@ -1927,13 +1926,14 @@ EOM # handle of an open nameless temporary file so we would lose # everything if we closed it. seek( $output_file, 0, 0 ) - or Die("unable to rewind a temporary file for -b option: $!\n"); + or + Die("unable to rewind a temporary file for -b option: $ERRNO\n"); my ( $fout, $iname ) = Perl::Tidy::streamhandle( $input_file, 'w', $is_encoded_data ); if ( !$fout ) { Die( -"problem re-opening $input_file for write for -b option; check file and directory permissions: $!\n" +"problem re-opening $input_file for write for -b option; check file and directory permissions: $ERRNO\n" ); } @@ -2047,7 +2047,7 @@ EOM else { unlink($ifname) or Die( -"unable to remove previous '$ifname' for -b option; check permissions: $!\n" +"unable to remove previous '$ifname' for -b option; check permissions: $ERRNO\n" ); } } @@ -2101,7 +2101,7 @@ sub line_diff { while ( $mask =~ /[^\0]/g ) { $count++; my $pos_last = $pos; - $pos = $-[0]; + $pos = $LAST_MATCH_START[0]; if ( $count == 1 ) { $pos1 = $pos; } $diff_marker .= ' ' x ( $pos - $pos_last - 1 ) . '^'; @@ -2295,7 +2295,7 @@ sub write_logfile_header { $rraw_options, $Windows_type, $readable_options ) = @_; $logger_object->write_logfile_entry( -"perltidy version $VERSION log file on a $^O system, OLD_PERL_VERSION=$]\n" +"perltidy version $VERSION log file on a $OSNAME system, OLD_PERL_VERSION=$OLD_PERL_VERSION\n" ); if ($Windows_type) { $logger_object->write_logfile_entry("Windows type is $Windows_type\n"); @@ -3211,7 +3211,7 @@ sub _process_command_line { # Previous configuration is reset at the exit of this routine. my $glc; eval { $glc = Getopt::Long::Configure() }; - unless ($@) { + unless ($EVAL_ERROR) { eval { Getopt::Long::ConfigDefaults() }; } else { $glc = undef } @@ -3284,7 +3284,7 @@ sub _process_command_line { } } unless ( -e $config_file ) { - Warn("cannot find file given with -pro=$config_file: $!\n"); + Warn("cannot find file given with -pro=$config_file: $ERRNO\n"); $config_file = ""; } } @@ -3839,7 +3839,7 @@ sub expand_command_abbreviations { # make sure we are not in an infinite loop if ( $pass_count == $max_passes ) { - local $" = ')('; + local $LIST_SEPARATOR = ')('; Warn(<{$name} ) { - local $" = ')('; + local $LIST_SEPARATOR = ')('; my @names = sort keys %{$rexpansion}; $death_message = "Here is a list of all installed aliases\n(@names)\n" - . "Attempting to redefine alias ($name) in config file $config_file line $.\n"; + . "Attempting to redefine alias ($name) in config file $config_file line $INPUT_LINE_NUMBER\n"; last; } $rexpansion->{$name} = []; diff --git a/lib/Perl/Tidy/Debugger.pm b/lib/Perl/Tidy/Debugger.pm index e60ecf8d..3e3e76a6 100644 --- a/lib/Perl/Tidy/Debugger.pm +++ b/lib/Perl/Tidy/Debugger.pm @@ -7,6 +7,7 @@ package Perl::Tidy::Debugger; use strict; use warnings; +use English qw( -no_match_vars ); our $VERSION = '20220217.04'; sub new { @@ -29,7 +30,7 @@ sub really_open_debug_file { my ( $fh, $filename ) = Perl::Tidy::streamhandle( $debug_file, 'w', $is_encoded_data ); if ( !$fh ) { - Perl::Tidy::Warn("can't open $debug_file: $!\n"); + Perl::Tidy::Warn("can't open $debug_file: $ERRNO\n"); } $self->{_debug_file_opened} = 1; $self->{_fh} = $fh; diff --git a/lib/Perl/Tidy/Diagnostics.pm b/lib/Perl/Tidy/Diagnostics.pm index df74dada..fcddc5a5 100644 --- a/lib/Perl/Tidy/Diagnostics.pm +++ b/lib/Perl/Tidy/Diagnostics.pm @@ -20,6 +20,7 @@ package Perl::Tidy::Diagnostics; use strict; use warnings; +use English qw( -no_match_vars ); our $VERSION = '20220217.04'; sub AUTOLOAD { @@ -70,7 +71,7 @@ sub write_diagnostics { unless ( $self->{_write_diagnostics_count} ) { open( $self->{_fh}, ">", "DIAGNOSTICS" ) - or Perl::Tidy::Die("couldn't open DIAGNOSTICS: $!\n"); + or Perl::Tidy::Die("couldn't open DIAGNOSTICS: $ERRNO\n"); } my $fh = $self->{_fh}; diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index a3148184..f1d7709b 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -49,6 +49,7 @@ use constant DEVEL_MODE => 0; { #<<< A non-indenting brace to contain all lexical variables use Carp; +use English qw( -no_match_vars ); our $VERSION = '20220217.04'; # The Tokenizer will be loaded with the Formatter @@ -205,8 +206,10 @@ my ( %is_if_unless_while_until_for_foreach, %is_last_next_redo_return, %is_if_unless, + %is_if_elsif, %is_if_unless_elsif, %is_if_unless_elsif_else, + %is_elsif_else, %is_and_or, %is_chain_operator, %is_block_without_semicolon, @@ -221,6 +224,8 @@ my ( %is_opening_sequence_token, %is_closing_sequence_token, %is_container_label_type, + %is_die_confess_croak_warn, + %is_my_our_local, @all_operators, @@ -532,7 +537,7 @@ BEGIN { use constant WS_NO => -1; # Token bond strengths. - use constant NO_BREAK => 10000; + use constant NO_BREAK => 10_000; use constant VERY_STRONG => 100; use constant STRONG => 2.1; use constant NOMINAL => 1.1; @@ -597,12 +602,18 @@ BEGIN { @q = qw(if unless); @is_if_unless{@q} = (1) x scalar(@q); + @q = qw(if elsif); + @is_if_elsif{@q} = (1) x scalar(@q); + @q = qw(if unless elsif); @is_if_unless_elsif{@q} = (1) x scalar(@q); @q = qw(if unless elsif else); @is_if_unless_elsif_else{@q} = (1) x scalar(@q); + @q = qw(elsif else); + @is_elsif_else{@q} = (1) x scalar(@q); + @q = qw(and or err); @is_and_or{@q} = (1) x scalar(@q); @@ -669,6 +680,12 @@ BEGIN { @q = qw( k => && || ? : . ); @is_container_label_type{@q} = (1) x scalar(@q); + @q = qw( die confess croak warn ); + @is_die_confess_croak_warn{@q} = (1) x scalar(@q); + + @q = qw( my our local ); + @is_my_our_local{@q} = (1) x scalar(@q); + # Braces -bbht etc must follow these. Note: experimentation with # including a simple comma shows that it adds little and can lead # to poor formatting in complex lists. @@ -968,7 +985,7 @@ sub check_keys { my $error = @unknown_keys; if ($exact_match) { $error ||= @missing_keys } if ($error) { - local $" = ')('; + local $LIST_SEPARATOR = ')('; my @expected_keys = sort keys %{$rvalid}; @unknown_keys = sort @unknown_keys; Fault(<{'delete-closing-side-comments'} ) { $rOpts->{'delete-closing-side-comments'} = 0; $rOpts->{'closing-side-comments'} = 1; - $rOpts->{'closing-side-comment-interval'} = 100000000; + $rOpts->{'closing-side-comment-interval'} = 100_000_000; } } @@ -1598,12 +1615,12 @@ EOM # make -l=0 equal to -l=infinite if ( !$rOpts->{'maximum-line-length'} ) { - $rOpts->{'maximum-line-length'} = 1000000; + $rOpts->{'maximum-line-length'} = 1_000_000; } # make -lbl=0 equal to -lbl=infinite if ( !$rOpts->{'long-block-line-count'} ) { - $rOpts->{'long-block-line-count'} = 1000000; + $rOpts->{'long-block-line-count'} = 1_000_000; } my $ole = $rOpts->{'output-line-ending'}; @@ -2272,7 +2289,7 @@ sub initialize_keep_old_breakpoints { my %flags = (); my @list = split_words($str); if ( DEBUG_KB && @list ) { - local $" = ' '; + local $LIST_SEPARATOR = ' '; print <print(<print(< 0 ) { $rbond_strength_to_go->[ $i - 1 ] -= $delta_bias; @@ -4534,7 +4553,7 @@ sub bad_pattern { # by this program. my ($pattern) = @_; eval "'##'=~/$pattern/"; - return $@; + return $EVAL_ERROR; } { ## begin closure prepare_cuddled_block_types @@ -4912,7 +4931,7 @@ sub make_keyword_group_list_pattern { my @keyword_list; my @comment_list; foreach my $word (@words) { - if ( $word =~ /^(BC|SBC)$/ ) { + if ( $word eq 'BC' || $word eq 'SBC' ) { push @comment_list, $word; if ( $word eq 'SBC' ) { push @comment_list, 'SBCX' } } @@ -6647,7 +6666,8 @@ sub respace_tokens { && $next_nonblank_token =~ /^[; \)\}]$/ # scalar is not declared - && !( $type_0 eq 'k' && $token_0 =~ /^(my|our|local)$/ ) + ## =~ /^(my|our|local)$/ + && !( $type_0 eq 'k' && $is_my_our_local{$token_0} ) ) { my $lno = 1 + $rLL_new->[$Kp]->[_LINE_INDEX_]; @@ -7233,12 +7253,13 @@ EOM $block_type =~ s/\s+$//; # Try to filter out parenless sub calls - my ( $Knn1, $Knn2 ); - my ( $type_nn1, $type_nn2 ) = ( 'b', 'b' ); - $Knn1 = $self->K_next_nonblank( $K_opening, $rLL_new ); - $Knn2 = $self->K_next_nonblank( $Knn1, $rLL_new ) if defined($Knn1); - $type_nn1 = $rLL_new->[$Knn1]->[_TYPE_] if ( defined($Knn1) ); - $type_nn2 = $rLL_new->[$Knn2]->[_TYPE_] if ( defined($Knn2) ); + my $Knn1 = $self->K_next_nonblank( $K_opening, $rLL_new ); + my $Knn2; + if ( defined($Knn1) ) { + $Knn2 = $self->K_next_nonblank( $Knn1, $rLL_new ); + } + my $type_nn1 = defined($Knn1) ? $rLL_new->[$Knn1]->[_TYPE_] : 'b'; + my $type_nn2 = defined($Knn2) ? $rLL_new->[$Knn2]->[_TYPE_] : 'b'; # if ( $type_nn1 =~ /^[wU]$/ && $type_nn2 =~ /^[wiqQGCZ]$/ ) { if ( $wU{$type_nn1} && $wiq{$type_nn2} ) { @@ -12919,7 +12940,8 @@ EOM # if we do not see another elseif or an else. if ($looking_for_else) { - unless ( $rLL->[$K_first_true]->[_TOKEN_] =~ /^(elsif|else)$/ ) { + ## /^(elsif|else)$/ + if ( !$is_elsif_else{ $rLL->[$K_first_true]->[_TOKEN_] } ) { write_logfile_entry("(No else block)\n"); } $looking_for_else = 0; @@ -13387,8 +13409,8 @@ EOM $looking_for_else = 1; # ok, check on next line } else { - - unless ( $next_nonblank_token =~ /^(elsif|else)$/ ) { + ## /^(elsif|else)$/ + if ( !$is_elsif_else{$next_nonblank_token} ) { write_logfile_entry("No else block :(\n"); } } @@ -13970,7 +13992,8 @@ sub starting_one_line_block { # ; # very long comment...... # so we do not need to include the length of the comment, which # would break the block. Project 'bioperl' has coding like this. - if ( $block_type !~ /^(if|else|elsif|unless)$/ + ## !~ /^(if|else|elsif|unless)$/ + if ( !$is_if_unless_elsif_else{$block_type} || $K_last == $Ki_nonblank ) { $Ki_nonblank = $K_last; @@ -17730,8 +17753,12 @@ sub break_long_lines { $nesting_depth_to_go[$i_next_nonblank] ) && ( $next_nonblank_type =~ /^(\.|\&\&|\|\|)$/ - || ( $next_nonblank_type eq 'k' - && $next_nonblank_token =~ /^(and|or)$/ ) + || ( + $next_nonblank_type eq 'k' + + ## /^(and|or)$/ # note: includes 'xor' now + && $is_and_or{$next_nonblank_token} + ) ) ) { @@ -21884,8 +21911,9 @@ EOM return unless (@candidates); # sort by available whitespace so that we can remove whitespace - # from the maximum available first - @candidates = sort { $b->[1] <=> $a->[1] } @candidates; + # from the maximum available first. + @candidates = + sort { $b->[1] <=> $a->[1] || $a->[0] <=> $b->[0] } @candidates; # keep removing whitespace until we are done or have no more foreach my $candidate (@candidates) { @@ -25883,7 +25911,8 @@ sub set_vertical_tightness_flags { # save text after 'if' and 'elsif' to append after 'else' if ($accumulating_text_for_block) { - if ( $accumulating_text_for_block =~ /^(if|elsif)$/ ) { + ## ( $accumulating_text_for_block =~ /^(if|elsif)$/ ) { + if ( $is_if_elsif{$accumulating_text_for_block} ) { push @{$rleading_block_if_elsif_text}, $leading_block_text; } } diff --git a/lib/Perl/Tidy/HtmlWriter.pm b/lib/Perl/Tidy/HtmlWriter.pm index eee9553f..5435a8f5 100644 --- a/lib/Perl/Tidy/HtmlWriter.pm +++ b/lib/Perl/Tidy/HtmlWriter.pm @@ -9,6 +9,7 @@ use strict; use warnings; our $VERSION = '20220217.04'; +use English qw( -no_match_vars ); use File::Basename; # class variables @@ -31,10 +32,10 @@ use vars qw{ BEGIN { if ( !eval { require HTML::Entities; 1 } ) { - $missing_html_entities = $@ ? $@ : 1; + $missing_html_entities = $EVAL_ERROR ? $EVAL_ERROR : 1; } if ( !eval { require Pod::Html; 1 } ) { - $missing_pod_html = $@ ? $@ : 1; + $missing_pod_html = $EVAL_ERROR ? $EVAL_ERROR : 1; } } @@ -88,7 +89,7 @@ sub new { ( $html_fh, my $html_filename ) = Perl::Tidy::streamhandle( $html_file, 'w' ); unless ($html_fh) { - Perl::Tidy::Warn("can't open $html_file: $!\n"); + Perl::Tidy::Warn("can't open $html_file: $ERRNO\n"); return; } $html_file_opened = 1; @@ -589,7 +590,7 @@ sub write_style_sheet_file { my $css_filename = shift; my $fh; unless ( $fh = IO::File->new("> $css_filename") ) { - Perl::Tidy::Die("can't open $css_filename: $!\n"); + Perl::Tidy::Die("can't open $css_filename: $ERRNO\n"); } write_style_sheet_data($fh); close_object($fh); @@ -953,7 +954,8 @@ sub pod_to_html { # because the tmpfile may be one of the names used for frames if ( -e $tmpfile ) { unless ( unlink($tmpfile) ) { - Perl::Tidy::Warn("couldn't unlink temporary file $tmpfile: $!\n"); + Perl::Tidy::Warn( + "couldn't unlink temporary file $tmpfile: $ERRNO\n"); $success_flag = 0; } } @@ -1000,7 +1002,8 @@ sub make_frame { # 2. The current .html filename is renamed to be the contents panel rename( $html_filename, $src_filename ) - or Perl::Tidy::Die("Cannot rename $html_filename to $src_filename:$!\n"); + or Perl::Tidy::Die( + "Cannot rename $html_filename to $src_filename: $ERRNO\n"); # 3. Then use the original html filename for the frame write_frame_html( @@ -1015,7 +1018,7 @@ sub write_toc_html { # write a separate html table of contents file for frames my ( $title, $toc_filename, $src_basename, $rtoc, $src_frame_name ) = @_; my $fh = IO::File->new( $toc_filename, 'w' ) - or Perl::Tidy::Die("Cannot open $toc_filename:$!\n"); + or Perl::Tidy::Die("Cannot open $toc_filename: $ERRNO\n"); $fh->print(< @@ -1046,7 +1049,7 @@ sub write_frame_html { ) = @_; my $fh = IO::File->new( $frame_filename, 'w' ) - or Perl::Tidy::Die("Cannot open $toc_basename:$!\n"); + or Perl::Tidy::Die("Cannot open $toc_basename: $ERRNO\n"); $fh->print(<{_warning_file}; ( $fh_warnings, my $filename ) = Perl::Tidy::streamhandle( $warning_file, 'w', $is_encoded_data ); - $fh_warnings or Perl::Tidy::Die("couldn't open $filename $!\n"); + $fh_warnings + or Perl::Tidy::Die("couldn't open $filename: $ERRNO\n"); Perl::Tidy::Warn_msg("## Please see file $filename\n") unless ref($warning_file); $self->{_fh_warnings} = $fh_warnings; diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm index 2cbc9ced..9da515fd 100644 --- a/lib/Perl/Tidy/Tokenizer.pm +++ b/lib/Perl/Tidy/Tokenizer.pm @@ -21,6 +21,8 @@ package Perl::Tidy::Tokenizer; use strict; use warnings; +use English qw( -no_match_vars ); + our $VERSION = '20220217.04'; # this can be turned on for extra checking during development @@ -94,6 +96,7 @@ use vars qw{ %is_keyword %is_code_block_token %is_sort_map_grep_eval_do + %is_sort_map_grep %is_grep_alias %really_want_term @opening_brace_names @@ -102,10 +105,13 @@ use vars qw{ %is_keyword_taking_optional_arg %is_keyword_rejecting_slash_as_pattern_delimiter %is_keyword_rejecting_question_as_pattern_delimiter + %is_q_qq_qx_qr_s_y_tr_m %is_q_qq_qw_qx_qr_s_y_tr_m %is_sub %is_package %is_comma_question_colon + %is_if_elsif_unless + %is_if_elsif_unless_case_when %other_line_endings $code_skipping_pattern_begin $code_skipping_pattern_end @@ -273,7 +279,7 @@ sub bad_pattern { # by this program. my ($pattern) = @_; eval "'##'=~/$pattern/"; - return $@; + return $EVAL_ERROR; } sub make_code_skipping_pattern { @@ -733,7 +739,7 @@ EOM @{ $tokenizer_self->[_rlower_case_labels_at_] }; write_logfile_entry( "Suggest using upper case characters in label(s)\n"); - local $" = ')('; + local $LIST_SEPARATOR = ')('; write_logfile_entry(" defined at line(s): (@lower_case_labels_at)\n"); } return $severe_error; @@ -788,7 +794,9 @@ sub get_line { # Find and remove what characters terminate this line, including any # control r my $input_line_separator = ""; - if ( chomp($input_line) ) { $input_line_separator = $/ } + if ( chomp($input_line) ) { + $input_line_separator = $INPUT_RECORD_SEPARATOR; + } # The first test here very significantly speeds things up, but be sure to # keep the regex and hash %other_line_endings the same. @@ -3870,12 +3878,12 @@ EOM $next_type = $rtoken_type->[ $i + 1 ]; DEBUG_TOKENIZE && do { - local $" = ')('; + local $LIST_SEPARATOR = ')('; my @debug_list = ( $last_nonblank_token, $tok, $next_tok, $brace_depth, $brace_type[$brace_depth], $paren_depth, - $paren_type[$paren_depth] + $paren_type[$paren_depth], ); print STDOUT "TOKENIZE:(@debug_list)\n"; }; @@ -4332,9 +4340,12 @@ EOM # else or elsif blocks to be formatted. This is indicated # by a last noblank token of ';' elsif ( $tok eq 'elsif' ) { - if ( $last_nonblank_token ne ';' - && $last_nonblank_block_type !~ - /^(if|elsif|unless)$/ ) + if ( + $last_nonblank_token ne ';' + + ## !~ /^(if|elsif|unless)$/ + && !$is_if_elsif_unless{$last_nonblank_block_type} + ) { warning( "expecting '$tok' to follow one of 'if|elsif|unless'\n" @@ -4345,15 +4356,17 @@ EOM # patched for SWITCH/CASE if ( - $last_nonblank_token ne ';' - && $last_nonblank_block_type !~ - /^(if|elsif|unless|case|when)$/ + $last_nonblank_token ne ';' + + ## !~ /^(if|elsif|unless|case|when)$/ + && !$is_if_elsif_unless_case_when{ + $last_nonblank_block_type} # patch to avoid an unwanted error message for # the case of a parenless 'case' (RT 105484): # switch ( 1 ) { case x { 2 } else { } } - && $statement_type !~ - /^(if|elsif|unless|case|when)$/ + ## !~ /^(if|elsif|unless|case|when)$/ + && !$is_if_elsif_unless_case_when{$statement_type} ) { warning( @@ -5731,8 +5744,11 @@ sub code_block_type { # print 'hi' if { x => 1, }->{x}; # We can identify this situation because the last nonblank type # will be a keyword (instead of a closing peren) - if ( $last_nonblank_token =~ /^(if|unless)$/ - && $last_nonblank_type eq 'k' ) + if ( + $last_nonblank_type eq 'k' + && ( $last_nonblank_token eq 'if' + || $last_nonblank_token eq 'unless' ) + ) { return ""; } @@ -5781,7 +5797,9 @@ sub code_block_type { # Check for a code block within a parenthesized function call elsif ( $last_nonblank_token eq '(' ) { my $paren_type = $paren_type[$paren_depth]; - if ( $paren_type && $paren_type =~ /^(map|grep|sort)$/ ) { + + # /^(map|grep|sort)$/ + if ( $paren_type && $is_sort_map_grep{$paren_type} ) { # We will mark this as a code block but use type 't' instead # of the name of the contining function. This will allow for @@ -5911,8 +5929,9 @@ sub decide_if_code_block { # it is a comma which is not a pattern delimeter except for qw ( - $pre_types[$j] eq ',' - && $pre_tokens[$jbeg] !~ /^(s|m|y|tr|qr|q|qq|qx)$/ + $pre_types[$j] eq ',' + ## !~ /^(s|m|y|tr|qr|q|qq|qx)$/ + && !$is_q_qq_qx_qr_s_y_tr_m{ $pre_tokens[$jbeg] } ) # or a => @@ -7782,7 +7801,10 @@ sub scan_identifier_do { # In something like '$${' we have type '$$' (and only # part of an identifier) && !( $identifier =~ /\$$/ && $tok eq '{' ) - && ( $identifier !~ /^(sub |package )$/ ) + + ## && ( $identifier !~ /^(sub |package )$/ ) + && $identifier ne 'sub ' + && $identifier ne 'package ' ) { $type = 'i'; @@ -9362,6 +9384,9 @@ BEGIN { @q = qw( sort map grep eval do ); @is_sort_map_grep_eval_do{@q} = (1) x scalar(@q); + @q = qw( sort map grep ); + @is_sort_map_grep{@q} = (1) x scalar(@q); + %is_grep_alias = (); # I'll build the list of keywords incrementally @@ -9691,7 +9716,10 @@ BEGIN { delete $really_want_term{'F'}; # file test works on $_ if no following term delete $really_want_term{'Y'}; # indirect object, too risky to check syntax; # let perl do it + @q = qw(q qq qx qr s y tr m); + @is_q_qq_qx_qr_s_y_tr_m{@q} = (1) x scalar(@q); + # Note added 'qw' here @q = qw(q qq qw qx qr s y tr m); @is_q_qq_qw_qx_qr_s_y_tr_m{@q} = (1) x scalar(@q); @@ -9702,6 +9730,12 @@ BEGIN { push @q, ','; @is_comma_question_colon{@q} = (1) x scalar(@q); + @q = qw( if elsif unless ); + @is_if_elsif_unless{@q} = (1) x scalar(@q); + + @q = qw( if elsif unless case when ); + @is_if_elsif_unless_case_when{@q} = (1) x scalar(@q); + # Hash of other possible line endings which may occur. # Keep these coordinated with the regex where this is used. # Note: chr(13) = chr(015)="\r". diff --git a/lib/Perl/Tidy/VerticalAligner.pm b/lib/Perl/Tidy/VerticalAligner.pm index ea4eb6fc..454736f0 100644 --- a/lib/Perl/Tidy/VerticalAligner.pm +++ b/lib/Perl/Tidy/VerticalAligner.pm @@ -2,6 +2,7 @@ package Perl::Tidy::VerticalAligner; use strict; use warnings; use Carp; +use English qw( -no_match_vars ); our $VERSION = '20220217.04'; use Perl::Tidy::VerticalAligner::Alignment; use Perl::Tidy::VerticalAligner::Line; @@ -1003,7 +1004,7 @@ sub fix_terminal_ternary { my @field_lengths = @{$rfield_lengths}; EXPLAIN_TERNARY && do { - local $" = '><'; + local $LIST_SEPARATOR = '><'; print STDOUT "CURRENT FIELDS=<@{$rfields_old}>\n"; print STDOUT "CURRENT TOKENS=<@{$rtokens_old}>\n"; print STDOUT "CURRENT PATTERNS=<@{$rpatterns_old}>\n"; @@ -1092,7 +1093,7 @@ sub fix_terminal_ternary { } EXPLAIN_TERNARY && do { - local $" = '><'; + local $LIST_SEPARATOR = '><'; print STDOUT "MODIFIED TOKENS=<@tokens>\n"; print STDOUT "MODIFIED PATTERNS=<@patterns>\n"; print STDOUT "MODIFIED FIELDS=<@fields>\n"; @@ -1387,7 +1388,7 @@ sub copy_old_alignments { sub dump_array { # debug routine to dump array contents - local $" = ')('; + local $LIST_SEPARATOR = ')('; print STDOUT "(@_)\n"; return; } @@ -2368,7 +2369,7 @@ sub delete_selected_tokens { use constant EXPLAIN_DELETE_SELECTED => 0; - local $" = '> <'; + local $LIST_SEPARATOR = '> <'; EXPLAIN_DELETE_SELECTED && print < old jmax: $jmax_old @@ -3557,7 +3558,7 @@ sub get_line_token_info { # debug 0 && do { - local $" = ')('; + local $LIST_SEPARATOR = ')('; print "lev_min=$lev_min, lev_max=$lev_max, levels=(@levs)\n"; foreach my $key ( sort keys %{$rtoken_patterns} ) { print "$key => $rtoken_patterns->{$key}\n"; @@ -3954,7 +3955,7 @@ sub prune_alignment_tree { sub Dump_tree_groups { my ( $rgroup, $msg ) = @_; print "$msg\n"; - local $" = ')('; + local $LIST_SEPARATOR = ')('; foreach my $item ( @{$rgroup} ) { my @fix = @{$item}; foreach (@fix) { $_ = "undef" unless defined $_; } -- 2.39.5