js/tests/known-failures.pl

   1 #!/usr/bin/perl
   2 # -*- Mode: Perl; tab-width: 4; indent-tabs-mode: nil; -*-
   3
   4 # ***** BEGIN LICENSE BLOCK *****
   5 # Version: MPL 1.1/GPL 2.0/LGPL 2.1
   6 #
   7 # The contents of this file are subject to the Mozilla Public License Version
   8 # 1.1 (the "License"); you may not use this file except in compliance with
   9 # the License. You may obtain a copy of the License at
  10 # http://www.mozilla.org/MPL/
  11 #
  12 # Software distributed under the License is distributed on an "AS IS" basis,
  13 # WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  14 # for the specific language governing rights and limitations under the
  15 # License.
  16 #
  17 # The Original Code is Mozilla JavaScript Testing Utilities
  18 #
  19 # The Initial Developer of the Original Code is
  20 # Mozilla Corporation.
  21 # Portions created by the Initial Developer are Copyright (C) 2007
  22 # the Initial Developer. All Rights Reserved.
  23 #
  24 # Contributor(s): Bob Clary <bclary@bclary.com>
  25 #
  26 # Alternatively, the contents of this file may be used under the terms of
  27 # either the GNU General Public License Version 2 or later (the "GPL"), or
  28 # the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  29 # in which case the provisions of the GPL or the LGPL are applicable instead
  30 # of those above. If you wish to allow use of your version of this file only
  31 # under the terms of either the GPL or the LGPL, and not to allow others to
  32 # use your version of this file under the terms of the MPL, indicate your
  33 # decision by deleting the provisions above and replace them with the notice
  34 # and other provisions required by the GPL or the LGPL. If you do not delete
  35 # the provisions above, a recipient may use your version of this file under
  36 # the terms of any one of the MPL, the GPL or the LGPL.
  37 #
  38 # ***** END LICENSE BLOCK *****
  39
  40 use strict;
  41 use Getopt::Mixed "nextOption";
  42
  43 # predeclarations
  44 sub debug;
  45 sub usage;
  46 sub parse_options;
  47 sub escape_string;
  48 sub escape_pattern;
  49 sub unescape_pattern;
  50
  51 # option arguments
  52
  53 my $option_desc = "b=s branch>b T=s buildtype>T R=s repo>R t=s testtype>t o=s os>o K=s kernel>K A=s arch>A M=s memory>M S=s speed>S z=s timezone>z l=s rawlogfile>l f=s failurelogfile>f r=s patterns>r O=s outputprefix>O D debug>D";
  54
  55 my $testid;
  56 my $branch;
  57 my $repo;
  58 my $buildtype;
  59 my $testtype;
  60 my $rawlogfile;
  61 my $failurelogfile;
  62 my $os;
  63 my $patterns;
  64 my $timezone;
  65 my $outputprefix;
  66 my $arch;
  67 my $kernel;
  68 my $memory;
  69 my $cpuspeed;
  70 my $debug = $ENV{DEBUG};
  71
  72 # pattern variables
  73
  74 my $knownfailurebranchpattern;
  75 my $failurebranchpattern;
  76 my $knownfailureospattern;
  77 my $failureospattern;
  78 my $knownfailurerepopattern;
  79 my $failurerepopattern;
  80 my $knownfailurebuildtypepattern;
  81 my $failurebuildtypepattern;
  82 my $knownfailuretesttypepattern;
  83 my $failuretesttypepattern;
  84 my $knownfailuretimezonepattern;
  85 my $failuretimezonepattern;
  86 my $knownfailurearchpattern;
  87 my $failurearchpattern;
  88 my $knownfailurekernelpattern;
  89 my $failurekernelpattern;
  90 my $knownfailurememorypattern;
  91 my $failurememorypattern;
  92 my $knownfailurecpuspeedpattern;
  93 my $failurecpuspeedpattern;
  94
  95 my @patterns;
  96 my $pattern;
  97 my @failures;
  98 my @fixes;
  99 my @excludedtests;
 100 my $excludedtest;
 101 my $excludedfile;
 102 my %includedtests = {};
 103 my $includedfile;
 104 my @results;
 105
 106 my $regchars = '\[\^\-\]\|\{\}\?\*\+\.\<\>\$\(\)';
 107
 108
 109 &parse_options;
 110
 111 my $jsdir = $ENV{TEST_JSDIR};
 112
 113 if (!defined($jsdir)) {
 114      $jsdir = "/work/mozilla/mozilla.com/test.mozilla.com/www/tests/mozilla.org/js";
 115 }
 116
 117 my @excludedfiles = ("excluded-$branch-$testtype-$buildtype.tests");
 118 my @includedfiles = ("included-$branch-$testtype-$buildtype.tests");
 119
 120  # create working patterns file consisting of matches to users selection
 121  # and which has the test description patterns escaped
 122
 123  # remove the excluded tests from the possible fixes log
 124
 125
 126 foreach $excludedfile ( @excludedfiles ) {
 127     open EXCLUDED, "<$jsdir/$excludedfile" or die "Unable to open excluded file $jsdir/$excludedfile: $!\n";
 128     while (<EXCLUDED>) {
 129         chomp;
 130
 131         next if ($_ =~ /^\#/);
 132
 133         s/\s+$//;
 134
 135         push @excludedtests, ($_);
 136     }
 137     close EXCLUDED;
 138 }
 139
 140 @excludedtests = sort @excludedtests;
 141
 142 foreach $includedfile ( @includedfiles ) {
 143     open INCLUDED, "<$jsdir/$includedfile" or die "Unable to open included file $jsdir/$includedfile: $!\n";
 144     while (<INCLUDED>) {
 145         chomp;
 146
 147         next if ($_ =~ /^\#/);
 148
 149         s/\s+$//;
 150
 151         $includedtests{$_} = 1;
 152     }
 153     close INCLUDED;
 154 }
 155
 156 debug "loading patterns $patterns";
 157 debug "pattern filter: ^TEST_ID=[^,]*, TEST_BRANCH=$knownfailurebranchpattern, TEST_REPO=$knownfailurerepopattern, TEST_BUILDTYPE=$knownfailurebuildtypepattern, TEST_TYPE=$knownfailuretesttypepattern, TEST_OS=$knownfailureospattern, TEST_KERNEL=$knownfailurekernelpattern, TEST_PROCESSORTYPE=$knownfailurearchpattern, TEST_MEMORY=$knownfailurememorypattern, TEST_CPUSPEED=$knownfailurecpuspeedpattern, TEST_TIMEZONE=$knownfailuretimezonepattern,";
 158
 159 open PATTERNS, "<$patterns" or die "Unable to open known failure patterns file $patterns: $!\n";
 160 while (<PATTERNS>) {
 161     chomp;
 162
 163     s/\s+$//;
 164
 165     ($testid) = $_ =~ /^TEST_ID=([^,]*),/;
 166
 167     if (!$includedtests{$testid})
 168     {
 169         debug "test $testid was not included during this run";
 170     }
 171     elsif ($_ =~ /^TEST_ID=[^,]*, TEST_BRANCH=$knownfailurebranchpattern, TEST_REPO=$knownfailurerepopattern, TEST_BUILDTYPE=$knownfailurebuildtypepattern, TEST_TYPE=$knownfailuretesttypepattern, TEST_OS=$knownfailureospattern, TEST_KERNEL=$knownfailurekernelpattern, TEST_PROCESSORTYPE=$knownfailurearchpattern, TEST_MEMORY=$knownfailurememorypattern, TEST_CPUSPEED=$knownfailurecpuspeedpattern, TEST_TIMEZONE=$knownfailuretimezonepattern,/) {
 172         debug "adding pattern  : $_";
 173         push @patterns, (escape_pattern($_));
 174     }
 175     else {
 176         debug "skipping pattern: $_";
 177     }
 178
 179 }
 180 close PATTERNS;
 181
 182  # create a working copy of the current failures which match the users selection
 183
 184 debug "failure filter: ^TEST_ID=[^,]*, TEST_BRANCH=$failurebranchpattern, TEST_REPO=$failurerepopattern, TEST_BUILDTYPE=$failurebuildtypepattern, TEST_TYPE=$failuretesttypepattern, TEST_OS=$failureospattern, TEST_KERNEL=$failurekernelpattern, TEST_PROCESSORTYPE=$failurearchpattern, TEST_MEMORY=$failurememorypattern, TEST_CPUSPEED=$failurecpuspeedpattern, TEST_TIMEZONE=$failuretimezonepattern, TEST_RESULT=FAIL[^,]*,/";
 185
 186 if (defined($rawlogfile)) {
 187
 188     $failurelogfile = "$outputprefix-results-failures.log";
 189     my $alllog      = "$outputprefix-results-all.log";
 190
 191     debug "writing failures $failurelogfile";
 192
 193     open INPUTLOG, "$jsdir/post-process-logs.pl $rawlogfile |" or die "Unable to open $rawlogfile $!\n";
 194     open ALLLOG, ">$alllog" or die "Unable to open $alllog $!\n";
 195     open FAILURELOG, ">$failurelogfile" or die "Unable to open $failurelogfile $!\n";
 196
 197     while (<INPUTLOG>) {
 198         chomp;
 199
 200         print ALLLOG "$_\n";
 201
 202         if ($_ =~ /^TEST_ID=[^,]*, TEST_BRANCH=$failurebranchpattern, TEST_REPO=$failurerepopattern, TEST_BUILDTYPE=$failurebuildtypepattern, TEST_TYPE=$failuretesttypepattern, TEST_OS=$failureospattern, TEST_KERNEL=$failurekernelpattern, TEST_PROCESSORTYPE=$failurearchpattern, TEST_MEMORY=$failurememorypattern, TEST_CPUSPEED=$failurecpuspeedpattern, TEST_TIMEZONE=$failuretimezonepattern, TEST_RESULT=FAIL[^,]*,/) {
 203             debug "failure: $_";
 204             push @failures, ($_);
 205             print FAILURELOG "$_\n";
 206         }
 207     }
 208     close INPUTLOG;
 209     my $inputrc = $?;
 210     close ALLLOG;
 211     close FAILURELOG;
 212
 213     die "FATAL ERROR in post-process-logs.pl" if $inputrc != 0;
 214 }
 215 else
 216 {
 217     debug "loading failures $failurelogfile";
 218
 219     my $failurelogfilemode;
 220
 221     if ($failurelogfile =~ /\.bz2$/)
 222     {
 223         $failurelogfilemode = "bzcat $failurelogfile|";
 224     }
 225     elsif ($failurelogfile =~ /\.gz$/)
 226     {
 227         $failurelogfilemode = "zcat $failurelogfile|";
 228     }
 229     else
 230     {
 231         $failurelogfilemode = "<$failurelogfile";
 232     }
 233
 234     open FAILURES, "$failurelogfilemode" or die "Unable to open current failure log $failurelogfile: $!\n";
 235     while (<FAILURES>) {
 236         chomp;
 237
 238         if ($_ =~ /^TEST_ID=[^,]*, TEST_BRANCH=$failurebranchpattern, TEST_REPO=$failurerepopattern, TEST_BUILDTYPE=$failurebuildtypepattern, TEST_TYPE=$failuretesttypepattern, TEST_OS=$failureospattern, TEST_KERNEL=$failurekernelpattern, TEST_PROCESSORTYPE=$failurearchpattern, TEST_MEMORY=$failurememorypattern, TEST_CPUSPEED=$failurecpuspeedpattern, TEST_TIMEZONE=$failuretimezonepattern, TEST_RESULT=FAIL[^,]*,/) {
 239             debug "failure: $_";
 240             push @failures, ($_);
 241         }
 242     }
 243     close FAILURES;
 244 }
 245
 246 debug "finding fixed bugs";
 247
 248 unlink "$outputprefix-results-possible-fixes.log";
 249
 250 foreach $pattern (@patterns) {
 251     # look for known failure patterns that don't have matches in the
 252     # the current failures selected by the user.
 253
 254     debug "searching for matches to $pattern\n";
 255
 256     @results = grep m@^$pattern@, @failures;
 257
 258     if ($debug) {
 259         my $failure;
 260         foreach $failure (@failures) {
 261             if ($failure =~ $pattern) {
 262                 debug "MATCH: $pattern - $failure\n";
 263             }
 264             else {
 265                 debug "NOMATCH: $pattern - $failure\n";
 266             }
 267         }
 268     }
 269     if ($#results == -1) {
 270         debug "fix: '$pattern'";
 271         push @fixes, ($pattern)
 272     }
 273 }
 274
 275 foreach $excludedtest ( @excludedtests ) {
 276     # remove any potential fixes which are due to the test being excluded
 277
 278     if ($debug) {
 279         @results = grep m@$excludedtest@, @fixes;
 280         if ($#results > -1) {
 281             print "excluding: " . (join ', ', @results) . "\n";
 282         }
 283     }
 284
 285     @results = grep !m@$excludedtest@, @fixes;
 286
 287     @fixes = @results;
 288 }
 289
 290 my $fix;
 291 open OUTPUT, ">$outputprefix-results-possible-fixes.log" or die "Unable to open $outputprefix-results-possible-fixes.log: $!";
 292 foreach $fix (@fixes) {
 293     print OUTPUT unescape_pattern($fix) . "\n";
 294     if ($debug) {
 295         debug "fix: $fix";
 296     }
 297 }
 298 close OUTPUT;
 299
 300 print STDOUT "log: $outputprefix-results-possible-fixes.log\n";
 301
 302 debug "finding regressions";
 303
 304 my $pass = 0;
 305 my $changed = ($#patterns != -1);
 306
 307 debug "changed=$changed, \$#patterns=$#patterns, \$#failures=$#failures";
 308
 309 while ($changed) {
 310
 311     $pass = $pass + 1;
 312
 313     $changed = 0;
 314
 315     debug "pass $pass";
 316
 317     foreach $pattern (@patterns) {
 318
 319         debug "Pattern: $pattern";
 320
 321         my @nomatches = grep !m@^$pattern@, @failures;
 322         my @matches   = grep m@^$pattern@, @failures;
 323
 324         if ($debug) {
 325             my $temp = join ', ', @nomatches;
 326             debug "nomatches: $#nomatches $temp";
 327             $temp = join ', ', @matches;
 328             debug "matches: $#matches $temp";
 329         }
 330
 331         @failures = @nomatches;
 332
 333         if ($#matches > -1) {
 334             $changed = 1;
 335         }
 336
 337         debug "*****************************************";
 338     }
 339
 340 }
 341
 342 debug "\$#excludedtests=$#excludedtests, \$#failures=$#failures";
 343
 344 foreach $excludedtest ( @excludedtests ) {
 345
 346     if ($debug) {
 347         @results = grep m@$excludedtest@, @failures;
 348         if ($#results > -1) {
 349             print "excluding: " . (join ', ', @results) . "\n";
 350         }
 351     }
 352
 353     @results = grep !m@$excludedtest@, @failures;
 354
 355     debug "\$#results=$#results, \$excludedtest=$excludedtest, \$#failures=$#failures";
 356
 357     @failures = @results;
 358 }
 359
 360 debug "possible regressions: \$#failures=$#failures";
 361
 362 open OUTPUT, ">$outputprefix-results-possible-regressions.log" or die "Unable to open $outputprefix-results-possible-regressions.log: $!";
 363
 364 my $failure;
 365 foreach $failure (@failures) {
 366     print OUTPUT "$failure\n";
 367     if ($debug) {
 368         debug "regression: $failure";
 369     }
 370 }
 371 close OUTPUT;
 372
 373 print STDOUT "log: $outputprefix-results-possible-regressions.log\n";
 374
 375
 376 sub debug {
 377     if ($debug) {
 378         my $msg = shift;
 379         print STDERR "DEBUG: $msg\n";
 380     }
 381 }
 382
 383 sub usage {
 384
 385     my $msg = shift;
 386
 387     print STDERR <<EOF;
 388
 389 usage: $msg
 390
 391 known-failures.pl [-b|--branch] branch
 392                   [-T|--buildtype] buildtype
 393                   [-t|--testtype] testtype
 394                   [-o|--os] os
 395                   [-K|--kernel] kernel
 396                   [-A|--arch] arch
 397                   [-M|--memory] memory
 398                   [-S|--speed] speed
 399                   [-z|--timezone] timezone
 400                   [-r|--patterns] patterns
 401                   ([-f|--failurelogfile] failurelogfile|[-l|--logfile] rawlogfile])
 402                   [-O|--outputprefix] outputprefix
 403                   [-D]
 404
 405     variable            description
 406     ===============     ============================================================
 407     -b branch           branch 1.8.0, 1.8.1, 1.9.0, all
 408     -R repository       CVS for 1.8.0, 1.8.1, 1.9.0 branches,
 409                         mercurial repository name for 1.9.1 branches
 410                         (\`basename http://hg.mozilla.org/repository\`)
 411     -T buildtype        build type opt, debug, all
 412     -t testtype         test type browser, shell, all
 413     -o os               operating system nt, darwin, linux, all
 414     -K kernel           kernel, all or a specific pattern
 415     -A arch             architecture, all or a specific pattern
 416     -M memory           memory in Gigabytes, all or a specific pattern
 417     -S speed            speed, all or specific pattern
 418     -z timezone         -0400, -0700, etc. default to user\'s zone
 419     -l rawlogfile       raw logfile
 420     -f failurelogfile   failure logfile
 421     -r patterns         known failure patterns
 422     -O outputprefix     output files will be generated with this prefix
 423     -D                  turn on debugging output
 424 EOF
 425
 426     exit(2);
 427 }
 428
 429 sub parse_options {
 430     my ($option, $value);
 431
 432     Getopt::Mixed::init ($option_desc);
 433     $Getopt::Mixed::order = $Getopt::Mixed::RETURN_IN_ORDER;
 434
 435     while (($option, $value) = nextOption()) {
 436
 437         if ($option eq "b") {
 438             $branch = $value;
 439         }
 440         elsif ($option eq "R") {
 441             $repo = $value;
 442         }
 443         elsif ($option eq "T") {
 444             $buildtype = $value;
 445         }
 446         elsif ($option eq "t") {
 447             $testtype = $value;
 448         }
 449         elsif ($option eq "o") {
 450             $os = $value;
 451         }
 452         elsif ($option eq "K") {
 453             $kernel = $value;
 454         }
 455         elsif ($option eq "A") {
 456             $arch = $value;
 457         }
 458         elsif ($option eq "M") {
 459             $memory = $value;
 460         }
 461         elsif ($option eq "S") {
 462             $cpuspeed = $value;
 463             if ($cpuspeed < 4)
 464             {
 465                 $cpuspeed = 'slow';
 466             }
 467             elsif ($cpuspeed < 9)
 468             {
 469                 $cpuspeed = 'medium';
 470             }
 471             else
 472             {
 473                 $cpuspeed = 'fast';
 474             }
 475         }
 476         elsif ($option eq "z") {
 477             $timezone = $value;
 478         }
 479         elsif ($option eq "r") {
 480             $patterns = $value;
 481         }
 482         elsif ($option eq "l") {
 483             $rawlogfile = $value;
 484         }
 485         elsif ($option eq "f") {
 486             $failurelogfile = $value;
 487         }
 488         elsif ($option eq "O") {
 489             $outputprefix = $value;
 490         }
 491         elsif ($option eq "D") {
 492             $debug = 1;
 493         }
 494
 495     }
 496
 497     if ($debug) {
 498         print "branch=$branch, buildtype=$buildtype, testtype=$testtype, os=$os, kernel=$kernel, arch=$arch, memory=$memory, cpuspeed=$cpuspeed, timezone=$timezone, patterns=$patterns, rawlogfile=$rawlogfile failurelogfile=$failurelogfile, outputprefix=$outputprefix\n";
 499     }
 500     Getopt::Mixed::cleanup();
 501
 502     if ( !defined($branch) ) {
 503         usage "missing branch";
 504     }
 505
 506     if (!defined($buildtype)) {
 507         usage "missing buildtype";
 508     }
 509
 510     if (!defined($testtype)) {
 511         usage "missing testtype";
 512     }
 513
 514     if (!defined($os)) {
 515         usage "missing os";
 516     }
 517
 518     if (!defined($memory)) {
 519         $memory = 'all';
 520     }
 521
 522     if (!defined($cpuspeed)) {
 523         $cpuspeed = 'all';
 524     }
 525
 526     if (!defined($timezone)) {
 527         usage "missing timezone";
 528     }
 529
 530     if (!defined($patterns)) {
 531         usage "missing patterns";
 532     }
 533
 534     if (!defined($rawlogfile) && !defined($failurelogfile)) {
 535         usage "missing logfile";
 536     }
 537
 538     if (!defined($outputprefix)) {
 539         usage "missing outputprefix";
 540     }
 541
 542     if ($branch eq "1.8.0") {
 543         $knownfailurebranchpattern = "(1\\.8\\.0|\\.\\*)";
 544         $failurebranchpattern      = "1\\.8\\.0";
 545     }
 546     elsif ($branch eq "1.8.1") {
 547         $knownfailurebranchpattern = "(1\\.8\\.1|\\.\\*)";
 548         $failurebranchpattern      = "1\\.8\\.1";
 549     }
 550     elsif ($branch eq "1.9.0") {
 551         $knownfailurebranchpattern = "(1\\.9\\.0|\\.\\*)";
 552         $failurebranchpattern      = "1\\.9\\.0";
 553     }
 554     elsif ($branch eq "1.9.1") {
 555         $knownfailurebranchpattern = "(1\\.9\\.1|\\.\\*)";
 556         $failurebranchpattern      = "1\\.9\\.1";
 557     }
 558     elsif ($branch eq "all") {
 559         $knownfailurebranchpattern = "[^,]*";
 560         $failurebranchpattern      = "[^,]*";
 561     }
 562
 563     if ($repo eq "all" || $repo eq ".*") {
 564         $knownfailurerepopattern = "[^,]*";
 565         $failurerepopattern      = "[^,]*";
 566     }
 567     else {
 568         $knownfailurerepopattern = "($repo|\\.\\*)";
 569         $failurerepopattern      = "$repo";
 570     }
 571
 572     if ($buildtype eq "opt") {
 573         $knownfailurebuildtypepattern = "(opt|\\.\\*)";
 574         $failurebuildtypepattern      = "opt";
 575     }
 576     elsif ($buildtype eq "debug") {
 577         $knownfailurebuildtypepattern = "(debug|\\.\\*)";
 578         $failurebuildtypepattern      = "debug";
 579     }
 580     elsif ($buildtype eq "all") {
 581         $knownfailurebuildtypepattern = "[^,]*";
 582         $failurebuildtypepattern      = "[^,]*";
 583     }
 584
 585     if ($testtype eq "shell") {
 586         $knownfailuretesttypepattern = "(shell|\\.\\*)";
 587         $failuretesttypepattern      = "shell";
 588     }
 589     elsif ($testtype eq "browser") {
 590         $knownfailuretesttypepattern = "(browser|\\.\\*)";
 591         $failuretesttypepattern      = "browser";
 592     }
 593     elsif ($testtype eq "all") {
 594         $knownfailuretesttypepattern = "[^,]*";
 595         $failuretesttypepattern      = "[^,]*";
 596     }
 597
 598     if ($os eq "nt") {
 599         $knownfailureospattern     = "(nt|\\.\\*)";
 600         $failureospattern          = "nt";
 601     }
 602     elsif ($os eq "darwin") {
 603         $knownfailureospattern     = "(darwin|\\.\\*)";
 604         $failureospattern          = "darwin";
 605     }
 606     elsif ($os eq "linux") {
 607         $knownfailureospattern     = "(linux|\\.\\*)";
 608         $failureospattern          = "linux";
 609     }
 610     elsif ($os eq "all") {
 611         $knownfailureospattern     = "[^,]*";
 612         $failureospattern          = "[^,]*";
 613     }
 614
 615     if ($kernel ne  "all") {
 616         $knownfailurekernelpattern = "(" . $kernel . "|\\.\\*)";
 617         $failurekernelpattern      = "$kernel";
 618     }
 619     else {
 620         $knownfailurekernelpattern = "[^,]*";
 621         $failurekernelpattern      = "[^,]*";
 622     }
 623
 624     if ($arch ne "all") {
 625         $knownfailurearchpattern = "(" . $arch . "|\\.\\*)";
 626         $failurearchpattern      = "$arch";
 627     }
 628     else {
 629         $knownfailurearchpattern = "[^,]*";
 630         $failurearchpattern      = "[^,]*";
 631     }
 632
 633     if ($memory ne  "all") {
 634         $knownfailurememorypattern = "(" . $memory . "|\\.\\*)";
 635         $failurememorypattern      = "$memory";
 636     }
 637     else {
 638         $knownfailurememorypattern = "[^,]*";
 639         $failurememorypattern      = "[^,]*";
 640     }
 641
 642     if ($cpuspeed ne  "all") {
 643         $knownfailurecpuspeedpattern = "(" . $cpuspeed . "|\\.\\*)";
 644         $failurecpuspeedpattern      = "$cpuspeed";
 645     }
 646     else {
 647         $knownfailurecpuspeedpattern = "[^,]*";
 648         $failurecpuspeedpattern      = "[^,]*";
 649     }
 650
 651     if ($timezone eq "all") {
 652         $knownfailuretimezonepattern = "[^,]*";
 653         $failuretimezonepattern      = "[^,]*";
 654     }
 655     else {
 656         $knownfailuretimezonepattern = "(" . escape_string($timezone) . "|\\.\\*)";
 657         $failuretimezonepattern      = escape_string("$timezone");
 658     }
 659
 660
 661 }
 662
 663 sub escape_string {
 664     my $s = shift;
 665
 666     # replace unescaped regular expression characters in the
 667     # string so they are not interpreted as regexp chars
 668     # when matching descriptions. leave the escaped regexp chars
 669     # `regexp` alone so they can be unescaped later and used in
 670     # pattern matching.
 671
 672     # see perldoc perlre
 673
 674     $s =~ s/\\/\\\\/g;
 675
 676     # escape non word chars that aren't surrounded by ``
 677     $s =~ s/(?<!`)([$regchars])(?!`)/\\$1/g;
 678     $s =~ s/(?<!`)([$regchars])(?=`)/\\$1/g;
 679     $s =~ s/(?<=`)([$regchars])(?!`)/\\$1/g;
 680
 681     # unquote the regchars
 682     $s =~ s/\`([^\`])\`/$1/g;
 683
 684     debug "escape_string  : $s";
 685
 686     return "$s";
 687
 688 }
 689
 690 sub escape_pattern {
 691
 692     my $line = shift;
 693
 694     chomp;
 695
 696     my ($leading, $trailing) = $line =~ /(.*TEST_DESCRIPTION=)(.*)/;
 697
 698     #    debug "escape_pattern: before: $leading$trailing";
 699
 700     $trailing = escape_string($trailing);
 701
 702     debug "escape_pattern  : $leading$trailing";
 703
 704     return "$leading$trailing";
 705
 706 }
 707
 708 sub unescape_pattern {
 709     my $line = shift;
 710
 711     chomp;
 712
 713     my ($leading, $trailing) = $line =~ /(.*TEST_DESCRIPTION=)(.*)/;
 714
 715     # quote the unescaped non word chars
 716     $trailing =~ s/(?<!\\)([$regchars])/`$1`/g;
 717
 718     # unescape the escaped non word chars
 719     $trailing =~ s/\\([$regchars])/$1/g;
 720
 721     $trailing =~ s/\\\\/\\/g;
 722
 723     debug "unescape_pattern: after: $leading$trailing";
 724
 725     return "$leading$trailing";
 726 }
 727
 728 ####
 729
 730
 731 1;