1package Test::Parser::ltp;
2
3my $i=0;
4
5=head1 NAME
6
7Test::Parser::ltp - Perl module to parse output from runs of the
8Linux Test Project (LTP) testsuite.
9
10=head1 SYNOPSIS
11
12 use Test::Parser::ltp;
13
14 my $parser = new Test::Parser::ltp;
15 $parser->parse($text);
16 printf("Num Executed:  %8d\n", $parser->num_executed());
17 printf("Num Passed:    %8d\n", $parser->num_passed());
18 printf("Num Failed:    %8d\n", $parser->num_failed());
19 printf("Num Skipped:   %8d\n", $parser->num_skipped());
20
21Additional information is available from the subroutines listed below
22and from the L<Test::Parser> baseclass.
23
24=head1 DESCRIPTION
25
26This module provides a way to extract information out of LTP test run
27output.
28
29=head1 FUNCTIONS
30
31Also see L<Test::Parser> for functions available from the base class.
32
33=cut
34
35use strict;
36use warnings;
37use Test::Parser;
38
39@Test::Parser::ltp::ISA = qw(Test::Parser);
40use base 'Test::Parser';
41
42use fields qw(
43              _state
44              _current_test
45              );
46
47use vars qw( %FIELDS $AUTOLOAD $VERSION );
48our $VERSION = '1.7';
49
50=head2 new()
51
52Creates a new Test::Parser::ltp instance.
53Also calls the Test::Parser base class' new() routine.
54Takes no arguments.
55
56=cut
57
58sub new {
59    my $class = shift;
60    my Test::Parser::ltp $self = fields::new($class);
61    $self->SUPER::new();
62
63    $self->name('LTP');
64    $self->type('standards');
65
66    $self->{_state}        = undef;
67    $self->{_current_test} = undef;
68
69    $self->{num_passed} = 0;
70    $self->{num_failed} = 0;
71    $self->{num_skipped} = 0;
72
73    return $self;
74}
75
76=head3
77
78Override of Test::Parser's default parse_line() routine to make it able
79to parse LTP output.
80
81=cut
82sub parse_line {
83    my $self = shift;
84    my $line = shift;
85
86    $self->{_state} ||= 'intro';
87
88    # Change state, if appropriate
89    if ($line =~ m|^<<<(\w+)>>>$|) {
90        $self->{_state} = $1;
91        if ($self->{_state} eq 'test_start') {
92            $self->{_current_test} = undef;
93        }
94        return 1;
95    }
96
97    # Parse content as appropriate to the section we're in
98    if ($self->{_state} eq 'intro') {
99        # TODO:  Parse the intro stuff about the system
100        #        Ignoring it for now until someone needs it...
101
102    } elsif ($self->{_state} eq 'test_start') {
103        if ($line =~ m|^([\w-]+)=(.*)$|) {
104            my ($key, $value) = ($1, $2);
105
106            if ($key eq 'tag') {
107                # Add the test to our collection and parse any additional
108                # parameters (such as stime)
109                if ($value =~ m|^([\w-]+)\s+(\w+)=(.*)$|) {
110                    $self->{_current_test}->{name} = $1;
111                    ($key, $value) = ($2, $3);
112
113                    push @{$self->{testcases}}, $self->{_current_test};
114                }
115            }
116
117            $self->{_current_test}->{$key} = $value;
118        }
119
120    } elsif ($self->{_state} eq 'test_output') {
121        # Has lines of the form:
122        # arp01       1  BROK  :  Test broke: command arp not found
123#        if ($line =~ m|^(\w+)\s+(\d+)\s+([A-Z]+)\s*:\s*(.*)$|) {
124#            my ($name, $num, $status, $message) = ($1, $2, $3, $4);
125#        }
126
127    } elsif ($self->{_state} eq 'execution_status') {
128        my ($termtype, $termid);
129        my @items = split /\s+/, $line;
130        foreach my $item (@items) {
131            if ($item =~ m|^(\w+)=(.*)$|) {
132                $self->{_current_test}->{execution_status}->{$1} = $2;
133                if ($1 eq 'termination_type') {
134                    $termtype = $2;
135                } elsif ($1 eq 'termination_id') {
136                    $termid = $2;
137                }
138            }
139        }
140
141        if (! defined $termtype or ! defined $termid) {
142            # no op
143        } elsif ($termtype eq 'exited') {
144            if ($termid == 0) {
145                $self->{_current_test}->{result} = "PASS";
146                $self->{num_passed}++;
147            } else {
148                $self->{_current_test}->{result} = "FAIL (exit=$termid)";
149                $self->{num_failed}++;
150            }
151            $termid = undef;
152        } elsif ($termtype eq 'signaled') {
153            $self->{_current_test}->{result} = "BROK (signal=$termid)";
154            $self->{num_skipped}++;
155            $termid = undef;
156        } else {
157            $self->{_current_test}->{result} = "$termtype ($termid)";
158            $self->{num_skipped}++;
159            $termid = undef;
160        }
161
162    } elsif ($self->{_state} eq 'test_end') {
163
164        # We've hit the end of the test record; clear buffer
165        $self->{_current_test} = undef;
166
167    } else {
168        # TODO:  Unknown text...  skip it
169    }
170
171    return 1;
172}
173
1741;
175__END__
176
177=head1 AUTHOR
178
179Bryce Harrington <bryce@osdl.org>
180
181=head1 COPYRIGHT
182
183Copyright (C) 2005 Bryce Harrington.
184All Rights Reserved.
185
186This script is free software; you can redistribute it and/or modify it
187under the same terms as Perl itself.
188
189=head1 SEE ALSO
190
191L<Test::Parser>
192
193=end
194
195