From: Steve Hancock <perltidy@users.sourceforge.net> Date: Sat, 16 Jan 2021 14:41:02 +0000 (-0800) Subject: update random testing scripts; added perltidy_minimal_flags X-Git-Tag: 20210402~84 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=f865d942ae7663b1dda050b2732cc0b773b02860;p=perltidy.git update random testing scripts; added perltidy_minimal_flags --- diff --git a/dev-bin/RandomTesting.md b/dev-bin/RandomTesting.md index 77e09597..bfe8b7e1 100644 --- a/dev-bin/RandomTesting.md +++ b/dev-bin/RandomTesting.md @@ -165,3 +165,11 @@ Also run which will help scan the ```nohup.my``` file for certain keywords. +## Additional scripts + +The files of parameters which are automatically are long and contain +many parameters which are on by default or which are not relevant, such +as the various flags for controlling html. A script which removes +these to assist in locating a problem is + + - perltidy\_minimal\_flags.pl diff --git a/dev-bin/perltidy_minimal_flags.pl b/dev-bin/perltidy_minimal_flags.pl new file mode 100755 index 00000000..b0024c52 --- /dev/null +++ b/dev-bin/perltidy_minimal_flags.pl @@ -0,0 +1,112 @@ +#!/usr/bin/perl -w +use strict; + +my $usage = <<EOM; + +Read one or more profile files written by perltidy_random_setup.pl and +write a reduced version which omits default and other non-essential +parameters. This is an aid for debugging blinkers. + +Usage: + $0 profile.1 [ profile.2 [ ... + +Writes: + profile.1.min [ profile.2.min [ ... + +EOM + +if (!@ARGV) { + die $usage; +} +my @files = @ARGV; +my $ris_default = get_defaults(); + +my $ris_non_essential = {}; +my @q = qw( + file-size-order + nofile-size-order + force-read-binary + noforce-read-binary + preserve-line-endings + nopreserve-line-endings + timestamp + notimestamp + profile + noprofile + npro + no-profile +); +@{$ris_non_essential}{@q} = (1) x scalar(@q); + +foreach my $file (@files) { + my @lines; + my $format = "tidy"; + open( IN, "<", $file ) || die "cannot open $file: $!\n"; + while ( my $line = <IN> ) { + chomp $line; + $line =~ s/^\s+//; + $line =~ s/\s+$//; + if ( $line =~ /-?-format=html$/ ) { $format = 'html' } + if ( $line =~ /-?-format=html$/ ) { $format = 'tidy' } + elsif ( $line =~ /-?-html$/ ) { $format = 'html' } + elsif ( $line =~ /-?-tidy$/ ) { $format = 'tidy' } + + # filter out defaults + my $key = $line; + $key =~ s/^--//; + next if ( $ris_default->{$key} ); + next if ( $key =~ /^perl-syntax-check-flags/ ); + + # remove flags not related to formatting + next if ( $ris_non_essential->{$key} ); + + push @lines, $line; + } + close IN; + + # remove html and pod flags in tidy mode + if ( $format ne 'html' ) { + my @newlines; + foreach my $line (@lines) { + my $key = $line; + $key =~ s/^--//; + + #next if ( $key =~ /html/ || $key =~ /pod/ ); + next + if ( $key =~ +/^(html|nohtml|pod|nopod|backlink|cachedir|stylesheet|profile|libpods|frames|title)/ + ); + push @newlines, $line; + } + @lines = @newlines; + } + + my $ofile = $file . ".min"; + open( OUT, ">", $ofile ) || die "cannot open $ofile: $!\n"; + foreach my $line (@lines) { + print OUT $line . "\n"; + } + close OUT; +} + +sub get_defaults { + + # get latest parameters from perltidy + use File::Temp qw(tempfile); + my $ris_default = {}; + my ( $fout, $tmpnam ) = File::Temp::tempfile(); + if ( !$fout ) { die "cannot get tempfile\n" } + my @parameters; + system "perltidy --dump-defaults >$tmpnam"; + open( IN, "<", $tmpnam ) || die "cannot open $tmpnam: $!\n"; + + while ( my $line = <IN> ) { + next if $line =~ /#/; + $line =~ s/^\s+//; + $line =~ s/\s+$//; + $ris_default->{$line} = 1; + } + close IN; + unlink $tmpnam if ( -e $tmpnam ); + return $ris_default; +} diff --git a/dev-bin/perltidy_random_run.pl b/dev-bin/perltidy_random_run.pl index 52d20b60..f61f551d 100755 --- a/dev-bin/perltidy_random_run.pl +++ b/dev-bin/perltidy_random_run.pl @@ -133,6 +133,7 @@ my @syntax_errors; my @saved_for_deletion; my @blinkers; my @strange; +my @uninitialized; if ( $nf_beg < 1 ) { $nf_beg = 1 } if ( $np_beg < 1 ) { $np_beg = 1 } @@ -215,15 +216,23 @@ for ( my $nf = $nf_beg ; $nf <= $nf_end ; $nf++ ) { open(IN,"<",$tmperr); foreach my $line(<IN>) { if ($line=~/BLINKER/) { + $error_count++; push @blinkers, $ofile; $error_count_this_file++; $error_count_this_case++; } if ($line=~/STRANGE/) { + $error_count++; push @strange, $ofile; $error_count_this_file++; $error_count_this_case++; } + if ($line=~/uninitialized/) { + $error_count++; + push @uninitialized, $ofile; + $error_count_this_file++; + $error_count_this_case++; + } print STDERR $line; } close(IN); @@ -550,6 +559,15 @@ EOM print STDERR <<EOM; $hash Some files with STRANGE message (search above for 'STRANGE'): $hash (@strange[0..$num-1]) +EOM + } + if (@uninitialized) { + local $" = ')('; + my $num = @uninitialized; + $num = 20 if ( $num > 20 ); + print STDERR <<EOM; +$hash Some files caused 'uninitialized' vars: +$hash (@uninitialized[0..$num-1]) EOM } } diff --git a/dev-bin/perltidy_random_setup.pl b/dev-bin/perltidy_random_setup.pl index 531f9dbc..ef329f0b 100755 --- a/dev-bin/perltidy_random_setup.pl +++ b/dev-bin/perltidy_random_setup.pl @@ -527,7 +527,8 @@ sub get_num { open( IN, "<", $tmpnam ) || die "cannot open $tmpnam: $!\n"; while ( my $line = <IN> ) { next if $line =~ /#/; - chomp $line, push @parameters, $line; + chomp $line; + push @parameters, $line; } close IN; unlink $tmpnam if ( -e $tmpnam );