Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 234 lines (181 sloc) 6.939 kB
af023c5 @flussence Just thought I'd put these somewhere
authored
1 #!/usr/bin/env perl
2 use 5.012;
3 use warnings;
4 use autodie;
5
6 use Class::Date;
ae0fc30 @flussence Multithread the build harness
authored
7 use Cwd;
5e19c78 @flussence Use File::Temp's object interface for sanity
authored
8 use File::Temp;
04694d7 @flussence Clean up the compiler script a bit
authored
9 use File::Slurp;
af023c5 @flussence Just thought I'd put these somewhere
authored
10 use Git;
11 use IO::File;
1ad6813 @flussence Begone, foul threads
authored
12 use List::Util qw(sum);
13 use TAP::Harness::Archive;
1807361 @flussence Fix the check for previously-done revisions
authored
14
15 use Specgraphs;
16
04694d7 @flussence Clean up the compiler script a bit
authored
17 ####################
18 # Configurable stuff
af023c5 @flussence Just thought I'd put these somewhere
authored
19 my %config = (
0e1bcf9 @flussence Stop assuming rakudo == perl6
authored
20 rakudo => {
21 path => "$ENV{HOME}/code/rakudo",
22 csv_file => getcwd()."/rakudo/spectest-progress.csv",
23 start => '28b06a25df9aca94bb631777efe0c28cc6a80e9b',
24 end => 'origin/nom',
25 parrot_opts => [qw(--without-pcre --without-opengl)],
e2dc2ea @flussence Niecza graph \o/
authored
26 repos => ['', qw(parrot nqp t/spec)],
0e1bcf9 @flussence Stop assuming rakudo == perl6
authored
27 },
28 niecza => {
29 path => "$ENV{HOME}/code/niecza",
30 csv_file => getcwd()."/niecza/spectest-progress.csv",
f858359 @flussence A bit more tweaking, and niecza data update
authored
31 start => '154255a2aa7ad07c463056080e5e6a84999a942c',
0e1bcf9 @flussence Stop assuming rakudo == perl6
authored
32 end => 'origin/master',
e2dc2ea @flussence Niecza graph \o/
authored
33 repos => ['', 't/spec'],
0e1bcf9 @flussence Stop assuming rakudo == perl6
authored
34 },
2ba2671 @flussence Fix broken result calculation
authored
35 tmp_root => "$ENV{HOME}/.local/tmp",
a6ccea9 @flussence Attempt to fix compile script
authored
36 max_procs => int qx'lscpu | awk \'/^CPU\(s\)/{ print $2 }\'',
af023c5 @flussence Just thought I'd put these somewhere
authored
37 );
38
04694d7 @flussence Clean up the compiler script a bit
authored
39 # Make sure tempdir can clean up if this dies
40 chdir '/';
41
e2dc2ea @flussence Niecza graph \o/
authored
42 run_rakudo_spectests();
43 run_niecza_spectests();
44
45 sub run_rakudo_spectests {
46 my $impl_config = $config{rakudo};
47
48 my @revs = get_untested_revisions($impl_config);
49 my $csv = IO::File->new($impl_config->{csv_file}, '>>');
50
51 # Compile them
52 for my $rev ( @revs ) {
53 my $tmp_dir = File::Temp->newdir(CLEANUP => 1, DIR => $config{tmp_root});
54 my $work_dir = "$tmp_dir/rakudo";
55
56 # Clone top level and all the relevant sub-repos from the master, saves network IO
57 clone_repo_tree($impl_config, $work_dir);
58
f858359 @flussence A bit more tweaking, and niecza data update
authored
59 # Adjust t/spec to run from the repo's particular date instead of HEAD
60 my ($main_repo, $rev_date) = get_repo_at_revision($work_dir, $rev);
e2dc2ea @flussence Niecza graph \o/
authored
61
62 my $configure_opts = join(q{ },
63 '--gen-parrot',
64 map {
65 "--parrot-option=$_"
66 } @{$impl_config->{parrot_opts}}
67 );
68
69 system(join(q{ && },
70 "cd $work_dir",
71 "perl Configure.pl $configure_opts",
72 sprintf('make -j%d -l%1$d all install', $config{max_procs})
73 ));
74
75 # Do this whether or not compiling fails, so that we record the failure and not redo it later
76 system(join(q{ && },
7a700e9 @flussence Add time ulimits to test phases
authored
77 'ulimit -t 30',
e2dc2ea @flussence Niecza graph \o/
authored
78 "cd $work_dir",
79 sprintf('make TEST_JOBS=%1$d spectest_smolder', $config{max_procs})
80 ));
81
82 put_tap_file_in_the_freezer('rakudo', $work_dir, $rev);
83
84 my %results = get_spectest_results('rakudo', $work_dir);
85
86 $csv->say(join(q{,}, qq{"$rev_date"}, $rev, @results{qw(pass fail todo skip plan spec files)}));
1ad6813 @flussence Begone, foul threads
authored
87 }
e2dc2ea @flussence Niecza graph \o/
authored
88 }
ae0fc30 @flussence Multithread the build harness
authored
89
e2dc2ea @flussence Niecza graph \o/
authored
90 sub run_niecza_spectests {
91 my $impl_config = $config{niecza};
ae0fc30 @flussence Multithread the build harness
authored
92
e2dc2ea @flussence Niecza graph \o/
authored
93 my @revs = get_untested_revisions($impl_config);
94 my $csv = IO::File->new($impl_config->{csv_file}, '>>');
ae0fc30 @flussence Multithread the build harness
authored
95
e2dc2ea @flussence Niecza graph \o/
authored
96 for my $rev ( @revs ) {
97 my $tmp_dir = File::Temp->newdir(CLEANUP => 1, DIR => $config{tmp_root});
98 my $work_dir = "$tmp_dir/niecza";
04694d7 @flussence Clean up the compiler script a bit
authored
99
e2dc2ea @flussence Niecza graph \o/
authored
100 clone_repo_tree($impl_config, $work_dir);
5e19c78 @flussence Use File::Temp's object interface for sanity
authored
101
f858359 @flussence A bit more tweaking, and niecza data update
authored
102 my ($main_repo, $rev_date) = get_repo_at_revision($work_dir, $rev);
e2dc2ea @flussence Niecza graph \o/
authored
103
104 system(join(q{ && },
105 "cd $work_dir",
106 'export RUN_CLR=mono-sgen',
107 'make', # XXX Niecza's compilation isn't -j-friendly, but it's short enough to not matter
f858359 @flussence A bit more tweaking, and niecza data update
authored
108 ));
109
29a35ff @flussence Updates!
authored
110 my $tap_file = 'niecza_test_run.tar.gz';
f858359 @flussence A bit more tweaking, and niecza data update
authored
111 system(join(q{ && },
7a700e9 @flussence Add time ulimits to test phases
authored
112 'ulimit -t 30',
f858359 @flussence A bit more tweaking, and niecza data update
authored
113 "cd $work_dir",
29a35ff @flussence Updates!
authored
114 sprintf('TEST_JOBS=%d ./t/run_spectests -j %1$d --archive %s',
115 $config{max_procs}, $tap_file
116 )
e2dc2ea @flussence Niecza graph \o/
authored
117 ));
118
119 put_tap_file_in_the_freezer('niecza', $work_dir, $rev);
120
121 my %results = get_spectest_results('niecza', $work_dir);
122
123 $csv->say(join(q{,}, qq{"$rev_date"}, $rev, @results{qw(pass fail todo skip plan spec files)}));
124 }
125 }
126
127 sub get_untested_revisions {
128 my $impl_config = shift;
129
130 # Get a list of revisions we want numbers for
131 my $impl_repo = Git->repository(Directory => $impl_config->{path});
132 my %already_done = map {
133 $_->{REVISION} => 1
134 } @{Specgraphs::csv_fetchall($impl_config->{csv_file})};
2ba2671 @flussence Fix broken result calculation
authored
135
e2dc2ea @flussence Niecza graph \o/
authored
136 return grep {
137 not exists $already_done{$_}
138 } $impl_repo->command('rev-list', '--reverse', "$impl_config->{start}..$impl_config->{end}");
139 }
140
141 sub clone_repo_tree {
142 my $impl_config = shift;
143 my $work_dir = shift;
144
145 for my $repo_path ( @{$impl_config->{repos}} ) {
146 Git::command_noisy('clone', "$impl_config->{path}/$repo_path", "$work_dir/$repo_path");
147 }
148 }
af023c5 @flussence Just thought I'd put these somewhere
authored
149
f858359 @flussence A bit more tweaking, and niecza data update
authored
150 sub get_repo_at_revision {
151 my $work_dir = shift;
152 my $rev = shift;
153
154 my $main_repo = Git->repository(Directory => $work_dir);
155 $main_repo->command('checkout', $rev);
156
157 my $rev_date = Class::Date->new(
158 $main_repo->command('show', '--pretty=format:%ci', '--summary')
159 );
160 say STDERR "# Working on revision $rev from $rev_date";
161
162 # Make sure we work on a chronologically consistent spectest tree
163 my $test_repo = Git->repository(Directory => "$work_dir/t/spec");
164 my $test_rev = $test_repo->command('rev-list', '-n1', '--until' => qq["$rev_date"], 'origin/master');
165 chomp $test_rev;
76e7c2e @flussence Update data: after rakudo/bigint
authored
166 # XXX: niecza broke this by erroring out when it can't git-pull
167 #$test_repo->command('checkout', $test_rev);
f858359 @flussence A bit more tweaking, and niecza data update
authored
168
169 return ($main_repo, $rev_date);
170 }
171
e2dc2ea @flussence Niecza graph \o/
authored
172 sub put_tap_file_in_the_freezer {
173 my $impl = shift;
174 my $work_dir = shift;
175 my $rev = shift;
176
177 my $archive_storage = "$config{tmp_root}/${impl}_tap_archives";
178 my $archived_archive = "$archive_storage/$rev.tar.gz";
179
180 system(join(q{&&},
181 "mkdir -p $archive_storage",
182 "cp $work_dir/${impl}_test_run.tar.gz $archived_archive"
183 ));
1ad6813 @flussence Begone, foul threads
authored
184 }
af023c5 @flussence Just thought I'd put these somewhere
authored
185
1ad6813 @flussence Begone, foul threads
authored
186 sub get_spectest_results {
e2dc2ea @flussence Niecza graph \o/
authored
187 my $impl = shift;
1ad6813 @flussence Begone, foul threads
authored
188 my $basedir = shift;
189
991d875 @flussence Don't break if the TAP file is missing
authored
190 my $tap_archive = qq[$basedir/${impl}_test_run.tar.gz];
191
192 return map { $_ => 0 } qw(pass fail todo skip plan spec files) unless -r $tap_archive;
193
1ad6813 @flussence Begone, foul threads
authored
194 my $agg = TAP::Harness::Archive->aggregator_from_archive({
991d875 @flussence Don't break if the TAP file is missing
authored
195 archive => File::Spec->rel2abs($tap_archive),
1ad6813 @flussence Begone, foul threads
authored
196 });
af023c5 @flussence Just thought I'd put these somewhere
authored
197
2ba2671 @flussence Fix broken result calculation
authored
198 my %results = (
199 pass => scalar $agg->passed,
200 fail => scalar $agg->failed,
201 todo => scalar $agg->todo,
202 skip => scalar $agg->skipped,
203 plan => scalar $agg->planned,
204 spec => count_plans($basedir),
e2dc2ea @flussence Niecza graph \o/
authored
205 files => count_tests($basedir, $impl),
2ba2671 @flussence Fix broken result calculation
authored
206 );
1ad6813 @flussence Begone, foul threads
authored
207
208 return %results;
209 }
210
211 sub count_plans {
212 my $basedir = shift;
213
214 my $fileglob = q{'\.t$'};
215
0e1bcf9 @flussence Stop assuming rakudo == perl6
authored
216 return sum map {
217 /plan \s+ (\d+) \s* ;/x ? $1 : 0
218 } qx(ack ^plan -G $fileglob $basedir/t/spec);
af023c5 @flussence Just thought I'd put these somewhere
authored
219 }
1ad6813 @flussence Begone, foul threads
authored
220
221 sub count_tests {
222 my $basedir = shift;
e2dc2ea @flussence Niecza graph \o/
authored
223 my $impl = shift;
1ad6813 @flussence Begone, foul threads
authored
224
0e1bcf9 @flussence Stop assuming rakudo == perl6
authored
225 my @testfiles = map {
226 my ($file) = split /\s+/; qq{t/spec/$file}
227 } grep {
228 not (/^#/ or /^\s*$/)
229 } read_file(qq{$basedir/t/spectest.data});
1ad6813 @flussence Begone, foul threads
authored
230
e2dc2ea @flussence Niecza graph \o/
authored
231 return scalar split(' ', qx(cd $basedir; perl t/spec/fudgeall $impl @testfiles));
1ad6813 @flussence Begone, foul threads
authored
232 }
233
Something went wrong with that request. Please try again.