pjs/js/tests/known-failures.pl

570 строки
16 KiB
Perl
Executable File

#!/usr/bin/perl
# -*- Mode: Perl; tab-width: 4; indent-tabs-mode: nil; -*-
# ***** BEGIN LICENSE BLOCK *****
# Version: MPL 1.1/GPL 2.0/LGPL 2.1
#
# The contents of this file are subject to the Mozilla Public License Version
# 1.1 (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS" basis,
# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
# for the specific language governing rights and limitations under the
# License.
#
# The Original Code is Mozilla JavaScript Testing Utilities
#
# The Initial Developer of the Original Code is
# Mozilla Corporation.
# Portions created by the Initial Developer are Copyright (C) 2007
# the Initial Developer. All Rights Reserved.
#
# Contributor(s): Bob Clary <bclary@bclary.com>
#
# Alternatively, the contents of this file may be used under the terms of
# either the GNU General Public License Version 2 or later (the "GPL"), or
# the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
# in which case the provisions of the GPL or the LGPL are applicable instead
# of those above. If you wish to allow use of your version of this file only
# under the terms of either the GPL or the LGPL, and not to allow others to
# use your version of this file under the terms of the MPL, indicate your
# decision by deleting the provisions above and replace them with the notice
# and other provisions required by the GPL or the LGPL. If you do not delete
# the provisions above, a recipient may use your version of this file under
# the terms of any one of the MPL, the GPL or the LGPL.
#
# ***** END LICENSE BLOCK *****
use strict;
use Getopt::Mixed "nextOption";
# predeclarations
sub debug;
sub usage;
sub parse_options;
sub escape_pattern;
sub unescape_pattern;
# option arguments
my $option_desc = "b=s branch>b T=s buildtype>T t=s testtype>t l=s rawlogfile>l f=s failurelogfile>f o=s os>o r=s patterns>r z=s timezone>z O=s outputprefix>O A=s arch>A K=s kernel>K D debug>D";
my $branch;
my $buildtype;
my $testtype;
my $rawlogfile;
my $failurelogfile;
my $os;
my $patterns;
my $timezone;
my $outputprefix;
my $arch;
my $kernel;
my $debug = $ENV{DEBUG};
# pattern variables
my $knownfailurebranchpattern;
my $failurebranchpattern;
my $knownfailureospattern;
my $failureospattern;
my $knownfailurebuildtypepattern;
my $failurebuildtypepattern;
my $knownfailuretesttypepattern;
my $failuretesttypepattern;
my $knownfailuretimezonepattern;
my $failuretimezonepattern;
my $knownfailurearchpattern;
my $failurearchpattern;
my $knownfailurekernelpattern;
my $failurekernelpattern;
my @patterns;
my $pattern;
my @failures;
my @fixes;
my @excludedtests;
my $excludedtest;
my @results;
my $regchars = '\[\^\-\]\|\{\}\?\*\+\.\<\>\$\(\)';
my @excludedfiles = ('spidermonkey-n.tests', 'slow-n.tests', 'performance.tests');
my $excludedfile;
&parse_options;
my $jsdir = $ENV{TEST_JSDIR};
if (!defined($jsdir)) {
$jsdir = "/work/mozilla/mozilla.com/test.mozilla.com/www/tests/mozilla.org/js";
}
# create working patterns file consisting of matches to users selection
# and which has the test description patterns escaped
# remove the excluded tests from the possible fixes log
foreach $excludedfile ( @excludedfiles ) {
open EXCLUDED, "<$jsdir/$excludedfile" or die "Unable to open excluded file $jsdir/$excludedfile: $!\n";
while (<EXCLUDED>) {
chomp;
next if ($_ =~ /^\#/);
push @excludedtests, ($_);
}
close EXCLUDED;
}
@excludedtests = sort @excludedtests;
debug "loading patterns $patterns";
debug "pattern filter: /^TEST_ID=[^,]*, TEST_BRANCH=$knownfailurebranchpattern, TEST_RESULT=[^,]*, TEST_BUILDTYPE=$knownfailurebuildtypepattern, TEST_TYPE=$knownfailuretesttypepattern, TEST_OS=$knownfailureospattern, TEST_MACHINE=[^,]*, TEST_PROCESSORTYPE=$knownfailurearchpattern, TEST_KERNEL=$knownfailurekernelpattern, TEST_DATE=[^,]*, TEST_TIMEZONE=$knownfailuretimezonepattern,/\n";
open PATTERNS, "<$patterns" or die "Unable to open known failure patterns file $patterns: $!\n";
while (<PATTERNS>) {
chomp;
if ($_ =~ /^TEST_ID=[^,]*, TEST_BRANCH=$knownfailurebranchpattern, TEST_RESULT=[^,]*, TEST_BUILDTYPE=$knownfailurebuildtypepattern, TEST_TYPE=$knownfailuretesttypepattern, TEST_OS=$knownfailureospattern, TEST_MACHINE=[^,]*, TEST_PROCESSORTYPE=$knownfailurearchpattern, TEST_KERNEL=$knownfailurekernelpattern, TEST_DATE=[^,]*, TEST_TIMEZONE=$knownfailuretimezonepattern,/) {
debug "adding pattern: $_";
push @patterns, (escape_pattern($_));
}
else {
debug "skipping pattern: $_";
}
}
close PATTERNS;
# create a working copy of the current failures which match the users selection
debug "failure filter: ^TEST_ID=[^,]*, TEST_BRANCH=$failurebranchpattern, TEST_RESULT=FAIL[^,]*, TEST_BUILDTYPE=$failurebuildtypepattern, TEST_TYPE=$failuretesttypepattern, TEST_OS=$failureospattern, TEST_MACHINE=[^,]*, TEST_PROCESSORTYPE=$failurearchpattern, TEST_KERNEL=$failurekernelpattern, TEST_DATE=[^,]*, TEST_TIMEZONE=$failuretimezonepattern,";
if (defined($rawlogfile)) {
$failurelogfile = "$outputprefix-results-failures.log";
my $alllog = "$outputprefix-results-all.log";
debug "writing failures $failurelogfile";
open INPUTLOG, "$jsdir/post-process-logs.pl $rawlogfile|sort|uniq|" or die "Unable to open $rawlogfile $!\n";
open ALLLOG, ">$alllog" or die "Unable to open $alllog $!\n";
open FAILURELOG, ">$failurelogfile" or die "Unable to open $failurelogfile $!\n";
while (<INPUTLOG>) {
chomp;
print ALLLOG "$_\n";
if ($_ =~ /^TEST_ID=[^,]*, TEST_BRANCH=$failurebranchpattern, TEST_RESULT=FAIL[^,]*, TEST_BUILDTYPE=$failurebuildtypepattern, TEST_TYPE=$failuretesttypepattern, TEST_OS=$failureospattern, TEST_MACHINE=[^,]*, TEST_PROCESSORTYPE=$failurearchpattern, TEST_KERNEL=$failurekernelpattern, TEST_DATE=[^,]*, TEST_TIMEZONE=$failuretimezonepattern,/) {
debug "failure: $_";
push @failures, ($_);
print FAILURELOG "$_\n";
}
}
close INPUTLOG;
close ALLLOG;
close FAILURELOG;
}
else {
debug "loading failures $failurelogfile";
open FAILURES, "<$failurelogfile" or die "Unable to open current failure log $failurelogfile: $!\n";
while (<FAILURES>) {
chomp;
if ($_ =~ /^TEST_ID=[^,]*, TEST_BRANCH=$failurebranchpattern, TEST_RESULT=FAIL[^,]*, TEST_BUILDTYPE=$failurebuildtypepattern, TEST_TYPE=$failuretesttypepattern, TEST_OS=$failureospattern, TEST_MACHINE=[^,]*, TEST_PROCESSORTYPE=$failurearchpattern, TEST_KERNEL=$failurekernelpattern, TEST_DATE=[^,]*, TEST_TIMEZONE=$failuretimezonepattern,/) {
debug "failure: $_";
push @failures, ($_);
}
}
close FAILURES;
}
debug "finding fixed bugs";
unlink "$outputprefix-results-possible-fixes.log";
foreach $pattern (@patterns) {
# look for known failure patterns that don't have matches in the
# the current failures selected by the user.
@results = grep m@^$pattern@, @failures;
if ($#results == -1) {
debug "fix: $pattern";
push @fixes, ($pattern)
}
}
foreach $excludedtest ( @excludedtests ) {
if ($debug) {
@results = grep m@$excludedtest@, @fixes;
if ($#results > -1) {
print "excluding: " . (join ', ', @results) . "\n";
}
}
@results = grep !m@$excludedtest@, @fixes;
@fixes = @results;
}
my $fix;
open OUTPUT, ">$outputprefix-results-possible-fixes.log" or die "Unable to open $outputprefix-results-possible-fixes.log: $!";
foreach $fix (@fixes) {
print OUTPUT unescape_pattern($fix) . "\n";
if ($debug) {
debug "fix: $fix";
}
}
close OUTPUT;
print STDOUT "log: $outputprefix-results-possible-fixes.log\n";
debug "finding regressions";
my $pass = 0;
my $changed = ($#patterns != -1);
while ($changed) {
$pass = $pass + 1;
$changed = 0;
debug "pass $pass";
foreach $pattern (@patterns) {
debug "Pattern: $pattern";
my @nomatches = grep !m@^$pattern@, @failures;
my @matches = grep m@^$pattern@, @failures;
if ($debug) {
my $temp = join ', ', @nomatches;
debug "nomatches: $#nomatches $temp";
$temp = join ', ', @matches;
debug "matches: $#matches $temp";
}
@failures = @nomatches;
if ($#matches > -1) {
$changed = 1;
}
debug "*****************************************";
}
}
foreach $excludedtest ( @excludedtests ) {
if ($debug) {
@results = grep m@$excludedtest@, @failures;
if ($#results > -1) {
print "excluding: " . (join ', ', @results) . "\n";
}
}
@results = grep !m@$excludedtest@, @failures;
@failures = @results;
}
open OUTPUT, ">$outputprefix-results-possible-regressions.log" or die "Unable to open $outputprefix-results-possible-regressions.log: $!";
my $failure;
foreach $failure (@failures) {
print OUTPUT "$failure\n";
if ($debug) {
debug "regression: $failure";
}
}
close OUTPUT;
print STDOUT "log: $outputprefix-results-possible-regressions.log\n";
sub debug {
if ($debug) {
my $msg = shift;
print "DEBUG: $msg\n";
}
}
sub usage {
my $msg = shift;
print STDERR <<EOF;
usage: $msg
known-failures.pl [-b|--branch] branch [-T|--buildtype] buildtype
[-t|--testtype] testtype [-o os|--os]
([-f|--failurelogfile] failurelogfile|[-l|--logfile] rawlogfile])
[-r|--patterns] patterns [-z|--timezone] timezone
[-O|--outputprefix] outputprefix
variable description
=============== ============================================================
-b branch branch 1.8.1, 1.9.0, all
-T buildtype build type opt, debug, all
-t testtype test type browser, shell, all
-l rawlogfile raw logfile
-f failurelogfile failure logfile
-o os operating system win32, mac, linux, all
-r patterns known failure patterns
-z timezone -0400, -0700, etc. default to user\'s zone
-O outputprefix output files will be generated with this prefix
-A arch architecture, all or a specific pattern
-K kernel kernel, all or a specific pattern
-D turn on debugging output
EOF
exit(2);
}
sub parse_options {
my ($option, $value);
Getopt::Mixed::init ($option_desc);
$Getopt::Mixed::order = $Getopt::Mixed::RETURN_IN_ORDER;
while (($option, $value) = nextOption()) {
if ($option eq "b") {
$branch = $value;
}
elsif ($option eq "T") {
$buildtype = $value;
}
elsif ($option eq "t") {
$testtype = $value;
}
elsif ($option eq "l") {
$rawlogfile = $value;
}
elsif ($option eq "f") {
$failurelogfile = $value;
}
elsif ($option eq "o") {
$os = $value;
}
elsif ($option eq "r") {
$patterns = $value;
}
elsif ($option eq "z") {
$timezone = $value;
}
elsif ($option eq "O") {
$outputprefix = $value;
}
elsif ($option eq "A") {
$arch = $value;
}
elsif ($option eq "K") {
$kernel = $value;
}
elsif ($option eq "D") {
$debug = 1;
}
}
if ($debug) {
print "branch=$branch, rawlogfile=$rawlogfile failurelogfile=$failurelogfile, os=$os, buildtype=$buildtype, testtype=$testtype, patterns=$patterns, timezone=$timezone, outputprefix=$outputprefix\n";
}
Getopt::Mixed::cleanup();
if ( !defined($branch) ) {
usage "missing branch";
}
if (!defined($rawlogfile) && !defined($failurelogfile)) {
usage "missing logfile";
}
if (!defined($os)) {
usage "missing os";
}
if (!defined($buildtype)) {
usage "missing buildtype";
}
if (!defined($testtype)) {
usage "missing testtype";
}
if (!defined($patterns)) {
usage "missing patterns";
}
if (!defined($timezone)) {
usage "missing timezone";
}
if (!defined($outputprefix)) {
usage "missing outputprefix";
}
if ($branch eq "1.8.1") {
$knownfailurebranchpattern = "([^,]*1\\.8\\.1[^,]*|\\.\\*)";
$failurebranchpattern = "1\\.8\\.1";
}
elsif ($branch eq "1.9.0") {
$knownfailurebranchpattern = "([^,]*1\\.9\\.0[^,]*|\\.\\*)";
$failurebranchpattern = "1\\.9\\.0";
}
elsif ($branch eq "all") {
$knownfailurebranchpattern = "[^,]*";
$failurebranchpattern = "[^,]*";
}
if ($os eq "win32") {
$knownfailureospattern = "([^,]*win32[^,]*|\\.\\*)";
$failureospattern = "win32";
}
elsif ($os eq "mac") {
$knownfailureospattern = "([^,]*mac[^,]*|\\.\\*)";
$failureospattern = "mac";
}
elsif ($os eq "linux") {
$knownfailureospattern = "([^,]*linux[^,]*|\\.\\*)";
$failureospattern = "linux";
}
elsif ($os eq "all") {
$knownfailureospattern = "[^,]*";
$failureospattern = "[^,]*";
}
if ($buildtype eq "opt") {
$knownfailurebuildtypepattern = "([^,]*opt[^,]*|\\.\\*)";
$failurebuildtypepattern = "opt";
}
elsif ($buildtype eq "debug") {
$knownfailurebuildtypepattern = "([^,]*debug[^,]*|\\.\\*)";
$failurebuildtypepattern = "debug";
}
elsif ($buildtype eq "all") {
$knownfailurebuildtypepattern = "[^,]*";
$failurebuildtypepattern = "[^,]*";
}
if ($testtype eq "shell") {
$knownfailuretesttypepattern = "([^,]*shell[^,]*|\\.\\*)";
$failuretesttypepattern = "shell";
}
elsif ($testtype eq "browser") {
$knownfailuretesttypepattern = "([^,]*browser[^,]*|\\.\\*)";
$failuretesttypepattern = "browser";
}
elsif ($testtype eq "all") {
$knownfailuretesttypepattern = "[^,]*";
$failuretesttypepattern = "[^,]*";
}
if ($timezone eq "all") {
$knownfailuretimezonepattern = "[^,]*";
$failuretimezonepattern = "[^,]*";
}
else {
$knownfailuretimezonepattern = "([^,]*" . $timezone . "[^,]*|\\.\\*)";
$failuretimezonepattern = "$timezone";
}
if ($arch ne "all") {
$knownfailurearchpattern = "([^,]*" . $arch . "[^,]*|\\.\\*)";
$failurearchpattern = "$arch";
}
else {
$knownfailurearchpattern = "[^,]*";
$failurearchpattern = "[^,]*";
}
if ($kernel ne "all") {
$knownfailurekernelpattern = "([^,]*" . $kernel . "[^,]*|\\.\\*)";
$failurekernelpattern = "$kernel";
}
else {
$knownfailurekernelpattern = "[^,]*";
$failurekernelpattern = "[^,]*";
}
}
sub escape_pattern {
my $line = shift;
chomp;
my ($leading, $trailing) = $line =~ /(.*TEST_DESCRIPTION=)(.*)/;
# debug "escape_pattern: before: $leading$trailing";
# replace unescaped regular expression characters in the
# description so they are not interpreted as regexp chars
# when matching descriptions. leave the escaped regexp chars
# `regexp alone so they can be unescaped later and used in
# pattern matching.
# see perldoc perlre
$trailing =~ s/\\/\\\\/g;
# escape non word chars that aren't surrounded by ``
$trailing =~ s/(?<!`)([$regchars])(?!`)/\\$1/g;
$trailing =~ s/(?<!`)([$regchars])(?=`)/\\$1/g;
$trailing =~ s/(?<=`)([$regchars])(?!`)/\\$1/g;
# $trailing =~ s/(?<!`)(\W)(?!`)/\\$1/g;
# unquote the regchars
$trailing =~ s/\`([^\`])\`/$1/g;
debug "escape_pattern: after: $leading$trailing";
return "$leading$trailing";
}
sub unescape_pattern {
my $line = shift;
chomp;
my ($leading, $trailing) = $line =~ /(.*TEST_DESCRIPTION=)(.*)/;
# quote the unescaped non word chars
$trailing =~ s/(?<!\\)([$regchars])/`$1`/g;
# unescape the escaped non word chars
$trailing =~ s/\\([$regchars])/$1/g;
$trailing =~ s/\\\\/\\/g;
debug "unescape_pattern: after: $leading$trailing";
return "$leading$trailing";
}
####
1;