From 81795e873a29b2981495b1ef8d7c614b7063a23c Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Sat, 12 Sep 2020 16:20:13 -0700 Subject: [PATCH] update random file generator --- t/snippets/perltidy_random_parameters.pl | 61 +++++++- t/snippets/random_file_generator.pl | 191 +++++++++++++++++++++++ 2 files changed, 245 insertions(+), 7 deletions(-) create mode 100755 t/snippets/random_file_generator.pl diff --git a/t/snippets/perltidy_random_parameters.pl b/t/snippets/perltidy_random_parameters.pl index eb84cab5..eca31c35 100755 --- a/t/snippets/perltidy_random_parameters.pl +++ b/t/snippets/perltidy_random_parameters.pl @@ -16,14 +16,14 @@ use warnings; # 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 = < 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"; @@ -151,6 +175,13 @@ foreach my $file (@files) { $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; @@ -214,8 +245,12 @@ foreach my $file (@files) { } } + # 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 } } @@ -289,10 +324,19 @@ EOM if (@chkfile_errors) { local $"=')('; my $num=@chkfile_errors; - $num=10 if ($num>10); + $num=20 if ($num>20); print STDERR <20); + print STDERR <; 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 ); diff --git a/t/snippets/random_file_generator.pl b/t/snippets/random_file_generator.pl new file mode 100755 index 00000000..56fd3cd3 --- /dev/null +++ b/t/snippets/random_file_generator.pl @@ -0,0 +1,191 @@ +#!/usr/bin/perl -w +use strict; +use warnings; + +# Do not use too source files +my $MAX_SOURCES = 10; + +my $usage = <= $MAX_SOURCES ); + open( IN, '<', $file ) || die "cannot open $file: $!\n"; + $rsource_files->[$i] = []; + foreach my $line () { + 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; +} -- 2.39.5