File Coverage

blib/lib/Test/Parser/ltp.pm
Criterion Covered Total %
statement 64 70 91.4
branch 27 34 79.4
condition 4 5 80.0
subroutine 8 8 100.0
pod 2 2 100.0
total 105 119 88.2


line stmt bran cond sub pod time code
1             package Test::Parser::ltp;
2              
3             my $i=0;
4              
5             =head1 NAME
6              
7             Test::Parser::ltp - Perl module to parse output from runs of the
8             Linux 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              
21             Additional information is available from the subroutines listed below
22             and from the L baseclass.
23              
24             =head1 DESCRIPTION
25              
26             This module provides a way to extract information out of LTP test run
27             output.
28              
29             =head1 FUNCTIONS
30              
31             Also see L for functions available from the base class.
32              
33             =cut
34              
35 1     1   65287 use strict;
  1         3  
  1         32  
36 1     1   5 use warnings;
  1         2  
  1         23  
37 1     1   691 use Test::Parser;
  1         14  
  1         53  
38              
39             @Test::Parser::ltp::ISA = qw(Test::Parser);
40 1     1   7 use base 'Test::Parser';
  1         3  
  1         307  
41              
42 1         6 use fields qw(
43             _state
44             _current_test
45 1     1   8 );
  1         2  
46              
47 1     1   160 use vars qw( %FIELDS $AUTOLOAD $VERSION );
  1         2  
  1         3122  
48             our $VERSION = '1.7';
49              
50             =head2 new()
51              
52             Creates a new Test::Parser::ltp instance.
53             Also calls the Test::Parser base class' new() routine.
54             Takes no arguments.
55              
56             =cut
57              
58             sub new {
59 1     1 1 820 my $class = shift;
60 1         5 my Test::Parser::ltp $self = fields::new($class);
61 1         4412 $self->SUPER::new();
62              
63 1         8 $self->name('LTP');
64 1         9 $self->type('standards');
65              
66 1         2 $self->{_state} = undef;
67 1         3 $self->{_current_test} = undef;
68              
69 1         3 $self->{num_passed} = 0;
70 1         3 $self->{num_failed} = 0;
71 1         3 $self->{num_skipped} = 0;
72              
73 1         4 return $self;
74             }
75              
76             =head3
77              
78             Override of Test::Parser's default parse_line() routine to make it able
79             to parse LTP output.
80              
81             =cut
82             sub parse_line {
83 1405     1405 1 1585 my $self = shift;
84 1405         1781 my $line = shift;
85              
86 1405   100     2834 $self->{_state} ||= 'intro';
87              
88             # Change state, if appropriate
89 1405 100       2891 if ($line =~ m|^<<<(\w+)>>>$|) {
90 136         252 $self->{_state} = $1;
91 136 100       299 if ($self->{_state} eq 'test_start') {
92 34         58 $self->{_current_test} = undef;
93             }
94 136         434 return 1;
95             }
96              
97             # Parse content as appropriate to the section we're in
98 1269 100       3784 if ($self->{_state} eq 'intro') {
    100          
    100          
    100          
    50          
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 170 50       636 if ($line =~ m|^([\w-]+)=(.*)$|) {
104 170         352 my ($key, $value) = ($1, $2);
105              
106 170 100       315 if ($key eq 'tag') {
107             # Add the test to our collection and parse any additional
108             # parameters (such as stime)
109 34 50       144 if ($value =~ m|^([\w-]+)\s+(\w+)=(.*)$|) {
110 34         105 $self->{_current_test}->{name} = $1;
111 34         127 ($key, $value) = ($2, $3);
112              
113 34         40 push @{$self->{testcases}}, $self->{_current_test};
  34         91  
114             }
115             }
116              
117 170         429 $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 68         72 my ($termtype, $termid);
129 68         262 my @items = split /\s+/, $line;
130 68         116 foreach my $item (@items) {
131 204 50       839 if ($item =~ m|^(\w+)=(.*)$|) {
132 204         711 $self->{_current_test}->{execution_status}->{$1} = $2;
133 204 100       681 if ($1 eq 'termination_type') {
    100          
134 34         61 $termtype = $2;
135             } elsif ($1 eq 'termination_id') {
136 34         58 $termid = $2;
137             }
138             }
139             }
140              
141 68 100 66     304 if (! defined $termtype or ! defined $termid) {
    50          
    0          
142             # no op
143             } elsif ($termtype eq 'exited') {
144 34 100       75 if ($termid == 0) {
145 13         42 $self->{_current_test}->{result} = "PASS";
146 13         34 $self->{num_passed}++;
147             } else {
148 21         88 $self->{_current_test}->{result} = "FAIL (exit=$termid)";
149 21         37 $self->{num_failed}++;
150             }
151 34         75 $termid = undef;
152             } elsif ($termtype eq 'signaled') {
153 0         0 $self->{_current_test}->{result} = "BROK (signal=$termid)";
154 0         0 $self->{num_skipped}++;
155 0         0 $termid = undef;
156             } else {
157 0         0 $self->{_current_test}->{result} = "$termtype ($termid)";
158 0         0 $self->{num_skipped}++;
159 0         0 $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 1         4 $self->{_current_test} = undef;
166              
167             } else {
168             # TODO: Unknown text... skip it
169             }
170              
171 1269         3961 return 1;
172             }
173              
174             1;
175             __END__