160 lines
3.9 KiB
Perl
Executable file
160 lines
3.9 KiB
Perl
Executable file
#!/usr/bin/env perl
|
|
|
|
use strict;
|
|
use warnings;
|
|
use v5.30;
|
|
|
|
use IO::Async;
|
|
use IO::Async::Function;
|
|
use IO::Async::Loop::Epoll;
|
|
use Getopt::Long;
|
|
use Future;
|
|
use Path::Tiny;
|
|
use IPC::Run;
|
|
use Time::HiRes qw/time/;
|
|
use Syntax::Keyword::Try;
|
|
|
|
my @bases = qw/bullseye-backports bookworm-backports/;
|
|
my @options = ("main", "main-threaded", "main-longdouble", "main-quadmath", "main-debugging", "main-longdouble-threaded", "main-quadmath-threaded", "main-debugging-threaded", "main-debugging-longdouble-threaded", "main-debugging-quadmath-threaded", "main-debugging-longdouble", "main-debugging-quadmath");
|
|
my @versions = ("5.20.3", "5.22.4", "5.24.4", "5.26.3", "5.28.3", "5.30.3", "5.32.1", "5.34.0", "5.34.1", "5.36.0");
|
|
my $max_workers = 8;
|
|
my $verbose = 1;
|
|
|
|
GetOptions('verbose' => \$verbose,
|
|
'quiet' => sub {$verbose = 0},
|
|
'workers=i' => \$max_workers,
|
|
);
|
|
|
|
my $loop = IO::Async::Loop::Epoll->new();
|
|
|
|
sub get_ts {
|
|
my $t = time();
|
|
|
|
return sprintf "%0.04f", $t;
|
|
}
|
|
|
|
sub process_lines {
|
|
my ($disp_prefix, $lines) = @_;
|
|
my $output = "";
|
|
|
|
while ($$lines =~ /\n/m) {
|
|
my $ts = get_ts();
|
|
$$lines =~ s/^(.*?)\n//m;
|
|
my $raw_line = $1;
|
|
|
|
my $log_line = $ts.": ".$raw_line;
|
|
my $disp_line = $disp_prefix." - ".$ts.": ".$raw_line;
|
|
print "out: ", $disp_line, "\n";
|
|
$output .= $log_line;
|
|
}
|
|
|
|
return $output;
|
|
}
|
|
|
|
sub run_cmd {
|
|
my ($cmd,$disp_prefix,$log_file,$input) = @_;
|
|
|
|
my ($output, $error, $raw_out, $raw_err);
|
|
|
|
try {
|
|
|
|
print "Running command $disp_prefix ".$cmd->[0], "\n";
|
|
|
|
my $handle = IPC::Run::start $cmd, \$input, \$raw_out, \$raw_err; # no timeout here, that's part of the ::Function
|
|
|
|
print "started, $handle\n";
|
|
print "pumpable? ", $handle->pumpable?"yes":"no", "\n";
|
|
|
|
while ($handle->pumpable) {
|
|
$handle->pump();
|
|
|
|
print "pumping $disp_prefix\n";
|
|
$output .= process_lines($disp_prefix, \$raw_out);
|
|
$error .= process_lines($disp_prefix."[ERR]", \$raw_err);
|
|
}
|
|
|
|
# Nothing we do here is a fatal error.
|
|
finish $handle;
|
|
|
|
my $return = $?;
|
|
|
|
print "Finished $disp_prefix\n";
|
|
|
|
return ($output, $error, $return);
|
|
} catch {
|
|
my $e = $@;
|
|
|
|
print "$disp_prefix: $e\n";
|
|
}
|
|
}
|
|
|
|
my $builder = IO::Async::Function->new(
|
|
code => sub {
|
|
my ( $version, $options, $os_base ) = @_;
|
|
|
|
my $expanded_version = $version =~ s/(?<major>5)\.(?<minor>\d+)\.(?<patch>\d+)/sprintf "%d.%03d.%03d", $+{major}, $+{minor}, $+{patch}/er;
|
|
|
|
my $tags = ["$version-$options-$os_base", "$expanded_version-$options-$os_base"];
|
|
|
|
my ($output, $error, $retval) = run_cmd(["ls"], $tags->[0], "", "");
|
|
# my ($output, $return) = tee_merged sub {
|
|
# my $workdir = path("output/perls")->child("$expanded_version-$options-$os_base");
|
|
#
|
|
# if ($workdir->exists()) {
|
|
#
|
|
# chdir($workdir);
|
|
# #print "$workdir\n";
|
|
# #system("ls");
|
|
# } else {
|
|
# print "Failed to find $workdir\n";
|
|
# }
|
|
# };
|
|
|
|
return $output;
|
|
},
|
|
|
|
max_workers => $max_workers,
|
|
min_workers => 1,
|
|
model => "fork",
|
|
);
|
|
|
|
$loop->add($builder);
|
|
$builder->start();
|
|
|
|
my %calls;
|
|
|
|
for my $version (@versions) {
|
|
for my $option (@options) {
|
|
for my $base (@bases) {
|
|
my $rend = "$version-$option-$base";
|
|
my $future = $builder->call(args => [$version, $option, $base])->on_ready(sub {
|
|
delete $calls{$rend};
|
|
});
|
|
$calls{$rend} = $future;
|
|
}
|
|
}
|
|
}
|
|
|
|
my $full_future = Future->wait_all( values %calls );
|
|
|
|
while (1) {
|
|
print "Is ready? ", $full_future->is_ready()?"yes":"no", "\n";
|
|
|
|
my @pending = $full_future->pending_futures;
|
|
|
|
print "Pending: ", 0+@pending, "\n";
|
|
print join(", ", keys %calls), "\n";
|
|
|
|
print "workers: ", $builder->workers, ", ", $builder->workers_idle, ", ", $builder->workers_busy, "\n";
|
|
|
|
$loop->delay_future(after => 1)->get();
|
|
|
|
if (@pending < 1) {
|
|
last;
|
|
}
|
|
}
|
|
|
|
my @result = $full_future->get();
|
|
|
|
use Data::Dumper;
|
|
#print Dumper(\@result);
|