1#
2#//===----------------------------------------------------------------------===//
3#//
4#// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
5#// See https://llvm.org/LICENSE.txt for license information.
6#// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
7#//
8#//===----------------------------------------------------------------------===//
9#
10package Build;
11
12use strict;
13use warnings;
14
15use Cwd qw{};
16
17use LibOMP;
18use tools;
19use Uname;
20use Platform ":vars";
21
22my $host = Uname::host_name();
23my $root = $ENV{ LIBOMP_WORK    };
24my $tmp  = $ENV{ LIBOMP_TMP     };
25my $out  = $ENV{ LIBOMP_EXPORTS };
26
27my @jobs;
28our $start = time();
29
30# --------------------------------------------------------------------------------------------------
31# Helper functions.
32# --------------------------------------------------------------------------------------------------
33
34# tstr -- Time string. Returns string "yyyy-dd-mm hh:mm:ss UTC".
35sub tstr(;$) {
36    my ( $time ) = @_;
37    if ( not defined( $time ) ) {
38        $time = time();
39    }; # if
40    my ( $sec, $min, $hour, $day, $month, $year ) = gmtime( $time );
41    $month += 1;
42    $year  += 1900;
43    my $str = sprintf( "%04d-%02d-%02d %02d:%02d:%02d UTC", $year, $month, $day, $hour, $min, $sec );
44    return $str;
45}; # sub tstr
46
47# dstr -- Duration string. Returns string "hh:mm:ss".
48sub dstr($) {
49    # Get time in seconds and format it as time in hours, minutes, seconds.
50    my ( $sec ) = @_;
51    my ( $h, $m, $s );
52    $h   = int( $sec / 3600 );
53    $sec = $sec - $h * 3600;
54    $m   = int( $sec / 60 );
55    $sec = $sec - $m * 60;
56    $s   = int( $sec );
57    $sec = $sec - $s;
58    return sprintf( "%02d:%02d:%02d", $h, $m, $s );
59}; # sub dstr
60
61# rstr -- Result string.
62sub rstr($) {
63    my ( $rc ) = @_;
64    return ( $rc == 0 ? "+++ Success +++" : "--- Failure ---" );
65}; # sub rstr
66
67sub shorter($;$) {
68    # Return shorter variant of path -- either absolute or relative.
69    my ( $path, $base ) = @_;
70    my $abs = abs_path( $path );
71    my $rel = rel_path( $path, $base );
72    if ( $rel eq "" ) {
73        $rel = ".";
74    }; # if
75    $path = ( length( $rel ) < length( $abs ) ? $rel : $abs );
76    if ( $target_os eq "win" ) {
77        $path =~ s{\\}{/}g;
78    }; # if
79    return $path;
80}; # sub shorter
81
82sub tee($$) {
83
84    my ( $action, $file ) = @_;
85    my $pid = 0;
86
87    my $save_stdout = Symbol::gensym();
88    my $save_stderr = Symbol::gensym();
89
90    # --- redirect stdout ---
91    STDOUT->flush();
92    # Save stdout in $save_stdout.
93    open( $save_stdout, ">&" . STDOUT->fileno() )
94        or die( "Cannot dup filehandle: $!; stopped" );
95    # Redirect stdout to tee or to file.
96    if ( $tools::verbose ) {
97        $pid = open( STDOUT, "| tee -a \"$file\"" )
98            or die "Cannot open pipe to \"tee\": $!; stopped";
99    } else {
100        open( STDOUT, ">>$file" )
101            or die "Cannot open file \"$file\" for writing: $!; stopped";
102    }; # if
103
104    # --- redirect stderr ---
105    STDERR->flush();
106    # Save stderr in $save_stderr.
107    open( $save_stderr, ">&" . STDERR->fileno() )
108        or die( "Cannot dup filehandle: $!; stopped" );
109    # Redirect stderr to stdout.
110    open( STDERR, ">&" . STDOUT->fileno() )
111        or die( "Cannot dup filehandle: $!; stopped" );
112
113    # Perform actions.
114    $action->();
115
116    # --- restore stderr ---
117    STDERR->flush();
118    # Restore stderr from $save_stderr.
119    open( STDERR, ">&" . $save_stderr->fileno() )
120        or die( "Cannot dup filehandle: $!; stopped" );
121    # Close $save_stderr.
122    $save_stderr->close() or die ( "Cannot close filehandle: $!; stopped" );
123
124    # --- restore stdout ---
125    STDOUT->flush();
126    # Restore stdout from $save_stdout.
127    open( STDOUT, ">&" . $save_stdout->fileno() )
128        or die( "Cannot dup filehandle: $!; stopped" );
129    # Close $save_stdout.
130    $save_stdout->close() or die ( "Cannot close filehandle: $!; stopped" );
131
132    # Wait for the child tee process, otherwise output of make and build.pl interleaves.
133    if ( $pid != 0 ) {
134        waitpid( $pid, 0 );
135    }; # if
136
137}; # sub tee
138
139sub log_it($$@) {
140    my ( $title, $format, @args ) = @_;
141    my $message  = sprintf( $format, @args );
142    my $progress = cat_file( $tmp, sprintf( "%s-%s.log", $target_platform, Uname::host_name() ) );
143    if ( $title ne "" and $message ne "" ) {
144        my $line = sprintf( "%-15s : %s\n", $title, $message );
145        info( $line );
146        write_file( $progress, tstr() . ": " . $line, -append => 1 );
147    } else {
148        write_file( $progress, "\n", -append => 1 );
149    }; # if
150}; # sub log_it
151
152sub progress($$@) {
153    my ( $title, $format, @args ) = @_;
154    log_it( $title, $format, @args );
155}; # sub progress
156
157sub summary() {
158    my $total   = @jobs;
159    my $success = 0;
160    my $finish = time();
161    foreach my $job ( @jobs ) {
162        my ( $build_dir, $rc ) = ( $job->{ build_dir }, $job->{ rc } );
163        progress( rstr( $rc ), "%s", $build_dir );
164        if ( $rc == 0 ) {
165            ++ $success;
166        }; # if
167    }; # foreach $job
168    my $failure = $total - $success;
169    progress( "Successes",      "%3d of %3d", $success, $total );
170    progress( "Failures",       "%3d of %3d", $failure, $total );
171    progress( "Time elapsed",   "  %s", dstr( $finish - $start ) );
172    progress( "Overall result", "%s", rstr( $failure ) );
173    return $failure;
174}; # sub summary
175
176# --------------------------------------------------------------------------------------------------
177# Worker functions.
178# --------------------------------------------------------------------------------------------------
179
180sub init() {
181    make_dir( $tmp );
182}; # sub init
183
184sub clean(@) {
185    # Clean directories.
186    my ( @dirs ) = @_;
187    my $exit = 0;
188    # Mimisc makefile -- print a command.
189    print( "rm -f -r " . join( " ", map( shorter( $_ ) . "/*", @dirs ) ) . "\n" );
190    $exit =
191        execute(
192            [ $^X, cat_file( $ENV{ LIBOMP_WORK }, "tools", "clean-dir.pl" ), @dirs ],
193            -ignore_status => 1,
194            ( $tools::verbose ? () : ( -stdout => undef, -stderr => "" ) ),
195        );
196    return $exit;
197}; # sub clean
198
199sub make($$$) {
200    # Change dir to build one and run make.
201    my ( $job, $clean, $marker ) = @_;
202    my $dir      = $job->{ build_dir };
203    my $makefile = $job->{ makefile };
204    my $args     = $job->{ make_args };
205    my $cwd      = Cwd::cwd();
206    my $width    = -10;
207
208    my $exit;
209    $dir = cat_dir( $tmp, $dir );
210    make_dir( $dir );
211    change_dir( $dir );
212
213    my $actions =
214        sub {
215            my $start = time();
216            $makefile = shorter( $makefile );
217            print( "-" x 79, "\n" );
218            printf( "%${width}s: %s\n", "Started",   tstr( $start ) );
219            printf( "%${width}s: %s\n", "Root dir",  $root );
220            printf( "%${width}s: %s\n", "Build dir", shorter( $dir, $root ) );
221            printf( "%${width}s: %s\n", "Makefile",  $makefile );
222            print( "-" x 79, "\n" );
223            {
224                # Use shorter LIBOMP_WORK to have shorter command lines.
225                # Note: Some tools may not work if current dir is changed.
226                local $ENV{ LIBOMP_WORK } = shorter( $ENV{ LIBOMP_WORK } );
227                $exit =
228                    execute(
229                        [
230                            "make",
231                            "-r",
232                            "-f", $makefile,
233                            "arch=" . $target_arch,
234                            "marker=$marker",
235                            @$args
236                        ],
237                        -ignore_status => 1
238                    );
239                if ( $clean and $exit == 0 ) {
240                    $exit = clean( $dir );
241                }; # if
242            }
243            my $finish = time();
244            print( "-" x 79, "\n" );
245            printf( "%${width}s: %s\n", "Finished", tstr( $finish ) );
246            printf( "%${width}s: %s\n", "Elapsed", dstr( $finish - $start ) );
247            printf( "%${width}s: %s\n", "Result", rstr( $exit ) );
248            print( "-" x 79, "\n" );
249            print( "\n" );
250        }; # sub
251    tee( $actions, "build.log" );
252
253    change_dir( $cwd );
254
255    # Save completed job to be able print summary later.
256    $job->{ rc } = $exit;
257    push( @jobs, $job );
258
259    return $exit;
260
261}; # sub make
262
2631;
264