]> git.donarmstrong.com Git - perltidy.git/commitdiff
adjust chain probability in testing; get perltidy.pl if missing
authorSteve Hancock <perltidy@users.sourceforge.net>
Mon, 4 Oct 2021 13:26:08 +0000 (06:26 -0700)
committerSteve Hancock <perltidy@users.sourceforge.net>
Mon, 4 Oct 2021 13:26:08 +0000 (06:26 -0700)
dev-bin/perltidy_random_run.pl
dev-bin/perltidy_random_setup.pl

index 1ac1e905ea66d9dc16bb161f8f10a19e36800fff..0f93d00e6d247bec8944e92602e40fd219b2e181 100755 (executable)
@@ -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";
index 440831d618899e2d13f15c04c853696b693481c5..7a343760fa96c4410f4f5219e4075f67aa11dfc9 100755 (executable)
@@ -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}