From a0adaa580c2309ab904813c63542aed34f319620 Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Tue, 5 Jan 2021 17:19:29 -0800 Subject: [PATCH] moved test scripts into dev-bin --- .../perltidy_random_run.pl | 66 ++++++---- .../perltidy_random_setup.pl | 117 +++++++++++------- .../random_file_generator.pl | 42 +++---- 3 files changed, 129 insertions(+), 96 deletions(-) rename {t/snippets => dev-bin}/perltidy_random_run.pl (91%) rename {t/snippets => dev-bin}/perltidy_random_setup.pl (91%) rename {t/snippets => dev-bin}/random_file_generator.pl (90%) diff --git a/t/snippets/perltidy_random_run.pl b/dev-bin/perltidy_random_run.pl similarity index 91% rename from t/snippets/perltidy_random_run.pl rename to dev-bin/perltidy_random_run.pl index 455dd073..471c3a9f 100755 --- a/t/snippets/perltidy_random_run.pl +++ b/dev-bin/perltidy_random_run.pl @@ -2,8 +2,15 @@ use strict; use warnings; -# This program stress-tests perltidy by running it repeatedly -# with random parameters on a variety of files. +# This is one of a set of programs for doing random testing of perltidy. The +# goal is to try to crash perltidy. The programs are: + +# random_file_generator.pl [optional initial step] +# perltidy_random_setup.pl [setup step] +# perltidy_random_run.pl [this program] + +# This program does the actual run based on the setup info made in the +# previous step. my $usage = <' x 60 . "\n"; print STDERR - "\n-----\nRun '$nf.$np' : profile='$profile', ifile='$ifile'\n"; + "$hash>Run '$nf.$np' : profile='$profile', ifile='$ifile'\n"; my $cmd = "$binfile <$ifile >$ofile -pro=$profile"; - print STDERR "$cmd\n"; - system $cmd; + system_echo($cmd,$hash); my $efile = "perltidy.ERR"; my $logfile = "perltidy.LOG"; if ( -e $efile ) { rename $efile, "ERR.$ext" } @@ -275,7 +285,7 @@ for ( my $nf = $nf_beg ; $nf <= $nf_end ; $nf++ ) { if ( $do_syntax_check && $starting_syntax_ok ) { my $synfile = "$ofile.syntax"; my $cmd = "perl -c $ofile 2>$synfile"; - system($cmd); + system_echo($cmd,$hash); my $fh; if ( open( $fh, '<', $synfile ) ) { my @lines = <$fh>; @@ -283,7 +293,7 @@ for ( my $nf = $nf_beg ; $nf <= $nf_end ; $nf++ ) { if ( $case == 1 ) { $starting_syntax_ok = $syntax_ok; unlink $synfile; - if ($syntax_ok) { print STDERR "syntax OK for $ofile\n"; } + if ($syntax_ok) { print STDERR "$hash syntax OK for $ofile\n"; } } elsif ($syntax_ok) { unlink $synfile; @@ -302,8 +312,8 @@ for ( my $nf = $nf_beg ; $nf <= $nf_end ; $nf++ ) { # run perltidy on the output to see if it can be reformatted # without errors my $cmd2 = "perltidy <$ofile >$chkfile"; - system $cmd2; - print STDERR "$cmd2\n"; + system_echo($cmd2,$hash); + #print STDERR "$cmd2\n"; my $err; if ( -e $efile ) { rename $efile, "$chkfile.ERR"; @@ -388,14 +398,12 @@ for ( my $nf = $nf_beg ; $nf <= $nf_end ; $nf++ ) { else { foreach (@created) { unlink $_ if ( -e $_ ); - ##print STDERR "deleting $_\n"; } foreach (@saved_for_deletion) { unlink $_ if ( -e $_ ); - ##print STDERR "deleting $_\n"; } @saved_for_deletion = (); - print STDERR "deleting $ofile, not needed\n"; + print STDERR "$hash deleting $ofile, not needed\n"; } } @@ -563,31 +571,31 @@ sub report_results { my $efile_case_max = $rh->{maximum_error_case}; print STDERR <; my $nlines=@lines; foreach my $line (@lines) { $lno++; + next if ($line =~ /^#/); if ( $line =~ /uninitialized/ || $line =~ /A fault was/ || length($line) > 80 ) @@ -710,3 +719,10 @@ sub read_list { $fh->close(); return $rlist; } + +sub system_echo { + my ( $cmd, $prefix ) = @_; + my $str = $prefix ? $prefix . " " . $cmd : $cmd; + print STDERR "$str\n"; + system($cmd); +} diff --git a/t/snippets/perltidy_random_setup.pl b/dev-bin/perltidy_random_setup.pl similarity index 91% rename from t/snippets/perltidy_random_setup.pl rename to dev-bin/perltidy_random_setup.pl index 56a66f23..f07610b6 100755 --- a/t/snippets/perltidy_random_setup.pl +++ b/dev-bin/perltidy_random_setup.pl @@ -3,23 +3,44 @@ use strict; use warnings; use Data::Dumper; -# This program sets up a run of perltidy with random parameters and files. -# This is an interactive program which writes a config file and a run script -# for the actual run. +# This is one of a set of programs for doing random testing of perltidy. The +# goal is to try to crash perltidy. These programs have been very helpful in +# finding subtle bugs but they are a work in progress and continually evolving. +# The programs are: + +# random_file_generator.pl [optional first step] +# perltidy_random_setup.pl [this file] +# perltidy_random_run.pl [next step] + +# This program is interactive and helps setup the files. It writes a config +# file and a run script for the next program which actually does the runs. + +# You should create a temporary directory for this work. our $rsetup; # the setup hash my $config_file = "config.txt"; my $FILES_file = "FILES.txt"; my $PROFILES_file = "PROFILES.txt"; -my $perltidy = ""; -my $rfiles = []; -my $rprofiles = []; +my $perltidy = ""; +my $rfiles = []; +my $rprofiles = []; -# Run this in a temporary directory to setup the actual run query(<. +IMPORTANT: You should start this program in an empty directory that you create +specifically for this test. After testing you will probably want to delete the +entire directory. It is useful to create this empty directory just below a +directory full of actual perl scripts which can be read as test input. + +You may want to put a special copy of perltidy in this directory for testing, +probably setting all constants DEVEL_MODE => 1. (You can make this with +the pm2pl script). + +If you want to test on random files, you should generate them first in this +directory with 'random_file_generator.pl'. That is currently a separate +program but will eventually be incorporated into this program. + +Hit to continue, or hit control-C to quit. EOM @@ -27,15 +48,15 @@ EOM default_config(); if ( -e $config_file ) { - if ( ifyes("Read the existing config.txt file? [Y/N]", "Y") ) { + if ( ifyes( "Read the existing config.txt file? [Y/N]", "Y" ) ) { read_config($config_file); } } if ( -e $FILES_file ) { - if (ifyes("Found $FILES_file, read it ? [Y/N]", "Y") ) { + if ( ifyes( "Found $FILES_file, read it ? [Y/N]", "Y" ) ) { $rfiles = read_list($FILES_file); - my $nfiles=@{$rfiles}; + my $nfiles = @{$rfiles}; print STDOUT "found $nfiles files\n"; } } @@ -46,9 +67,9 @@ if ( !@{$rfiles} ) { } if ( -e $PROFILES_file ) { - if (ifyes("Found $PROFILES_file, read it ? [Y/N]", "Y") ) { + if ( ifyes( "Found $PROFILES_file, read it ? [Y/N]", "Y" ) ) { $rprofiles = read_list($PROFILES_file); - my $nfiles=@{$rprofiles}; + my $nfiles = @{$rprofiles}; print STDOUT "found $nfiles profiles\n"; } } @@ -58,7 +79,7 @@ if ( !@{$rprofiles} ) { $rprofiles = filter_profiles($rprofiles); } -$rsetup->{'syntax_check'} = ifyes(<{'syntax_check'} = ifyes( <{files}; my $chain_mode = $rsetup->{chain_mode}; @@ -100,30 +121,32 @@ EOM edit_config(); } elsif ( $ans eq 'F' ) { - define_files(); - $rfiles = filter_files($rfiles); - $file_info=get_file_info() + define_files(); + $rfiles = filter_files($rfiles); + $file_info = get_file_info(); } elsif ( $ans eq 'P' ) { - make_profiles(); - $rprofiles = filter_profiles($rprofiles); - $profile_info = get_profile_info(); + make_profiles(); + $rprofiles = filter_profiles($rprofiles); + $profile_info = get_profile_info(); } elsif ( $ans eq 'C' ) { $chain_mode = get_num("Chaining: 0=no, 1=always,2=random"); $rsetup->{chain_mode} = $chain_mode; } elsif ( $ans eq 'D' ) { - $delete_good_output = ifyes("Delete needless good output files? [Y/N]","Y"); + $delete_good_output = + ifyes( "Delete needless good output files? [Y/N]", "Y" ); $rsetup->{delete_good_output} = $delete_good_output; } elsif ( $ans eq 'S' ) { - $do_syntax_check = ifyes("Do syntax checking? [Y/N]","N"); + $do_syntax_check = ifyes( "Do syntax checking? [Y/N]", "N" ); $rsetup->{syntax_check} = $do_syntax_check; } elsif ( $ans eq 'V' ) { my $test = - query("Enter the full path to the perltidy binary, or for default"); + query( + "Enter the full path to the perltidy binary, or for default"); if ( $test && !-e $test ) { next unless ( @@ -250,14 +273,14 @@ EOM sub get_profile_info { - my $nprofiles = @{$rprofiles}; - my $profile0 = "(none)"; - my $profileN = "(none)"; + my $nprofiles = @{$rprofiles}; + my $profile0 = "(none)"; + my $profileN = "(none)"; if ($nprofiles) { $profile0 = $rprofiles->[0]; $profileN = $rprofiles->[-1]; } - my $profile_info = <[0]; $fileN = $rfiles->[-1]; } - my $file_info = < 0 ) { - my $profile_info = get_profile_info(); + my $profile_info = get_profile_info(); print $profile_info; print "There are already $nfiles_old existing files"; while (1) { @@ -837,15 +860,15 @@ EOM elsif ( $ans eq 'A' ) { foreach my $fname ( @{$rprofiles} ) { if ( $fname =~ /\.([\d]+$)/ ) { - if ( $1 > $case) { $case= $1 } + if ( $1 > $case ) { $case = $1 } } } last; } elsif ( $ans eq 'D' ) { - my $num=get_num("Number to keep:",$nfiles_old); - if ($num > $nfiles_old || $num <=0 ) { - query("Sorry, must keep 0 to $nfiles_old, hit "); + my $num = get_num( "Number to keep:", $nfiles_old ); + if ( $num > $nfiles_old || $num <= 0 ) { + query("Sorry, must keep 0 to $nfiles_old, hit "); } else { @{$rprofiles} = @{$rprofiles}[ 0 .. $num - 1 ]; @@ -856,7 +879,7 @@ EOM } } my $max_cases = - get_num( "Number of new random profiles to generate", 50); + get_num( "Number of new random profiles to generate", 50 ); for ( 1 .. $max_cases ) { $case += 1; my $profile = "profile.$case"; @@ -932,8 +955,8 @@ EOM ); my %option_range = ( - 'format' => [ 'tidy', 'html' ], #, 'user' ], - 'output-line-ending' => [ 'dos', 'win', 'mac', 'unix' ], + 'format' => [ 'tidy', 'html' ], #, 'user' ], + 'output-line-ending' => [ 'dos', 'win', 'mac', 'unix' ], 'space-backslash-quote' => [ 0, 2 ], 'block-brace-tightness' => [ 0, 2 ], diff --git a/t/snippets/random_file_generator.pl b/dev-bin/random_file_generator.pl similarity index 90% rename from t/snippets/random_file_generator.pl rename to dev-bin/random_file_generator.pl index 0776526f..26622568 100755 --- a/t/snippets/random_file_generator.pl +++ b/dev-bin/random_file_generator.pl @@ -2,39 +2,33 @@ use strict; use warnings; -# Do not use too source files -my $MAX_SOURCES = 10; +# This is one of a set of programs for doing random testing of perltidy. The +# goal is to try to crash perltidy. The programs are: -my $usage = <