From 4dcec923d21fc8f7326bfd06eb9d8042606a6ca1 Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Sun, 6 Sep 2020 12:43:34 -0700 Subject: [PATCH] updates preparing for next release --- CHANGES.md | 14 + MANIFEST | 1 + bin/perltidy | 28 +- docs/ChangeLog.html | 35 ++ docs/Tidy.html | 2 +- docs/perltidy.html | 37 +- lib/Perl/Tidy.pm | 2 +- lib/Perl/Tidy.pod | 2 +- lib/Perl/Tidy/Debugger.pm | 2 +- lib/Perl/Tidy/DevNull.pm | 2 +- lib/Perl/Tidy/Diagnostics.pm | 2 +- lib/Perl/Tidy/FileWriter.pm | 2 +- lib/Perl/Tidy/Formatter.pm | 39 +- lib/Perl/Tidy/HtmlWriter.pm | 2 +- lib/Perl/Tidy/IOScalar.pm | 2 +- lib/Perl/Tidy/IOScalarArray.pm | 2 +- lib/Perl/Tidy/IndentationItem.pm | 2 +- lib/Perl/Tidy/LineBuffer.pm | 2 +- lib/Perl/Tidy/LineSink.pm | 2 +- lib/Perl/Tidy/LineSource.pm | 2 +- lib/Perl/Tidy/Logger.pm | 2 +- lib/Perl/Tidy/Tokenizer.pm | 2 +- lib/Perl/Tidy/VerticalAligner.pm | 12 +- lib/Perl/Tidy/VerticalAligner/Alignment.pm | 2 +- lib/Perl/Tidy/VerticalAligner/Line.pm | 2 +- t/snippets/perltidy_random_parameters.pl | 422 ++++++++++++++------- 26 files changed, 430 insertions(+), 194 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index a438761c..03a9210f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,19 @@ # Perltidy Change Log +## 2020 09 07 + + - Fixed a bug when the combination -scbb -csc was used. It occurs in perltidy + versions 20200110, 20200619, and 20200822. What happens is + that when two consecutive lines with isolated closing braces had new side + 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. + + 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 with a special side comment, '#<<<'. For example, diff --git a/MANIFEST b/MANIFEST index 380314db..0a3137dd 100644 --- a/MANIFEST +++ b/MANIFEST @@ -18,6 +18,7 @@ examples/ex_mp.pl examples/filter_example.in examples/filter_example.pl examples/find_naughty.pl +examples/fix-scbb-csc-bug.pl examples/lextest examples/perlcomment.pl examples/perllinetype.pl diff --git a/bin/perltidy b/bin/perltidy index 2685c505..c499b948 100755 --- a/bin/perltidy +++ b/bin/perltidy @@ -851,9 +851,10 @@ The default is not to do this, indicated by B<-nicb>. =item B<-nib>, B<--non-indenting-braces> Normally, lines of code contained within a pair of block braces receive one -additional level of indentation. If this flag is set, perltidy will look for -opening block braces which are followed by a special side comment, which is -B<#<<<> by default. If found, the code between this opening brace and its +additional level of indentation. This flag, which is enabled by default, +causes perltidy to look for +opening block braces which are followed by a special side comment. This special +side comment is B<#<<<> by default. If found, the code between this opening brace and its corresponding closing brace will not be given the normal extra indentation level. For example: @@ -864,23 +865,24 @@ level. For example: } - # this line cannot 'see' $var; + # this line does not 'see' $var; This can be useful, for example, when combining code from different files. Different sections of code can be placed within braces to keep their lexical -variables from being visible to the end of the file. To keep the new blocks -from causing all of their contained code to be reformatted if you run perltidy, -you can mark the opening braces with this special side comment. +variables from being visible to the end of the file. To keep the new braces +from causing all of their contained code to be indented if you run perltidy, +and possibly introducing new line breaks in long lines, you can mark the +opening braces with this special side comment. Only the opening brace needs to be marked, since perltidy knows where the closing brace is. Braces contained within marked braces may also be marked as non-indenting. -This feature is on by default. If your code happens to have some opening -braces followed by '#<<<', and you don't want this, you can use B<-nnib> to -deactivate it. To make it easy to remember, the default string is the same as -the string for starting a B section. There is no confusion -because in that case it is for a block comment rather than a side-comment. +If your code happens to have some opening braces followed by '#<<<', and you +don't want this behavior, you can use B<-nnib> to deactivate it. To make it +easy to remember, the default string is the same as the string for starting a +B section. There is no confusion because in that case it is +for a block comment rather than a side-comment. The special side comment can be changed with the next parameter. @@ -4110,7 +4112,7 @@ The perltidy binary uses the Perl::Tidy module and is installed when that module =head1 VERSION -This man page documents perltidy version 20200822 +This man page documents perltidy version 20200907 =head1 BUG REPORTS diff --git a/docs/ChangeLog.html b/docs/ChangeLog.html index 609978cc..c36bf85c 100644 --- a/docs/ChangeLog.html +++ b/docs/ChangeLog.html @@ -1,5 +1,40 @@

