From 92a6bdc51b0d5ac28fd3d7130dba51ca0d919790 Mon Sep 17 00:00:00 2001
From: Steve Hancock <perltidy@users.sourceforge.net>
Date: Mon, 4 Oct 2021 06:26:08 -0700
Subject: [PATCH] adjust chain probability in testing; get perltidy.pl if
 missing

---
 dev-bin/perltidy_random_run.pl   | 10 ++++++++--
 dev-bin/perltidy_random_setup.pl | 26 ++++++++++++++------------
 2 files changed, 22 insertions(+), 14 deletions(-)

diff --git a/dev-bin/perltidy_random_run.pl b/dev-bin/perltidy_random_run.pl
index 1ac1e905..0f93d00e 100755
--- a/dev-bin/perltidy_random_run.pl
+++ b/dev-bin/perltidy_random_run.pl
@@ -407,7 +407,12 @@ for ( my $nf = $nf_beg ; $nf <= $nf_end ; $nf++ ) {
             # 1 = always chain unless error
             # 2 = random chaining
 
-            if ( $chain_mode == 1 || int( rand(1) + 0.5 ) ) {
+            # reduce this value to increase the fraction of chaining;
+            # 0.5 gives equal probability of chain/nochain
+            my $frac_no_chain = 0.4;
+
+            #if ( $chain_mode == 1 || int( rand(1) + 0.5 ) ) {
+            if ( $chain_mode == 1 || rand(1) > $frac_no_chain ) {
                 { $ifile = $ofile }
             }
         }
@@ -702,11 +707,12 @@ sub write_GO {
 
     my ( $nf, $np ) = @_;
     my $runme = "GO.sh";
+
     #unlink $runme if ( -e $runme );
     if ( -e $runme ) {
         my $bak = "$runme.bak";
         if ( -e $bak ) { unlink $bak }
-        system ("mv $runme $bak");
+        system("mv $runme $bak");
     }
     my $fh;
     open( $fh, '>', $runme ) || die "cannot open $runme: $!\n";
diff --git a/dev-bin/perltidy_random_setup.pl b/dev-bin/perltidy_random_setup.pl
index 440831d6..7a343760 100755
--- a/dev-bin/perltidy_random_setup.pl
+++ b/dev-bin/perltidy_random_setup.pl
@@ -29,8 +29,16 @@ my $rprofiles     = [];
 if ( -e './perltidy.pl' ) { $perltidy = './perltidy.pl' }
 
 # always require a separate version of perltidy
-# TODO: go get a copy if there is none
-else { die "Please move a copy of perltidy.pl here first\n" }
+# go get a copy if there is none:
+# On my system I have a utility 'get_perltidy.pl' which gets the latest
+# perltidy.pl with DEVEL_MODE => 1 everywhere
+else {
+    print STDERR "Attempting to get perltidy.pl in DEVEL_MODE...\n";
+    my $fail = system("get_perltidy.pl");
+    if ($fail) {
+        die "..Failed. Please move a copy of perltidy.pl here first\n";
+    }
+}
 
 # TODO: see if DEVEL_MODE is set, turn it on if not
 
@@ -198,19 +206,13 @@ sub filter_files {
     # only work on regular files with non-zero length
     @{$rlist} = grep { -f $_ && !-z $_ } @{$rlist};
 
+    # and text files
+    @{$rlist} = grep { -T $_  } @{$rlist};
+
     # Ignore .tdy and related files
-    @{$rlist} = grep { $_ !~ /\.tdy$/ } @{$rlist};
+    @{$rlist} = grep { $_ !~ /\.DEBUG$/ } @{$rlist};
     @{$rlist} = grep { $_ !~ /\.ERR$/ } @{$rlist};
     @{$rlist} = grep { $_ !~ /\.LOG$/ } @{$rlist};
-    @{$rlist} = grep { $_ !~ /\.DEBUG$/ } @{$rlist};
-    @{$rlist} = grep { $_ !~ /\.gz$/ } @{$rlist};
-    @{$rlist} = grep { $_ !~ /\.tgz$/ } @{$rlist};
-    @{$rlist} = grep { $_ !~ /\.zip$/ } @{$rlist};
-    @{$rlist} = grep { $_ !~ /\.tar$/ } @{$rlist};
-    @{$rlist} = grep { $_ !~ /\.Z$/ } @{$rlist};
-    @{$rlist} = grep { $_ !~ /\.png$/ } @{$rlist};
-    @{$rlist} = grep { $_ !~ /\.jpg$/i } @{$rlist};
-    @{$rlist} = grep { $_ !~ /\.jpeg$/i } @{$rlist};
     @{$rlist} = grep { $_ !~ /\bDIAGNOSTICS$/ } @{$rlist};
 
     # exclude pro{$rlist}
-- 
2.39.5