llvm-project/openmp/runtime/tools/lib/Build.pm

265 lines
8.1 KiB
Perl

#
#//===----------------------------------------------------------------------===//
#//
#// The LLVM Compiler Infrastructure
#//
#// This file is dual licensed under the MIT and the University of Illinois Open
#// Source Licenses. See LICENSE.txt for details.
#//
#//===----------------------------------------------------------------------===//
#
package Build;
use strict;
use warnings;
use Cwd qw{};
use LibOMP;
use tools;
use Uname;
use Platform ":vars";
my $host = Uname::host_name();
my $root = $ENV{ LIBOMP_WORK };
my $tmp = $ENV{ LIBOMP_TMP };
my $out = $ENV{ LIBOMP_EXPORTS };
my @jobs;
our $start = time();
# --------------------------------------------------------------------------------------------------
# Helper functions.
# --------------------------------------------------------------------------------------------------
# tstr -- Time string. Returns string "yyyy-dd-mm hh:mm:ss UTC".
sub tstr(;$) {
my ( $time ) = @_;
if ( not defined( $time ) ) {
$time = time();
}; # if
my ( $sec, $min, $hour, $day, $month, $year ) = gmtime( $time );
$month += 1;
$year += 1900;
my $str = sprintf( "%04d-%02d-%02d %02d:%02d:%02d UTC", $year, $month, $day, $hour, $min, $sec );
return $str;
}; # sub tstr
# dstr -- Duration string. Returns string "hh:mm:ss".
sub dstr($) {
# Get time in seconds and format it as time in hours, minutes, seconds.
my ( $sec ) = @_;
my ( $h, $m, $s );
$h = int( $sec / 3600 );
$sec = $sec - $h * 3600;
$m = int( $sec / 60 );
$sec = $sec - $m * 60;
$s = int( $sec );
$sec = $sec - $s;
return sprintf( "%02d:%02d:%02d", $h, $m, $s );
}; # sub dstr
# rstr -- Result string.
sub rstr($) {
my ( $rc ) = @_;
return ( $rc == 0 ? "+++ Success +++" : "--- Failure ---" );
}; # sub rstr
sub shorter($;$) {
# Return shorter variant of path -- either absolute or relative.
my ( $path, $base ) = @_;
my $abs = abs_path( $path );
my $rel = rel_path( $path, $base );
if ( $rel eq "" ) {
$rel = ".";
}; # if
$path = ( length( $rel ) < length( $abs ) ? $rel : $abs );
if ( $target_os eq "win" ) {
$path =~ s{\\}{/}g;
}; # if
return $path;
}; # sub shorter
sub tee($$) {
my ( $action, $file ) = @_;
my $pid = 0;
my $save_stdout = Symbol::gensym();
my $save_stderr = Symbol::gensym();
# --- redirect stdout ---
STDOUT->flush();
# Save stdout in $save_stdout.
open( $save_stdout, ">&" . STDOUT->fileno() )
or die( "Cannot dup filehandle: $!; stopped" );
# Redirect stdout to tee or to file.
if ( $tools::verbose ) {
$pid = open( STDOUT, "| tee -a \"$file\"" )
or die "Cannot open pipe to \"tee\": $!; stopped";
} else {
open( STDOUT, ">>$file" )
or die "Cannot open file \"$file\" for writing: $!; stopped";
}; # if
# --- redirect stderr ---
STDERR->flush();
# Save stderr in $save_stderr.
open( $save_stderr, ">&" . STDERR->fileno() )
or die( "Cannot dup filehandle: $!; stopped" );
# Redirect stderr to stdout.
open( STDERR, ">&" . STDOUT->fileno() )
or die( "Cannot dup filehandle: $!; stopped" );
# Perform actions.
$action->();
# --- restore stderr ---
STDERR->flush();
# Restore stderr from $save_stderr.
open( STDERR, ">&" . $save_stderr->fileno() )
or die( "Cannot dup filehandle: $!; stopped" );
# Close $save_stderr.
$save_stderr->close() or die ( "Cannot close filehandle: $!; stopped" );
# --- restore stdout ---
STDOUT->flush();
# Restore stdout from $save_stdout.
open( STDOUT, ">&" . $save_stdout->fileno() )
or die( "Cannot dup filehandle: $!; stopped" );
# Close $save_stdout.
$save_stdout->close() or die ( "Cannot close filehandle: $!; stopped" );
# Wait for the child tee process, otherwise output of make and build.pl interleaves.
if ( $pid != 0 ) {
waitpid( $pid, 0 );
}; # if
}; # sub tee
sub log_it($$@) {
my ( $title, $format, @args ) = @_;
my $message = sprintf( $format, @args );
my $progress = cat_file( $tmp, sprintf( "%s-%s.log", $target_platform, Uname::host_name() ) );
if ( $title ne "" and $message ne "" ) {
my $line = sprintf( "%-15s : %s\n", $title, $message );
info( $line );
write_file( $progress, tstr() . ": " . $line, -append => 1 );
} else {
write_file( $progress, "\n", -append => 1 );
}; # if
}; # sub log_it
sub progress($$@) {
my ( $title, $format, @args ) = @_;
log_it( $title, $format, @args );
}; # sub progress
sub summary() {
my $total = @jobs;
my $success = 0;
my $finish = time();
foreach my $job ( @jobs ) {
my ( $build_dir, $rc ) = ( $job->{ build_dir }, $job->{ rc } );
progress( rstr( $rc ), "%s", $build_dir );
if ( $rc == 0 ) {
++ $success;
}; # if
}; # foreach $job
my $failure = $total - $success;
progress( "Successes", "%3d of %3d", $success, $total );
progress( "Failures", "%3d of %3d", $failure, $total );
progress( "Time elapsed", " %s", dstr( $finish - $start ) );
progress( "Overall result", "%s", rstr( $failure ) );
return $failure;
}; # sub summary
# --------------------------------------------------------------------------------------------------
# Worker functions.
# --------------------------------------------------------------------------------------------------
sub init() {
make_dir( $tmp );
}; # sub init
sub clean(@) {
# Clean directories.
my ( @dirs ) = @_;
my $exit = 0;
# Mimisc makefile -- print a command.
print( "rm -f -r " . join( " ", map( shorter( $_ ) . "/*", @dirs ) ) . "\n" );
$exit =
execute(
[ $^X, cat_file( $ENV{ LIBOMP_WORK }, "tools", "clean-dir.pl" ), @dirs ],
-ignore_status => 1,
( $tools::verbose ? () : ( -stdout => undef, -stderr => "" ) ),
);
return $exit;
}; # sub clean
sub make($$$) {
# Change dir to build one and run make.
my ( $job, $clean, $marker ) = @_;
my $dir = $job->{ build_dir };
my $makefile = $job->{ makefile };
my $args = $job->{ make_args };
my $cwd = Cwd::cwd();
my $width = -10;
my $exit;
$dir = cat_dir( $tmp, $dir );
make_dir( $dir );
change_dir( $dir );
my $actions =
sub {
my $start = time();
$makefile = shorter( $makefile );
print( "-" x 79, "\n" );
printf( "%${width}s: %s\n", "Started", tstr( $start ) );
printf( "%${width}s: %s\n", "Root dir", $root );
printf( "%${width}s: %s\n", "Build dir", shorter( $dir, $root ) );
printf( "%${width}s: %s\n", "Makefile", $makefile );
print( "-" x 79, "\n" );
{
# Use shorter LIBOMP_WORK to have shorter command lines.
# Note: Some tools may not work if current dir is changed.
local $ENV{ LIBOMP_WORK } = shorter( $ENV{ LIBOMP_WORK } );
$exit =
execute(
[
"make",
"-r",
"-f", $makefile,
"arch=" . $target_arch,
"marker=$marker",
@$args
],
-ignore_status => 1
);
if ( $clean and $exit == 0 ) {
$exit = clean( $dir );
}; # if
}
my $finish = time();
print( "-" x 79, "\n" );
printf( "%${width}s: %s\n", "Finished", tstr( $finish ) );
printf( "%${width}s: %s\n", "Elapsed", dstr( $finish - $start ) );
printf( "%${width}s: %s\n", "Result", rstr( $exit ) );
print( "-" x 79, "\n" );
print( "\n" );
}; # sub
tee( $actions, "build.log" );
change_dir( $cwd );
# Save completed job to be able print summary later.
$job->{ rc } = $exit;
push( @jobs, $job );
return $exit;
}; # sub make
1;