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