office-gobmx/solenv/bin/subsequenttests

eval 'exec "$PERL" -Sw "$0" "$@"'
    if 0;
#*************************************************************************
#
# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
#
# Copyright 2000, 2010 Oracle and/or its affiliates.
#
# OpenOffice.org - a multi-platform office productivity suite
#
# This file is part of OpenOffice.org.
#
# OpenOffice.org is free software: you can redistribute it and/or modify
# it under the terms of the GNU Lesser General Public License version 3
# only, as published by the Free Software Foundation.
#
# OpenOffice.org is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU Lesser General Public License version 3 for more details
# (a copy is included in the LICENSE file that accompanied this code).
#
# You should have received a copy of the GNU Lesser General Public License
# version 3 along with OpenOffice.org.  If not, see
# <http://www.openoffice.org/license.html>
# for a copy of the LGPLv3 License.
#
#***********************************************************************/

use lib("$ENV{SOLARENV}/bin/modules");
use SourceConfig;

my $keep_going = 0;
my $dry_run = 0;
my $max_running = 1;
while (@ARGV) {
    my $arg = shift(@ARGV);
    if ($arg =~ /^-P([1-9]\d*)$/) {
        $max_running = $1;
    } elsif ($arg eq '--') {
        last;
    } else {
        my $n = substr($arg, 0, 1) eq '-' ? 1 : 0;
        while ($n && $n < length($arg)) {
            my $c = substr($arg, $n++, 1);
            if ($c eq 'k') {
                $keep_going = 1;
            } elsif ($c eq 'n') {
                $dry_run = 1;
            } else {
                $n = 0;
                last;
            }
        }
        if (!$n) {
            print STDERR "unknown argument \"$arg\"\n";
            print STDERR "usage: $0 [-kn] [-P<n>] [-- <args>]\n";
            print STDERR " -k     continue with other dmake invocations upon\n";
            print STDERR "        failure\n";
            print STDERR " -n     write directories that would be processed\n";
            print STDERR "        to standard output\n";
            print STDERR " -P<n>  number of parallel dmake invocations\n";
            print STDERR " <args> are passed to dmake invocations\n";
            exit(1);
        }
    }
}

my @testpaths = ();
my $sc = SourceConfig->new($ENV{'SOLARSRC'});
my $module;
my $gbuildpath = "$ENV{'SOLARSRC'}/GNUmakefile";
foreach $module ($sc->get_active_modules()) {
    my $buildlst = $sc->get_module_build_list($module);
    next unless defined($buildlst);
    my %deps = ();
    open(BUILDLST, $buildlst) or die("cannot open $buildlst");
    while (<BUILDLST>) {
        next unless
            /^\s*\w+\s+(\S+)\s+nmake\s+-\s+all\s+(\S+)(\s+(:?\S+\s+)*)NULL\s*$/;
        my ($dir, $id, $ids) = ($1, $2, $3);
        $dir =~ s|\\|/|g;
        $dir =~ s|^[^/]+||;
        my $path = $sc->get_module_path($module) . $dir;
        my $makefile = $path . '/makefile.mk';
        open(MAKEFILE, $makefile) or die("cannot open $makefile");
        while (<MAKEFILE>) {
            if (/\bOOO_SUBSEQUENT_TESTS\b/) {
                push(@testpaths, $path);
                $deps{$id} = $ids;
                last;
            }
        }
        close(MAKEFILE);
    }
    close(BUILDLST);
    my $id1;
    foreach $id1 (keys(%deps)) {
        my ($id2, $ids);
        while (($id2, $ids) = each(%deps)) {
            $ids !~ /\s\Q$id1\E\s/ or die("$module: $id2 depends on $id1");
        }
    }
}

if ($dry_run) {
    foreach $path (@testpaths) {
        print "$path\n";
    }
    print "$gbuildpath\n";
    exit(0);
}

my @failedpaths = ();
my @gbuildargs = ("-j$max_running", "-s");
if ($keep_going) {
    push(@gbuildargs,"-k");
}
push(@gbuildargs, "--file=$gbuildpath");
push(@gbuildargs, "subsequentcheck");
if (system($ENV{'GNUMAKE'}, @gbuildargs) != 0) {
	push(@failedpaths,$gbuildpath);
	@testpaths = () unless $keep_going;
}

my $cmd = 'dmake';
foreach (@ARGV) {
    s/'/'\''/g;
    $cmd .= " '" . $_ . "'";
}
$cmd .= ' 2>&1 |';

my %pids = ();
my $running = 0;
my $counter = 0;
while (@testpaths || $running > 0) {
    while (@testpaths && $running < $max_running) {
        my $testpath = shift(@testpaths);
        ++$counter;
        print("$counter: make $testpath\n");
        my $pid = fork();
        defined($pid) or die("$counter: $!");
        if ($pid == 0) {
            chdir($testpath) or die("$counter: $!");
            $ENV{'OOO_SUBSEQUENT_TESTS'} = 'TRUE';
            open(OUTPUT, $cmd) or die("$counter: $!");
            while (<OUTPUT>) {
                s/\r?\n$//;
                print("$counter: $_\n");
            }
            close(OUTPUT);
            exit($? == 0 ? 0 : 1);
        }
        $pids{$pid} = $testpath;
        ++$running;
    }
    my $pid = wait();
    $pid != -1 or die($!);
    my $testpath = delete($pids{$pid});
    defined($testpath) or die("unmatched PID $pid");
    if ($? != 0) {
        push(@failedpaths, $testpath);
        @testpaths = () unless $keep_going;
    }
    --$running;
}
my $failedpath;
foreach $failedpath (@failedpaths) {
    print STDERR "failed in $failedpath\n";
}
exit(scalar(@failedpaths) == 0 ? 0 : 1);