Update the mozilla tests to new version (as of 2010-06-29).

mozilla-tests/pattern-extracter.pl

 #!/usr/bin/perl -w
 # -*- 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/
 #
@@ skipping 57 matching lines @@
     my $i;
     my $j;
     my $v;
 
     while (<ARGV>) {
 
         chomp;
 
         $recordcurr = {};
 
-        my ($test_id, $test_branch, $test_repo, $test_buildtype, $test_type, $test_os, $test_kernel, $test_processortype, $test_memory, $test_cpuspeed, $test_timezone, $test_result, $test_exitstatus, $test_description) = $_ =~ 
-            /TEST_ID=([^,]*), TEST_BRANCH=([^,]*), TEST_REPO=([^,]*), TEST_BUILDTYPE=([^,]*), TEST_TYPE=([^,]*), TEST_OS=([^,]*), TEST_KERNEL=([^,]*), TEST_PROCESSORTYPE=([^,]*), TEST_MEMORY=([^,]*), TEST_CPUSPEED=([^,]*), TEST_TIMEZONE=([^,]*), TEST_RESULT=([^,]*), TEST_EXITSTATUS=([^,]*), TEST_DESCRIPTION=(.*)/;
+        my ($test_id, $test_branch, $test_repo, $test_buildtype, $test_type, $test_os, $test_kernel, $test_processortype, $test_memory, $test_timezone, $test_options, $test_result, $test_exitstatus, $test_description) = $_ =~ 
+            /TEST_ID=([^,]*), TEST_BRANCH=([^,]*), TEST_REPO=([^,]*), TEST_BUILDTYPE=([^,]*), TEST_TYPE=([^,]*), TEST_OS=([^,]*), TEST_KERNEL=([^,]*), TEST_PROCESSORTYPE=([^,]*), TEST_MEMORY=([^,]*), TEST_TIMEZONE=([^,]*), TEST_OPTIONS=([^,]*), TEST_RESULT=([^,]*), TEST_EXITSTATUS=([^,]*), TEST_DESCRIPTION=(.*)/;
 
         $recordcurr->{TEST_ID}            = $test_id;
         $recordcurr->{TEST_BRANCH}        = $test_branch;
         $recordcurr->{TEST_REPO}          = $test_repo;
         $recordcurr->{TEST_BUILDTYPE}     = $test_buildtype;
         $recordcurr->{TEST_TYPE}          = $test_type;
         $recordcurr->{TEST_OS}            = $test_os;
         $recordcurr->{TEST_KERNEL}        = $test_kernel;
         $recordcurr->{TEST_PROCESSORTYPE} = $test_processortype;
         $recordcurr->{TEST_MEMORY}        = $test_memory;
-        $recordcurr->{TEST_CPUSPEED}      = $test_cpuspeed;
         $recordcurr->{TEST_TIMEZONE}      = $test_timezone;
+        $recordcurr->{TEST_OPTIONS}       = $test_options;
         $recordcurr->{TEST_RESULT}        = $test_result;
         $recordcurr->{TEST_EXITSTATUS}    = $test_exitstatus;
         $recordcurr->{TEST_DESCRIPTION}   = $test_description;
 
         push @records, ($recordcurr);
     }
 
     for ($j = $#universefields; $j >= 0; $j--)
     {
         $universefield   = $universefields[$j];
@@ skipping 21 matching lines @@
             dbg("processfile: \$keycurr=$keycurr");
 
             if ($keycurr ne $keyprev)
             {
                 # key changed, must output previous record
                 dbg("processfile: new key");
                 $universefielduniversekey = getuniversekey($recordprev, $universefield);
                 @universefielduniverse = getuniverse($universefielduniversekey, $universefield);
                 dbg("processfile: \@values: ". join(',', @values));
                 dbg("processfile: \$universefielduniversekey=$universefielduniversekey, \@universefielduniverse=" . join(',', @universefielduniverse));
-                @values = ('.*') if (arraysequal(\@values, \@universefielduniverse));
+                @values = ('.*') if (arraysequal($universefield, \@values, \@universefielduniverse));
                 dbg("processfile: \@values=" . join(',', @values));
 
                 for ($v = 0; $v < @values; $v++)
                 {
                     dbg("processfile: stuffing $values[$v]");
                     $recordtemp = copyreference($recordprev);
                     $recordtemp->{$universefield} = $values[$v];
                     dbg("processfile: stuffed $recordtemp->{$universefield}");
                     dbg("processfile: recordprev: " . recordtostring($recordprev));
                     dbg("processfile: output: " . recordtostring($recordtemp));
                     push @output, ($recordtemp);
                 }
                 @values = ();
             }
             dbg("processfile: collecting \$recordcurr->{$universefield}=$recordcurr->{$universefield}");
             push @values, ($recordcurr->{$universefield});
             $keyprev = $keycurr;
             $recordprev = $recordcurr;
         }
         dbg("processfile: finish processing records for \$universefields[$j]=$universefield");
         if (@values)
         {
             dbg("processfile: last record for \$universefields[$j]=$universefield has pending values");
             $universefielduniversekey = getuniversekey($recordprev, $universefield);
             @universefielduniverse = getuniverse($universefielduniversekey, $universefield);
             dbg("processfile: \@values: ". join(',', @values));
             dbg("processfile: \$universefielduniversekey=$universefielduniversekey, \@universefielduniverse=" . join(',', @universefielduniverse));
-            @values = ('.*') if (arraysequal(\@values, \@universefielduniverse));
+            @values = ('.*') if (arraysequal($universefield, \@values, \@universefielduniverse));
             dbg("processfile: \@values=" . join(',', @values));
 
             for ($v = 0; $v < @values; $v++)
             {
                 dbg("processfile: stuffing $values[$v]");
                 $recordtemp = copyreference($recordprev);
                 $recordtemp->{$universefield} = $values[$v];
                 dbg("processfile: stuffed $recordprev->{$universefield}");
                 dbg("processfile: recordprev: " . recordtostring($recordprev));
                 dbg("processfile: output: " . recordtostring($recordtemp));
@@ skipping 23 matching lines @@
         if ($sortkeyfields[$i] ne $universefield)
         {
             $key .= $record->{$sortkeyfields[$i]}
         }
     }
     return $key;
 }
 
 sub arraysequal 
 {
-    my ($larrayref, $rarrayref) = @_;
+    my ($universefield, $larrayref, $rarrayref) = @_;
     my $i;
 
-    dbg("arraysequal: checking if " . (join ',', @{$larrayref}) . " is equal to " . (join ',', @{$rarrayref}));
+    dbg("arraysequal: checking $universefield if " . (join ',', @{$larrayref}) . " is equal to " . (join ',', @{$rarrayref}));
+
+    # fail if lengths not equal
     return 0 if (@{$larrayref} != @{$rarrayref});
 
+    # if the universe field is 'important', fail if lengths are 1, 
+    # so that important field singletons are not replaced by wildcards.
+    my @importantfields = ('TEST_BRANCH', 'TEST_REPO', 'TEST_BUILDTYPE', 'TEST_TYPE', 'TEST_OS');
+    my @matches = grep /$universefield/, @importantfields;
+
+    return 0 if ( @matches && @{$larrayref} == 1);
+
     for ($i = 0; $i < @{$larrayref}; $i++)
     {
         return 0 if ($rarrayref->[$i] ne $larrayref->[$i]);
     }
     dbg("arraysequal: equal");
     return 1;
 }