1 eval 'exec "$PERL" -Sw "$0" "$@"' 2 if 0; 3 #************************************************************************* 4 # 5 # DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. 6 # 7 # Copyright 2000, 2010 Oracle and/or its affiliates. 8 # 9 # OpenOffice.org - a multi-platform office productivity suite 10 # 11 # This file is part of OpenOffice.org. 12 # 13 # OpenOffice.org is free software: you can redistribute it and/or modify 14 # it under the terms of the GNU Lesser General Public License version 3 15 # only, as published by the Free Software Foundation. 16 # 17 # OpenOffice.org is distributed in the hope that it will be useful, 18 # but WITHOUT ANY WARRANTY; without even the implied warranty of 19 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 # GNU Lesser General Public License version 3 for more details 21 # (a copy is included in the LICENSE file that accompanied this code). 22 # 23 # You should have received a copy of the GNU Lesser General Public License 24 # version 3 along with OpenOffice.org. If not, see 25 # <http://www.openoffice.org/license.html> 26 # for a copy of the LGPLv3 License. 27 # 28 #***********************************************************************/ 29 30 use lib("$ENV{SOLARENV}/bin/modules"); 31 use SourceConfig; 32 33 my $keep_going = 0; 34 my $dry_run = 0; 35 my $max_running = 1; 36 while (@ARGV) { 37 my $arg = shift(@ARGV); 38 if ($arg =~ /^-P([1-9]\d*)$/) { 39 $max_running = $1; 40 } elsif ($arg eq '--') { 41 last; 42 } else { 43 my $n = substr($arg, 0, 1) eq '-' ? 1 : 0; 44 while ($n && $n < length($arg)) { 45 my $c = substr($arg, $n++, 1); 46 if ($c eq 'k') { 47 $keep_going = 1; 48 } elsif ($c eq 'n') { 49 $dry_run = 1; 50 } else { 51 $n = 0; 52 last; 53 } 54 } 55 if (!$n) { 56 print STDERR "unknown argument \"$arg\"\n"; 57 print STDERR "usage: $0 [-kn] [-P<n>] [-- <args>]\n"; 58 print STDERR " -k continue with other dmake invocations upon\n"; 59 print STDERR " failure\n"; 60 print STDERR " -n write directories that would be processed\n"; 61 print STDERR " to standard output\n"; 62 print STDERR " -P<n> number of parallel dmake invocations\n"; 63 print STDERR " <args> are passed to dmake invocations\n"; 64 exit(1); 65 } 66 } 67 } 68 69 my @testpaths = (); 70 my $sc = SourceConfig->new($ENV{'SOLARSRC'}); 71 my $module; 72 my $gbuildpath = "$ENV{'SOLARSRC'}/GNUmakefile"; 73 foreach $module ($sc->get_active_modules()) { 74 my $buildlst = $sc->get_module_build_list($module); 75 next unless defined($buildlst); 76 my %deps = (); 77 open(BUILDLST, $buildlst) or die("cannot open $buildlst"); 78 while (<BUILDLST>) { 79 next unless 80 /^\s*\w+\s+(\S+)\s+nmake\s+-\s+all\s+(\S+)(\s+(:?\S+\s+)*)NULL\s*$/; 81 my ($dir, $id, $ids) = ($1, $2, $3); 82 $dir =~ s|\\|/|g; 83 $dir =~ s|^[^/]+||; 84 my $path = $sc->get_module_path($module) . $dir; 85 my $makefile = $path . '/makefile.mk'; 86 open(MAKEFILE, $makefile) or die("cannot open $makefile"); 87 while (<MAKEFILE>) { 88 if (/\bOOO_SUBSEQUENT_TESTS\b/) { 89 push(@testpaths, $path); 90 $deps{$id} = $ids; 91 last; 92 } 93 } 94 close(MAKEFILE); 95 } 96 close(BUILDLST); 97 my $id1; 98 foreach $id1 (keys(%deps)) { 99 my ($id2, $ids); 100 while (($id2, $ids) = each(%deps)) { 101 $ids !~ /\s\Q$id1\E\s/ or die("$module: $id2 depends on $id1"); 102 } 103 } 104 } 105 106 if ($dry_run) { 107 foreach $path (@testpaths) { 108 print "$path\n"; 109 } 110 print "$gbuildpath\n"; 111 exit(0); 112 } 113 114 my @failedpaths = (); 115 my @gbuildargs = ("-j$max_running", "-s", "-r"); 116 if ($keep_going) { 117 push(@gbuildargs,"-k"); 118 } 119 push(@gbuildargs, "--file=$gbuildpath"); 120 push(@gbuildargs, "subsequentcheck"); 121 if (system($ENV{'GNUMAKE'}, @gbuildargs) != 0) { 122 push(@failedpaths,$gbuildpath); 123 @testpaths = () unless $keep_going; 124 } 125 126 my $cmd = 'dmake'; 127 foreach (@ARGV) { 128 s/'/'\''/g; 129 $cmd .= " '" . $_ . "'"; 130 } 131 $cmd .= ' 2>&1 |'; 132 133 my %pids = (); 134 my $running = 0; 135 my $counter = 0; 136 while (@testpaths || $running > 0) { 137 while (@testpaths && $running < $max_running) { 138 my $testpath = shift(@testpaths); 139 ++$counter; 140 print("$counter: make $testpath\n"); 141 my $pid = fork(); 142 defined($pid) or die("$counter: $!"); 143 if ($pid == 0) { 144 chdir($testpath) or die("$counter: $!"); 145 $ENV{'OOO_SUBSEQUENT_TESTS'} = 'TRUE'; 146 open(OUTPUT, $cmd) or die("$counter: $!"); 147 while (<OUTPUT>) { 148 s/\r?\n$//; 149 print("$counter: $_\n"); 150 } 151 close(OUTPUT); 152 exit($? == 0 ? 0 : 1); 153 } 154 $pids{$pid} = $testpath; 155 ++$running; 156 } 157 my $pid = wait(); 158 $pid != -1 or die($!); 159 my $testpath = delete($pids{$pid}); 160 defined($testpath) or die("unmatched PID $pid"); 161 if ($? != 0) { 162 push(@failedpaths, $testpath); 163 @testpaths = () unless $keep_going; 164 } 165 --$running; 166 } 167 my $failedpath; 168 foreach $failedpath (@failedpaths) { 169 print STDERR "failed in $failedpath\n"; 170 } 171 exit(scalar(@failedpaths) == 0 ? 0 : 1); 172