xref: /aoo4110/main/solenv/bin/subsequenttests (revision b1cdbd2c)

eval 'exec "$PERL" -Sw "$0" "$@"'
    if 0;
#**************************************************************
#
#  Licensed to the Apache Software Foundation (ASF) under one
#  or more contributor license agreements.  See the NOTICE file
#  distributed with this work for additional information
#  regarding copyright ownership.  The ASF licenses this file
#  to you under the Apache License, Version 2.0 (the
#  "License"); you may not use this file except in compliance
#  with the License.  You may obtain a copy of the License at
#
#    http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing,
#  software distributed under the License is distributed on an
#  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
#  KIND, either express or implied.  See the License for the
#  specific language governing permissions and limitations
#  under the 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", "-r");
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);