← Back to branch summary

~ubuntu-branches/ubuntu/oneiric/ghostscript/oneiric

« back to all changes in this revision

Viewing changes to toolbin/localcluster/compare.pl

  • Committer: Bazaar Package Importer
  • Author(s): Till Kamppeter
  • Date: 2011-07-15 16:49:55 UTC
  • mfrom: (1.1.23 upstream)
  • Revision ID: james.westby@ubuntu.com-20110715164955-uga6qibao6kez05c
Tags: 9.04~dfsg~20110715-0ubuntu1
* New upstream release
   - GIT snapshot from Jult, 12 2011.
* debian/patches/020110406~a54df2d.patch,
  debian/patches/020110408~0791cc8.patch,
  debian/patches/020110408~507cbee.patch,
  debian/patches/020110411~4509a49.patch,
  debian/patches/020110412~78bb9a6.patch,
  debian/patches/020110418~a05ab8a.patch,
  debian/patches/020110420~20b6c78.patch,
  debian/patches/020110420~4ddefa2.patch: Removed upstream patches.
* debian/rules: Generate ABI version number (variable "abi") correctly,
  cutting off repackaging and pre-release parts.
* debian/rules: Added ./lcms2/ directory to DEB_UPSTREAM_REPACKAGE_EXCLUDES.
* debian/copyright: Added lcms2/* to the list of excluded files.
* debian/symbols.common: Updated for new upstream source. Applied patch
  which dpkg-gensymbols generated for debian/libgs9.symbols to this file.

Show diffs side-by-side

added added

removed removed

Lines of Context:
toolbin/localcluster/compare.pl
1
 
#!/usr/bin/perl
2
 
 
3
 
use strict;
4
 
use warnings;
5
 
 
6
 
use Data::Dumper;
7
 
 
8
 
my $verbose=0;
9
 
my $reportAllErrors=0;  # possibly changed below
10
 
my $previousValues=50;
11
 
 
12
 
my @errorDescription=(
13
 
"none",
14
 
"Error_reading_input_file",
15
 
"Error_reading_Ghostscript_produced_PDF/PS_file",
16
 
"Timeout_reading_input_file",
17
 
"Timeout_reading_Ghostscript_produced_PDF/PS_File",
18
 
"Input_file_missing",
19
 
"Ghostscript_generated_PDF/PS_file_missing",
20
 
"Seg_Fault_during_pdfwrite",
21
 
"Seg_Fault",
22
 
"Seg_Fault_reading_Ghostscript_produced_PDF/PS_File",
23
 
"Internal_error");
24
 
 
25
 
my $current=shift;
26
 
my $previous=shift;
27
 
my $elapsedTime=shift;
28
 
my $machineCount=shift || die "usage: compare.pl current.tab previous.tab elapsedTime machineCount [skipMissing [products]]";
29
 
my $skipMissing=shift;
30
 
my $products=shift;
31
 
 
32
 
$products="gs pcl xps svg" if (!$products);
33
 
 
34
 
my %skip;
35
 
if (open(F,"<skip.lst")) {
36
 
  while(<F>) {
37
 
    chomp;
38
 
    s|__|/|g;
39
 
    my @a=split '\s';
40
 
    $skip{$_}=$a[0];
41
 
  }
42
 
  close(F);
43
 
}
44
 
 
45
 
$reportAllErrors=1 if ($current=~m/icc_work/);
46
 
 
47
 
 
48
 
my %current;
49
 
my %currentError;
50
 
my %currentProduct;
51
 
my %currentMachine;
52
 
my %currentTime1;
53
 
my %currentTime2;
54
 
my %previous;
55
 
my %previousError;
56
 
my %previousProduct;
57
 
my %previousMachine;
58
 
my %previousTime1;
59
 
my %previousTime2;
60
 
my %archive;
61
 
my %archiveProduct;
62
 
my %archiveMachine;
63
 
my %archiveCount;
64
 
 
65
 
my %archiveCache;
66
 
 
67
 
my @filesRemoved;
68
 
my @filesAdded;
69
 
my @allErrors;
70
 
my @brokePrevious;
71
 
my @repairedPrevious;
72
 
my @differencePrevious;
73
 
my @differencePreviousPdfwrite;
74
 
my @differencePreviousPs2write;
75
 
my @archiveMatch;
76
 
 
77
 
my @baselineUpdateNeeded;
78
 
 
79
 
my $t2;
80
 
 
81
 
print STDERR "reading $current\n" if ($verbose);
82
 
open(F,"<$current") || die "file $current not found";
83
 
while(<F>) {
84
 
  chomp;
85
 
  s|__|/|g;
86
 
  my @a=split '\t';
87
 
  next if (exists $skip{$a[0]} && $a[1]==0);  # skip only if no error
88
 
# $a[6]=$a[1] if ($a[1] ne "0");
89
 
  $current{$a[0]}=$a[6];
90
 
  $currentError{$a[0]}=0;
91
 
  if ($a[1]!=0) {
92
 
    $currentError{$a[0]}='unknown';
93
 
    $currentError{$a[0]}=$errorDescription[$a[1]] if (exists $errorDescription[$a[1]]);
94
 
    $current{$a[0]}=0;
95
 
  }
96
 
  $currentProduct{$a[0]}=$a[8];
97
 
  $currentMachine{$a[0]}=$a[9];
98
 
  $currentTime1{$a[0]}=$a[2];
99
 
  $currentTime2{$a[0]}=$a[3];
100
 
}
101
 
 
102
 
print STDERR "reading $previous\n" if ($verbose);
103
 
open(F,"<$previous") || die "file $previous not found";
104
 
while(<F>) {
105
 
  chomp;
106
 
  s|__|/|g;
107
 
  my @a=split '\t';
108
 
  next if (exists $skip{$a[0]} && $a[1]==0);  # skip only if no error
109
 
# $a[6]=$a[1] if ($a[1] ne "0");
110
 
  $previous{$a[0]}=$a[6];
111
 
  $previousError{$a[0]}=0;
112
 
  if ($a[1]!=0) {
113
 
    $previousError{$a[0]}='unknown';
114
 
    $previousError{$a[0]}=$errorDescription[$a[1]] if (exists $errorDescription[$a[1]]);
115
 
    $previous{$a[0]}=0;
116
 
  }
117
 
  $previousProduct{$a[0]}=$a[8];
118
 
  $previousMachine{$a[0]}=$a[9];
119
 
  $previousTime1{$a[0]}=$a[2];
120
 
  $previousTime2{$a[0]}=$a[3];
121
 
}
122
 
close(F);
123
 
 
124
 
if ($elapsedTime==0) {
125
 
} else {
126
 
if (open(F,"<md5sum.cache")) {
127
 
print STDERR "reading md5sum.cache\n" if ($verbose);
128
 
  while(<F>) {
129
 
    chomp;
130
 
    if (m/(.+) \| (.+)/) {
131
 
      $archiveCache{$1}=$2;
132
 
    } elsif (m/^(\d+)$/) {
133
 
      $previousValues=$1;
134
 
    }
135
 
  }
136
 
  close(F);
137
 
} else {
138
 
 
139
 
# build list of archived files
140
 
print STDERR "reading archive directory\n" if ($verbose);
141
 
my %archives;
142
 
if (opendir(DIR, 'archive')) { # || die "can't opendir archive: $!";
143
 
foreach (readdir(DIR)) {
144
 
  $archives{$_}=1 if (!(-d $_) && (m/.tab$/));
145
 
}
146
 
closedir DIR;
147
 
}
148
 
 
149
 
my $count=$previousValues;
150
 
my %current;
151
 
foreach my $i (sort {$b cmp $a} keys %archives) {
152
 
# print STDERR "$i\n";
153
 
  if ($count>0) {
154
 
    print STDERR "reading archive/$i\n" if ($verbose);
155
 
    open(F,"<archive/$i") || die "file archive/$i not found";
156
 
    while(<F>) {
157
 
      chomp;
158
 
      s|__|/|g;
159
 
      my @a=split '\t';
160
 
      $i=~m/(.+)\.tab/;
161
 
      my $r=$1;
162
 
#     $archive{$r}{$a[0]}=$a[6];
163
 
#     $archiveProduct{$r}{$a[0]}=$a[8];
164
 
#     $archiveMachine{$r}{$a[0]}=$a[9];
165
 
#     $archiveMachine{$r}{$a[0]}="unknown" if (!$archiveMachine{$r}{$a[0]});
166
 
#     $archiveCount{$r}=$previousValues-$count+1;
167
 
      $a[6]=$a[1] if ($a[1] ne "0");
168
 
      my $key=$a[0].' '.$a[6];
169
 
      if ($count==$previousValues) {
170
 
        $current{$key}=1;
171
 
      } else {
172
 
        if (!exists $current{$key} && !exists $archiveCache{$key}) {
173
 
          $archiveCache{$key}=$r."\t".$a[8]."\t".$a[9]."\t".($previousValues-$count+1);
174
 
        }
175
 
      }
176
 
 
177
 
    }
178
 
    close(F);
179
 
    $count--;
180
 
  }
181
 
}
182
 
 
183
 
}
184
 
#print Dumper(\%archiveCache);
185
 
}
186
 
 
187
 
#print "previous\n".Dumper(\%previous);
188
 
#print "current \n".Dumper(\%current);
189
 
 
190
 
my $first=0;
191
 
 
192
 
if (!($previous=~m/users/)) {
193
 
foreach my $t (sort keys %current) {
194
 
  if ($currentError{$t} =~ m/Seg_Fault/) {
195
 
    print "\n*****************************************************************************\nSeg faults with current rev:\n\n" if (!$first);
196
 
    $first=1;
197
 
    print "$t $currentMachine{$t} $currentError{$t}\n";
198
 
  }
199
 
}
200
 
print "\n*****************************************************************************\n\n\n" if ($first);
201
 
}
202
 
 
203
 
 
204
 
foreach my $t (sort keys %previous) {
205
 
  if (exists $current{$t}) {
206
 
    my $match=0;
207
 
    if ($currentError{$t}) {
208
 
      push @allErrors,"$t $previousProduct{$t} $previousMachine{$t} $currentMachine{$t} $currentError{$t}";
209
 
    }
210
 
    if ($currentError{$t} && !$previousError{$t}) {
211
 
      if (exists $archiveCache{$t.' '.$current{$t}}) {
212
 
            my @a=split "\t", $archiveCache{$t.' '.$current{$t}};
213
 
            my $message="";
214
 
            $message=$currentError{$t} if ($currentError{$t});
215
 
            push @archiveMatch,"$t $a[1] $a[2] $currentMachine{$t} $a[0] $a[3] $message";
216
 
            $match=1;
217
 
      } else {
218
 
        push @brokePrevious,"$t $previousProduct{$t} $previousMachine{$t} $currentMachine{$t} $currentError{$t}";
219
 
      }
220
 
    } else {
221
 
      if (!$currentError{$t} && $previousError{$t}) {
222
 
        if (exists $archiveCache{$t.' '.$current{$t}}) {
223
 
            my @a=split "\t", $archiveCache{$t.' '.$current{$t}};
224
 
            my $message="";
225
 
            $message=$currentError{$t} if ($currentError{$t});
226
 
            push @archiveMatch,"$t $a[1] $a[2] $currentMachine{$t} $a[0] $a[3] $message";
227
 
            $match=1;
228
 
        } else {
229
 
          push @repairedPrevious,"$t $previousProduct{$t} $previousMachine{$t} $currentMachine{$t} $previousError{$t}";
230
 
        }
231
 
      }
232
 
    }
233
 
##    } else {
234
 
        if ($current{$t} eq $previous{$t}) {
235
 
          #         print "$t match $previous and $current\n";
236
 
        } else {
237
 
#         foreach my $p (sort {$b cmp $a} keys %archive) {
238
 
#           if (!$match && exists $archive{$p}{$t} && $archive{$p}{$t} eq $current{$t}) {
239
 
#             $match=1;
240
 
#             push @archiveMatch,"$t $archiveProduct{$p}{$t} $archiveMachine{$p}{$t} $currentMachine{$t} $p $archiveCount{$p}";
241
 
#           }
242
 
#         }
243
 
          if (exists $archiveCache{$t.' '.$current{$t}}) {
244
 
            my @a=split "\t", $archiveCache{$t.' '.$current{$t}};
245
 
            my $message="";
246
 
            $message=$currentError{$t} if ($currentError{$t});
247
 
            # die "happened" if ($currentError{$t});
248
 
            push @archiveMatch,"$t $a[1] $a[2] $currentMachine{$t} $a[0] $a[3] $message";
249
 
            $match=1;
250
 
          }
251
 
          if (!$match) {
252
 
            if ($currentProduct{$t} =~ m/pdfwrite/) {
253
 
              push @differencePreviousPdfwrite,"$t $previousProduct{$t} $previousMachine{$t} $currentMachine{$t}";
254
 
            } elsif ($currentProduct{$t} =~ m/ps2write/) {
255
 
              push @differencePreviousPs2write,"$t $previousProduct{$t} $previousMachine{$t} $currentMachine{$t}";
256
 
            } else {
257
 
              push @differencePrevious,"$t $previousProduct{$t} $previousMachine{$t} $currentMachine{$t}";
258
 
            }
259
 
          }
260
 
        }
261
 
        if ($currentMachine{$t} eq $previousMachine{$t}) {
262
 
          my $timeDelta1=0;
263
 
          my $timeDelta2=0;
264
 
          if ($previousTime1{$t}>0) {
265
 
            $timeDelta1=($currentTime1{$t}-$previousTime1{$t})/$previousTime1{$t};
266
 
          }
267
 
          if ($previousTime2{$t}>0) {
268
 
            $timeDelta2=($currentTime2{$t}-$previousTime2{$t})/$previousTime2{$t};
269
 
          }
270
 
#printf  "%10f %10f %10f %s\n",$timeDelta1,$currentTime1{$t},$previousTime1{$t},$t;
271
 
        }
272
 
##    }
273
 
##  }
274
 
  } else {
275
 
    if (!exists $skip{$t}) {
276
 
      push @filesRemoved,"$t $previousProduct{$t}";
277
 
    }
278
 
  }
279
 
}
280
 
 
281
 
#print Dumper(\@archiveMatch);
282
 
 
283
 
my $pdfwriteTestCount=0;
284
 
my $ps2writeTestCount=0;
285
 
my $notPdfwriteTestCount=0;
286
 
 
287
 
foreach my $t (sort keys %current) {
288
 
  if (!exists $previous{$t} && !exists $skip{$t}) {
289
 
    push @filesAdded,"$t $currentProduct{$t}";
290
 
    if ($currentError{$t}) {
291
 
      push @allErrors,"$t $currentMachine{$t} $currentError{$t}";
292
 
      push @brokePrevious,"$t $currentMachine{$t} $currentError{$t}";
293
 
    }
294
 
  }
295
 
  my $p=$currentProduct{$t};
296
 
  $p =~ s/ pdfwrite//;
297
 
  $p =~ s/ ps2write//;
298
 
  if ($products =~ m/$p/) {
299
 
    if ($currentProduct{$t} =~ m/pdfwrite/) {
300
 
      $pdfwriteTestCount++;
301
 
    } elsif ($currentProduct{$t} =~ m/ps2write/) {
302
 
      $ps2writeTestCount++;
303
 
    } else {
304
 
      $notPdfwriteTestCount++;
305
 
    }
306
 
  }
307
 
}
308
 
 
309
 
if ($elapsedTime==0 || $elapsedTime==1) {
310
 
} else {
311
 
  print "ran ".($pdfwriteTestCount+$ps2writeTestCount+$notPdfwriteTestCount)." tests in $elapsedTime seconds on $machineCount nodes\n\n";
312
 
}
313
 
 
314
 
if (@differencePrevious) {
315
 
  print "Differences in ".scalar(@differencePrevious)." of $notPdfwriteTestCount non-pdfwrite/ps2write test(s):\n";
316
 
  while(my $t=shift @differencePrevious) {
317
 
    print "$t\n";
318
 
    push @baselineUpdateNeeded,$t;
319
 
  }
320
 
  print "\n";
321
 
} else {
322
 
  print "No differences in $notPdfwriteTestCount non-pdfwrite/ps2write tests\n\n";
323
 
}
324
 
 
325
 
if (@differencePreviousPdfwrite) {
326
 
  print "Differences in ".scalar(@differencePreviousPdfwrite)." of $pdfwriteTestCount pdfwrite test(s):\n";
327
 
  while(my $t=shift @differencePreviousPdfwrite) {
328
 
    print "$t\n";
329
 
    push @baselineUpdateNeeded,$t;
330
 
  }
331
 
  print "\n";
332
 
} else {
333
 
  print "No differences in $pdfwriteTestCount pdfwrite tests\n\n";
334
 
}
335
 
 
336
 
if (@differencePreviousPs2write) {
337
 
  print "Differences in ".scalar(@differencePreviousPs2write)." of $ps2writeTestCount ps2write test(s):\n";
338
 
  while(my $t=shift @differencePreviousPs2write) {
339
 
    print "$t\n";
340
 
    push @baselineUpdateNeeded,$t;
341
 
  }
342
 
  print "\n";
343
 
} else {
344
 
  print "No differences in $ps2writeTestCount ps2write tests\n\n";
345
 
}
346
 
 
347
 
 
348
 
 
349
 
if (@brokePrevious) {
350
 
  print "The following ".scalar(@brokePrevious)." regression file(s) have started producing errors:\n";
351
 
  while(my $t=shift @brokePrevious) {
352
 
    print "$t\n";
353
 
  }
354
 
  print "\n";
355
 
}
356
 
 
357
 
if (@repairedPrevious) {
358
 
  print "The following ".scalar(@repairedPrevious)." regression file(s) have stopped producing errors:\n";
359
 
  while(my $t=shift @repairedPrevious) {
360
 
    print "$t\n";
361
 
    push @baselineUpdateNeeded,$t;
362
 
  }
363
 
  print "\n";
364
 
}
365
 
 
366
 
if (!$skipMissing || $skipMissing eq "false" || $skipMissing eq "0") {
367
 
 
368
 
  if (@filesRemoved) {
369
 
    print "The following ".scalar(@filesRemoved)." regression file(s) have been removed:\n";
370
 
    while(my $t=shift @filesRemoved) {
371
 
      print "$t\n";
372
 
    }
373
 
    print "\n";
374
 
  }
375
 
 
376
 
  if (@filesAdded) {
377
 
    print "The following ".scalar(@filesAdded)." regression file(s) have been added:\n";
378
 
    while(my $t=shift @filesAdded) {
379
 
      print "$t\n";
380
 
      push @baselineUpdateNeeded,$t;
381
 
    }
382
 
    print "\n";
383
 
  }
384
 
 
385
 
if ($reportAllErrors) {
386
 
  if (@allErrors) {
387
 
    print "The following ".scalar(@allErrors)." regression file(s) are producing errors:\n";
388
 
    while(my $t=shift @allErrors) {
389
 
      print "$t\n";
390
 
    }
391
 
    print "\n";
392
 
  }
393
 
}
394
 
 
395
 
my $first=1;
396
 
foreach my $t (sort keys %current) {
397
 
  if ($t =~ m/(.+\.)1$/) {
398
 
    $t2=$1.'0';
399
 
    if (exists $current{$t2}) {
400
 
      if ($current{$t} ne $current{$t2} && (!exists $previous{$t} || !exists $previous{$t2} || $previous{$t} eq $previous{$t2})) {
401
 
        if ($first) {
402
 
          print "\nThe following files are showing a new mismatch between banded and page mode:\n";
403
 
          $first=0;
404
 
        }
405
 
        print "$t\n";
406
 
      }
407
 
    }
408
 
  }
409
 
}
410
 
print "\n" if (!$first);
411
 
 
412
 
 
413
 
  if (@archiveMatch) {
414
 
    print "-------------------------------------------------------------------------------------------------------\n\n";
415
 
    print "The following ".scalar(@archiveMatch)." regression file(s) had differences but matched at least once in the previous $previousValues runs:\n";
416
 
    while(my $t=shift @archiveMatch) {
417
 
      print "$t\n";
418
 
    }
419
 
    print "\n";
420
 
  }
421
 
 
422
 
# open(F,">>baselineupdateneeded.lst");
423
 
# while(my $t=shift @baselineUpdateNeeded) {
424
 
#   my @a=split ' ',$t;
425
 
#   $a[0] =~ s/\//__/g;
426
 
#   print F "$a[0]\n";
427
 
# }
428
 
# close(F);
429
 
}
430