Perltidy Change Log

+

2020 09 07

+ +
- Fixed a bug when the combination -scbb -csc was used.  It occurs in perltidy
+  versions 20200110, 20200619, and 20200822.  What happens is
+  that when two consecutive lines with isolated closing braces had new side
+  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. 
+
+  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 
+  with a special side comment, '#<<<'.  For example,
+
+                { #<<<   a closure to contain lexical vars
+
+                my $var;  # this line does not indent
+
+                }
+
+                # this line cannot 'see' $var;
+
+  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. 
+
+- 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 
+  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
diff --git a/docs/Tidy.html b/docs/Tidy.html
index b6cf9995..398fcea4 100644
--- a/docs/Tidy.html
+++ b/docs/Tidy.html
@@ -372,7 +372,7 @@
 
 
VERSION

 
-
This man page documents Perl::Tidy version 20200822

+
This man page documents Perl::Tidy version 20200907

 
 
LICENSE

 
diff --git a/docs/perltidy.html b/docs/perltidy.html
index 4e33e25f..d4050276 100644
--- a/docs/perltidy.html
+++ b/docs/perltidy.html
@@ -648,6 +648,39 @@
 
 
The default is not to do this, indicated by -nicb.

 
+
+
-nib, --non-indenting-braces

+

+
+
Normally, lines of code contained within a pair of block braces receive one additional level of indentation. This flag, which is enabled by default, causes perltidy to look for opening block braces which are followed by a special side comment. This special side comment is #<<< by default. If found, the code between this opening brace and its corresponding closing brace will not be given the normal extra indentation level. For example:

+
+
            { #<<<   a closure to contain lexical vars
+
+            my $var;  # this line does not get one level of indentation
+            ...
+
+            }
+
+            # this line does not 'see' $var;

+
+
This can be useful, for example, when combining code from different files. Different sections of code can be placed within braces to keep their lexical variables from being visible to the end of the file. To keep the new braces from causing all of their contained code to be indented if you run perltidy, and possibly introducing new line breaks in long lines, you can mark the opening braces with this special side comment.

+
+
Only the opening brace needs to be marked, since perltidy knows where the closing brace is. Braces contained within marked braces may also be marked as non-indenting.

+
+
If your code happens to have some opening braces followed by '#<<<', and you don't want this behavior, you can use -nnib to deactivate it. To make it easy to remember, the default string is the same as the string for starting a format-skipping section. There is no confusion because in that case it is for a block comment rather than a side-comment.

+
+
The special side comment can be changed with the next parameter.

+
+

+
-nibp=s, --non-indenting-brace-prefix=s

+

+
+
The -nibp=string parameter may be used to change the marker for non-indenting braces. The default is equivalent to -nibp='#<<<'. The string that you enter must begin with a # and should be in quotes as necessary to get past the command shell of your system. This string is the leading text of a regex pattern that is constructed by appending pre-pending a '^' and appending a'\s', so you must also include backslashes for characters to be taken literally rather than as patterns.

+
+
For example, to match the side comment '#++', the parameter would be

+
+
  -nibp='#\+\+'

+
 

 
-olq, --outdent-long-quotes

 

@@ -1383,6 +1416,8 @@
                 1, 4, 6, 4, 1,);
  #>>>
+

Format skipping begins when a format skipping comment is seen and continues until either a format-skipping end pattern is found or until the end of file.

+

The comment markers may be placed at any location that a block comment may appear. If they do not appear to be working, use the -log flag and examine the .LOG file. Use -nfs to disable this feature.

This method works for any code. For the specific case of a comma-separated list of values, as in this example, another possibility is to insert a blank or comment somewhere between the opening and closing parens. See the section "Controlling List Formatting".

@@ -3123,7 +3158,7 @@

