# 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:
+# - create scripts to easily package problems with bugs
+
+# - Add option to generate random input files
# - This currently runs the perltidy binary. Add an option to run call the
# module.
# - Add additional garbage strings for better test coverage
# - Review all perltidy error output and add some unique string
# for easy searching.
-# - Add option to randomly scramble input files
-# - Add option to check extrude/mangle/normal cycle
my $usage = <<EOM;
Run perltidy repeatedly on a selected file with randomly generated parameters:
my $stop_file = 'stop.now';
if ( -e $stop_file ) { unlink $stop_file }
my @chkfile_errors;
+my @size_errors;
foreach my $file (@files) {
next unless -e $file;
$file_count++;
my ( $efile_case_min, $efile_case_max ) = ( "", "" );
my ( $chkfile_size_min, $chkfile_size_max );
my ( $chkfile_case_min, $chkfile_case_max );
+ my $ofile_size_min_expected = 0;
my $error_flag = 0;
my $restart_count = 0;
# Use same random parameters for second and later files..
my $profile = "profile.$case";
+
+ # Make the profile
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 ) {
+ if ( $case == 1 ) {
+ $rrandom_parameters = [ "" ];
+ }
+
+ # Case 2 creates the smallest possible output file size
+ if ($case == 2) {
+ $rrandom_parameters = [ "--mangle -dac -i=0 -ci=0" ];
+ }
+
+ # Case 3 checks extrude from mangle (case 2)
+ if ($case == 3) {
+ $rrandom_parameters = [ "--extrude" ];
+ }
+
+ # Case 4 checks mangle again from extrude (
+ if ($case == 4) {
+ $rrandom_parameters = [ "--mangle" ];
+ }
+
+ # From then on random parameters are generated
+ if ( $case > 5 ) {
$rrandom_parameters = get_random_parameters();
}
open OUT, ">", $profile || die "cannot open $profile: $!\n";
$ofile_case_max = $ofile;
}
}
+ if ( $case == 2 ) { $ofile_size_min_expected = $ofile_size }
+ elsif ( $case > 2 && $ofile_size < 0.95 * $ofile_size_min_expected )
+ {
+ print STDERR
+"**ERROR for ofile=$ofile: size = $ofile_size < $ofile_size_min_expected = min expected\n";
+ push @size_errors, $ofile;
+ }
}
my $efile_size = 0;
}
}
+ # Set input file for next run
$ifile = $ifile_original;
- if ( $CHAIN_MODE && !$err ) {
+ if ($case < 4) {
+ $ifile = $ofile;
+ }
+ elsif ( $CHAIN_MODE && !$err ) {
if ( $CHAIN_MODE == 1 || int( rand(1) + 0.5 ) ) {
{ $ifile = $ofile }
}
if (@chkfile_errors) {
local $"=')(';
my $num=@chkfile_errors;
- $num=10 if ($num>10);
+ $num=20 if ($num>20);
print STDERR <<EOM;
Some check files with errors (search above for '**ERROR'):
(@chkfile_errors[1..$num-1])
+EOM
+ }
+ if (@size_errors) {
+ local $"=')(';
+ my $num=@size_errors;
+ $num=20 if ($num>20);
+ print STDERR <<EOM;
+Some files with definite size errors (search above for '**ERROR'):
+(@size_errors[1..$num-1])
EOM
}
my $nlines=@lines;
foreach my $line (@lines) {
$lno++;
- if ( $line =~ /uninitialized/ || length($line) > 80 ) {
+ if ( $line =~ /uninitialized/
+ || $line =~ /A fault was/
+ || length($line) > 80 )
+ {
# ignore last few lines
next if ( $lno > $nlines - 4 );
--- /dev/null
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+
+# Do not use too source files
+my $MAX_SOURCES = 10;
+
+my $usage = <<EOM;
+Run perltidy repeatedly on a selected file with randomly generated parameters:
+
+ perltidy_random_parameters file1 [file2 [ ... Num
+
+file1 ... are the names of a text to be formatted
+Num is the number of times, default 1000;
+
+You can stop the run any time by creating a file "stop.now"
+EOM
+
+# Random testing of Perl::Tidy
+# Given:
+# - a list of files
+# - a list of options
+
+# Write out a logfile of results:
+# name, exit flag, isize, osize
+# gzip name.in, name.in.tdy, name.par, name.ERR
+
+# Also save nohup.out, and echo each file as you go
+# Looking for perl complaints
+
+# Structure:
+# logfile.txt
+# files/ - has text input files for random selection
+# tmp/ - has zipped output
+
+# Continually generate files with random parameters and some randomly removed
+# lines and run perltidy.
+
+my @source_files = @ARGV;
+
+my $max_cases = pop @source_files;
+if ( $max_cases !~ /^\d+$/ ) {
+ push @source_files, $max_cases;
+ $max_cases = 100;
+}
+
+# only work on regular source_files with non-zero length
+@source_files=grep {-f $_ && !-z $_} @source_files;
+
+if ( !@source_files ) { die "$usage" }
+
+my $rsource_files = [];
+my $i = -1;
+foreach my $file (@source_files) {
+ $i++;
+ last if ( $i >= $MAX_SOURCES );
+ open( IN, '<', $file ) || die "cannot open $file: $!\n";
+ $rsource_files->[$i] = [];
+ foreach my $line (<IN>) {
+ push @{ $rsource_files->[$i] }, $line;
+ }
+ close(IN);
+}
+
+my $basename = "ranfile";
+my $nsources = @{$rsource_files};
+
+for ( my $nf = 1 ; $nf <= $max_cases ; $nf++ ) {
+ my $fname = "$basename.$nf";
+ my $frac = rand(1);
+ my $ix = int( rand($nsources) );
+ $ix = random_index( $nsources - 1 );
+ my $method = random_index(2);
+ my $rfile;
+ if ( $method == 2 ) {
+ my $nchars=1+random_index(1000);
+ $rfile = random_characters($nchars);
+print STDERR "Method $method, nchars=$nchars\n";
+ }
+ elsif ( $method == 1 ) {
+ $rfile = skip_random_lines( $rsource_files->[$ix], $frac );
+print STDERR "Method $method, frac=$frac, file=$ix\n";
+ }
+ else {
+ $rfile = select_random_lines( $rsource_files->[$ix], $frac );
+print STDERR "Method $method, frac=$frac, file=$ix\n";
+ }
+ open( OUT, ">", $fname ) || die "cannot open $fname: $!\n";
+ foreach my $line ( @{$rfile} ) {
+ print OUT $line;
+ }
+ close OUT;
+}
+
+sub random_index {
+ my ($ix_max) = @_;
+ $ix_max = 0 if ( $ix_max < 0 );
+ my $ix_min = 0;
+ my $ix = int( rand($ix_max) + 0.5 );
+ $ix = $ix_max if ( $ix > $ix_max );
+ $ix = $ix_min if ( $ix < $ix_min );
+ return $ix;
+}
+
+sub random_characters {
+
+ my ($nchars) = @_;
+ my @qc = qw# { [ ( } ] ) , ; $x for #;
+ my $nqc = @qc;
+ my @lines;
+ my $ncpl = 0;
+ my $line = "";
+ for ( my $ich = 0 ; $ich < $nchars ; $ich++ ) {
+ my $ix = random_index( $nqc - 1 );
+ my $ch = $qc[$ix];
+ $line .= " $ch ";
+ $ncpl++;
+ if ( $ncpl > 20 ) {
+ $line .= "\n";
+ push @lines, $line;
+ $ncpl = 0;
+ }
+ }
+ $line .= "\n";
+ push @lines, $line;
+ return \@lines;
+}
+
+sub select_random_lines {
+
+ # select some fraction of the lines in a source file
+ # in any order
+ my ($rsource, $fkeep) = @_;
+
+ my $nlines = @{$rsource};
+ my $num_keep = $nlines*$fkeep;
+ my $count=0;
+ my @selected;
+ while ($count < $num_keep) {
+ my $ii = random_index($nlines-1);
+ push @selected, $rsource->[$ii];
+ $count++;
+ }
+ return \@selected;
+}
+
+sub skip_random_lines {
+
+ # skip some fraction of the lines in a source file
+ # but keep lines in the original order
+ my ($rsource, $fskip) = @_;
+
+ my %skip;
+ my $nlines = @{$rsource};
+ my $num_delete = $nlines*$fskip;
+ my $count=0;
+ while ($count < $num_delete) {
+ my $ii = rand($nlines);
+ $ii = int($ii);
+ $skip{$ii} = 1;
+ $count++;
+ }
+
+ my @selected;
+ my $jj = -1;
+ foreach my $line (@{$rsource}) {
+ $jj++;
+ next if $skip{$jj};
+ push @selected, $line;
+ }
+ return \@selected;
+}
+
+__END__
+
+my $ii = rand(@lines);
+$ii = int($ii);
+my %skip;
+$skip{$ii} = 1;
+print STDERR "Skipping line $ii\n";
+
+my @select;
+my $jj = -1;
+foreach my $line (@lines) {
+ $jj++;
+ next if $skip{$jj};
+ push @selected, $line;
+}
+foreach my $line (@selected) {
+ print STDOUT $line;
+}
projects / perltidy.git / commitdiff