265 lines
8.1 KiB
Perl
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;
|