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