From: Steve Hancock Date: Wed, 13 May 2020 14:53:21 +0000 (-0700) Subject: fixed error handling for -ce, added test X-Git-Tag: 20200619~31 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=0ee4137db6a68bbe0e97c95b128207c045601706;p=perltidy.git fixed error handling for -ce, added test --- diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index e0866875..2568f1ce 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -1621,7 +1621,12 @@ sub write_line { # Negative values can occur in files with unbalanced containers my $slevel = $rslevels->[$j]; if ( $slevel < 0 ) { $slevel = 0 } - if ( $rlevels->[$j] < 0 ) { $rlevels->[$j] = 0 } + + # But do not clip the 'level' variable yet. We will do this later, + # in sub 'store_token_to_go'. The reason is that in files with + # level errors, the logic in 'weld_cuddled_else' uses a stack + # logic that will give bad welds if we clip levels here. + ## if ( $rlevels->[$j] < 0 ) { $rlevels->[$j] = 0 } my @tokary; @tokary[ @@ -3111,12 +3116,12 @@ sub respace_tokens { my ( $Kfirst, $Klast ) = @{$rK_range}; my $jmax = -1; if ( defined($Kfirst) ) { $jmax = $Klast - $Kfirst } - my $input_line = $line_of_tokens->{_line_text}; + my $input_line = $line_of_tokens->{_line_text}; my $is_static_block_comment = 0; # Handle a continued quote.. - if ($line_of_tokens->{_starting_in_quote} ) { + if ( $line_of_tokens->{_starting_in_quote} ) { # A line which is entirely a quote or pattern must go out # verbatim. Note: the \n is contained in $input_line. @@ -4459,11 +4464,11 @@ sub whitespace_cycle_adjustment { my $radjusted_levels; my $rOpts_whitespace_cycle = $rOpts->{'whitespace-cycle'}; if ( $rOpts_whitespace_cycle && $rOpts_whitespace_cycle > 0 ) { - my $whitespace_last_level = -1; + my $whitespace_last_level = -1; my @whitespace_level_stack = (); - my $last_nonblank_type = 'b'; - my $last_nonblank_token = ''; - my $Kmax = @{$rLL} - 1; + my $last_nonblank_type = 'b'; + my $last_nonblank_token = ''; + my $Kmax = @{$rLL} - 1; foreach my $KK ( 0 .. $Kmax ) { my $level_abs = $rLL->[$KK]->[_LEVEL_]; my $level = $level_abs; @@ -4517,7 +4522,7 @@ sub bli_adjustment { # if -bli is set, adds one continuation indentation for certain braces my $self = shift; - return unless ($rOpts->{'brace-left-and-indent'}); + return unless ( $rOpts->{'brace-left-and-indent'} ); my $rLL = $self->{rLL}; return unless ( defined($rLL) && @{$rLL} ); my $KNEXT = 0; @@ -4768,7 +4773,7 @@ sub finish_formatting { $self->mark_short_nested_blocks(); # Set adjusted levels for the whitespace cycle option - $self->whitespace_cycle_adjustment(); + $self->whitespace_cycle_adjustment(); # Adjust continuation indentation if -bli is set $self->bli_adjustment(); @@ -4884,8 +4889,8 @@ sub set_leading_whitespace { $level_abs, $ci_level, $in_continued_quote ) = @_; - return unless ($rOpts_line_up_parentheses); - return unless ( defined($max_index_to_go) && $max_index_to_go >= 0 ); + return unless ($rOpts_line_up_parentheses); + return unless ( defined($max_index_to_go) && $max_index_to_go >= 0 ); # uses Global Symbols: # "$gnu_position_predictor" @@ -7028,13 +7033,57 @@ sub copy_token_as_type { { # begin process_line_of_CODE + # uses Global Symbols: + # "$ending_in_quote" + # "$file_writer_object" + # "$input_line_number" + # "$is_static_block_comment" + # "$last_line_leading_type" + # "$last_output_short_opening_token" + # "$saw_VERSION_in_this_file" + # "$starting_in_quote" + + # "$rOpts" + # "$ANYSUB_PATTERN" + # "$ASUB_PATTERN" + # "$closing_side_comment_list_pattern" + # "$closing_side_comment_prefix_pattern" + + # "%is_anon_sub_1_brace_follower" + # "%is_anon_sub_brace_follower" + # "%is_block_without_semicolon" + # "%is_do_follower" + # "%is_else_brace_follower" + # "%is_if_brace_follower" + # "%is_other_brace_follower" + # "%is_sort_map_grep_eval" + + # "$max_index_to_go" + # "@K_to_go" + # "@block_type_to_go" + # "@bond_strength_to_go" + # "@ci_levels_to_go" + # "@container_environment_to_go" + # "@forced_breakpoint_to_go" + # "@inext_to_go" + # "@iprev_to_go" + # "@levels_to_go" + # "@mate_index_to_go" + # "@nesting_depth_to_go" + # "@nobreak_to_go" + # "@old_breakpoint_to_go" + # "@summed_lengths_to_go" + # "@token_lengths_to_go" + # "@tokens_to_go" + # "@type_sequence_to_go" + # "@types_to_go" + # flags needed by the store routine - my $in_continued_quote; + my $line_of_tokens; my $no_internal_newlines; my $side_comment_follows; - # range of K of tokens for the current line, which might be useful - # for checking for indexing errors + # range of K of tokens for the current line my ( $K_first, $K_last ); # past stored nonblank tokens @@ -7058,7 +7107,8 @@ sub copy_token_as_type { # batch variables my ( $rbrace_follower, $index_start_one_line_block, - $semicolons_before_block_self_destruct, $comma_count_in_batch ); + $semicolons_before_block_self_destruct, + $comma_count_in_batch ); # called at the start of each new batch sub initialize_batch_variables { @@ -7068,11 +7118,11 @@ sub copy_token_as_type { } sub create_one_line_block { - ( $index_start_one_line_block, $semicolons_before_block_self_destruct ) = - @_; + ( $index_start_one_line_block, $semicolons_before_block_self_destruct ) + = @_; return; } - + sub destroy_one_line_block { $index_start_one_line_block = UNDEFINED_INDEX; $semicolons_before_block_self_destruct = 0; @@ -7103,6 +7153,10 @@ sub copy_token_as_type { my $slevel = $rtoken_vars->[_SLEVEL_]; my $ci_level = $rtoken_vars->[_CI_LEVEL_]; + # Clip levels to zero if there are level errors in the file. + # We had to wait until now for reasons explained in sub 'write_line'. + if ( $level < 0 ) { $level = 0 } + # Programming check: The K indexes in the batch must be a continuous # sequence of the global token array. If this relationship fails we # are in danger of losing data. An error here implies an error in @@ -7157,10 +7211,13 @@ sub copy_token_as_type { $summed_lengths_to_go[$max_index_to_go] + $token_lengths_to_go[$max_index_to_go]; + my $in_continued_quote = + ( $Ktoken_vars == $K_first ) && $line_of_tokens->{_starting_in_quote}; + # Define the indentation that this token would have if it started # a new line. We start by using the default formula. # First Adjust levels if necessary to recycle whitespace: - my $level_wc = $level; + my $level_wc = $level; my $radjusted_levels = $self->{radjusted_levels}; if ( defined($radjusted_levels) && @{$radjusted_levels} == @{$rLL} ) { $level_wc = $radjusted_levels->[$Ktoken_vars]; @@ -7217,7 +7274,7 @@ sub copy_token_as_type { # flush is called to output any tokens in the pipeline, so that # an alternate source of lines can be written in the correct order sub flush { - my ($self, $CODE_type) = @_; + my ( $self, $CODE_type ) = @_; destroy_one_line_block(); # if we are flushing within the code stream to insert blank line(s), @@ -7234,7 +7291,7 @@ sub copy_token_as_type { sub process_line_of_CODE { - my ( $self, $line_of_tokens ) = @_; + my ( $self, $my_line_of_tokens ) = @_; # This routine is called once per input line to process all of the # tokens on that line. This is the first stage of beautification. @@ -7261,6 +7318,7 @@ sub copy_token_as_type { # lists and logical structures, and to keep line lengths below the # requested maximum line length. + $line_of_tokens = $my_line_of_tokens; $input_line_number = $line_of_tokens->{_line_number}; my $input_line = $line_of_tokens->{_line_text}; my $CODE_type = $line_of_tokens->{_code_type}; @@ -7319,11 +7377,9 @@ sub copy_token_as_type { } } - my $jmax = $K_last - $K_first; my $rtok_first = $rLL->[$K_first]; - $in_continued_quote = $starting_in_quote = - $line_of_tokens->{_starting_in_quote}; + $starting_in_quote = $line_of_tokens->{_starting_in_quote}; my $in_quote = $line_of_tokens->{_ending_in_quote}; $ending_in_quote = $in_quote; my $guessed_indentation_level = @@ -7485,12 +7541,11 @@ sub copy_token_as_type { # loop to process the tokens one-by-one # We do not want a leading blank if the previous batch just got output - my $Kmin = $K_first; if ( $max_index_to_go < 0 && $rLL->[$K_first]->[_TYPE_] eq 'b' ) { - $Kmin = $K_first + 1; + $K_first++; } - foreach my $Ktoken_vars ( $Kmin .. $K_last ) { + foreach my $Ktoken_vars ( $K_first .. $K_last ) { # pull out some values for this token my $rtoken_vars = $rLL->[$Ktoken_vars]; @@ -7890,11 +7945,6 @@ sub copy_token_as_type { $K_last_nonblank_code = $Ktoken_vars; } - # unset the continued-quote flag since it only applies to the - # first token, and we want to resume normal formatting if - # there are additional tokens on the line - $in_continued_quote = 0; - } # end of loop over all tokens in this 'line_of_tokens' my $type = $rLL->[$K_last]->[_TYPE_]; @@ -7955,8 +8005,8 @@ sub consecutive_nonblank_lines { # arrays. sub process_batch_of_CODE { - my ($self, $comma_count_in_batch ) = @_; - my $rLL = $self->{rLL}; + my ( $self, $comma_count_in_batch ) = @_; + my $rLL = $self->{rLL}; my $rOpts_add_newlines = $rOpts->{'add-newlines'}; my $rOpts_comma_arrow_breakpoints = $rOpts->{'comma-arrow-breakpoints'}; @@ -8377,8 +8427,8 @@ sub starting_one_line_block { my $previous_nonblank_token = ''; my $i_last_nonblank = -1; if ( defined($K_last_nonblank) ) { - $i_last_nonblank = $K_last_nonblank - $K_to_go[0]; - if ($i_last_nonblank >=0) { + $i_last_nonblank = $K_last_nonblank - $K_to_go[0]; + if ( $i_last_nonblank >= 0 ) { $previous_nonblank_token = $rLL->[$K_last_nonblank]->[_TOKEN_]; } } @@ -11258,7 +11308,7 @@ sub lookup_opening_indentation { # Patch for RT#131115: honor -bli flag at closing brace my $is_bli = - $rOpts->{'brace-left-and-indent'} + $rOpts->{'brace-left-and-indent'} && $block_type_to_go[$i_terminal] && $block_type_to_go[$i_terminal] =~ /$bli_pattern/; diff --git a/t/snippets/ce2.in b/t/snippets/ce2.in new file mode 100644 index 00000000..a0061501 --- /dev/null +++ b/t/snippets/ce2.in @@ -0,0 +1,20 @@ +# Previously, perltidy -ce would move a closing brace below a pod section to +# form '} else {'. No longer doing this because if you change back to -nce, the +# brace cannot go back to where it was. +if ($notty) { + $runnonstop = 1; + share($runnonstop); +} + +=pod + +If there is a TTY, we have to determine who it belongs to before we can +... + +=cut + +else { + + # Is Perl being run from a slave editor or graphical debugger? + ... +} diff --git a/t/snippets/expect/ce2.ce b/t/snippets/expect/ce2.ce new file mode 100644 index 00000000..d9204483 --- /dev/null +++ b/t/snippets/expect/ce2.ce @@ -0,0 +1,21 @@ +# Previously, perltidy -ce would move a closing brace below a pod section to +# form '} else {'. No longer doing this because if you change back to -nce, the +# brace cannot go back to where it was. +if ($notty) { + $runnonstop = 1; + share($runnonstop); + +} + +=pod + +If there is a TTY, we have to determine who it belongs to before we can +... + +=cut + +else { + + # Is Perl being run from a slave editor or graphical debugger? + ...; +} diff --git a/t/snippets/expect/ce2.def b/t/snippets/expect/ce2.def new file mode 100644 index 00000000..5755761d --- /dev/null +++ b/t/snippets/expect/ce2.def @@ -0,0 +1,20 @@ +# Previously, perltidy -ce would move a closing brace below a pod section to +# form '} else {'. No longer doing this because if you change back to -nce, the +# brace cannot go back to where it was. +if ($notty) { + $runnonstop = 1; + share($runnonstop); +} + +=pod + +If there is a TTY, we have to determine who it belongs to before we can +... + +=cut + +else { + + # Is Perl being run from a slave editor or graphical debugger? + ...; +} diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt index 9ecdd1a1..1638e6c9 100644 --- a/t/snippets/packing_list.txt +++ b/t/snippets/packing_list.txt @@ -235,6 +235,9 @@ ../snippets20.t space6.def ../snippets20.t space6.space6 ../snippets20.t sub3.def +../snippets20.t wc.def +../snippets20.t wc.wc1 +../snippets20.t wc.wc2 ../snippets3.t ce_wn1.ce_wn ../snippets3.t ce_wn1.def ../snippets3.t colin.colin @@ -375,6 +378,5 @@ ../snippets9.t rt98902.def ../snippets9.t rt98902.rt98902 ../snippets9.t rt99961.def -../snippets20.t wc.def -../snippets20.t wc.wc1 -../snippets20.t wc.wc2 +../snippets20.t ce2.ce +../snippets20.t ce2.def diff --git a/t/snippets20.t b/t/snippets20.t index 5f41b56a..1845695f 100644 --- a/t/snippets20.t +++ b/t/snippets20.t @@ -7,6 +7,8 @@ #4 wc.def #5 wc.wc1 #6 wc.wc2 +#7 ce2.ce +#8 ce2.def # To locate test #13 you can search for its name or the string '#13' @@ -24,6 +26,7 @@ BEGIN { # BEGIN SECTION 1: Parameter combinations # ########################################### $rparams = { + 'ce' => "-cuddled-blocks", 'def' => "", 'space6' => <<'----------', -nwrs="+ - / *" @@ -38,6 +41,29 @@ BEGIN { ############################ $rsources = { + 'ce2' => <<'----------', +# Previously, perltidy -ce would move a closing brace below a pod section to +# form '} else {'. No longer doing this because if you change back to -nce, the +# brace cannot go back to where it was. +if ($notty) { + $runnonstop = 1; + share($runnonstop); +} + +=pod + +If there is a TTY, we have to determine who it belongs to before we can +... + +=cut + +else { + + # Is Perl being run from a slave editor or graphical debugger? + ... +} +---------- + 'space6' => <<'----------', # test some spacing rules at possible filehandles my $z=$x/$y; # ok to change spaces around both sides of the / @@ -198,6 +224,61 @@ my $bb = sub # #6........... }, + + 'ce2.ce' => { + source => "ce2", + params => "ce", + expect => <<'#7...........', +# Previously, perltidy -ce would move a closing brace below a pod section to +# form '} else {'. No longer doing this because if you change back to -nce, the +# brace cannot go back to where it was. +if ($notty) { + $runnonstop = 1; + share($runnonstop); + +} + +=pod + +If there is a TTY, we have to determine who it belongs to before we can +... + +=cut + +else { + + # Is Perl being run from a slave editor or graphical debugger? + ...; +} +#7........... + }, + + 'ce2.def' => { + source => "ce2", + params => "def", + expect => <<'#8...........', +# Previously, perltidy -ce would move a closing brace below a pod section to +# form '} else {'. No longer doing this because if you change back to -nce, the +# brace cannot go back to where it was. +if ($notty) { + $runnonstop = 1; + share($runnonstop); +} + +=pod + +If there is a TTY, we have to determine who it belongs to before we can +... + +=cut + +else { + + # Is Perl being run from a slave editor or graphical debugger? + ...; +} +#8........... + }, }; my $ntests = 0 + keys %{$rtests};