From 6f25ca6842d977f345a574254c6d4aa10e2759fe Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Sun, 21 Jan 2024 17:51:32 -0800 Subject: [PATCH] additional internal checks added to -vsn --- bin/perltidy | 3 +- lib/Perl/Tidy/VerticalAligner.pm | 157 ++++++++++++++++++++++++------- 2 files changed, 126 insertions(+), 34 deletions(-) diff --git a/bin/perltidy b/bin/perltidy index da3584e5..f82fce6c 100755 --- a/bin/perltidy +++ b/bin/perltidy @@ -5042,7 +5042,8 @@ The current default alignment is strict left justification: [ 10.9, 10.9, 11 ], ); -In a future release B<-vsn> will become the default. +This option is mainly limited to lists of comma-separated numbers. In a future +release B<-vsn> will become the default. This option has a control parameter B<--valign-signed-number-limit=N>, or B<-vsnl=N>. This value controls formatting of very long columns of numbers and diff --git a/lib/Perl/Tidy/VerticalAligner.pm b/lib/Perl/Tidy/VerticalAligner.pm index cbdf9d25..e7363bca 100644 --- a/lib/Perl/Tidy/VerticalAligner.pm +++ b/lib/Perl/Tidy/VerticalAligner.pm @@ -5014,20 +5014,36 @@ EOM } ## end sub pad_signed_field sub split_field { - my ( $pat1, $field ) = @_; + my ( $pat1, $field, $pattern ) = @_; # Given; - # $pat1 = first part of a pattern before a 'Q' - # $field = corresponding text field + # $pat1 = first part of a pattern before a 'Q' + # $field = corresponding text field + # $pattern = full pattern # Return: # $pos_start_number = positiion in $field where the Q should start # = 0 if cannot find # $char_end_part1 = the character preceding $pos_start_number + # $ch_opening = the preceding opening container character, if any my $pos_start_number = 0; my $char_end_part1 = EMPTY_STRING; + my $ch_opening = EMPTY_STRING; + my @fail = ( $pos_start_number, $char_end_part1, $ch_opening ); + + # Be sure there is just one 'Q' in the pattern. Multiple Q terms can occur + # when fields are joined, but since we are jumping into the middle of a + # field it is safest not to try to handle them. + my $Q_count = ( $pattern =~ tr/Q/Q/ ); + if ( $Q_count && $Q_count > 1 ) { + return @fail; + } - my @fail = ( 0, EMPTY_STRING ); + # Same thing for commas + my $comma_count = ( $pattern =~ tr/,/,/ ); + if ( $comma_count && $comma_count > 1 ) { + return @fail; + } # Require 0 or 1 braces my $len_field = length($field); @@ -5054,7 +5070,6 @@ sub split_field { my $i_bracket = index( $field, '[' ); my $i_brace = index( $field, '{' ); my $i_opening = length($field); - my $ch_opening; if ( $i_paren >= 0 ) { $i_opening = $i_paren; $ch_opening = '('; @@ -5112,13 +5127,75 @@ sub split_field { return @fail; } - # A final check that we are not in a quote - my $field1 = substr( $field, 0, $pos_start_number - 1 ); - if ( $field1 =~ /[\'\"\`]/ ) { return @fail; } - - return ( $pos_start_number, $char_end_part1 ); + return ( $pos_start_number, $char_end_part1, $ch_opening ); } ## end sub split_field +sub field_matches_end_pattern { + my ( $field2, $pat2 ) = @_; + + # Check that a possible numeric field matches the ending pattern + + # Given: + # $field2 = the rest of the field after removing any sign + # $pat2 = the end pattern of this field + # Return: + # false if field is definitely non-numeric + # true otherwise + + my $next_char = substr( $pat2, 1, 1 ); + my $field2_trim = EMPTY_STRING; + + # if pattern is one of: 'Q,', 'Q,b' + if ( $next_char eq ',' ) { + my $icomma = index( $field2, ',' ); + if ( $icomma >= 0 ) { + $field2_trim = substr( $field2, 0, $icomma ); + } + } + + # if pattern is one of: 'Qb', 'Qb}', 'Qb},' + elsif ( $next_char eq 'b' ) { + my $ispace = index( $field2, SPACE ); + if ( $ispace >= 0 ) { + $field2_trim = substr( $field2, 0, $ispace ); + } + } + + # if pattern is one of 'Q},', 'Q};' + elsif ( $next_char eq '}' ) { + if ( $field2 =~ /^([^\)\}\]]+)/ ) { + $field2_trim = $1; + } + } + + # unrecognized pattern + else { + DEVEL_MODE && Fault(<= 0 ) { - $pat1 = substr( $pattern, 0, $posq ); - $pat2 = substr( $pattern, $posq, 3 ); - } - else { - $field_ok = 0; - } + # Just look at up to 3 of the pattern characters + # We require $pat2 to have one of the known patterns + $pat1 = substr( $pattern, 0, $posq ); + $pat2 = substr( $pattern, $posq, 3 ); + $field_ok = $is_leading_sign_pattern{$pat2}; } - # We require $pat2 to have one of the known patterns - if ( $field_ok && $pat2 && $is_leading_sign_pattern{$pat2} ) { + if ($field_ok) { # If the number starts within the field then we must # find its offset position. @@ -5289,8 +5368,8 @@ sub pad_signed_number_columns { # calls for each column and use them if possible, but # benchmarking shows that this is not necessary. # See .ba54 for example coding. - ( $pos_start_number, $char_end_part1 ) = - split_field( $pat1, $field ); + ( $pos_start_number, $char_end_part1, $ch_opening ) = + split_field( $pat1, $field, $pattern ); $field_ok ||= $pos_start_number; } @@ -5298,10 +5377,7 @@ sub pad_signed_number_columns { if ($field_ok) { # look for an optional + or - sign - my $test_char = - $field - ? substr( $field, $pos_start_number, 1 ) - : EMPTY_STRING; + my $test_char = substr( $field, $pos_start_number, 1 ); my $sign; if ( $is_plus_or_minus{$test_char} ) { $sign = $test_char; @@ -5309,10 +5385,25 @@ sub pad_signed_number_columns { substr( $field, $pos_start_number + 1, 1 ); } - # followed by a digit + # and a digit if ( $is_digit_char{$test_char} ) { - if ($sign) { $is_signed_number = 1 } - else { $is_unsigned_number = 1 } + my $field2; + if ($sign) { + $is_signed_number = 1; + $field2 = + substr( $field, $pos_start_number + 1 ); + } + else { + $is_unsigned_number = 1; + $field2 = + $pos_start_number + ? substr( $field, $pos_start_number ) + : $field; + } + + # Check for match to ending pattern + $field_ok = + field_matches_end_pattern( $field2, $pat2 ); } else { $field_ok = 0; -- 2.39.5