Author: paultcochrane
Date: Mon Jun 4 13:27:35 2007
New Revision: 18810
Modified:
trunk/tools/dev/as2c.pl
trunk/tools/dev/cc_flags.pl
trunk/tools/dev/check_source_standards.pl
trunk/tools/dev/lib_deps.pl
trunk/tools/dev/mk_manifests.pl
trunk/tools/dev/parrot_api.pl
trunk/tools/dev/parrot_coverage.pl
trunk/tools/dev/parrotbench.pl
trunk/tools/dev/pbc_header.pl
trunk/tools/dev/rebuild_miniparrot.pl
trunk/tools/dev/run_indent.pl
trunk/tools/dev/symlink.pl
Log:
[tools] Replaced bareword filehandles with variables as per coding standards
Modified: trunk/tools/dev/as2c.pl
==============================================================================
--- trunk/tools/dev/as2c.pl (original)
+++ trunk/tools/dev/as2c.pl Mon Jun 4 13:27:35 2007
@@ -65,11 +65,11 @@
sub parse_s {
my $s = shift;
- open IN, "<", "$s" or die "Can't read '$s': $1";
+ open my $IN, "<", "$s" or die "Can't read '$s': $1";
my ($in_comment);
$in_comment = 1;
print "/*\n";
- while (<IN>) {
+ while (<$IN>) {
next if (/^\f/); # FF
next if (/#(?:NO_)?APP/); # APP, NO_APP
chomp;
@@ -101,16 +101,16 @@
}
print " 0x00\n";
print "};\n";
- close IN;
+ close $IN;
}
sub add_glue {
my $s = shift;
- open IN, "<", "$s" or die "Can't read '$s': $1";
- while (<IN>) {
+ open $IN, "<", "$s" or die "Can't read '$s': $1";
+ while (<$IN>) {
if (/\/\*INTERFACE/) {
my $text = "";
- while (<IN>) {
+ while (<$IN>) {
last if (/INTERFACE\*\//);
$text .= $_;
}
@@ -120,7 +120,7 @@
print $text;
}
}
- close IN;
+ close $IN;
}
# Local Variables:
Modified: trunk/tools/dev/cc_flags.pl
==============================================================================
--- trunk/tools/dev/cc_flags.pl (original)
+++ trunk/tools/dev/cc_flags.pl Mon Jun 4 13:27:35 2007
@@ -32,11 +32,11 @@
my $cflags = shift;
-open F, '<', $cflags or die "open $cflags: $!\n";
+open my $F, '<', $cflags or die "open $cflags: $!\n";
my @options;
-while (<F>) {
+while (<$F>) {
chomp;
s/#.*//;
next unless /\S/;
Modified: trunk/tools/dev/check_source_standards.pl
==============================================================================
--- trunk/tools/dev/check_source_standards.pl (original)
+++ trunk/tools/dev/check_source_standards.pl Mon Jun 4 13:27:35 2007
@@ -56,12 +56,12 @@
###############################################################################
sub check_manifest {
- open( F, "<", "MANIFEST" ) || die "Unable to read MANIFEST: $!\n";
+ open( my $F, "<", "MANIFEST" ) || die "Unable to read MANIFEST: $!\n";
my %files_in_dir_nocase;
my %files_in_dir_8dot3;
my $line = 0;
- while (<F>) {
+ while (<$F>) {
$line++;
chomp;
@@ -98,7 +98,7 @@
$files_in_dir_nocase{$dirname}{ lc($filename) } = $_;
}
- close(F);
+ close($F);
}
sub info {
Modified: trunk/tools/dev/lib_deps.pl
==============================================================================
--- trunk/tools/dev/lib_deps.pl (original)
+++ trunk/tools/dev/lib_deps.pl Mon Jun 4 13:27:35 2007
@@ -101,7 +101,7 @@
print "Running cxref (pass 1)\n";
system("$cmd > $devnull 2>$devnull");
print "Running cxref (pass 2)\n";
- open( F, '<', "$cmd 2>$devnull|" )
+ open( my $F, '<', "$cmd 2>$devnull|" )
|| die "Can't run $cmd.\n";
my %external_calls;
@@ -109,7 +109,7 @@
my %variable_visible;
my %system_include;
my ( $file, $function, $variable );
- while (<F>) {
+ while (<$F>) {
if (/----------------------------------------/) {
undef $file if defined($file);
@@ -182,7 +182,7 @@
}
}
- close(F);
+ close($F);
# filter out things that start with _. Probably internal libc stuff.
my @external_calls = grep { !/^_/ } sort keys %external_calls;
@@ -215,9 +215,9 @@
sub do_object {
foreach my $obj (@files) {
- open( F, '<', "nm -a $obj|" ) || die "Can't run nm on $obj\n";
+ open( my $F, '<', "nm -a $obj|" ) || die "Can't run nm on $obj\n";
- while (<F>) {
+ while (<$F>) {
chomp;
my ( $type, $symbol ) = /^........ (\S) (.*)/;
@@ -231,7 +231,7 @@
}
}
- close(F);
+ close($F);
}
# omit symbols which begin with _. These are likely to be internal
Modified: trunk/tools/dev/mk_manifests.pl
==============================================================================
--- trunk/tools/dev/mk_manifests.pl (original)
+++ trunk/tools/dev/mk_manifests.pl Mon Jun 4 13:27:35 2007
@@ -117,9 +117,9 @@
while ( my ( $package, $files ) = each %FILES ) {
my $manifest = "MANIFEST.$package";
- open( MANIFEST, ">", "$manifest" ) or die "create $manifest: $!";
- print MANIFEST "$_\n" foreach (@$files);
- close MANIFEST;
+ open( my $MANIFEST, ">", "$manifest" ) or die "create $manifest: $!";
+ print $MANIFEST "$_\n" foreach (@$files);
+ close $MANIFEST;
print "Wrote $manifest\n";
}
Modified: trunk/tools/dev/parrot_api.pl
==============================================================================
--- trunk/tools/dev/parrot_api.pl (original)
+++ trunk/tools/dev/parrot_api.pl Mon Jun 4 13:27:35 2007
@@ -149,13 +149,13 @@
my @H = qw(include/parrot/embed.h include/parrot/extend.h);
for my $h (@H) {
- if ( open( H, '<', $h ) ) {
- while (<H>) {
+ if ( open( my $H, '<', $h ) ) {
+ while (<$H>) {
if (/^\w+\s+(Parrot_\w+)\(/) {
$ParrotAPI{$1}++;
}
}
- close(H);
+ close($H);
}
else {
die "$0: Header '$h': $!\n";
Modified: trunk/tools/dev/parrot_coverage.pl
==============================================================================
--- trunk/tools/dev/parrot_coverage.pl (original)
+++ trunk/tools/dev/parrot_coverage.pl Mon Jun 4 13:27:35 2007
@@ -97,10 +97,10 @@
# block (.bb) files.
my $cmd = "gcov -f -b -o $dirname $src_filename";
print "Running $cmd\n" if $DEBUG;
- open( GCOVSUMMARY, '<', "$cmd |" ) or die "Error invoking '$cmd': $!";
+ open( my $GCOVSUMMARY, '<', "$cmd |" ) or die "Error invoking '$cmd': $!";
my $tmp;
my %generated_files;
- while (<GCOVSUMMARY>) {
+ while (<$GCOVSUMMARY>) {
if (/^Creating (.*)\./) {
my $path = "$dirname/$1";
rename( $1, "$dirname/$1" )
@@ -113,7 +113,7 @@
$tmp .= $_;
}
}
- close(GCOVSUMMARY);
+ close($GCOVSUMMARY);
foreach my $gcov_file ( keys %generated_files ) {
my $source_file = $gcov_file;
@@ -192,7 +192,7 @@
sub write_index {
print "Writing $HTMLDIR/index.html..\n" if $DEBUG;
- open( OUT, ">", "$HTMLDIR/index.html" )
+ open( my $OUT, ">", "$HTMLDIR/index.html" )
or die "Can't open $HTMLDIR/index.html for writing: $!\n";
$totals{line_coverage} = sprintf( "%.2f",
@@ -202,8 +202,8 @@
$totals{call_coverage} = sprintf( "%.2f",
( $totals{calls} ? ( $totals{covered_calls} / $totals{calls} * 100 ) :
0 ) );
- print OUT page_header("Parrot Test Coverage");
- print OUT qq(
+ print $OUT page_header("Parrot Test Coverage");
+ print $OUT qq(
<ul>
<li><a href="file_summary.html">File Summary</a>
<li><a href="function_summary.html">Function Summary</a>
@@ -224,17 +224,17 @@
</table>
</ul>
);
- print OUT page_footer();
+ print $OUT page_footer();
}
sub write_file_coverage_summary {
print "Writing $HTMLDIR/file_summary.html..\n" if $DEBUG;
- open( OUT, ">", "$HTMLDIR/file_summary.html" )
+ open( my $OUT, ">", "$HTMLDIR/file_summary.html" )
or die "Can't open $HTMLDIR/file_summary.html for writing: $!\n";
- print OUT page_header("File Coverage Summary");
- print OUT qq(
+ print $OUT page_header("File Coverage Summary");
+ print $OUT qq(
<i>You may click on a percentage to see line-by-line detail</i>
<table border="1">
<tbody>
@@ -250,7 +250,7 @@
my $outfile_base = $source_file;
$outfile_base =~ s/\//_/g;
- print OUT qq(
+ print $OUT qq(
<tr>
<td>$source_file</td>
<td><a
href="$outfile_base.lines.html">@{[$file_line_coverage{$source_file} ?
"$file_line_coverage{$source_file} %" : "n/a" ]}</a></td>
@@ -261,29 +261,29 @@
);
}
- print OUT qq(
+ print $OUT qq(
</tbody>
</table>
);
- print OUT page_footer();
+ print $OUT page_footer();
- close(OUT);
+ close($OUT);
}
sub write_function_coverage_summary {
print "Writing $HTMLDIR/function_summary.html..\n" if $DEBUG;
- open( OUT, ">", "$HTMLDIR/function_summary.html" )
+ open( my $OUT, ">", "$HTMLDIR/function_summary.html" )
or die "Can't open $HTMLDIR/function_summary.html for writing: $!\n";
- print OUT page_header("Function Coverage Summary");
- print OUT qq(
+ print $OUT page_header("Function Coverage Summary");
+ print $OUT qq(
<i>You may click on a percentage to see line-by-line detail</i>
);
foreach my $source_file ( sort keys %file_line_coverage ) {
- print OUT qq(
+ print $OUT qq(
<hr noshade>
<a name="$source_file"></a>
<b>File: $source_file</b><br>
@@ -301,7 +301,7 @@
foreach my $function ( sort keys %{
$function_line_coverage{$source_file} } ) {
- print OUT qq(
+ print $OUT qq(
<tr>
<td>$function</td>
<td><a
href="$outfile_base.lines.html#$function">@{[$function_line_coverage{$source_file}{$function}
? "$function_line_coverage{$source_file}{$function} %" : "n/a" ]}</a></td>
@@ -310,15 +310,15 @@
</tr>
);
}
- print OUT qq(
+ print $OUT qq(
</tbody>
</table>
);
}
- print OUT page_footer();
+ print $OUT page_footer();
- close(OUT);
+ close($OUT);
}
sub filter_gcov {
@@ -333,61 +333,62 @@
my $outfile = "$outfile_base.lines.html";
print "Writing $outfile..\n" if $DEBUG;
- open( IN, "<", "$infile" ) or die "Can't read $infile: $!\n";
- open( OUT, ">", "$outfile" ) or die "Can't write $outfile: $!\n";
+ our ($IN, $OUT);
+ open( $IN, "<", "$infile" ) or die "Can't read $infile: $!\n";
+ open( $OUT, ">", "$outfile" ) or die "Can't write $outfile: $!\n";
- print OUT page_header("Line Coverage for $source_file");
- print OUT "<pre>";
+ print $OUT page_header("Line Coverage for $source_file");
+ print $OUT "<pre>";
# filter out any branch or call coverage lines.
do_filter( sub { /^(call|branch)/ } );
- print OUT "</pre>";
- print OUT page_footer();
+ print $OUT "</pre>";
+ print $OUT page_footer();
- close(OUT);
- close(IN);
+ close($OUT);
+ close($IN);
$outfile = "$outfile_base.branches.html";
print "Writing $outfile..\n" if $DEBUG;
- open( IN, "<", "$infile" ) or die "Can't read $infile: $!\n";
- open( OUT, ">", "$outfile" ) or die "Can't write $outfile: $!\n";
+ open( $IN, "<", "$infile" ) or die "Can't read $infile: $!\n";
+ open( $OUT, ">", "$outfile" ) or die "Can't write $outfile: $!\n";
- print OUT page_header("Branch Coverage for $source_file");
- print OUT "<pre>";
+ print $OUT page_header("Branch Coverage for $source_file");
+ print $OUT "<pre>";
# filter out any call coverage lines.
do_filter( sub { /^call/ } );
- print OUT "</pre>";
- print OUT page_footer();
+ print $OUT "</pre>";
+ print $OUT page_footer();
- close(OUT);
- close(IN);
+ close($OUT);
+ close($IN);
$outfile = "$outfile_base.calls.html";
print "Writing $outfile..\n" if $DEBUG;
- open( IN, "<", "$infile" ) or die "Can't read $infile: $!\n";
- open( OUT, ">", "$outfile" ) or die "Can't write $outfile: $!\n";
+ open( $IN, "<", "$infile" ) or die "Can't read $infile: $!\n";
+ open( $OUT, ">", "$outfile" ) or die "Can't write $outfile: $!\n";
- print OUT page_header("Call Coverage for $source_file");
- print OUT "<pre>";
+ print $OUT page_header("Call Coverage for $source_file");
+ print $OUT "<pre>";
# filter out any branch coverage lines.
do_filter( sub { /^branch/ } );
- print OUT "</pre>";
- print OUT page_footer();
+ print $OUT "</pre>";
+ print $OUT page_footer();
- close(OUT);
- close(IN);
+ close($OUT);
+ close($IN);
return;
sub do_filter {
my ($skip_func) = @_;
- while (<IN>) {
+ while (<$IN>) {
s/&/&/g;
s/</</g;
s/>/>/g;
@@ -401,25 +402,25 @@
my ($initial) = substr( $_, 0, 16 );
if ( $initial =~ /^\s*\d+\s*$/ ) {
- print OUT qq($atag<font color="green">$_</font>);
+ print $OUT qq($atag<font color="green">$_</font>);
}
elsif ( $_ =~ /branch \d+ taken = 0%/ ) {
- print OUT qq($atag<font color="red">$_</font>);
+ print $OUT qq($atag<font color="red">$_</font>);
}
elsif ( $_ =~ /call \d+ returns = 0%/ ) {
- print OUT qq($atag<font color="red">$_</font>);
+ print $OUT qq($atag<font color="red">$_</font>);
}
elsif ( $_ =~ /^call \d+ never executed/ ) {
- print OUT qq($atag<font color="red">$_</font>);
+ print $OUT qq($atag<font color="red">$_</font>);
}
elsif ( $_ =~ /^branch \d+ never executed/ ) {
- print OUT qq($atag<font color="red">$_</font>);
+ print $OUT qq($atag<font color="red">$_</font>);
}
elsif ( $initial =~ /\#\#\#/ ) {
- print OUT qq($atag<font color="red">$_</font>);
+ print $OUT qq($atag<font color="red">$_</font>);
}
else {
- print OUT $_;
+ print $OUT $_;
}
}
}
Modified: trunk/tools/dev/parrotbench.pl
==============================================================================
--- trunk/tools/dev/parrotbench.pl (original)
+++ trunk/tools/dev/parrotbench.pl Mon Jun 4 13:27:35 2007
@@ -218,9 +218,9 @@
}
print "\n";
-open( COPYOUT, ">&STDOUT" ) or die "Unable to copy STDOUT";
+open( my $COPYOUT, ">&STDOUT" ) or die "Unable to copy STDOUT";
open( STDOUT, '>', File::Spec->devnull ) or die "Unable to redirect STDOUT";
-select COPYOUT;
+select $COPYOUT;
$| = 1;
my @max = $cfg{method} == 1 ? (5) x @program : (6) x @program;
Modified: trunk/tools/dev/pbc_header.pl
==============================================================================
--- trunk/tools/dev/pbc_header.pl (original)
+++ trunk/tools/dev/pbc_header.pl Mon Jun 4 13:27:35 2007
@@ -35,9 +35,9 @@
# s. also fingerprint_c.pl
my $compat_file = 'PBC_COMPAT';
- open IN, '<', $compat_file or die "Can't read $compat_file";
- my @lines = <IN>;
- close IN;
+ open my $IN, '<', $compat_file or die "Can't read $compat_file";
+ my @lines = <$IN>;
+ close $IN;
my $len = 10;
my $fingerprint = md5 join "\n", grep { !/^#/ } @lines;
@@ -46,9 +46,9 @@
sub get_version {
my $version_file = 'VERSION';
- open IN, '<', $version_file or die "Can't read $version_file";
- my $v = <IN>;
- close IN;
+ open my $IN, '<', $version_file or die "Can't read $version_file";
+ my $v = <$IN>;
+ close $IN;
$v =~ /^(\d+)\.(\d+)/;
( $1, $2 );
}
@@ -58,20 +58,20 @@
my $fp = get_fp;
my ( $major, $minor ) = get_version;
for my $f (@args) {
- open F, "+<", "$f" or die "Can't open $f: $!";
- seek F, 2, 0; # pos 2: major, minor
- print F pack "cc", $major, $minor;
- seek F, 6, 0; # pos 6: pad = finger_print
- print F $fp;
- close F;
+ open my $F, "+<", "$f" or die "Can't open $f: $!";
+ seek $F, 2, 0; # pos 2: major, minor
+ print $F pack "cc", $major, $minor;
+ seek $F, 6, 0; # pos 6: pad = finger_print
+ print $F $fp;
+ close $F;
}
}
sub pbc_info {
for my $f (@ARGV) {
- open F, "<", "$f" or die "Can't open $f: $!";
+ open my $F, "<", "$f" or die "Can't open $f: $!";
my $header;
- read F, $header, 16;
+ read $F, $header, 16;
my (@fields) = qw( wordsize byteorder major minor
intvalsize floattype );
print "$f\n";
Modified: trunk/tools/dev/rebuild_miniparrot.pl
==============================================================================
--- trunk/tools/dev/rebuild_miniparrot.pl (original)
+++ trunk/tools/dev/rebuild_miniparrot.pl Mon Jun 4 13:27:35 2007
@@ -124,16 +124,16 @@
## GCC ##
print "- miniparrot/build_gcc.sh\n";
- open( F, ">", "miniparrot/build_gcc.sh" )
+ open( my $F, ">", "miniparrot/build_gcc.sh" )
|| die "Unable to write miniparrot/build_gcc.sh: $!\n";
- print F "#!/bin/sh\n";
- print F "\nset -x -e\n";
+ print $F "#!/bin/sh\n";
+ print $F "\nset -x -e\n";
foreach (@compiled_files) {
- print F "gcc -DMINIPARROT -I./include -c $_->[0] -o $_->[1]\n";
+ print $F "gcc -DMINIPARROT -I./include -c $_->[0] -o $_->[1]\n";
}
my @obj_files = map { $_->[1] } @compiled_files;
- print F "gcc -lm -o parrot " . ( join ' ', @obj_files ) . "\n";
- close(F);
+ print $F "gcc -lm -o parrot " . ( join ' ', @obj_files ) . "\n";
+ close($F);
}
############################################################################
Modified: trunk/tools/dev/run_indent.pl
==============================================================================
--- trunk/tools/dev/run_indent.pl (original)
+++ trunk/tools/dev/run_indent.pl Mon Jun 4 13:27:35 2007
@@ -83,10 +83,10 @@
}
# now a little trick. Weed out the ones we know aren't used in this file.
- open( F, "<", "$file" ) || die "Can't read $file: $!\n";
+ open( my $F, "<", "$file" ) || die "Can't read $file: $!\n";
{
local $/ = undef;
- my $contents = <F>;
+ my $contents = <$F>;
foreach ( keys %$typedefs ) {
delete $typedefs->{$_} unless ( $contents =~ /\Q$_\E/ );
@@ -98,7 +98,7 @@
}
}
- close(F);
+ close($F);
print STDERR "$errors parse errors. " if ($errors);
print STDERR "Found " . scalar( keys %$typedefs ) . " typedefs.\n";
Modified: trunk/tools/dev/symlink.pl
==============================================================================
--- trunk/tools/dev/symlink.pl (original)
+++ trunk/tools/dev/symlink.pl Mon Jun 4 13:27:35 2007
@@ -52,9 +52,9 @@
my $topsrcdir = File::Spec->catdir(@topsrcdir);
my $manifest = File::Spec->catfile( $topsrcdir, "MANIFEST" );
my @srcfiles = ();
-if ( open( MANIFEST, '<', $manifest ) ) {
+if ( open( my $MANIFEST, '<', $manifest ) ) {
my %dstdir;
- while (<MANIFEST>) {
+ while (<$MANIFEST>) {
next if /^\#/;
if (/^(.+?)\s+\[/) {
my $manifile = $1;
@@ -101,7 +101,7 @@
}
}
warn "$self: could not find any files to symlink\n" unless @srcfiles;
- close(MANIFEST);
+ close($MANIFEST);
}
else {
die "$self: Failed to open $manifest: $!\n";
