-
Notifications
You must be signed in to change notification settings - Fork 3
/
autoclassify
executable file
·101 lines (91 loc) · 2.71 KB
/
autoclassify
1
2
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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
#!/usr/bin/perl -w
# for packages that do not build reproducibly, this script tries to find the
# source of indeterminism.
# If you do not give it bits as CLI args,
# it starts with maximally reduced indeterminism and if that is not enough,
# the resulting bits have a 99 appended
# If a build is still reproducible, it goes through the list of bits
# and drops them one by one, thereby slowly increasing sources of indeterminism.
# The resulting bitmask is written to .rb.autoclassify
# See the rbkt script for the meaning of individual bits.
# For low-entropy indeterminism such as two entries ordered correctly
# 50% of the time, use rbretries=4 as environment variable
use strict;
my $slot=$ENV{slot}||4;
my $rbretries=$ENV{rbretries}||1;
$ENV{rbminor}||="";
our $nextclean=1;
sub rbk(@)
{
$ENV{CLEAN}=$nextclean;
#$nextclean=$_[2]||$_[5]; # FIXME: cleanup after disorderfs hack or when switching rpm versions between main and test repos
my $ret;
for(1..$rbretries) {
$ret=system("rbkt", @_);
return $ret if $ret;
}
return $ret;
}
sub debugtry(@)
{
my $result=<STDIN>;chomp($result);
return $result;
}
sub run(@)
{
print "trying @_\n";
rbk(@_);
#debugtry(@_);
}
sub printclassify(@)
{
print "classified as @_\n";
open(my $outfd, ">.rb.autoclassify") or die $!;
print $outfd "@_ $ENV{rbminor}\n";
}
sub isunreproducible($) {$_[0] == (1<<8)}
sub isnonbuilding($) {$_[0] == (255<<8)}
sub stupid_bisect($$&)
{
my $min=shift;
my $max=shift;
my $isbadfunc=shift;
if($#$max != $#$min) {die "need same size"}
my @cur=@$max;
for(my $i=$#cur; $i>=0; $i--) {
next if($min->[$i] == $cur[$i]);
$cur[$i]=$min->[$i];
my $res=run(@cur);
if(&$isbadfunc($res)) {
$cur[$i]=$max->[$i];
}
}
print "cur: @cur\n";
printclassify(@cur);
return @cur;
}
# tweaks that may trigger build failures in some packages:
my @unstable=(0,0,1,1,1,1,1,0,0,0,1,1);
my @min= (0,0,0,0,0,0,0,0,0,0,0,0);
my @max=@ARGV;
for(my $i=$#min+1; $i<=$#max; $i++) {
$min[$i]=0 unless defined $min[$i];
}
for(my $i=$#min; $i>=0; $i--) {
$max[$i]=1 unless defined $max[$i];
}
my $res=run(@max);
if($res == (255<<8)) {
print "build failed => analyzing build failure reason...\n";
my @stablemin=@max;
for(my $i=$#unstable; $i>=0; $i--) {
if($unstable[$i]) {$stablemin[$i]=0}
}
$res=run(@stablemin);
if(isnonbuilding($res)) { printclassify(@stablemin, 98); exit 0; }
@max=stupid_bisect(\@max, \@stablemin, \&isnonbuilding);
print "found it builds with @max\n";
$res=run(@max);
}
if(isunreproducible($res)) { printclassify(@max, 99); exit 0; }
stupid_bisect(\@min, \@max, \&isunreproducible);