without parens around the call args. Some examples:
# OLD
- mkTextConfi2022 Helen Hancockg $c, $x, $y, -anchor => 'se', $color;
+ mkTextConfig $c, $x, $y, -anchor => 'se', $color;
mkTextConfig $c, $x + 30, $y, -anchor => 's', $color;
mkTextConfig $c, $x + 60, $y, -anchor => 'sw', $color;
mkTextConfig $c, $x, $y + 30, -anchor => 'e', $color;
without parens around the call args. Some examples:
# OLD
- mkTextConfi2022 Helen Hancockg $c, $x, $y, -anchor => 'se', $color;
+ mkTextConfig $c, $x, $y, -anchor => 'se', $color;
mkTextConfig $c, $x + 30, $y, -anchor => 's', $color;
mkTextConfig $c, $x + 60, $y, -anchor => 'sw', $color;
mkTextConfig $c, $x, $y + 30, -anchor => 'e', $color;
if ( $abbrev{$_} ) { delete $abbrev{$_} }
}
-
# Select the short names which can be negated
my @short_list;
foreach my $long (@binary_long_names) {
# special aliases not obtained automatically
my @special = qw(
-oll
-dac
-tac
-html
-sob
-baa
-bbs
-kgb
-icp
-otr
-sot
-sct
-sac
-sobb
-conv
+ oll
+ dac
+ tac
+ html
+ sob
+ baa
+ bbs
+ kgb
+ icp
+ otr
+ sot
+ sct
+ sac
+ sobb
+ conv
);
my $FIELD_WIDTH = 6;
my $line = " ";
my $count = 0;
-foreach my $word ( sort (@short_list, @special) ) {
+foreach my $word ( sort ( @short_list, @special ) ) {
my $len = length($word);
my $nsp = $FIELD_WIDTH - $len + 1;
$word .= " " x $nsp;
use Perl::Tidy;
use Data::Dumper;
+#--------------------------------------------------------------------------
+# NOTE: While this gives useful information, I have concluded that due to
+# the large number of parameters and their possible interactions, automated
+# random testing is a better way to be sure perltidy parameters are tested.
+# So this program is no longer used.
+#--------------------------------------------------------------------------
+
# This will eventually read all of the '.par' files and write a report
# showing the parameter coverage.
# The starting point for this program is 'examples/perltidyrc_dump.pl'
-# The plan is:
+# The plan is:
# read each '.par' file
# use perltidy's options-dump feature to convert to long names and return in a hash
# combine all of these results and write back to standard output in sorted order
#
# It will also be useful to output a list of unused parameters
-# NOTE: While this gives useful information, I have concluded that due to
-# the large number of parameters and their possible interactions, automated
-# random testing is a better way to be sure perltidy parameters are tested.
-
my $usage = <<EOM;
# writes a summary of parameters covered in snippet testing
# no_coverage.txt has list of parameters not covered
getopts( 'hdsq', \%my_opts ) or die "$usage";
if ( $my_opts{h} ) { die "$usage" }
-my @files=@ARGV;
-if ( !@files ) { @files=glob('*.par')}
+my @files = @ARGV;
+if ( !@files ) { @files = glob('*.par') }
# Get a list of all options, their sections and abbreviations
# Also get the list of defaults
# Initialize to defaults
foreach my $long_name ( keys %{$rGetopt_flags} ) {
- if ( defined($rOpts_default->{$long_name}) ) {
+ if ( defined( $rOpts_default->{$long_name} ) ) {
my $val = $rOpts_default->{$long_name};
$rsaw_values->{$long_name} = [$val];
}
# Store a 0 default for all switches with no default value
my $flag = $rGetopt_flags->{$long_name};
if ( $flag eq '!' ) {
- my $val=0;
+ my $val = 0;
$rsaw_values->{$long_name} = [$val];
}
}
}
-
# Loop over config files
foreach my $config_file (@files) {
my @uniq = uniq(@vals);
my @sorted = sort { $a cmp $b } @uniq;
$rsaw_values->{$long_name} = \@sorted;
- my $options_flag = $rGetopt_flags->{$long_name};
-
- # Consider switches with just one value as not seen
- if ($options_flag eq '!' && @sorted<2) {
- push @not_seen, $long_name;
- }
- else {
- push @seen, $long_name;
- }
+ my $options_flag = $rGetopt_flags->{$long_name};
+
+ # Consider switches with just one value as not seen
+ if ( $options_flag eq '!' && @sorted < 2 ) {
+ push @not_seen, $long_name;
+ }
+ else {
+ push @seen, $long_name;
+ }
}
else {
- push @not_seen, $long_name;
+ push @not_seen, $long_name;
}
}
# Remove the unseen from the big hash
-foreach my $long_name(@not_seen) {
+foreach my $long_name (@not_seen) {
delete $rsaw_values->{$long_name};
}
#print Data::Dumper->Dump($rsaw_values);
my $fseen = "coverage_values.txt";
open( $fh, ">", $fseen ) || die "can open $fseen: $!\n";
-$fh->print( Dumper($rsaw_values));
+$fh->print( Dumper($rsaw_values) );
$fh->close();
print "wrote $fseen\n";
"# ERROR in dump_options: unrecognized flag $flag for $long_name\n";
}
}
+
=pod
# These long option names have no abbreviations or are treated specially
@option_string = qw(
# print the long version of the parameter
# with the short version as a side comment
- my $short_name = $short_name{$long_name};
- my $long_option = $prefix . $long_name . $suffix;
-
-
- # A few options do not have a short abbreviation
- # so we will make it the same as the long option
- # These include 'recombine' and 'valign', which are mainly
- # for debugging.
- my $short_option = $long_option;
- if ($short_name) {
- $short_option = $short_prefix . $short_name . $suffix;
- }
+ my $short_name = $short_name{$long_name};
+ my $long_option = $prefix . $long_name . $suffix;
+
+ # A few options do not have a short abbreviation
+ # so we will make it the same as the long option
+ # These include 'recombine' and 'valign', which are mainly
+ # for debugging.
+ my $short_option = $long_option;
+ if ($short_name) {
+ $short_option = $short_prefix . $short_name . $suffix;
+ }
my $note = $requals_default->{$long_name} ? " [=default]" : "";
if ( $rmy_opts->{s} ) {
}
}
- return ( $error_message, \%Getopt_flags, \%sections, \%abbreviations,
- \%Opts_default, );
+ return (
+ $error_message, \%Getopt_flags, \%sections,
+ \%abbreviations, \%Opts_default,
+ );
}
sub read_perltidyrc {
my %abbreviations;
Perl::Tidy::perltidy(
- perltidyrc => $config_file,
- dump_options => \%Opts,
- dump_options_type => 'perltidyrc', # default is 'perltidyrc'
- dump_abbreviations => \%abbreviations,
- stderr => \$stderr,
- argv => \$argv,
+ perltidyrc => $config_file,
+ dump_options => \%Opts,
+ dump_options_type => 'perltidyrc', # default is 'perltidyrc'
+ dump_abbreviations => \%abbreviations,
+ stderr => \$stderr,
+ argv => \$argv,
);
# try to capture any errors generated by perltidy call
print "$key -> $Opts{$key}\n";
}
}
- return ( $error_message, \%Opts);
+ return ( $error_message, \%Opts );
}
sub xx_read_perltidyrc {
my ($pname) = @_;
if ( $pname && !defined( $rparams->{$pname} ) ) {
my $pstring = $get_string->( $pname . ".par" );
- chomp $pstring;
-# my $pstring = $read_parameters->( $pname . ".par" );
-# if ($pstring) {
-# $pstring =~ s/\n/ /g;
-# $pstring =~ s/\s+/ /;
-# $pstring =~ s/\s*$//;
-# }
+ chomp $pstring;
+
+ # my $pstring = $read_parameters->( $pname . ".par" );
+ # if ($pstring) {
+ # $pstring =~ s/\n/ /g;
+ # $pstring =~ s/\s+/ /;
+ # $pstring =~ s/\s*$//;
+ # }
$rparams->{$pname} = $pstring;
}
};
# To speed up testing, you may enter specific files
# if none are given all are used
my @files = @ARGV;
-if (!@files) {
- @files = glob('*.in *.par');
+if ( !@files ) {
+ @files = glob('*.in *.par');
}
foreach my $file (@files) {
my @pnames;
@pnames = keys %{$rparams};
foreach my $pname (@pnames) {
- my $proot = ( $pname =~ /^([^\d]+)/ ) ? $1 : $pname;
+ my $proot = ( $pname =~ /^([^\d]+)/ ) ? $1 : $pname;
my $match =
- # exact match of source and parameter file base names
- $pname eq $sname
+ # exact match of source and parameter file base names
+ $pname eq $sname
- # match of source root to parameter file base name
+ # match of source root to parameter file base name
|| $pname eq $sroot
- # match of source base name to parameter root
+ # match of source base name to parameter root
|| $proot eq $sname
- # defaults apply to all files
+ # defaults apply to all files
|| $pname eq $defname;
- next unless ($match);
+ next unless ($match);
my $output;
my $source = $rsources->{$sname};
source => \$source,
destination => \$output,
perltidyrc => \$params,
- argv => '', # don't let perltidy look at my @ARGV
+ argv => '', # don't let perltidy look at my @ARGV
stderr => \$stderr_string,
- errorfile => \$errorfile_string, # not used when -se flag is set
+ errorfile => \$errorfile_string, # not used when -se flag is set
);
if ($stderr_string) {
- print STDERR "---------------------\n";
+ print STDERR "---------------------\n";
print STDERR "<<STDERR>>\n$stderr_string\n";
- print STDERR "---------------------\n";
+ print STDERR "---------------------\n";
die "The above error was received with $source + $params\n";
}
- if ($errorfile_string) {
- print STDERR "---------------------\n";
+ if ($errorfile_string) {
+ print STDERR "---------------------\n";
print STDERR "<<.ERR file>>\n$errorfile_string\n";
- print STDERR "---------------------\n";
+ print STDERR "---------------------\n";
die "The above .ERR was received with $source + $params\n";
- }
+ }
if ($err) {
die "error calling Perl::Tidy with $source + $params\n";
}
my $tname = $opath . $basename;
my $ename = $epath . $basename;
if ( !-e $ename ) {
- my $new_file = "tmp/$basename";
- push @new, $new_file;
+ my $new_file = "tmp/$basename";
+ push @new, $new_file;
print "$new_file is a new file\n";
push @mv, "cp $tname $ename";
}
}
}
-my $diff_file="diff.txt";
-if ( -e "$diff_file" ) { unlink("$diff_file") }
+my $diff_file = "diff.txt";
+if ( -e "$diff_file" ) { unlink("$diff_file") }
if (@same) {
my $num = @same;
print "$num Unchanged files\n";
if ( !@mv ) {
print "No differences\n";
- if (-e $runme) {unlink $runme}
+ if ( -e $runme ) { unlink $runme }
exit;
}
Enter ./$runme to move results from tmp/ to expect/ and make new .t files
EOM
}
+
sub query {
my ($msg) = @_;
print $msg;
my $ans = <STDIN>;
chomp $ans;
+
#my $val=$ans;
return $ans;
}
+
sub ifyes {
- # Updated to have default, which should be "Y" or "N"
- my ($msg, $default)=@_;
+ # Updated to have default, which should be "Y" or "N"
+ my ( $msg, $default ) = @_;
my $count = 0;
ASK:
- my $ans = query($msg);
+ my $ans = query($msg);
if ( defined($default) ) {
$ans = $default unless ($ans);
}
# methods work. It can be necessary to switch between these
# methods if something goes wrong during development.
#my $rpacking_list=get_packing_list($fpacking_list);
-my $rpacking_list=get_packing_list();
+my $rpacking_list = get_packing_list();
my @exp = glob("$ipath*");
#print "exp=(@exp)\n";
-my $ix = 0;
+my $ix = 0;
my $rix_lookup = {};
my %is_basename;
-foreach my $file_exp (sort @exp) {
+foreach my $file_exp ( sort @exp ) {
my $estring = $get_string->($file_exp);
my $ename = $file_exp;
if ( $ename =~ /([^\/]+)$/ ) { $ename = $1 }
# Find the base names. NOTE: I tried packing by basename, which makes tracking
# down errors a little easier, and makes the files change less frequently, but
# the run times increased too much over the 'snippets*.t' packing method. For
-# example, here are times recorded in April 2020
+# example, here are times recorded in April 2020
-# packing in 20 files, snippets1.t ... snippets20.t: 17.7 s
-# packing in 226 files, 105484.t ... wngnu1.t: 44.7 s
+# packing in 20 files, snippets1.t ... snippets20.t: 17.7 s
+# packing in 226 files, 105484.t ... wngnu1.t: 44.7 s
# so there is over a factor of 2 increase in run time for the convenience of
# packing by base name. The extra time is due to continually reloading
print STDERR
"Unexpected filename $sname.$pname, using basename=$basename\n";
}
- push @{$item}, $basename;
+ push @{$item}, $basename;
push @{ $rpacking_by_basename->{$basename} }, $item;
}
-# assign indexes to existing packing locations
+# assign indexes to existing packing locations
my $rassigned;
my $rcount;
-my $high_file="";
-my $high_digits=0;
+my $high_file = "";
+my $high_digits = 0;
foreach my $item ( @{$rpacking_list} ) {
my ( $ofile, $ename ) = @{$item};
$rcount->{$ofile}++;
}
# Pack all new items. Continue with last file in the list
-my $ofile_last = $high_file; ##$rpacking_list->[-1]->[0];
+my $ofile_last = $high_file; ##$rpacking_list->[-1]->[0];
my $case_count = $rcount->{$ofile_last} + 1;
my $file_count = $high_digits;
}
else {
- # a file no longer exists, we should delete or move it
+ # a file no longer exists, we should delete or move it
push @empty_files, $ofile;
- system "mv $ofile $ofile.bak";
+ system "mv $ofile $ofile.bak";
}
}
EOM
}
-write_packing_list("$fpacking_list", $rpacking_list);
+write_packing_list( "$fpacking_list", $rpacking_list );
print "Now run a 'make test' from the top directory to check these\n";
# Example showing how to pack the snippet files using base names
sub write_packing_list {
my ( $ofile, $rpacking ) = @_;
- if (-e $ofile) {system "mv $ofile $ofile.bak"}
+ if ( -e $ofile ) { system "mv $ofile $ofile.bak" }
open my $fh, '>', $ofile or die "cannot open $ofile: $!\n";
$fh->print("# This file is automatically generated by make_t.pl\n");
foreach my $item ( @{$rpacking} ) {
# pull out the parameters and sources we need
my $rparams = {};
my $rsources = {};
- my $nn=0;
+ my $nn = 0;
foreach my $item ( @{$rtests} ) {
my ( $ename, $pname, $sname, $estring ) = @{$item};
$rparams->{$pname} = $rparams_all->{$pname};
$rsources->{$sname} = $rsources_all->{$sname};
- $nn++;
- $ename_string .= "#$nn $ename\n";
+ $nn++;
+ $ename_string .= "#$nn $ename\n";
}
my $count = 0;
my $err = Perl::Tidy::perltidy(
source => \$script,
destination => \$output,
- argv => '', # hide any ARGV from perltidy
+ argv => '', # hide any ARGV from perltidy
stderr => \$stderr_string,
errorfile => \$errorfile_string, # not used when -se flag is set
);
if ( length($string) > $short_length ) {
$long = $string;
my @words = split( /[\s\-\_\(\)\,\&\+]/, $string );
- my $num = @words;
+ my $num = @words;
$short = shift(@words);
for ( my $i = 0 ; $i < $num ; $i++ ) {
my $word = shift(@words);
use strict;
my @files = @ARGV;
my %saw;
+
# Look at a number of .pro profiles and show their common flags.
# This can help pinpoint the flags which are causing an issue.
foreach my $file (@files) {
}
close IN;
}
-my $nfiles=@files;
-foreach my $key(sort keys %saw) {
- next if ($saw{$key} != $nfiles);
- print $key,"\n";
+my $nfiles = @files;
+foreach my $key ( sort keys %saw ) {
+ next if ( $saw{$key} != $nfiles );
+ print $key, "\n";
}
projects / perltidy.git / commitdiff