1eval 'exec "$PERL" -Sw "$0" "$@"' 2 if 0; 3#************************************************************** 4# 5# Licensed to the Apache Software Foundation (ASF) under one 6# or more contributor license agreements. See the NOTICE file 7# distributed with this work for additional information 8# regarding copyright ownership. The ASF licenses this file 9# to you under the Apache License, Version 2.0 (the 10# "License"); you may not use this file except in compliance 11# with the License. You may obtain a copy of the License at 12# 13# http://www.apache.org/licenses/LICENSE-2.0 14# 15# Unless required by applicable law or agreed to in writing, 16# software distributed under the License is distributed on an 17# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 18# KIND, either express or implied. See the License for the 19# specific language governing permissions and limitations 20# under the License. 21# 22#************************************************************** 23 24use lib("$ENV{SOLARENV}/bin/modules"); 25use SourceConfig; 26 27my $keep_going = 0; 28my $dry_run = 0; 29my $max_running = 1; 30while (@ARGV) { 31 my $arg = shift(@ARGV); 32 if ($arg =~ /^-P([1-9]\d*)$/) { 33 $max_running = $1; 34 } elsif ($arg eq '--') { 35 last; 36 } else { 37 my $n = substr($arg, 0, 1) eq '-' ? 1 : 0; 38 while ($n && $n < length($arg)) { 39 my $c = substr($arg, $n++, 1); 40 if ($c eq 'k') { 41 $keep_going = 1; 42 } elsif ($c eq 'n') { 43 $dry_run = 1; 44 } else { 45 $n = 0; 46 last; 47 } 48 } 49 if (!$n) { 50 print STDERR "unknown argument \"$arg\"\n"; 51 print STDERR "usage: $0 [-kn] [-P<n>] [-- <args>]\n"; 52 print STDERR " -k continue with other dmake invocations upon\n"; 53 print STDERR " failure\n"; 54 print STDERR " -n write directories that would be processed\n"; 55 print STDERR " to standard output\n"; 56 print STDERR " -P<n> number of parallel dmake invocations\n"; 57 print STDERR " <args> are passed to dmake invocations\n"; 58 exit(1); 59 } 60 } 61} 62 63my @testpaths = (); 64my $sc = SourceConfig->new($ENV{'SOLARSRC'}); 65my $module; 66my $gbuildpath = "$ENV{'SOLARSRC'}/GNUmakefile"; 67foreach $module ($sc->get_active_modules()) { 68 my $buildlst = $sc->get_module_build_list($module); 69 next unless defined($buildlst); 70 my %deps = (); 71 open(BUILDLST, $buildlst) or die("cannot open $buildlst"); 72 while (<BUILDLST>) { 73 next unless 74 /^\s*\w+\s+(\S+)\s+nmake\s+-\s+all\s+(\S+)(\s+(:?\S+\s+)*)NULL\s*$/; 75 my ($dir, $id, $ids) = ($1, $2, $3); 76 $dir =~ s|\\|/|g; 77 $dir =~ s|^[^/]+||; 78 my $path = $sc->get_module_path($module) . $dir; 79 my $makefile = $path . '/makefile.mk'; 80 open(MAKEFILE, $makefile) or die("cannot open $makefile"); 81 while (<MAKEFILE>) { 82 if (/\bOOO_SUBSEQUENT_TESTS\b/) { 83 push(@testpaths, $path); 84 $deps{$id} = $ids; 85 last; 86 } 87 } 88 close(MAKEFILE); 89 } 90 close(BUILDLST); 91 my $id1; 92 foreach $id1 (keys(%deps)) { 93 my ($id2, $ids); 94 while (($id2, $ids) = each(%deps)) { 95 $ids !~ /\s\Q$id1\E\s/ or die("$module: $id2 depends on $id1"); 96 } 97 } 98} 99 100if ($dry_run) { 101 foreach $path (@testpaths) { 102 print "$path\n"; 103 } 104 print "$gbuildpath\n"; 105 exit(0); 106} 107 108my @failedpaths = (); 109my @gbuildargs = ("-j$max_running", "-s", "-r"); 110if ($keep_going) { 111 push(@gbuildargs,"-k"); 112} 113push(@gbuildargs, "--file=$gbuildpath"); 114push(@gbuildargs, "subsequentcheck"); 115if (system($ENV{'GNUMAKE'}, @gbuildargs) != 0) { 116 push(@failedpaths,$gbuildpath); 117 @testpaths = () unless $keep_going; 118} 119 120my $cmd = 'dmake'; 121foreach (@ARGV) { 122 s/'/'\''/g; 123 $cmd .= " '" . $_ . "'"; 124} 125$cmd .= ' 2>&1 |'; 126 127my %pids = (); 128my $running = 0; 129my $counter = 0; 130while (@testpaths || $running > 0) { 131 while (@testpaths && $running < $max_running) { 132 my $testpath = shift(@testpaths); 133 ++$counter; 134 print("$counter: make $testpath\n"); 135 my $pid = fork(); 136 defined($pid) or die("$counter: $!"); 137 if ($pid == 0) { 138 chdir($testpath) or die("$counter: $!"); 139 $ENV{'OOO_SUBSEQUENT_TESTS'} = 'TRUE'; 140 open(OUTPUT, $cmd) or die("$counter: $!"); 141 while (<OUTPUT>) { 142 s/\r?\n$//; 143 print("$counter: $_\n"); 144 } 145 close(OUTPUT); 146 exit($? == 0 ? 0 : 1); 147 } 148 $pids{$pid} = $testpath; 149 ++$running; 150 } 151 my $pid = wait(); 152 $pid != -1 or die($!); 153 my $testpath = delete($pids{$pid}); 154 defined($testpath) or die("unmatched PID $pid"); 155 if ($? != 0) { 156 push(@failedpaths, $testpath); 157 @testpaths = () unless $keep_going; 158 } 159 --$running; 160} 161my $failedpath; 162foreach $failedpath (@failedpaths) { 163 print STDERR "failed in $failedpath\n"; 164} 165exit(scalar(@failedpaths) == 0 ? 0 : 1); 166