VERSION

-

This man page documents perltidy version 20200822

+

This man page documents perltidy version 20200907

BUG REPORTS

diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index 81fa3cd5..a7a71819 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -110,7 +110,7 @@ BEGIN { # Release version must be bumped, and it is probably past time for a # release anyway. - $VERSION = '20200822'; + $VERSION = '20200907'; } sub streamhandle { diff --git a/lib/Perl/Tidy.pod b/lib/Perl/Tidy.pod index 16577ca6..34e953f5 100644 --- a/lib/Perl/Tidy.pod +++ b/lib/Perl/Tidy.pod @@ -432,7 +432,7 @@ The module 'Perl::Tidy' comes with a binary 'perltidy' which is installed when t =head1 VERSION -This man page documents Perl::Tidy version 20200822 +This man page documents Perl::Tidy version 20200907 =head1 LICENSE diff --git a/lib/Perl/Tidy/Debugger.pm b/lib/Perl/Tidy/Debugger.pm index e2f21021..8dd2c17a 100644 --- a/lib/Perl/Tidy/Debugger.pm +++ b/lib/Perl/Tidy/Debugger.pm @@ -7,7 +7,7 @@ package Perl::Tidy::Debugger; use strict; use warnings; -our $VERSION = '20200822'; +our $VERSION = '20200907'; sub new { diff --git a/lib/Perl/Tidy/DevNull.pm b/lib/Perl/Tidy/DevNull.pm index 9a10a3c2..2be4a2f5 100644 --- a/lib/Perl/Tidy/DevNull.pm +++ b/lib/Perl/Tidy/DevNull.pm @@ -7,7 +7,7 @@ package Perl::Tidy::DevNull; use strict; use warnings; -our $VERSION = '20200822'; +our $VERSION = '20200907'; sub new { my $self = shift; return bless {}, $self } sub print { return } sub close { return } diff --git a/lib/Perl/Tidy/Diagnostics.pm b/lib/Perl/Tidy/Diagnostics.pm index 518fc1af..e1c425b6 100644 --- a/lib/Perl/Tidy/Diagnostics.pm +++ b/lib/Perl/Tidy/Diagnostics.pm @@ -20,7 +20,7 @@ package Perl::Tidy::Diagnostics; use strict; use warnings; -our $VERSION = '20200822'; +our $VERSION = '20200907'; sub new { diff --git a/lib/Perl/Tidy/FileWriter.pm b/lib/Perl/Tidy/FileWriter.pm index d898ff41..644b7b1c 100644 --- a/lib/Perl/Tidy/FileWriter.pm +++ b/lib/Perl/Tidy/FileWriter.pm @@ -7,7 +7,7 @@ package Perl::Tidy::FileWriter; use strict; use warnings; -our $VERSION = '20200822'; +our $VERSION = '20200907'; # Maximum number of little messages; probably need not be changed. my $MAX_NAG_MESSAGES = 6; diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 4596c002..2fff8663 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -12,7 +12,7 @@ package Perl::Tidy::Formatter; use strict; use warnings; use Carp; -our $VERSION = '20200822'; +our $VERSION = '20200907'; # The Tokenizer will be loaded with the Formatter ##use Perl::Tidy::Tokenizer; # for is_keyword() @@ -902,8 +902,9 @@ sub keyword_group_scan { Unexpected value for -kgbs: '$Opt_size'; expecting 'min' or 'min.max'; ignoring all -kgb flags EOM - # Turn this option off so that this message does not keep repeating - # during iterations and other files. + + # Turn this option off so that this message does not keep repeating + # during iterations and other files. $rOpts->{'keyword-group-blanks-size'} = ""; return $rhash_of_desires; } @@ -1232,11 +1233,11 @@ EOM ( $K_first, $K_last ) = @{$rK_range}; if ( !defined($K_first) ) { - # Unexpected blank line..shouldn't happen - # $rK_range should be defined for line type CODE - Warn( -"Programming Error: Unexpected Blank Line in sub 'keyword_group_scan'. Ignoring" - ); + # Somewhat unexpected blank line.. + # $rK_range is normally defined for line type CODE, but this can + # happen for example if the input line was a single semicolon which + # is being deleted. In that case there was code in the input + # file but it is not being retained. So we can silently return. return $rhash_of_desires; } @@ -4623,7 +4624,7 @@ sub non_indenting_braces { my @seqno_stack; my $is_non_indenting_brace = sub { - my ($KK) = @_; + my ($KK) = @_; # looking for an opening block brace my $token = $rLL->[$KK]->[_TOKEN_]; @@ -4631,13 +4632,13 @@ sub non_indenting_braces { return unless ( $token eq '{' && $block_type ); # followed by a comment - my $K_sc = $self->K_next_nonblank($KK); + my $K_sc = $self->K_next_nonblank($KK); return unless defined($K_sc); my $type_sc = $rLL->[$K_sc]->[_TYPE_]; return unless ( $type_sc eq '#' ); # on the same line - my $line_index = $rLL->[$KK]->[_LINE_INDEX_]; + my $line_index = $rLL->[$KK]->[_LINE_INDEX_]; my $line_index_sc = $rLL->[$K_sc]->[_LINE_INDEX_]; return unless ( $line_index_sc == $line_index ); @@ -12663,11 +12664,11 @@ sub get_seqno { my $rOpts_add_whitespace = $rOpts->{'add-whitespace'}; my $ralignment_type_to_go; - # Initialize the alignment array. Note that closing side comments can - # insert up to 2 additional tokens beyond the original - # $max_index_to_go, so we need to check ri_last for the last index. + # Initialize the alignment array. Note that closing side comments can + # insert up to 2 additional tokens beyond the original + # $max_index_to_go, so we need to check ri_last for the last index. my $max_line = @{$ri_first} - 1; - my $iend = $ri_last->[$max_line]; + my $iend = $ri_last->[$max_line]; if ( $iend < $max_index_to_go ) { $iend = $max_index_to_go } for my $i ( 0 .. $iend ) { $ralignment_type_to_go->[$i] = ''; @@ -14861,10 +14862,10 @@ sub pad_array_to_go { # so don't break before it too && $i_start_2 ne $i_opening - # Defensive coding check: be sure the index is valid. - # FIXME: We should probably be using K indexes for 'starting_index' - # so that the object can remain valid between batches. - # See test problem: random_issues/random_487.pro + # Defensive coding check: be sure the index is valid. + # FIXME: We should probably be using K indexes for 'starting_index' + # so that the object can remain valid between batches. + # See test problem: random_issues/random_487.pro && $i_start_2 >= 0 && $i_start_2 <= $max_index_to_go ) diff --git a/lib/Perl/Tidy/HtmlWriter.pm b/lib/Perl/Tidy/HtmlWriter.pm index c5c82c7f..52665f2a 100644 --- a/lib/Perl/Tidy/HtmlWriter.pm +++ b/lib/Perl/Tidy/HtmlWriter.pm @@ -7,7 +7,7 @@ package Perl::Tidy::HtmlWriter; use strict; use warnings; -our $VERSION = '20200822'; +our $VERSION = '20200907'; use File::Basename; diff --git a/lib/Perl/Tidy/IOScalar.pm b/lib/Perl/Tidy/IOScalar.pm index 97b3e8fc..3ca49f67 100644 --- a/lib/Perl/Tidy/IOScalar.pm +++ b/lib/Perl/Tidy/IOScalar.pm @@ -10,7 +10,7 @@ package Perl::Tidy::IOScalar; use strict; use warnings; use Carp; -our $VERSION = '20200822'; +our $VERSION = '20200907'; sub new { my ( $package, $rscalar, $mode ) = @_; diff --git a/lib/Perl/Tidy/IOScalarArray.pm b/lib/Perl/Tidy/IOScalarArray.pm index 079faf19..ad5b2c1b 100644 --- a/lib/Perl/Tidy/IOScalarArray.pm +++ b/lib/Perl/Tidy/IOScalarArray.pm @@ -14,7 +14,7 @@ package Perl::Tidy::IOScalarArray; use strict; use warnings; use Carp; -our $VERSION = '20200822'; +our $VERSION = '20200907'; sub new { my ( $package, $rarray, $mode ) = @_; diff --git a/lib/Perl/Tidy/IndentationItem.pm b/lib/Perl/Tidy/IndentationItem.pm index d69a5b77..d65591bd 100644 --- a/lib/Perl/Tidy/IndentationItem.pm +++ b/lib/Perl/Tidy/IndentationItem.pm @@ -8,7 +8,7 @@ package Perl::Tidy::IndentationItem; use strict; use warnings; -our $VERSION = '20200822'; +our $VERSION = '20200907'; BEGIN { diff --git a/lib/Perl/Tidy/LineBuffer.pm b/lib/Perl/Tidy/LineBuffer.pm index 07ceae28..4117d452 100644 --- a/lib/Perl/Tidy/LineBuffer.pm +++ b/lib/Perl/Tidy/LineBuffer.pm @@ -12,7 +12,7 @@ package Perl::Tidy::LineBuffer; use strict; use warnings; -our $VERSION = '20200822'; +our $VERSION = '20200907'; sub new { diff --git a/lib/Perl/Tidy/LineSink.pm b/lib/Perl/Tidy/LineSink.pm index e2f6ad8b..d7ccf72d 100644 --- a/lib/Perl/Tidy/LineSink.pm +++ b/lib/Perl/Tidy/LineSink.pm @@ -8,7 +8,7 @@ package Perl::Tidy::LineSink; use strict; use warnings; -our $VERSION = '20200822'; +our $VERSION = '20200907'; sub new { diff --git a/lib/Perl/Tidy/LineSource.pm b/lib/Perl/Tidy/LineSource.pm index e5b6e458..4bb1e9ab 100644 --- a/lib/Perl/Tidy/LineSource.pm +++ b/lib/Perl/Tidy/LineSource.pm @@ -8,7 +8,7 @@ package Perl::Tidy::LineSource; use strict; use warnings; -our $VERSION = '20200822'; +our $VERSION = '20200907'; sub new { diff --git a/lib/Perl/Tidy/Logger.pm b/lib/Perl/Tidy/Logger.pm index 01002e6e..c93ba05b 100644 --- a/lib/Perl/Tidy/Logger.pm +++ b/lib/Perl/Tidy/Logger.pm @@ -7,7 +7,7 @@ package Perl::Tidy::Logger; use strict; use warnings; -our $VERSION = '20200822'; +our $VERSION = '20200907'; sub new { diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm index 898dc741..1089587e 100644 --- a/lib/Perl/Tidy/Tokenizer.pm +++ b/lib/Perl/Tidy/Tokenizer.pm @@ -21,7 +21,7 @@ package Perl::Tidy::Tokenizer; use strict; use warnings; -our $VERSION = '20200822'; +our $VERSION = '20200907'; use Perl::Tidy::LineBuffer; diff --git a/lib/Perl/Tidy/VerticalAligner.pm b/lib/Perl/Tidy/VerticalAligner.pm index 7c799d9e..36f57463 100644 --- a/lib/Perl/Tidy/VerticalAligner.pm +++ b/lib/Perl/Tidy/VerticalAligner.pm @@ -1,7 +1,7 @@ package Perl::Tidy::VerticalAligner; use strict; use warnings; -our $VERSION = '20200822'; +our $VERSION = '20200907'; use Perl::Tidy::VerticalAligner::Alignment; use Perl::Tidy::VerticalAligner::Line; @@ -4137,17 +4137,17 @@ sub get_output_line_number { my $line = $leading_string . $str; my $line_length = $leading_string_length + $str_length; - # Safety check: be sure that a line to be cached as a stacked block - # brace line ends in the appropriate opening or closing block brace. - # This should always be the case if the caller set flags correctly. - # Code '3' is for -sobb, code '4' is for -scbb. + # Safety check: be sure that a line to be cached as a stacked block + # brace line ends in the appropriate opening or closing block brace. + # This should always be the case if the caller set flags correctly. + # Code '3' is for -sobb, code '4' is for -scbb. if ($open_or_close) { if ( $open_or_close == 3 && $line !~ /\{\s*$/ || $open_or_close == 4 && $line !~ /\}\s*$/ ) { $open_or_close = 0; } - } + } # write or cache this line if ( !$open_or_close || $side_comment_length > 0 ) { diff --git a/lib/Perl/Tidy/VerticalAligner/Alignment.pm b/lib/Perl/Tidy/VerticalAligner/Alignment.pm index 1076c68e..370b95d6 100644 --- a/lib/Perl/Tidy/VerticalAligner/Alignment.pm +++ b/lib/Perl/Tidy/VerticalAligner/Alignment.pm @@ -7,7 +7,7 @@ package Perl::Tidy::VerticalAligner::Alignment; use strict; use warnings; -our $VERSION = '20200822'; +our $VERSION = '20200907'; { diff --git a/lib/Perl/Tidy/VerticalAligner/Line.pm b/lib/Perl/Tidy/VerticalAligner/Line.pm index 539c13af..1bb014f3 100644 --- a/lib/Perl/Tidy/VerticalAligner/Line.pm +++ b/lib/Perl/Tidy/VerticalAligner/Line.pm @@ -8,7 +8,7 @@ package Perl::Tidy::VerticalAligner::Line; use strict; use warnings; -our $VERSION = '20200822'; +our $VERSION = '20200907'; { diff --git a/t/snippets/perltidy_random_parameters.pl b/t/snippets/perltidy_random_parameters.pl index a44684d6..e214e4ba 100755 --- a/t/snippets/perltidy_random_parameters.pl +++ b/t/snippets/perltidy_random_parameters.pl @@ -13,12 +13,16 @@ use warnings; # I typically run it in the background from a bash script, something like this # nohup nice -n19 perltidy_random_parameters.pl $filename $number +# This creates a lot of output, so run it in a temporary directory and +# delete everything after checking the results and saving anything noteworthy. + # TODO: # - This currently runs the perltidy binary. Add an option to run call the # module directly. -# - Add additional garbage strings -# - The parameters are hardwired but could be obtained directly from perltidy +# - The parameters are hardwired but should be obtained directly from perltidy # so that they are always up to date. +# - Simplify the summary: filter essential results to a spreadsheet +# - Add some additional garbage strings my $usage = <", $profile || die "cannot open $profile: $!\n"; - foreach ( @{$rrandom_parameters} ) { - print OUT "$_\n"; - } - close OUT; - my $ofile = "ofile.$case"; - my $chkfile = "chkfile.$case"; - system "perltidy < $ifile > $ofile -pro=$profile"; - my $efile = "perltidy.ERR"; - my $logfile = "perltidy.LOG"; - if ( -e $efile ) { rename $efile, "ERR.$case" } - if ( -e $logfile ) { rename $logfile, "LOG.$case" } - - if ( !-e $ofile ) { - print STDERR "**Warning** missing output $ofile\n"; - $missing_ofile_count++; - $error_flag = 1; - } +foreach my $file (@files) { + next unless -e $file; + $file_count++; + my $ifile = $file; + my $ifile_original = $ifile; + my $ifile_size = -s $ifile; + + my $case = 0; + my $error_count = 0; + my $missing_ofile_count = 0; + my $missing_chkfile_count = 0; + my ( $ofile_size_min, $ofile_size_max ); + my ( $ofile_case_min, $ofile_case_max ); + my ( $efile_size_min, $efile_size_max ) = ( 0, 0 ); + my ( $efile_case_min, $efile_case_max ) = ( "", "" ); + my ( $chkfile_size_min, $chkfile_size_max ); + my ( $chkfile_case_min, $chkfile_case_max ); + + my $error_flag = 0; + my $restart_count = 0; + my $efile_count = 0; + my $has_starting_error; + + RUN: + for ( 1 .. $max_cases ) { + $case += 1; + print STDERR "\n-----\nCase $case, File $file_count, File name: '$ifile'\n"; + + # Use same random parameters for second and later files.. + my $profile = "profile.$case"; + if ( $file_count == 1 ) { + + # use default parameters on first case. That way we can check + # if a file produces an error output + my $rrandom_parameters; + if ( $case > 1 ) { + $rrandom_parameters = get_random_parameters(); + } + open OUT, ">", $profile || die "cannot open $profile: $!\n"; + foreach ( @{$rrandom_parameters} ) { + print OUT "$_\n"; + } + close OUT; + } - else { - my $ofile_size = -s $ofile; - if ( !defined($ofile_size_min) ) { - $ofile_size_min = $ofile_size_max = $ofile_size; - $ofile_case_min = $ofile_case_max = $ofile; + my $ext = $case; + if ( @files > 1 ) { $ext .= ".$file_count" } + my $fno = @files > 1 ? ".$file_count" : ""; + + my $ofile = "ofile.$ext"; + my $chkfile = "chkfile.$ext"; + system "perltidy < $ifile > $ofile -pro=$profile"; + my $efile = "perltidy.ERR"; + my $logfile = "perltidy.LOG"; + if ( -e $efile ) { rename $efile, "ERR.$ext" } + if ( -e $logfile ) { rename $logfile, "LOG.$ext" } + + if ( !-e $ofile ) { + print STDERR "**Warning** missing output $ofile\n"; + $missing_ofile_count++; + $error_flag = 1; } + else { - if ( $ofile_size < $ofile_size_min ) { - $ofile_size_min = $ofile_size; - $ofile_case_min = $ofile; + my $ofile_size = -s $ofile; + if ( !defined($ofile_size_min) ) { + $ofile_size_min = $ofile_size_max = $ofile_size; + $ofile_case_min = $ofile_case_max = $ofile; } - if ( $ofile_size > $ofile_size_max ) { - $ofile_size_max = $ofile_size; - $ofile_case_max = $ofile; + else { + if ( $ofile_size < $ofile_size_min ) { + $ofile_size_min = $ofile_size; + $ofile_case_min = $ofile; + } + if ( $ofile_size > $ofile_size_max ) { + $ofile_size_max = $ofile_size; + $ofile_case_max = $ofile; + } } } - } - # run perltidy on the output to see if it can be reformatted - # without errors - system "perltidy < $ofile > $chkfile"; - my $err; - if ( -e $efile ) { - rename $efile, "$chkfile.ERR"; - print STDERR "**Error reformatting** see $chkfile.ERR\n"; - $error_count++; - $err = 1; - } - if ( !-e $chkfile ) { - print STDERR "**Warning** missing checkfile output $chkfile\n"; - $missing_chkfile_count++; - $err = 1; - } - else { - my $chkfile_size = -s $chkfile; - if ( !defined($chkfile_size_min) ) { - $chkfile_size_min = $chkfile_size_max = $chkfile_size; - $chkfile_case_min = $chkfile_case_max = $chkfile; + my $efile_size = 0; + if ( -e $efile ) { + $efile_size = -s $efile; + $efile_count++; + if ( !defined($efile_size_min) ) { + $efile_size_min = $efile_size_max = $efile_size; + $efile_case_min = $efile_case_max = $efile; + } + else { + if ( $efile_size < $efile_size_min ) { + $efile_size_min = $efile_size; + $efile_case_min = $efile; + } + if ( $efile_size > $efile_size_max ) { + $efile_size_max = $efile_size; + $efile_case_max = $efile; + } + } + } + + # run perltidy on the output to see if it can be reformatted + # without errors + system "perltidy < $ofile > $chkfile"; + my $err; + if ( -e $efile ) { + rename $efile, "$chkfile.ERR"; + $err = 1; + if ($case == 1) { + $has_starting_error=1; + } + elsif ( !$has_starting_error ) { + print STDERR "**Error reformatting** see $chkfile.ERR\n"; + $error_count++; + } + } + if ( !-e $chkfile ) { + print STDERR "**Warning** missing checkfile output $chkfile\n"; + $missing_chkfile_count++; + $err = 1; } else { - if ( $chkfile_size < $chkfile_size_min ) { - $chkfile_size_min = $chkfile_size; - $chkfile_case_min = $chkfile; + my $chkfile_size = -s $chkfile; + if ( !defined($chkfile_size_min) ) { + $chkfile_size_min = $chkfile_size_max = $chkfile_size; + $chkfile_case_min = $chkfile_case_max = $chkfile; + } + else { + if ( $chkfile_size < $chkfile_size_min ) { + $chkfile_size_min = $chkfile_size; + $chkfile_case_min = $chkfile; + } + if ( $chkfile_size > $chkfile_size_max ) { + $chkfile_size_max = $chkfile_size; + $chkfile_case_max = $chkfile; + } } - if ( $chkfile_size > $chkfile_size_max ) { - $chkfile_size_max = $chkfile_size; - $chkfile_case_max = $chkfile; + } + + $ifile = $ifile_original; + if ( $CHAIN_MODE && !$err ) { + if ( $CHAIN_MODE == 1 || int( rand(1) + 0.5 ) ) { + { $ifile = $ofile } } } + + if ( -e $stop_file ) { + print STDERR "$stop_file seen; exiting\n"; + last RUN; + } } - if ($CHAIN_MODE) { - $ifile = $err ? $ifile_original : $ofile; - $restart_count++ if ($err); + $rsummary->[$file_count] = { + input_name => $ifile_original, + input_size => $ifile_size, + error_count => $error_count, + efile_count => $efile_count, + missing_ofile_count => $missing_ofile_count, + missing_chkfile_count => $missing_chkfile_count, + minimum_output_size => $ofile_size_min, + maximum_output_size => $ofile_size_max, + minimum_output_case => $ofile_case_min, + maximum_output_case => $ofile_case_max, + minimum_rerun_size => $chkfile_size_min, + maximum_rerun_size => $chkfile_size_max, + minimum_rerun_case => $chkfile_case_min, + maximum_rerun_case => $chkfile_case_max, + minimum_error_size => $efile_size_min, + maximum_error_size => $efile_size_max, + minimum_error_case => $efile_case_min, + maximum_error_case => $efile_case_max, + }; + + report_results($rsummary->[$file_count]); + + # Save anything that looks like it needs attention + if ( $error_count + || $missing_ofile_count + || $missing_chkfile_count + || $ofile_size_min == 0 + || $chkfile_size_min == 0 ) + { + push @problems, $file_count; } - if ( -e $stop_file ) { - print STDERR "$stop_file seen; exiting\n"; +} # End loop over files + +if (@problems) { + print STDERR <[$nf] ); } } +else { + print STDERR <{input_name}; + my $ifile_size = $rh->{input_size}; + my $error_count = $rh->{error_count}; + my $efile_count = $rh->{efile_count}; + my $missing_ofile_count = $rh->{missing_ofile_count}; + my $missing_chkfile_count = $rh->{missing_chkfile_count}; + my $ofile_size_min = $rh->{minimum_rerun_size}; + my $ofile_size_max = $rh->{maximum_rerun_size}; + my $ofile_case_min = $rh->{minimum_rerun_case}; + my $ofile_case_max = $rh->{maximum_rerun_case}; + my $chkfile_size_min = $rh->{minimum_output_size}; + my $chkfile_size_max = $rh->{maximum_output_size}; + my $chkfile_case_min = $rh->{minimum_output_case}; + my $chkfile_case_max = $rh->{maximum_output_case}; + my $efile_size_min = $rh->{minimum_error_size}; + my $efile_size_max = $rh->{maximum_error_size}; + my $efile_case_min = $rh->{minimum_error_case}; + my $efile_case_max = $rh->{maximum_error_case}; + + print STDERR < 'OPTIONAL STRING', ); - my @random_words = qw(bannanas sub train apples); + my @random_words = qw(bannanas sub subaru train 1x =+ !); + my @operators = qw(% + - * / x != == >= <= =~ !~ < > | & = **= += *= &= <<= &&= -= /= |= >>= ||= //= .= %= ^= x=); my @keywords = qw(my our local do while if garbage1 34 ); @@ -545,13 +710,12 @@ sub get_random_parameters { 'default-tabsize' => [ 0, 8 ], 'entab-leading-whitespace' => [ 0, 8 ], - # TODO: FILL thESE with multiple random operators - 'want-break-after' => \@operators, #['+', '-', '*', '=', '.'], - 'want-break-before' => \@operators, #['+', '-', '*'], - 'want-left-space' => \@operators, #['+', '-', '*'], - 'want-right-space' => \@operators, #['+', '-', '*'], - 'nowant-left-space' => \@operators, #['+', '-', '*'], - 'nowant-right-space' => \@operators, #['+', '-', '*'], + 'want-break-after' => \@operators, + 'want-break-before' => \@operators, + 'want-left-space' => \@operators, + 'want-right-space' => \@operators, + 'nowant-left-space' => \@operators, + 'nowant-right-space' => \@operators, #'keyword-group-blanks-list=s 'keyword-group-blanks-size' => [ 0, 2, 4, 7, 10, 2.8, 1.8 ], @@ -619,10 +783,21 @@ sub get_random_parameters { html notidy format + help + version starting-indentation-level tee-block-comments tee-pod tee-side-comments + dump-cuddled-block-list + dump-defaults + dump-long-names + dump-options + dump-profile + dump-short-names + dump-token-types + dump-want-left-space + dump-want-right-space ); my %skip; @@ -706,30 +881,3 @@ sub get_random_parameters { } return \@random_parameters; } - -sub get_num { - my ( $msg, $default ) = @_; - if ( defined($default) ) { - $msg =~ s/:$//; - $msg .= " (=$default):"; - } - my $ans = query($msg); - $ans = $default if ( defined($default) && $ans eq "" ); - my $val = eval($ans); - if ($@) { warn $@; $val = $ans; } - return $val; -} - -sub queryu { - return uc query(@_); -} - -sub query { - my ($msg) = @_; - print $msg; - my $ans = ; - chomp $ans; - - #my $val=$ans; - return $ans; -} -- 2.39.5