Permalink
Browse files

Committing patch submitted for RT 45523 and 45525. Add --fatal and

---fatal-step options for Configuration.  Default behavior remains to
continue with configuration when a config step fails, but now you get a
list of failed steps at the conclusion of configuration.  Add test
files to test new functionality.  Some renumbering of existing test
files.


git-svn-id: https://svn.parrot.org/parrot/trunk@22303 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
1 parent e7ba0dc commit a5e76432573804a81a749e3b7af5d661d1cb806b @jkeenan jkeenan committed Oct 20, 2007
View
@@ -44,6 +44,15 @@ =head2 Command-line Options
Run C<--verbose=2> for step number C<N> or matching description.
+=item C<--fatal>
+
+Tells Configure.pl to halt completely if any configuration step fails.
+
+=item C<--fatal-step={init::alpha,inter::beta,auto::gamma}>
+
+Tells Configure.pl to halt completely if any configuration step in
+comma-delimited string individually fails.
+
=item C<--nomanicheck>
Tells Configure.pl not to run the MANIFEST check.
@@ -343,9 +352,10 @@ =head1 SEE ALSO
# as command-line option
$opttest->run_build_tests();
+my $make = $conf->data->get('make');
# from Parrot::Configure::Messages
-print_conclusion( $conf->data->get('make') );
-exit(0);
+my $rv = print_conclusion( $conf, $make );
+exit($rv);
################### DOCUMENTATION ###################
View
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Fri Oct 19 00:41:16 2007 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sat Oct 20 12:17:17 2007 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -2953,8 +2953,24 @@ t/configure/035-step.t []
t/configure/036-config_steps.t []
t/configure/037-run_single_step.t []
t/configure/038-run_single_step.t []
-t/configure/039-slurp_file.t []
+t/configure/039-run_single_step.t []
+t/configure/040-return_undef.t []
t/configure/040_warnings_sniff.t []
+t/configure/041-return_undef.t []
+t/configure/042-list_of_steps.t []
+t/configure/043-verbose_step_name.t []
+t/configure/044-slurp_file.t []
+t/configure/046-inter.t []
+t/configure/047-inter.t []
+t/configure/050-fatal.t []
+t/configure/051-fatal_step.t []
+t/configure/052-fatal_step.t []
+t/configure/053-fatal_step.t []
+t/configure/054-fatal_step.t []
+t/configure/055-fatal_step.t []
+t/configure/056-fatal_step.t []
+t/configure/057-fatal_step.t []
+t/configure/058-fatal_step.t []
t/configure/101-init_manifest-01.t []
t/configure/101-init_manifest-02.t []
t/configure/102-init_defaults-01.t []
View
@@ -221,9 +221,36 @@ sub runsteps {
my $conf = shift;
my $n = 0; # step number
- my ( $verbose, $verbose_step, $ask ) = $conf->options->get(qw( verbose verbose-step ask ));
+ my ( $verbose, $verbose_step, $fatal, $fatal_step, $ask ) =
+ $conf->options->get(qw( verbose verbose-step fatal fatal-step ask ));
+
+ $conf->{log} = [];
+ my %steps_to_die_for = ();
+ # If the --fatal option is true, then all config steps are mapped into
+ # %steps_to_die_for and there is no consideration of --fatal-step.
+ if ($fatal) {
+ %steps_to_die_for = map {$_, 1} @{ $conf->{list_of_steps} };
+ }
+ # We make certain that argument to --fatal-step is a comma-delimited
+ # string of configuration steps, each of which is a string delimited by
+ # two colons, the first half of which is one of init|inter|auto|gen
+ # (This will be modified to take a step sequence number.)
+ elsif ( defined ( $fatal_step ) ) {
+ %steps_to_die_for = $conf->_handle_fatal_step_option( $fatal_step );
+ }
+ else {
+ # No action needed; this is the default case where no step is fatal
+ }
foreach my $task ( $conf->steps ) {
+ my $red_flag;
+ my $step_name = $task->step;
+ if ( scalar ( keys ( %steps_to_die_for ) ) ) {
+ if ( $steps_to_die_for{$step_name} ) {
+ $red_flag++;
+ }
+ }
+
$n++;
my $rv = $conf->_run_this_step(
{
@@ -234,10 +261,51 @@ sub runsteps {
n => $n,
}
);
+ if ( ! defined $rv ) {
+ if ( $red_flag ) {
+ return;
+ } else {
+ $conf->{log}->[$n] = {
+ step => $step_name,
+ };
+ }
+ }
}
return 1;
}
+sub _handle_fatal_step_option {
+ my $conf = shift;
+ my ($fatal_step) = @_;
+ my %steps_to_die_for = ();
+ my $named_step_pattern = qr/(?:init|inter|auto|gen)::[a-z]+/;
+ my $unit_step_pattern = qr/\d+|$named_step_pattern/;
+ if ( $fatal_step =~ /^
+ $unit_step_pattern
+ (, $unit_step_pattern)*
+ $/x
+ ) {
+ my @fatal_steps = split /,/, $fatal_step;
+ for my $s (@fatal_steps) {
+ if ($s =~ /^\d+$/) {
+ die "No configuration step corresponding to $fatal_step"
+ unless defined $conf->{list_of_steps}->[$s - 1];
+ my $step_name = $conf->{list_of_steps}->[$s - 1];
+ if ($step_name =~ /$named_step_pattern/) {
+ $steps_to_die_for{$step_name}++;
+ } else {
+ die "Configuration step corresponding to $s is invalid";
+ }
+ } else {
+ $steps_to_die_for{$s}++;
+ }
+ }
+ } else {
+ die "Argument to 'fatal-step' option must be comma-delimited string of valid configuration steps or configuration step sequence numbers";
+ }
+ return %steps_to_die_for;
+}
+
=item * C<run_single_step()>
The invoking L<Parrot::Configure> object is passed as the first argument to
@@ -252,7 +320,8 @@ sub run_single_step {
my $conf = shift;
my $taskname = shift;
- my ( $verbose, $verbose_step, $ask ) = $conf->options->get(qw( verbose verbose-step ask ));
+ my ( $verbose, $verbose_step, $ask ) =
+ $conf->options->get(qw( verbose verbose-step ask ));
my $task = ( $conf->steps() )[0];
if ( $task->{"Parrot::Configure::Task::step"} eq $taskname ) {
@@ -337,10 +406,11 @@ sub _run_this_step {
# A Parrot configuration step can run successfully, but if it fails to
# achieve its objective it is supposed to return an undefined status.
- if ($ret) {
+ if ( $ret ) {
_finish_printing_result(
{
step => $step,
+ step_name => $step_name,
args => $args,
description => $step->description,
}
@@ -360,8 +430,7 @@ sub _run_this_step {
);
}
return 1;
- }
- else {
+ } else {
_failure_message( $step, $step_name );
return;
}
@@ -29,8 +29,28 @@ END
}
sub print_conclusion {
+ my $conf = shift;
my $make = shift;
- print <<"END";
+ my @failed_steps = @{ $conf->{log} };
+ my @logged_failed_steps = ();
+ for (my $i = 1; $i <= $#failed_steps; $i++) {
+ if ( defined $failed_steps[$i] ) {
+ push @logged_failed_steps, [ $i, $conf->{log}->[$i] ];
+ }
+ }
+ if ( scalar ( @logged_failed_steps ) ) {
+ print "During configuration the following steps failed:\n";
+ foreach my $fail (@logged_failed_steps) {
+ my $msg = sprintf " %02d: %s\n", (
+ $fail->[0],
+ $fail->[1]->{step},
+ );
+ print $msg;
+ }
+ print "You should diagnose and fix these errors before calling '$make'\n";
+ return;
+ } else {
+ print <<"END";
Okay, we're done!
@@ -41,7 +61,8 @@ Happy Hacking,
The Parrot Team
END
- return 1;
+ return 1;
+ }
}
1;
@@ -29,6 +29,8 @@ our @valid_options = qw{
define
exec-prefix
execcapable
+ fatal
+ fatal-step
floatval
gc
help
@@ -82,10 +84,10 @@ our $script = q{Configure.pl};
our $parrot_version = Parrot::BuildUtil::parrot_version();
our $svnid = '$Id$',
- my %short_circuits = (
+my %short_circuits = (
help => \&print_help,
version => \&print_version,
- );
+);
our %options_components = (
'valid_options' => \@valid_options,
@@ -122,6 +124,10 @@ General Options:
--verbose=2 Output every setting change
--verbose-step=N Set verbose for step N only
--verbose-step=regex Set verbose for step matching description
+ --fatal Failure of any configuration step will cause
+ Configure.pl to halt
+ --fatal-step Comma-delimited string of configuration steps
+ which upon failure cause Configure.pl to halt
--nomanicheck Don't check the MANIFEST
--step=(gen::languages)
Execute a single configure step
View
@@ -6,7 +6,7 @@
use strict;
use warnings;
use Carp;
-use Test::More tests => 10;
+use Test::More tests => 12;
use lib qw( lib );
use_ok(
'Parrot::Configure::Messages', qw|
@@ -40,19 +40,45 @@ my $make_version = 'gnu make';
}
{
- my ( $tie, $rv, $msg );
+ my ( $tie, $rv, @lines, $msg );
$tie = tie *STDOUT, "Parrot::IO::Capture::Mini"
or croak "Unable to tie";
- $rv = print_conclusion($make_version);
+ my $pseudo_conf = {
+ log => [],
+ };
+ $rv = print_conclusion($pseudo_conf, $make_version);
ok( $rv, "print_conclusion() returned true" );
- $msg = $tie->READLINE;
+ @lines = $tie->READLINE;
+ $msg = join("/n", @lines);
# Following test is definitive.
like( $msg, qr/$make_version/, "Message included make version supplied as argument" );
undef $tie;
}
+{
+ my ( $tie, $rv, @lines, $msg );
+ $tie = tie *STDOUT, "Parrot::IO::Capture::Mini"
+ or croak "Unable to tie";
+ my $pseudo_conf = {
+ log => [
+ undef,
+ { step => q{init::manifest} },
+ ],
+ };
+ $rv = print_conclusion($pseudo_conf, $make_version);
+ ok(! defined $rv, "print_conclusion() returned undefined value" );
+ @lines = $tie->READLINE;
+ $msg = join("/n", @lines);
+
+ like( $msg,
+ qr/During configuration the following steps failed:.*init::manifest/s,
+ "Got expected message re configuration step failure" );
+
+ undef $tie;
+}
+
pass("Completed all tests in $0");
################### DOCUMENTATION ###################
@@ -1,7 +1,7 @@
#! perl
# Copyright (C) 2007, The Perl Foundation.
# $Id$
-# 037-run_single_step.t
+# 038-run_single_step.t
use strict;
use warnings;
@@ -37,11 +37,11 @@ pass("Completed all tests in $0");
=head1 NAME
-037-run_single_step.t - test C<run_single_step()> during configuration
+038-run_single_step.t - test C<run_single_step()> during configuration
=head1 SYNOPSIS
- % prove t/configure/037-run_single_step.t
+ % prove t/configure/038-run_single_step.t
=head1 DESCRIPTION
Oops, something went wrong.

0 comments on commit a5e7643

Please sign in to comment.