test2tasks.pl 4.9 KB
Newer Older
1 2
#!/usr/bin/perl -w

3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
############################################################################
#
# Copyright (C) 2016 The Qt Company Ltd.
# Contact: https://www.qt.io/licensing/
#
# This file is part of Qt Creator.
#
# Commercial License Usage
# Licensees holding valid commercial Qt licenses may use this file in
# accordance with the commercial license agreement provided with the
# Software or, alternatively, in accordance with the terms contained in
# a written agreement between you and The Qt Company. For licensing terms
# and conditions see https://www.qt.io/terms-conditions. For further
# information use the contact form at https://www.qt.io/contact-us.
#
# GNU General Public License Usage
# Alternatively, this file may be used under the terms of the GNU
# General Public License version 3 as published by the Free Software
# Foundation with exceptions as appearing in the file LICENSE.GPL3-EXCEPT
# included in the packaging of this file. Please review the following
# information to ensure the GNU General Public License requirements will
# be met: https://www.gnu.org/licenses/gpl-3.0.html.
#
############################################################################

28 29 30 31 32 33
=head1 NAME

test2tasks.pl - Convert QTest logs into Qt Creator task files.

=head1 SYNOPSIS

34 35 36 37 38 39 40 41 42
    test2tasks.pl [OPTIONS] < logfile > taskfile

Options:

    -a              Use absolute file paths

    -r <some_path>  Prefix all file names by <some_path> (Used for
                    creating a summarized log of a submodule repository)

43 44 45 46 47 48 49 50 51 52

The script needs to be run in the working directory from which the test log was
obtained as it attempts to perform a mapping from the source file base names of
the test log to relative path names by searching the files.

=cut

use strict;

use File::Find;
53 54 55 56 57 58
use Getopt::Long;
use File::Spec;
use Cwd;

my $optAbsolute = 0;
my $optRelativeTo;
59

60 61 62 63 64 65 66 67 68 69
# --------------- Detect OS

my ($OS_LINUX, $OS_WINDOWS, $OS_MAC)  = (0, 1, 2);
my $os = $OS_LINUX;
if (index($^O, 'MSWin') >= 0) {
    $os = $OS_WINDOWS;
} elsif (index($^O, 'darwin') >= 0) {
   $os = $OS_MAC;
}

70 71 72
# -- Build a hash from source file base name to relative paths.

my %fileHash;
73
my $workingDirectory = getcwd();
74 75 76 77

sub handleFile
{
    my $file = $_;
78 79
    return unless -f $file;
    return unless index($file, '.cpp') != -1 || index($file, '.h') != -1 || index($file, '.qml');
80
#   './file' -> 'file'
81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97
    my $name = substr($File::Find::name, 0, 1) eq '.' ?
               substr($File::Find::name, 2) : $File::Find::name;
     my $fullName = $name;
    if (defined $optRelativeTo) {
    $fullName = File::Spec->catfile($optRelativeTo, $File::Find::name);
    } else {
    $fullName = File::Spec->catfile($workingDirectory, $File::Find::name) if ($optAbsolute);
    }
    $fullName =~ s|\\|/|g; # The task pane wants forward slashes on Windows, also.
    $fileHash{$file} = $fullName;
}

#   Main
if (!GetOptions("absolute" => \$optAbsolute,
                "relative=s" => \$optRelativeTo)) {
    print "Invalid option\n";
    exit (0);
98 99 100 101 102 103 104 105
}

find({ wanted => \& handleFile}, '.');

# --- Find file locations and format them with the cause of the error
#     from the above lines as task entry.

my $lastLine = '';
106 107
my ($failCount, $fatalCount) = (0, 0);

108 109 110 111 112 113 114
sub isAbsolute
{
    my ($f) = @_;
    return $f =~ /^[a-zA-Z]:/ ? 1 : 0 if $os eq $OS_WINDOWS;
    return index($f, '/') == 0 ? 1 : 0;
}

115 116 117
while (my $line = <STDIN> ) {
    chomp($line);
    # --- Continuation line?
118
    if (substr($line, 0, 1) eq ' ' && index($line, 'Loc: [') < 0) {
119 120 121
       $lastLine .= $line;
       next;
    }
122 123 124 125 126 127
    # --- extract file name based matching:
    #     Windows: '[..\].\tst_lancelot.cpp(258) : failure location'
    #     Unix:    '  Loc: [file(1596)]'
    if ($line =~ /^([^(]+)\((\d+)\) : failure location$/
        || $line =~ /^\s*Loc:\s*\[([^(]+)\((\d+)\).*$/) {
        my $fullFileName = $1;
128
        my $line = $2;
129 130 131
        #  -- Fix '/C:/bla' which is sometimes reported for QML errors.
        $fullFileName = substr($fullFileName, 1) if ($os eq $OS_WINDOWS && $fullFileName =~ /^\/[a-zA-Z]:\//);
        if (!isAbsolute($fullFileName)) { # Unix has absolute file names, Windows may not
132 133
            my $slashPos = rindex($fullFileName, '/');
            $slashPos = rindex($fullFileName, "\\") if $slashPos < 0;
134
            my $fileName = $slashPos > 0 ? substr($fullFileName, $slashPos + 1) : $fullFileName;
135 136 137
            $fullFileName = $fileHash{$fileName};
            $fullFileName = $fileName unless defined $fullFileName;
        }
138 139
        my $type = index($lastLine, 'FAIL') == 0 || index($lastLine, 'XPASS') == 0 ?
                   'err' : 'unknown';
140
        print $fullFileName, "\t", $line, "\t", $type, "\t", $lastLine,"\n";
141 142 143 144 145 146
        $failCount++;
    } else {
        if (index($line, 'QFATAL') == 0 || index($line, 'Received a fatal error.') >= 0) {
            print STDERR $line,"\n";
            $fatalCount++;
        }
147 148 149
    }
    $lastLine = $line;
}
150

151
print STDERR 'Done, ISSUES: ',$failCount, ', FATAL: ',$fatalCount, "\n";