update random testing scripts; added perltidy_minimal_flags

diff --git a/dev-bin/RandomTesting.md b/dev-bin/RandomTesting.md
index 77e095974836eb31b505575c043c9ec24fd5132f..bfe8b7e12e62b89cc06b3f35f54c4ae31f01b5b8 100644 (file)
--- a/dev-bin/RandomTesting.md
+++ b/dev-bin/RandomTesting.md
@@ -165,3 +165,11 @@ Also run
 
 which will help scan the ```nohup.my``` file for certain keywords.  
 
+## Additional scripts
+
+The files of parameters which are automatically are long and contain
+many parameters which are on by default or which are not relevant, such
+as the various flags for controlling html.  A script which removes
+these to assist in locating a problem is
+
+ -  perltidy\_minimal\_flags.pl

diff --git a/dev-bin/perltidy_minimal_flags.pl b/dev-bin/perltidy_minimal_flags.pl
new file mode 100755 (executable)
index 0000000..b0024c5
--- /dev/null
+++ b/dev-bin/perltidy_minimal_flags.pl
@@ -0,0 +1,112 @@
+#!/usr/bin/perl -w
+use strict;
+
+my $usage = <<EOM;
+
+Read one or more profile files written by perltidy_random_setup.pl and
+write a reduced version which omits default and other non-essential
+parameters.  This is an aid for debugging blinkers.
+
+Usage:
+   $0 profile.1 [ profile.2 [ ...
+
+Writes:
+   profile.1.min [ profile.2.min [ ...
+
+EOM
+
+if (!@ARGV) {
+   die $usage;
+}
+my @files       = @ARGV;
+my $ris_default = get_defaults();
+
+my $ris_non_essential = {};
+my @q                 = qw(
+  file-size-order
+  nofile-size-order
+  force-read-binary
+  noforce-read-binary
+  preserve-line-endings
+  nopreserve-line-endings
+  timestamp
+  notimestamp
+  profile
+  noprofile
+  npro
+  no-profile
+);
+@{$ris_non_essential}{@q} = (1) x scalar(@q);
+
+foreach my $file (@files) {
+    my @lines;
+    my $format = "tidy";
+    open( IN, "<", $file ) || die "cannot open $file: $!\n";
+    while ( my $line = <IN> ) {
+        chomp $line;
+        $line =~ s/^\s+//;
+        $line =~ s/\s+$//;
+        if    ( $line =~ /-?-format=html$/ ) { $format = 'html' }
+        if    ( $line =~ /-?-format=html$/ ) { $format = 'tidy' }
+        elsif ( $line =~ /-?-html$/ )        { $format = 'html' }
+        elsif ( $line =~ /-?-tidy$/ )        { $format = 'tidy' }
+
+        # filter out defaults
+        my $key = $line;
+        $key =~ s/^--//;
+        next if ( $ris_default->{$key} );
+        next if ( $key =~ /^perl-syntax-check-flags/ );
+
+        # remove flags not related to formatting
+        next if ( $ris_non_essential->{$key} );
+
+        push @lines, $line;
+    }
+    close IN;
+
+    # remove html and pod flags in tidy mode
+    if ( $format ne 'html' ) {
+        my @newlines;
+        foreach my $line (@lines) {
+            my $key = $line;
+            $key =~ s/^--//;
+
+            #next if ( $key =~ /html/ || $key =~ /pod/ );
+            next
+              if ( $key =~
+/^(html|nohtml|pod|nopod|backlink|cachedir|stylesheet|profile|libpods|frames|title)/
+              );
+            push @newlines, $line;
+        }
+        @lines = @newlines;
+    }
+
+    my $ofile = $file . ".min";
+    open( OUT, ">", $ofile ) || die "cannot open $ofile: $!\n";
+    foreach my $line (@lines) {
+        print OUT $line . "\n";
+    }
+    close OUT;
+}
+
+sub get_defaults {
+
+    # get latest parameters from perltidy
+    use File::Temp qw(tempfile);
+    my $ris_default = {};
+    my ( $fout, $tmpnam ) = File::Temp::tempfile();
+    if ( !$fout ) { die "cannot get tempfile\n" }
+    my @parameters;
+    system "perltidy --dump-defaults >$tmpnam";
+    open( IN, "<", $tmpnam ) || die "cannot open $tmpnam: $!\n";
+
+    while ( my $line = <IN> ) {
+        next if $line =~ /#/;
+        $line         =~ s/^\s+//;
+        $line         =~ s/\s+$//;
+        $ris_default->{$line} = 1;
+    }
+    close IN;
+    unlink $tmpnam if ( -e $tmpnam );
+    return $ris_default;
+}

diff --git a/dev-bin/perltidy_random_run.pl b/dev-bin/perltidy_random_run.pl
index 52d20b60dd9329a2292e9ee069103f3b1fa6e225..f61f551d43ca81e2ebdd257ff1bf8bf2b7a3ac1d 100755 (executable)
--- a/dev-bin/perltidy_random_run.pl
+++ b/dev-bin/perltidy_random_run.pl
@@ -133,6 +133,7 @@ my @syntax_errors;
 my @saved_for_deletion;
 my @blinkers;
 my @strange;
+my @uninitialized;
 
 if ( $nf_beg < 1 ) { $nf_beg = 1 }
 if ( $np_beg < 1 ) { $np_beg = 1 }
@@ -215,15 +216,23 @@ for ( my $nf = $nf_beg ; $nf <= $nf_end ; $nf++ ) {
             open(IN,"<",$tmperr);
             foreach my $line(<IN>) {
                 if ($line=~/BLINKER/) {
+                    $error_count++;
                     push @blinkers, $ofile;
                     $error_count_this_file++;
                     $error_count_this_case++;
                 }
                 if ($line=~/STRANGE/) {
+                    $error_count++;
                     push @strange, $ofile;
                     $error_count_this_file++;
                     $error_count_this_case++;
                 }
+                if ($line=~/uninitialized/) {
+                    $error_count++;
+                    push @uninitialized, $ofile;
+                    $error_count_this_file++;
+                    $error_count_this_case++;
+                }
                 print STDERR $line;
             }
             close(IN);
@@ -550,6 +559,15 @@ EOM
         print STDERR <<EOM;
 $hash Some files with STRANGE message (search above for 'STRANGE'):
 $hash (@strange[0..$num-1])
+EOM
+    }
+    if (@uninitialized) {
+        local $" = ')(';
+        my $num = @uninitialized;
+        $num = 20 if ( $num > 20 );
+        print STDERR <<EOM;
+$hash Some files caused 'uninitialized' vars:
+$hash (@uninitialized[0..$num-1])
 EOM
     }
 }

diff --git a/dev-bin/perltidy_random_setup.pl b/dev-bin/perltidy_random_setup.pl
index 531f9dbc853f204942d70d35548595aba238e757..ef329f0bd95d4a162edcc13c619f20f87badc2e5 100755 (executable)
--- a/dev-bin/perltidy_random_setup.pl
+++ b/dev-bin/perltidy_random_setup.pl
@@ -527,7 +527,8 @@ sub get_num {
         open( IN, "<", $tmpnam ) || die "cannot open $tmpnam: $!\n";
         while ( my $line = <IN> ) {
             next if $line =~ /#/;
-            chomp $line, push @parameters, $line;
+            chomp $line; 
+            push @parameters, $line;
         }
         close IN;
         unlink $tmpnam if ( -e $tmpnam );