diff options
| author | Rohan McGovern <rohan.mcgovern@nokia.com> | 2012-04-19 13:52:02 +1000 |
|---|---|---|
| committer | Qt by Nokia <qt-info@nokia.com> | 2012-04-23 01:45:47 +0200 |
| commit | b5ad6c2870d2dac2a33c84b18b5cb7058957fa0e (patch) | |
| tree | eda06fe94e24e44385adfde71deafc1ec70a4a10 /scripts/lib/perl5/QtQA/TestScript.pm | |
| parent | 20e6bacc5bd002c122329713c1bd07ca3173af75 (diff) | |
Provide a way to make fatal errors parseable by parse_build_log.pl
Rather than explicitly hardcoding every possible error case in
parse_build_log.pl, we can introduce our own standard error format for
scripts under our control.
The new fatal_error function will format a fatal error message so that
it is both (reasonably) human-readable, and also robustly readable by
parse_build_log.pl, potentially with additional metadata.
YAML is used to satisfy the "human and machine readable" quality.
Change-Id: I03b3012860376fed406602b5d0e529c1ee0d13c7
Reviewed-by: Toby Tomkins <toby.tomkins@nokia.com>
Diffstat (limited to 'scripts/lib/perl5/QtQA/TestScript.pm')
| -rw-r--r-- | scripts/lib/perl5/QtQA/TestScript.pm | 106 |
1 files changed, 85 insertions, 21 deletions
diff --git a/scripts/lib/perl5/QtQA/TestScript.pm b/scripts/lib/perl5/QtQA/TestScript.pm index 32b03de1..06416352 100644 --- a/scripts/lib/perl5/QtQA/TestScript.pm +++ b/scripts/lib/perl5/QtQA/TestScript.pm @@ -57,6 +57,8 @@ use List::MoreUtils qw(zip); use Params::Validate qw(validate); use Pod::Simple::Text; use Pod::Usage qw(pod2usage); +use YAML qw(); +use YAML::Node; use QtQA::Proc::Reliable; @@ -88,6 +90,16 @@ sub new return \%self; } +sub _croak +{ + my ($self, @rest) = @_; + + local %Carp::Internal = $self->_carp_internal( ); + croak @rest; + + return; +} + sub set_permitted_properties { @@ -105,12 +117,14 @@ sub property my $default_value = shift; unless ($self->{permitted_properties}) { - croak q{test script error: `property' was called before `set_permitted_properties'}; + $self->_croak( q{test script error: `property' was called before `set_permitted_properties'} ); } unless (exists($self->{permitted_properties}->{$property_name})) { - croak "test script error: test script attempted to read property `$property_name', " - . "but did not declare it as a permitted property"; + $self->_croak( + "test script error: test script attempted to read property `$property_name', " + . "but did not declare it as a permitted property" + ); } my $value = $self->_resolved_property($property_name); @@ -232,7 +246,7 @@ sub _handle_exe_status my ($self, $status, @command) = @_; if ($status != 0) { - croak "@command exited with status $status"; + $self->_croak( "@command exited with status $status" ); } return; @@ -346,6 +360,25 @@ sub _format_signal ; } +# Returns a hash suitable for assignment to %Carp::Internal to ensure Carp reports +# backtraces relative to the correct place. +sub _carp_internal +{ + my ($self) = @_; + + my %out = %Carp::Internal; + + foreach my $package (qw( + QtQA::Proc::Reliable + QtQA::TestScript + Capture::Tiny + )) { + $out{ $package }++; + } + + return %out; +} + # Warn with $message, and prefix each line with the package name so that it is obvious where # this message is coming from. Also, carp is used so that the message hopefully ends up # pointing out a relevant line in the actual test script. @@ -358,20 +391,7 @@ sub _warn $message =~ s{\n}{\n$prefix}g; $message = $prefix . $message; - # Try hard to make sure Carp logs this message relative to the test script. - # We do this here in _warn, rather than using @CARP_NOT, to ensure that only - # "controlled" warnings have this smart logic - any kind of unexpected warnings - # from internal coding errors should not be munged. - - local %Carp::Internal = %Carp::Internal; - - foreach my $package (qw( - QtQA::Proc::Reliable - QtQA::TestScript - Capture::Tiny - )) { - $Carp::Internal{ $package }++; - } + local %Carp::Internal = $self->_carp_internal( ); carp $message; @@ -403,13 +423,35 @@ sub exe_qx } if ($status != 0) { - croak( Data::Dumper->new( [\@command], ['command'] )->Indent( 0 )->Dump( ) - . qq{ exited with status $status} ); + $self->_croak( + Data::Dumper->new( [\@command], ['command'] )->Indent( 0 )->Dump( ) + . qq{ exited with status $status} + ); } return wantarray ? ($stdout, $stderr) : $stdout; } +sub fatal_error +{ + my ($self, $error) = @_; + + # We want to ensure that the 'error' key always comes first. + # This is why we use YAML::Node. + my $ynode = YAML::Node->new({}, 'qtqa.qt-project.org/error' ); + %{$ynode} = ( + error => $error, + ### what else should go here? + ); + + local $YAML::UseBlock = 1; + my $formatted = YAML::Dump( $ynode ); + + $self->_croak( "$formatted...\n" ); + + return; +} + sub print_when_verbose { @@ -595,7 +637,7 @@ sub _croak_from_missing_property $message .= join(q{}, map { " $_\n" } @set_methods); } - croak $message; + $self->_croak( $message ); } # Attempt to return this host's most significant IP address @@ -774,6 +816,28 @@ Example: +=item B<fatal_error>( STRING ) + +Formats the given error STRING into a human and machine-readable value, then dies +with the formatted string. + +The output error message is formatted with YAML in a manner intended to be quite +human-readable, but also possible to robustly extract from a plain text log by +a YAML parsing script. + +The format of the message is loosely defined as a YAML document of type +C<QtQA::TestScript::Error>, containing a mapping from the scalar 'error' to +an error string. Beyond this, the format is undefined; the message is permitted +to include additional metadata. + +This function should be used in place of "die" or "confess" when a useful error +string is known. If the error message is generic - for example, "process <foo> +exited with status 123" where the process is expected to output its own error +messages - it is generally better not to use this function, as the formatted +error message is unlikely to provide any additional value. + + + =item B<get_options_from_array>( ARRAYREF [, LIST ] ) Read command-line options from the given ARRAYREF (which would typically be \@ARGV ). |