From a468eba9cafed134c0a72f456aaaf2ed5f83f59c Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Fri, 19 Jan 2024 16:23:27 -0800 Subject: [PATCH] update -vsn --- CHANGES.md | 88 ++++-- bin/perltidy | 48 +++- lib/Perl/Tidy.pm | 3 + lib/Perl/Tidy/Logger.pm | 2 +- lib/Perl/Tidy/VerticalAligner.pm | 450 ++++++++++++++++++++++--------- t/snippets/expect/vsn.def | 12 + t/snippets/expect/vsn.vsn1 | 12 + t/snippets/expect/vsn.vsn2 | 12 + t/snippets/packing_list.txt | 7 +- t/snippets/vsn.in | 12 + t/snippets/vsn1.par | 2 + t/snippets/vsn2.par | 3 + t/snippets29.t | 89 +++++- 13 files changed, 569 insertions(+), 171 deletions(-) create mode 100644 t/snippets/expect/vsn.def create mode 100644 t/snippets/expect/vsn.vsn1 create mode 100644 t/snippets/expect/vsn.vsn2 create mode 100644 t/snippets/vsn.in create mode 100644 t/snippets/vsn1.par create mode 100644 t/snippets/vsn2.par diff --git a/CHANGES.md b/CHANGES.md index 1a210672..653315b5 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,36 @@ ## 2023 09 12.12 + - Added --valign-signed-numbers, or -vsn. This improves the appearance + of columns of numbers by aligning leading algebraic signs. For example: + + # perltidy -vsn + my $xyz_shield = [ + [ -0.060, -0.060, 0. ], + [ 0.060, -0.060, 0. ], + [ 0.060, 0.060, 0. ], + [ -0.060, 0.060, 0. ], + [ -0.0925, -0.0925, 0.092 ], + [ 0.0925, -0.0925, 0.092 ], + [ 0.0925, 0.0925, 0.092 ], + [ -0.0925, 0.0925, 0.092 ], + ]; + + # perltidy -nvsn (current DEFAULT) + my $xyz_shield = [ + [ -0.060, -0.060, 0. ], + [ 0.060, -0.060, 0. ], + [ 0.060, 0.060, 0. ], + [ -0.060, 0.060, 0. ], + [ -0.0925, -0.0925, 0.092 ], + [ 0.0925, -0.0925, 0.092 ], + [ 0.0925, 0.0925, 0.092 ], + [ -0.0925, 0.0925, 0.092 ], + ]; + + This new option works well but is currently OFF to allow more testing + and fine-tuning. It is expected to be activated in a future release. + - Added --dump-mixed-call-parens (-dmcp ) which will dump a list of operators which are sometimes followed by parens and sometimes not. Issue git #128. For example @@ -964,21 +994,21 @@ were added to request that old breakpoints be kept before or after selected token types. For example, -kbb='=>' means that newlines before fat commas should be kept. - + - Fix git #44, fix exit status for assert-tidy/untidy. The exit status was always 0 for --assert-tidy if the user had turned off all error messages with the -quiet flag. This has been fixed. - Add flag -maxfs=n, --maximum-file-size-mb=n. This parameter is provided to - avoid causing system problems by accidentally attempting to format an - extremely large data file. The default is n=10. The command to increase + avoid causing system problems by accidentally attempting to format an + extremely large data file. The default is n=10. The command to increase the limit to 20 MB for example would be -mfs=20. This only applies to files specified by filename on the command line. - - Skip formatting if there are too many indentation level errors. This is - controlled with -maxle=n, --maximum-level-errors=n. This means that if + - Skip formatting if there are too many indentation level errors. This is + controlled with -maxle=n, --maximum-level-errors=n. This means that if the ending indentation differs from the starting indentation by more than - n levels, the file will be output verbatim. The default is n=1. + n levels, the file will be output verbatim. The default is n=1. To skip this check, set n=-1 or set n to a large number. - A related new flag, --maximum-unexpected-errors=n, or -maxue=n, is available @@ -986,10 +1016,10 @@ - Add flag -xci, --extended-continuation-indentation, regarding issue git #28 This flag causes continuation indentation to "extend" deeper into structures. - Since this is a fairly new flag, the default is -nxci to avoid disturbing + Since this is a fairly new flag, the default is -nxci to avoid disturbing existing formatting. BUT you will probably see some improved formatting - in complex data structures by setting this flag if you currently use -ci=n - and -i=n with the same value of 'n' (as is the case if you use -pbp, + in complex data structures by setting this flag if you currently use -ci=n + and -i=n with the same value of 'n' (as is the case if you use -pbp, --perl-best-practices, where n=4). - Fix issue git #42, clarify how --break-at-old-logical-breakpoints works. @@ -998,33 +1028,33 @@ - Fix issue git #41, typo in manual regarding -fsb. - - Fix issue git #40: when using the -bli option, a closing brace followed by - a semicolon was not being indented. This applies to braces which require + - Fix issue git #40: when using the -bli option, a closing brace followed by + a semicolon was not being indented. This applies to braces which require semicolons, such as a 'do' block. - Added 'state' as a keyword. - A better test for convergence has been added. When iterations are requested, the new test will stop after the first pass if no changes in line break - locations are made. Previously, file checksums were used and required at least two - passes to verify convergence unless no formatting changes were made. With the new test, - only a single pass is needed when formatting changes are limited to adjustments of + locations are made. Previously, file checksums were used and required at least two + passes to verify convergence unless no formatting changes were made. With the new test, + only a single pass is needed when formatting changes are limited to adjustments of indentation and whitespace on the lines of code. Extensive testing has been made to verify the correctness of the new convergence test. - - Line breaks are now automatically placed after 'use overload' to + - Line breaks are now automatically placed after 'use overload' to improve formatting when there are numerous overloaded operators. For example - + use overload '+' => sub { ... - A number of minor problems with parsing signatures and prototypes have - been corrected, particularly multi-line signatures. Some signatures - had previously been parsed as if they were prototypes, which meant the + been corrected, particularly multi-line signatures. Some signatures + had previously been parsed as if they were prototypes, which meant the normal spacing rules were not applied. For example - + OLD: sub echo ($message= 'Hello World!' ) { ...; @@ -1036,16 +1066,16 @@ } - Numerous minor issues that the average user would not encounter were found - and fixed. They can be seen in the more complete list of updates at + and fixed. They can be seen in the more complete list of updates at https://github.com/perltidy/perltidy/blob/master/local-docs/BugLog.pod ## 2020 10 01 - - Robustness of perltidy has been significantly improved. Updating is recommended. Continual - automated testing runs began about 1 Sep 2020 and numerous issues have been found and fixed. + - Robustness of perltidy has been significantly improved. Updating is recommended. Continual + automated testing runs began about 1 Sep 2020 and numerous issues have been found and fixed. Many involve references to uninitialized variables when perltidy is fed random text and random - control parameters. + control parameters. - Added the token '->' to the list of alignment tokens, as suggested in git #39, so that it can be vertically aligned if a space is placed before them with -wls='->'. @@ -1065,14 +1095,14 @@ comments generated by the -csc parameter, a separating newline was missing. The resulting script will not then run, but worse, if it is reformatted with the same parameters then closing side comments could be overwritten and data - lost. + lost. This problem was found during automated random testing. The parameter -scbb is rarely used, which is probably why this has not been reported. Please upgrade your version. - Added parameter --non-indenting-braces, or -nib, which prevents - code from indenting one level if it follows an opening brace marked + code from indenting one level if it follows an opening brace marked with a special side comment, '#<<<'. For example, { #<<< a closure to contain lexical vars @@ -1085,16 +1115,16 @@ This is on by default. If your code happens to have some opening braces followed by '#<<<', and you - don't want this, you can use -nnib to deactivate it. + don't want this, you can use -nnib to deactivate it. - Side comment locations reset at a line ending in a level 0 open - block, such as when a new multi-line sub begins. This is intended to + block, such as when a new multi-line sub begins. This is intended to help keep side comments from drifting to far to the right. ## 2020 08 22 - Fix RT #133166, encoding not set for -st. Also reported as RT #133171 - and git #35. + and git #35. This is a significant bug in version 20200616 which can corrupt data if perltidy is run as a filter on encoded text. @@ -1107,7 +1137,7 @@ - Vertical alignment has been improved. Numerous minor issues have been fixed. - - Formatting with the -lp option is improved. + - Formatting with the -lp option is improved. - Fixed issue git #32, misparse of bare 'ref' in ternary diff --git a/bin/perltidy b/bin/perltidy index 56a2d2fe..7023e4fd 100755 --- a/bin/perltidy +++ b/bin/perltidy @@ -2234,8 +2234,9 @@ this: #>>V -Additional text may appear on the special comment lines provided that it -is separated from the marker by at least one space, as in the above examples. +Additional text may appear on the special comment lines provided that it is +separated from the marker by at least one space to highlight the sign, as in +the above examples. Any number of code-skipping or format-skipping sections may appear in a file. If an opening code-skipping or format-skipping comment is not followed by a @@ -5016,6 +5017,45 @@ postfix B for purposes of alignment. Thus print "RPM Output:\n" unless $Quiet; print join( "\n", @RPMOutput ) . "\n" unless $Quiet; +=item B + +Setting B<-vsn> causes columns of numbers containing both signed and unsigned +values to have leading signs placed in their own column. For example: + + # perltidy -vsn + my @correct = ( + [ 123456.79, 86753090000.868, 11 ], + [ -123456.79, -86753090000.868, -11 ], + [ 123456.001, 80.080, 10 ], + [ -123456.001, -80.080, 0 ], + [ 10.9, 10.9, 11 ], + ); + +The current default alignment is strict left justification: + + # perltidy -nvsn + my @correct = ( + [ 123456.79, 86753090000.868, 11 ], + [ -123456.79, -86753090000.868, -11 ], + [ 123456.001, 80.080, 10 ], + [ -123456.001, -80.080, 0 ], + [ 10.9, 10.9, 11 ], + ); + +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 +should not normally need to be changed. To see the function of this parameter, +consider a very long column of just unsigned numbers, say 1000 lines. If we add +a single negative number, it is undesirable to move all of the other lines over +by one space. This would create many lines of file differences but not really +improve the appearance when a local section of the table was viewed. The number +B avoids this problem by not adding extra indentation to a run +of more than B lines of unsigned numbers. The default value, B, is +set to be approximately the number of lines for which a viewer does not +normally see both ends of a long column of unsigned numbers on a single page. + =back =head2 Extended Syntax @@ -6106,8 +6146,8 @@ The following list shows all short parameter names which allow a prefix sbl scbb schb scp scsb sct se sfp sfs skp sob sobb sohb sop sosb sot ssc st sts t tac tbc toc tp tqw trp ts tsc tso vbc - vc viu vmll vsc w wfc wme wn x xbt - xci xlp xs + vc viu vmll vsc vsn w wfc wme wn x + xbt xci xlp xs Equivalently, the prefix 'no' or 'no-' on the corresponding long names may be used. diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index bb15180c..0a9b3338 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -3546,6 +3546,7 @@ sub generate_options { $add_option->( 'valign-inclusion-list', 'vil', '=s' ); $add_option->( 'valign-if-unless', 'viu', '!' ); $add_option->( 'valign-signed-numbers', 'vsn', '!' ); + $add_option->( 'valign-signed-numbers-limit', 'vsnl', '=i' ); $add_option->( 'extended-block-tightness', 'xbt', '!' ); $add_option->( 'extended-block-tightness-list', 'xbtl', '=s' ); @@ -3878,6 +3879,7 @@ sub generate_options { valign-code valign-block-comments valign-side-comments + valign-signed-numbers-limit=20 short-concatenation-item-length=8 space-for-semicolon space-backslash-quote=1 @@ -4022,6 +4024,7 @@ sub generate_options { 'starting-indentation-level' => [ 0, undef ], 'vertical-tightness' => [ 0, 2 ], 'vertical-tightness-closing' => [ 0, 3 ], + 'valign-signed-numbers-limit' => [ 0, undef ], 'whitespace-cycle' => [ 0, undef ], ); diff --git a/lib/Perl/Tidy/Logger.pm b/lib/Perl/Tidy/Logger.pm index 27722cbf..931c7674 100644 --- a/lib/Perl/Tidy/Logger.pm +++ b/lib/Perl/Tidy/Logger.pm @@ -105,7 +105,7 @@ sub new { _complaint_count => 0, _is_encoded_data => $is_encoded_data, _saw_code_bug => -1, # -1=no 0=maybe 1=for sure - _saw_brace_error => 0, + _saw_brace_error => 0, _output_array => [], _input_stream_name => $input_stream_name, _filename_stamp => $filename_stamp, diff --git a/lib/Perl/Tidy/VerticalAligner.pm b/lib/Perl/Tidy/VerticalAligner.pm index 56203486..ea68bccf 100644 --- a/lib/Perl/Tidy/VerticalAligner.pm +++ b/lib/Perl/Tidy/VerticalAligner.pm @@ -75,7 +75,7 @@ sub AUTOLOAD { ====================================================================== Error detected in package '$my_package', version $VERSION Received unexpected AUTOLOAD call for sub '$AUTOLOAD' -Called from package: '$pkg' +Called from package: '$pkg' Called from File '$fname' at line '$lno' This error is probably due to a recent programming change ====================================================================== @@ -223,6 +223,7 @@ my ( $rOpts_valign_block_comments, $rOpts_valign_side_comments, $rOpts_valign_signed_numbers, + $rOpts_valign_signed_numbers_limit, $require_tabs, @@ -294,6 +295,8 @@ sub check_options { $rOpts_valign_block_comments = $rOpts->{'valign-block-comments'}; $rOpts_valign_side_comments = $rOpts->{'valign-side-comments'}; $rOpts_valign_signed_numbers = $rOpts->{'valign-signed-numbers'}; + $rOpts_valign_signed_numbers_limit = + $rOpts->{'valign-signed-numbers-limit'}; return; } ## end sub check_options @@ -1507,7 +1510,7 @@ sub check_fit { if ( $jmax_old ne $jmax ) { warning(< 0; my %is_digit_char; my %is_plus_or_minus; my %is_leading_sign_pattern; +my %is_opening_token; BEGIN { - # These patterns match a signed number (and a lot of other things) - my @q = ( 'Q,', 'Q,b', 'Qb', 'Qb}', 'Qb},' ); + # These leading patterns can match a signed number + # here 'Q' can be a number, 'b'=blank, '}'=one of )]} + my @q = ( 'Q,', 'Q,b', 'Qb', 'Qb}', 'Qb},', 'Q},', 'Q};' ); + @is_leading_sign_pattern{@q} = (1) x scalar(@q); @q = qw( 0 1 2 3 4 5 6 7 8 9 ); @@ -4815,28 +4821,36 @@ BEGIN { @q = qw( + - ); @is_plus_or_minus{@q} = (1) x scalar(@q); + + @q = qw< { ( [ >; + @is_opening_token{@q} = (1) x scalar(@q); } sub end_signed_number_column { - my ( $rgroup_lines, $rcol_hash, $ix_last ) = @_; + my ( $rgroup_lines, $rcol_hash, $ix_last, $ending_alignment ) = @_; # Finish formatting a column of unsigned numbers # Given: # $rgroup_lines - the current vertical aligment group of lines # $rcol_hash - a hash of information about this vertical column # $ix_last - index of the last line of this vertical column + # $ending_alignment - true if this ends a vertical alignment col # Task: # If this is a mixture of signed and unsigned numbers, then add a # single space before the unsigned numbers to improve appearance. return unless ($rcol_hash); - my $jcol = $rcol_hash->{jcol}; - my $unsigned = $rcol_hash->{unsigned_count}; - my $signed = $rcol_hash->{signed_count}; + my $jcol = $rcol_hash->{jcol}; + my $unsigned = $rcol_hash->{unsigned_count}; + my $signed = $rcol_hash->{signed_count}; + my $starting_alignment = $rcol_hash->{starting_alignment}; + my $rsigned_lines = $rcol_hash->{rsigned_lines}; + if ( !$signed && $unsigned ) { DEVEL_MODE && Fault("avoid calling without mixed signed and unsigned\n"); return; } + my $pos_start_number = $rcol_hash->{pos_start_number}; my $ix_first = $rcol_hash->{ix_first}; my $nlines = $ix_last - $ix_first + 1; @@ -4845,7 +4859,7 @@ sub end_signed_number_column { if ( $signed + $unsigned != $nlines ) { my $line = $rgroup_lines->[$ix_last]; my $rfields = $line->{'rfields'}; - my $text = join '', @{$rfields}; + my $text = join EMPTY_STRING, @{$rfields}; DEVEL_MODE && Fault(<Max where Nu=unsigned count, and Max is about 20. + # Little visual improvement is gained by padding more than this , and this + # avoids large numbers of differences in a file when a single line is + # changed. + my @unsigned_subgroups; + my $ix_last_negative = $ix_first - 1; + foreach my $ix ( @{$rsigned_lines} ) { + my $Nu = $ix - $ix_last_negative; + if ( $Nu > 0 && $Nu <= $rOpts_valign_signed_numbers_limit ) { + push @unsigned_subgroups, [ $ix_last_negative + 1, $ix - 1 ]; + } + $ix_last_negative = $ix; + } + my $Nu = $ix_last - $ix_last_negative; + if ( $Nu > 0 && $Nu <= $rOpts_valign_signed_numbers_limit ) { + push @unsigned_subgroups, [ $ix_last_negative + 1, $ix_last ]; + } + + if ( !@unsigned_subgroups ) { return } # shouldn't happen + + # Apply the limiting number of lines to pad in the average sense; + # require Nu <= Nc*Max where Nu=unsigned count, Nc=sign change count. + # - interior unsigned_subgroups have two sign-change interfaces + # - boundary unsigned_subgroups have one sign-change interfaces + my $Nc = 2 * @unsigned_subgroups; + if ( $unsigned_subgroups[0]->[0] eq $ix_first ) { $Nc -= 1 } + if ( $unsigned_subgroups[-1]->[1] eq $ix_last ) { $Nc -= 1 } + if ( $unsigned > $Nc * $rOpts_valign_signed_numbers_limit ) { + return; + } + + # Make a list of lines to be processed + # TODO: This loop can eventually store available space and use it to and + # do additional filtering out of things like unwanted sign alternation + my @ix_todo; + foreach my $item (@unsigned_subgroups) { + my ( $ix_min, $ix_max ) = @{$item}; + foreach my $ix ( $ix_min .. $ix_max ) { + push @ix_todo, $ix; + } + } + + foreach my $ix_line (@ix_todo) { my $line = $rgroup_lines->[$ix_line]; my $leading_space_count = $line->{'leading_space_count'}; my $rfields = $line->{'rfields'}; @@ -4896,33 +4953,140 @@ sub pad_signed_field { # $pos_start_number = string position of the leading digit # Task: update $rstr and $rstr_len with a single space + # Give up if there is no space available + if ( ${$rstr_len} >= $avail ) { return } + # First partition the string into $part1 and $part2, so that the # number starts at the beginning of part2. my $part1 = EMPTY_STRING; my $part2 = ${$rstr}; + my $str = ${$rstr}; if ( $pos_start_number > 0 ) { - $part1 = substr( ${$rstr}, 0, $pos_start_number ); - $part2 = substr( ${$rstr}, $pos_start_number ); + my $len = length($str); + if ( $pos_start_number >= $len ) { + DEVEL_MODE && Fault(<= 0 ) { $i_opening = $i_paren } + if ( $i_bracket >= 0 + && $i_bracket < $i_opening ) + { + $i_opening = $i_bracket; + } + if ( $i_brace >= 0 && $i_brace < $i_opening ) { + $i_opening = $i_brace; + } + if ( $i_opening >= 0 + && $i_opening < length($field) - 1 ) + { + $pos_start_number = $i_opening + 1 + $ending_b; + } + else { + # strange - could not find the opening token + } + } + + # no braces: maybe '=>b' + else { + + # looking for patterns ending in '=b' or '=>b' + if ( !$ending_b ) { return 0 } + + # find the = in the text + my $pos_equals = index( $field, '=' ); + return 0 unless ( $pos_equals >= 0 ); + + # be sure there are no other '=' in the pattern + my $equals_count = ( $pat1 =~ tr/=/=/ ); + return 0 if ( $equals_count != 1 ); + + if ( $len_pat1 >= 2 && substr( $pat1, -2, 2 ) eq '=b' ) { + $pos_start_number = $pos_equals + 2; + } + elsif ( $len_pat1 >= 3 && substr( $pat1, -3, 3 ) eq '=>b' ) { + $pos_start_number = $pos_equals + 3; + } + else { + + # cannot handle this pattern + return 0; + } + } + + if ( $pos_start_number >= $len_field ) { $pos_start_number = 0 } + + return ($pos_start_number); +} ## end sub split_field + sub pad_signed_number_columns { my ($rgroup_lines) = @_; @@ -4942,13 +5106,13 @@ sub pad_signed_number_columns { # [ 10.9, 10.9, 11 ], # ); - return unless ($rOpts_valign_signed_numbers); + # A current limitation is that lines with just a single column of numbers + # cannot be processed because the vertical aligner does not currently form + # them them into groups (since they are otherwise already aligned). This + # situation is rare, but could be fixed with a future coding change + # upstream. - # TODO: This option works well but there are some remaining issues. - # - Form groups of single columns of numbers when this option is on - # - Align last ragged entry item (see case rfc.in) - # - Needs a fine-tuning parameter for handling extremely large tables - # - Could use a little more optimization. + return unless ($rOpts_valign_signed_numbers); my %column_info; my @columns; @@ -4964,13 +5128,20 @@ sub pad_signed_number_columns { $jmax = $line->{'jmax'}; my $jmax_change = $jmax ne $jmax_last; - #----------------------------------- - # Handle a reduced number of columns - #----------------------------------- + my @alignments = @{ $line->{'ralignments'} }; + my $rfields = $line->{'rfields'}; + my $rfield_lengths = $line->{'rfield_lengthss'}; + my $rpatterns = $line->{'rpatterns'}; + my $rtokens = $line->{'rtokens'}; + + #----------------------------------------------- + # Check for a reduction in the number of columns + #----------------------------------------------- if ( $jmax < $jmax_last ) { + foreach my $jcol ( keys %column_info ) { - # end any stranded columns + # end any stranded columns on the right next if ( $jcol < $jmax ); my $rcol_hash = $column_info{$jcol}; next unless ($rcol_hash); @@ -4978,19 +5149,33 @@ sub pad_signed_number_columns { && $rcol_hash->{unsigned_count} ) { end_signed_number_column( $rgroup_lines, $rcol_hash, - $ix_line - 1 ); + $ix_line - 1, 1 ); } delete $column_info{$jcol}; } - } - my $rfields = $line->{'rfields'}; - my $rpatterns = $line->{'rpatterns'}; - my @alignments = @{ $line->{'ralignments'} }; + # Try to keep the end data column running; test case 'rfc.in' + # In a list, the last item will still need a trailing comma. + # TODO: consider doing this earlier in the left-right sweep + my $jcol = $jmax - 1; + if ( $jcol > 0 && $column_info{$jcol} ) { + my $alignment = $alignments[$jcol]; + my $old_col = $columns[$jcol]; + my $col = $alignment->{column}; + if ( $col < $old_col ) { + my $spaces_needed = $old_col - $col; + my $spaces_available = + $line->get_available_space_on_right(); + if ( $spaces_available >= $spaces_needed ) { + $line->increase_field_width( $jcol, $spaces_needed ); + } + } + } + } - #-------------------------------------------------- - # loop over fields except last field (side comment) - #-------------------------------------------------- + #-------------------------------------------- + # Loop over fields except last (side comment) + #-------------------------------------------- for my $jcol ( 0 .. $jmax - 1 ) { #----------------------------------------- @@ -5010,7 +5195,7 @@ sub pad_signed_number_columns { && $rcol_hash->{unsigned_count} ) { end_signed_number_column( $rgroup_lines, $rcol_hash, - $ix_line - 1 ); + $ix_line - 1, 1 ); } delete $column_info{$jcol_old}; } @@ -5018,7 +5203,6 @@ sub pad_signed_number_columns { # A new padded sign column can only start at an alignment change my $rcol_hash = $column_info{$jcol}; - next if ( !$rcol_hash && !$is_new_alignment ); #---------------------------------------------------------------- # Examine this field, looking for for signed and unsigned numbers @@ -5028,100 +5212,94 @@ sub pad_signed_number_columns { my $is_signed_number = 0; my $is_unsigned_number = 0; - my $has_leading_quote = 0; - my $pos_start_number = 0; - my ( $pat1, $pat2 ); - if ( substr( $pattern, 0, 1 ) ne 'Q' ) { - my $posq = index( $pattern, 'Q' ); - if ( $posq >= 0 ) { - $pat1 = substr( $pattern, 0, $posq ); - $pat2 = substr( $pattern, $posq, 3 ); - } - } - else { - # Just look at up to 3 of the pattern characters - $pat2 = substr( $pattern, 0, 3 ); - } + #-------------------------------------------------------- + # set $pos_start_number = index in field of digit or sign + #-------------------------------------------------------- + my $pos_start_number = 0; - my $sign; - if ( $pat2 && $is_leading_sign_pattern{$pat2} ) { - - # find the start of the number - if ($pat1) { - - # Originally only allowed $pat1 eq '{b', - # but we would also like to work with 'U{b'. - # For example, for this text - # '-1,-1' => [ -1, +1 ], - # $pat1= '=>b{b' - # so this has are two blanks, and we have to find - # the second. - my $pos_b = index( $pat1, 'b' ); - my $iblank = index( $field, SPACE ); - - # Allow up to 2 blank characters (type 'b'). Note that - # multiple spaces in the string would cause trouble, - # so checks to verify correctness must be made later. - my $b_count = ( $pat1 =~ tr/b/b/ ); - if ( $b_count == 2 ) { - $pos_b = index( $pat1, 'b', $pos_b + 1 ); - $iblank = index( $field, SPACE, $iblank + 1 ); - } - if ( $pos_b >= 0 - && $pos_b + 1 == length($pat1) - && $iblank > 0 ) - { - # position of the first number character - $pos_start_number = $iblank + 1; + # Set $field_ok to false on encountering any problem + # Do not pad signed and unsigned hash keys + my $field_ok = length($field) > 0 + && substr( $rtokens->[$jcol], 0, 2 ) ne '=>'; + + if ( $field_ok && $pattern ) { + + # Split the pattern at the first 'Q' (a quote or number): + # $pat1 = pattern before the 'Q' (if any) + # $pat2 = pattern starting at the 'Q' + my ( $pat1, $pat2 ); + if ( substr( $pattern, 0, 1 ) eq 'Q' ) { + + # Just look at up to 3 of the pattern characters + $pat2 = substr( $pattern, 0, 3 ); + } + else { + my $posq = index( $pattern, 'Q' ); + if ( $posq >= 0 ) { + $pat1 = substr( $pattern, 0, $posq ); + $pat2 = substr( $pattern, $posq, 3 ); } else { - # will not match + $field_ok = 0; } } - # look for an optional + or - sign - my $test_char = substr( $field, $pos_start_number, 1 ); - if ( $is_plus_or_minus{$test_char} ) { - $sign = $test_char; - $test_char = substr( $field, $pos_start_number + 1, 1 ); - } + # We require $pat2 to have one of the known patterns + if ( $field_ok && $pat2 && $is_leading_sign_pattern{$pat2} ) { - # followed by a digit - if ( $is_digit_char{$test_char} ) { - if ($sign) { $is_signed_number = 1 } - else { $is_unsigned_number = 1 } - } - elsif ( $test_char eq '"' || $test_char eq "'" ) { - $has_leading_quote = 1; - } - else { - # something else + # If the number starts within the field then we must + # find its offset position. + if ($pat1) { + + # Note: an optimization would be to remember previous + # 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 = split_field( $pat1, $field ); + + $field_ok ||= $pos_start_number; + } + + if ($field_ok) { + + # look for an optional + or - sign + my $test_char = + $field + ? substr( $field, $pos_start_number, 1 ) + : EMPTY_STRING; + my $sign; + if ( $is_plus_or_minus{$test_char} ) { + $sign = $test_char; + $test_char = + substr( $field, $pos_start_number + 1, 1 ); + } + + # followed by a digit + if ( $is_digit_char{$test_char} ) { + if ($sign) { $is_signed_number = 1 } + else { $is_unsigned_number = 1 } + } + else { + $field_ok = 0; + } + } } } #---------------------- # Figure out what to do #---------------------- - # we require a signed or unsigned number field - my $field_ok = $is_signed_number || $is_unsigned_number; + # which is not a hash key + $field_ok &&= ( $is_signed_number || $is_unsigned_number ); # if a column has not started.. if ( !$rcol_hash ) { # and this is not a signed or unsigned numeric value if ( !$field_ok ) { - - # give up unless a new column can start - next if ( !$is_new_alignment ); - - # Column heading patch: - # Allow the first line to be a column heading quote. - # Mark it unsigned to make the line count correct. - # See 'col_headings.pl' for an example. - next if ( !$has_leading_quote ); - $is_unsigned_number = 1; + next; } } @@ -5134,18 +5312,14 @@ sub pad_signed_number_columns { || $rcol_hash->{col} ne $col ) { - # Give up if a new column cannot start - if ( !$is_new_alignment ) { - $column_info{$jcol} = undef; - next; - } - # or end the current column and start over if ( $rcol_hash->{signed_count} && $rcol_hash->{unsigned_count} ) { - end_signed_number_column( $rgroup_lines, $rcol_hash, - $ix_line - 1 ); + end_signed_number_column( + $rgroup_lines, $rcol_hash, + $ix_line - 1, $is_new_alignment + ); } delete $column_info{$jcol}; $rcol_hash = undef; @@ -5164,15 +5338,18 @@ sub pad_signed_number_columns { #-------------------------------- if ( !defined($rcol_hash) ) { - # Currently we only start at an alignment change - next if ( !$is_new_alignment ); + next if ( !$field_ok ); + + my $rsigned_lines = $is_signed_number ? [$ix_line] : []; $column_info{$jcol} = { - unsigned_count => $is_unsigned_number, - signed_count => $is_signed_number, - pos_start_number => $pos_start_number, - ix_first => $ix_line, - col => $col, - jcol => $jcol, + unsigned_count => $is_unsigned_number, + signed_count => $is_signed_number, + pos_start_number => $pos_start_number, + ix_first => $ix_line, + col => $col, + jcol => $jcol, + rsigned_lines => $rsigned_lines, + starting_alignment => $is_new_alignment, }; } @@ -5182,15 +5359,20 @@ sub pad_signed_number_columns { else { $rcol_hash->{unsigned_count} += $is_unsigned_number; $rcol_hash->{signed_count} += $is_signed_number; + if ($is_signed_number) { + push @{ $rcol_hash->{rsigned_lines} }, $ix_line; + } } } } - # Loop to finish remaining columns + #------------------------------------- + # Loop to finish any remaining columns + #------------------------------------- foreach my $jcol ( keys %column_info ) { my $rcol_hash = $column_info{$jcol}; if ( $rcol_hash->{signed_count} && $rcol_hash->{unsigned_count} ) { - end_signed_number_column( $rgroup_lines, $rcol_hash, $ix_line ); + end_signed_number_column( $rgroup_lines, $rcol_hash, $ix_line, 1 ); } } return; @@ -6053,7 +6235,7 @@ sub add_leading_tabs { # be called because we might be in a quote of some kind if ( $leading_space_count <= 0 ) { DEVEL_MODE && Fault(<drawLine( 35, 0 ); +$s->drawLine( 0, 10 ); +$s->drawLine( -35, 0 ); +$s->drawLine( 0, -10 ); diff --git a/t/snippets/expect/vsn.vsn1 b/t/snippets/expect/vsn.vsn1 new file mode 100644 index 00000000..026a3c27 --- /dev/null +++ b/t/snippets/expect/vsn.vsn1 @@ -0,0 +1,12 @@ +@data = ( + ["1st", "2nd", "3rd", "4th", "5th", "6th", "7th", "8th", "9th"], + [ 1, 2, 5, 6, 3, 1.5, -1, -3, -4], + [-4, -3, 1, 1, -3, -1.5, -2, -1, 0], + [ 9, 8, 9, 8.4, 7.1, 7.5, 8, 3, -3], + [ 0.1, 0.2, 0.5, 0.4, 0.3, 0.5, 0.1, 0, 0.4], + ); + +$s->drawLine( 35, 0); +$s->drawLine( 0, 10); +$s->drawLine(-35, 0); +$s->drawLine( 0, -10); diff --git a/t/snippets/expect/vsn.vsn2 b/t/snippets/expect/vsn.vsn2 new file mode 100644 index 00000000..787c13c6 --- /dev/null +++ b/t/snippets/expect/vsn.vsn2 @@ -0,0 +1,12 @@ +@data = ( + [ "1st", "2nd", "3rd", "4th", "5th", "6th", "7th", "8th", "9th" ], + [ 1, 2, 5, 6, 3, 1.5, -1, -3, -4 ], + [ -4, -3, 1, 1, -3, -1.5, -2, -1, 0 ], + [ 9, 8, 9, 8.4, 7.1, 7.5, 8, 3, -3 ], + [ 0.1, 0.2, 0.5, 0.4, 0.3, 0.5, 0.1, 0, 0.4 ], +); + +$s->drawLine( 35, 0 ); +$s->drawLine( 0, 10 ); +$s->drawLine( -35, 0 ); +$s->drawLine( 0, -10 ); diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt index 65ef0cbc..87662cfc 100644 --- a/t/snippets/packing_list.txt +++ b/t/snippets/packing_list.txt @@ -402,6 +402,8 @@ ../snippets28.t git124.def ../snippets28.t c269.c269 ../snippets28.t c269.def +../snippets28.t git125.def +../snippets29.t git125.git125 ../snippets3.t ce_wn1.ce_wn ../snippets3.t ce_wn1.def ../snippets3.t colin.colin @@ -542,5 +544,6 @@ ../snippets9.t rt98902.def ../snippets9.t rt98902.rt98902 ../snippets9.t rt99961.def -../snippets28.t git125.def -../snippets29.t git125.git125 +../snippets29.t vsn.def +../snippets29.t vsn.vsn1 +../snippets29.t vsn.vsn2 diff --git a/t/snippets/vsn.in b/t/snippets/vsn.in new file mode 100644 index 00000000..d2f785c3 --- /dev/null +++ b/t/snippets/vsn.in @@ -0,0 +1,12 @@ +@data = ( + [ "1st", "2nd", "3rd", "4th", "5th", "6th", "7th", "8th", "9th" ], + [ 1, 2, 5, 6, 3, 1.5, -1, -3, -4 ], + [ -4, -3, 1, 1, -3, -1.5, -2, -1, 0 ], + [ 9, 8, 9, 8.4, 7.1, 7.5, 8, 3, -3 ], + [ 0.1, 0.2, 0.5, 0.4, 0.3, 0.5, 0.1, 0, 0.4 ], +); + +$s->drawLine( 35, 0 ); +$s->drawLine( 0, 10 ); +$s->drawLine( -35, 0 ); +$s->drawLine( 0, -10 ); diff --git a/t/snippets/vsn1.par b/t/snippets/vsn1.par new file mode 100644 index 00000000..f066325a --- /dev/null +++ b/t/snippets/vsn1.par @@ -0,0 +1,2 @@ +-vsn +-gnu diff --git a/t/snippets/vsn2.par b/t/snippets/vsn2.par new file mode 100644 index 00000000..6254cf37 --- /dev/null +++ b/t/snippets/vsn2.par @@ -0,0 +1,3 @@ +# turn off vsn with -vsnl +-vsn +-vsnl=1 diff --git a/t/snippets29.t b/t/snippets29.t index 66c1c15d..349c583e 100644 --- a/t/snippets29.t +++ b/t/snippets29.t @@ -2,6 +2,9 @@ # Contents: #1 git125.git125 +#2 vsn.def +#3 vsn.vsn1 +#4 vsn.vsn2 # To locate test #13 you can search for its name or the string '#13' @@ -18,7 +21,19 @@ BEGIN { ########################################### # BEGIN SECTION 1: Parameter combinations # ########################################### - $rparams = { 'git125' => "-ssp=0", }; + $rparams = { + 'def' => "", + 'git125' => "-ssp=0", + 'vsn1' => <<'----------', +-vsn +-gnu +---------- + 'vsn2' => <<'----------', +# turn off vsn with -vsnl +-vsn +-vsnl=1 +---------- + }; ############################ # BEGIN SECTION 2: Sources # @@ -28,6 +43,21 @@ BEGIN { 'git125' => <<'----------', sub Add ( $x, $y ); sub Sub( $x, $y ); +---------- + + 'vsn' => <<'----------', +@data = ( + [ "1st", "2nd", "3rd", "4th", "5th", "6th", "7th", "8th", "9th" ], + [ 1, 2, 5, 6, 3, 1.5, -1, -3, -4 ], + [ -4, -3, 1, 1, -3, -1.5, -2, -1, 0 ], + [ 9, 8, 9, 8.4, 7.1, 7.5, 8, 3, -3 ], + [ 0.1, 0.2, 0.5, 0.4, 0.3, 0.5, 0.1, 0, 0.4 ], +); + +$s->drawLine( 35, 0 ); +$s->drawLine( 0, 10 ); +$s->drawLine( -35, 0 ); +$s->drawLine( 0, -10 ); ---------- }; @@ -44,6 +74,63 @@ sub Add( $x, $y ); sub Sub( $x, $y ); #1........... }, + + 'vsn.def' => { + source => "vsn", + params => "def", + expect => <<'#2...........', +@data = ( + [ "1st", "2nd", "3rd", "4th", "5th", "6th", "7th", "8th", "9th" ], + [ 1, 2, 5, 6, 3, 1.5, -1, -3, -4 ], + [ -4, -3, 1, 1, -3, -1.5, -2, -1, 0 ], + [ 9, 8, 9, 8.4, 7.1, 7.5, 8, 3, -3 ], + [ 0.1, 0.2, 0.5, 0.4, 0.3, 0.5, 0.1, 0, 0.4 ], +); + +$s->drawLine( 35, 0 ); +$s->drawLine( 0, 10 ); +$s->drawLine( -35, 0 ); +$s->drawLine( 0, -10 ); +#2........... + }, + + 'vsn.vsn1' => { + source => "vsn", + params => "vsn1", + expect => <<'#3...........', +@data = ( + ["1st", "2nd", "3rd", "4th", "5th", "6th", "7th", "8th", "9th"], + [ 1, 2, 5, 6, 3, 1.5, -1, -3, -4], + [-4, -3, 1, 1, -3, -1.5, -2, -1, 0], + [ 9, 8, 9, 8.4, 7.1, 7.5, 8, 3, -3], + [ 0.1, 0.2, 0.5, 0.4, 0.3, 0.5, 0.1, 0, 0.4], + ); + +$s->drawLine( 35, 0); +$s->drawLine( 0, 10); +$s->drawLine(-35, 0); +$s->drawLine( 0, -10); +#3........... + }, + + 'vsn.vsn2' => { + source => "vsn", + params => "vsn2", + expect => <<'#4...........', +@data = ( + [ "1st", "2nd", "3rd", "4th", "5th", "6th", "7th", "8th", "9th" ], + [ 1, 2, 5, 6, 3, 1.5, -1, -3, -4 ], + [ -4, -3, 1, 1, -3, -1.5, -2, -1, 0 ], + [ 9, 8, 9, 8.4, 7.1, 7.5, 8, 3, -3 ], + [ 0.1, 0.2, 0.5, 0.4, 0.3, 0.5, 0.1, 0, 0.4 ], +); + +$s->drawLine( 35, 0 ); +$s->drawLine( 0, 10 ); +$s->drawLine( -35, 0 ); +$s->drawLine( 0, -10 ); +#4........... + }, }; my $ntests = 0 + keys %{$rtests}; -- 2.39.5