Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Modernizing some code. Eliminated globals from Configure.pl. Error ch…
…ecking on file closes.
  • Loading branch information
pmichaud committed Mar 3, 2009
1 parent e2ee4c7 commit 688f9a2
Show file tree
Hide file tree
Showing 3 changed files with 73 additions and 64 deletions.
113 changes: 58 additions & 55 deletions Configure.pl
Expand Up @@ -5,65 +5,74 @@
use warnings;
use 5.008;

MAIN: {
my %valid_options = (
'help' => 'Display configuration help',
'parrot-config' => 'Use configuration given by parrot_config binary',
'gen-parrot' => 'Automatically retrieve and build Parrot',
);

# Get any options from the command line
my %options = get_command_options( \%valid_options );

# Print help if it's requested
if ($options{'help'}) {
print_help();
exit(0);
}

my %valid_options = (
'help' => 'Display configuration help',
'parrot-config' => 'Use configuration given by parrot_config binary',
'gen-parrot' => 'Automatically retrieve and build Parrot',
);


# Get any options from the command line
my %options = get_command_options();


# Print help if it's requested
if ($options{'help'}) {
print_help();
exit(0);
}


# Update/generate parrot build if needed
if ($options{'gen-parrot'}) {
system("$^X build/gen_parrot.pl");
}
# Update/generate parrot build if needed
if ($options{'gen-parrot'}) {
system("$^X build/gen_parrot.pl");
}

# Get a list of parrot-configs to invoke.
my @parrot_config_exe = qw(
parrot/parrot_config
../../parrot_config
parrot_config
);
# Get a list of parrot-configs to invoke.
my @parrot_config_exe = qw(
parrot/parrot_config
../../parrot_config
parrot_config
);

if ($options{'parrot-config'} && $options{'parrot-config'} ne '1') {
@parrot_config_exe = ($options{'parrot-config'});
}
if ($options{'parrot-config'} && $options{'parrot-config'} ne '1') {
@parrot_config_exe = ($options{'parrot-config'});
}

# Get configuration information from parrot_config
my %config = read_parrot_config(@parrot_config_exe);
unless (%config) {
die <<'END';
# Get configuration information from parrot_config
my %config = read_parrot_config(@parrot_config_exe);
unless (%config) {
die <<'END';
Unable to locate parrot_config.
To automatically checkout (svn) and build a copy of parrot,
try re-running Configure.pl with the '--gen-parrot' option.
Or, use the '--parrot-config' option to explicitly specify
the location of parrot_config.
END
}
}

# Create the Makefile using the information we just got
create_makefile(%config);
create_makefile(%config);

# Done.
done();
my $make = $config{'make'};
print <<"END";
You can now use '$make' to build Rakudo Perl.
After that, you can use '$make test' to run some local tests,
or '$make spectest' to check out (via svn) a copy of the Perl 6
official test suite and run its tests.
END
exit 0;

}


# Process command line arguments into a hash.
sub get_command_options {
my $valid_options = shift;

my %options = ();
for my $arg (@ARGV) {
if ($arg =~ /^--(\w[-\w]*)(?:=(.*))?/ && $valid_options{$1}) {
if ($arg =~ /^--(\w[-\w]*)(?:=(.*))?/ && $valid_options->{$1}) {
my ($key, $value) = ($1, $2);
$value = 1 unless defined $value;
$options{$key} = $value;
Expand Down Expand Up @@ -96,11 +105,8 @@ sub read_parrot_config {
# Generate a Makefile from a configuration
sub create_makefile {
my %config = @_;
my $infile = 'build/Makefile.in';
open my $ROOTIN, '<', $infile or
die "Unable to read $infile\n";
my $maketext = join('', <$ROOTIN>);
close $ROOTIN or die $!;

my $maketext = slurp( 'build/Makefile.in' );

$config{'win32_libparrot_copy'} = $^O eq 'MSWin32' ? 'copy $(BUILD_DIR)\libparrot.dll .' : '';
$maketext =~ s/@(\w+)@/$config{$1}/g;
Expand All @@ -118,18 +124,15 @@ sub create_makefile {
return;
}

sub slurp {
my $filename = shift;

sub done {
my $make = $config{'make'};
print <<"END";
open my $fh, '<', $filename or die "Unable to read $filename\n";
local $/ = undef;
my $maketext = <$fh>;
close $fh or die $!;

You can now use '$make' to build Rakudo Perl.
After that, you can use '$make test' to run some local tests,
or '$make spectest' to check out (via svn) a copy of the Perl 6
official test suite and run its tests.
END
exit 0;
return $maketext;
}


Expand Down
23 changes: 14 additions & 9 deletions tools/test_summary.pl
Expand Up @@ -30,7 +30,7 @@
next unless $specfile;
push @tfiles, "t/spec/$specfile";
}
close($fh);
close $fh or die $!;

{
my $cmd = join ' ', $^X, 't/spec/fudgeall', 'rakudo', @tfiles;
Expand All @@ -41,9 +41,12 @@
@tfiles = sort @tfiles;
my $max = 0;
for my $tfile (@tfiles) {
my $tname = $tfile; $tname =~ s!^t/spec/!!;
my $tname = $tfile;
$tname =~ s{^t/spec/}{};
$tname = substr($tname, 0, 49);
if (length($tname) > $max) { $max = length($tname); }
if (length($tname) > $max) {
$max = length($tname);
}
$tname{$tfile} = $tname;
}

Expand All @@ -69,7 +72,7 @@
while (<$th>) {
if (/^\s*plan\D*(\d+)/) { $plan = $1; last; }
}
close($th);
close $th or die $!;
my $tname = $tname{$tfile};
my $syn = substr($tname, 0, 3); $syn{$syn}++;
printf "%s%s..", $tname, '.' x ($max - length($tname));
Expand Down Expand Up @@ -132,24 +135,26 @@

my $sumfmt = qq(%-9.9s %6s,%6s,%6s,%6s,%6s,%6s\n);
print "----------------\n";
print qq("Synopsis","pass","fail","todo","skip","regr","spec"\n);
print qq{"Synopsis","pass","fail","todo","skip","regr","spec"\n};
for my $syn (sort keys %syn) {
printf $sumfmt, qq("$syn",), map { $sum{"$syn-$_"} } @col;
printf $sumfmt, qq{"$syn",}, map { $sum{"$syn-$_"} } @col;
}

my $total = scalar(@tfiles).' regression files';
printf $sumfmt, qq("total",), map { $sum{$_} } @col;
printf $sumfmt, qq{"total",}, map { $sum{$_} } @col;

print "----------------\n";
my $rev = $ENV{'REV'};
if ($rev) {
my $file = scalar(@tfiles);
print join(',', $rev, (map { $sum{$_} } @col), $file), "\n";
print "spectest-progress.csv update: ",
print 'spectest-progress.csv update: ',
"$file files, $sum{'pass'} passing, $sum{'fail'} failing\n";
}

if (@fail) {
print "Failure summary:\n";
foreach (@fail) { print " $_\n"; }
foreach (@fail) {
print " $_\n";
}
}
1 change: 1 addition & 0 deletions tools/update_passing_test_data.pl
Expand Up @@ -86,6 +86,7 @@ sub read_specfile {
s/\s+\z//;
push @res, "t/spec/$_";
}
close $f or die $!;
return @res;
}

Expand Down

0 comments on commit 688f9a2

Please sign in to comment.