ld64-278.4.tar.gz

[apple/ld64.git] / unit-tests / bin / make-recursive.pl

diff --git a/unit-tests/bin/make-recursive.pl b/unit-tests/bin/make-recursive.pl
index a44135022ed41a585c88ef7b62ccf33b2ffa6daa..0d681ba4ed00cc5c11f92e56867f044469c23017 100755 (executable)
--- a/unit-tests/bin/make-recursive.pl
+++ b/unit-tests/bin/make-recursive.pl
@@ -4,9 +4,13 @@ use strict;
 use Data::Dumper;
 use File::Find;
 use Cwd qw(realpath);
+use English;
 
 my @args = @ARGV;
 
+$ENV{'LD_NO_CLASSSIC_LINKER'} = '1';
+$ENV{'LD_NO_CLASSSIC_LINKER_STATIC'} = '1';
+
 my $makefiles =
 {
     'makefile' => undef,
@@ -28,6 +32,17 @@ my $keywords =
     'stderr' => [],
 };
 
+# Determine how many tests to run at a time in parallel. Default to cpu count.
+my $max_concurrent_tests = $ENV{'LD_UNIT_TEST_CONCURRENCY'};
+if (!defined $max_concurrent_tests) {
+    # shell command returns cpu count in exit status
+    system("/bin/csh", "-c", "set n=`sysctl hw.ncpu`; exit \$n[2]");
+    if ($? == -1 || $? & 127) {
+        die("could not determine cpu count");
+    }
+    $max_concurrent_tests = $? >> 8;
+}
+
 my $keyword;
 my $max_keyword_len = 0;
 foreach $keyword (keys %$keywords)
@@ -39,82 +54,117 @@ my $last_keyword = '';
 
 sub print_line
 {
-    my ($keyword, $val) = @_;
-
+    my ($file, $keyword, $val) = @_;
+    
     if(!exists($$keywords{$keyword}))
     {
-       print STDERR "error: keyword $keyword not in \$keywords set\n";
-       exit(1);
+        print STDERR "error: keyword $keyword not in \$keywords set\n";
+        exit(1);
     }
-
+    
     my $keyword_len = 0;
-
+    
     if($keyword ne $last_keyword)
     {
-       print("$keyword"); print($delim);
-       $keyword_len = length($keyword) + length($delim);
+        print($file "$keyword"); print($file $delim);
+        $keyword_len = length($keyword) + length($delim);
     }
     if($max_keyword_len > $keyword_len)
     {
-       my $num_spaces = $max_keyword_len - $keyword_len;
-       print(' ' x $num_spaces);
+        my $num_spaces = $max_keyword_len - $keyword_len;
+        print($file ' ' x $num_spaces);
     }
-    print("$val");
+    print($file "$val");
     if(0)
     {
-       $last_keyword = $keyword;
+        $last_keyword = $keyword;
     }
 }
 
 my $root = '.';
 $root = &realpath($root);
-print_line("root", "$root\n");
-
+print_line(*STDOUT, "root", "$root\n");
+my $running_test_count=0;
 find($find_opts, $root);
+while ( $running_test_count > 0 ) {
+    &reaper;
+}
 
 sub find_callback
 {
     if(exists($$makefiles{$_}))
     {
-       my $makefile = $_;
-       my $reldir = $File::Find::dir;
-       $reldir =~ s|^$root/||;
-       
-       &print_line("cwd", "\$root/$reldir\n");
-       my $cmd = [ "make" ];
-       
-       my $arg; foreach $arg (@ARGV) { push @$cmd, $arg; } # better way to do this?
-       &print_line("cmd", "@$cmd\n");
-
-        open(SAVEOUT, ">&STDOUT") || die("$!");
-        open(SAVEERR, ">&STDERR") || die("$!");
-       open(STDOUT, ">/tmp/unit-tests-stdout") || die("$!");
-       open(STDERR, ">/tmp/unit-tests-stderr") || die("$!");
-
-       $ENV{UNIT_TEST_NAME} = $reldir;
-       my $exit = system(@$cmd);
-
-       close(STDOUT) || die("$!");
-       close(STDERR) || die("$!");
-        open(STDOUT, ">&SAVEOUT") || die("$!");
-        open(STDERR, ">&SAVEERR") || die("$!");
-
-       &print_line("exit", "$exit\n");
+        my $makefile = $_;
+        my $reldir = $File::Find::dir;
+        $reldir =~ s|^$root/||;
+        
+        my $cmd = [ "make" ];
+        
+        my $arg; foreach $arg (@ARGV) { push @$cmd, $arg; } # better way to do this?
+        
+        $ENV{UNIT_TEST_NAME} = $reldir;
+        my $pid = fork();
+        if (not defined $pid) {
+            die "Couldn't fork"
+        }
+        elsif ($pid == 0) {
+            # Child. Redirect stdout/stderr to files and exec test.
+            open(STDOUT, ">/tmp/unit-tests-stdout.$PID") || die("$!");
+            open(STDERR, ">/tmp/unit-tests-stderr.$PID") || die("$!");
+            exec 'make', @ARGV;
+            exit(-1);    #just to be sure
+        }
+        
+        # Write the test cwd/cmd to a temporary file associated with the child's pid, to be retrieved later.
+        my $info;
+        open($info, ">/tmp/unit-tests-info.$pid") || die("$!");
+        &print_line($info, "cwd", "\$root/$reldir\n"); # post filtering depends on this line being first
+        &print_line($info, "cmd", "@$cmd\n");
+        close($info) || die("$!");
+        
+        $running_test_count++;
+        # if we have reached max # of concurrent tests, wait for one to exit
+        if ( $running_test_count == $max_concurrent_tests ) {
+            &reaper;
+        }
+    }
+}
 
-       open(OUT, "</tmp/unit-tests-stdout") || die("$!");
-       while(<OUT>)
-       {
-           &print_line("stdout", "$_");
-       }
-       close(OUT) || die("$!");
-       unlink("/tmp/unit-tests-stdout");
-       
-       open(ERR, "</tmp/unit-tests-stderr") || die("$!");
-       while(<ERR>)
-       {
-           &print_line("stderr", "$_");
+sub reaper {
+       if ( $running_test_count > 0 ) {
+               my $pid = wait;
+        if ( $pid == -1 ) {
+            die("no child\n");
+        }
+        my $exit = $?;
+        
+               $running_test_count--;
+        
+               open(INFO, "</tmp/unit-tests-info.$pid") || die("$!");
+               while(<INFO>)
+               {
+            print $_;
+               }
+               close(INFO) || die("$!");
+               unlink("/tmp/unit-tests-info.$pid");
+        
+        &print_line(*STDOUT, "exit", "$exit\n");
+        
+               open(OUT, "</tmp/unit-tests-stdout.$pid") || die("$!");
+               while(<OUT>)
+               {
+                   &print_line(*STDOUT, "stdout", "$_");
+               }
+               close(OUT) || die("$!");
+               unlink("/tmp/unit-tests-stdout.$pid");
+        
+               open(ERR, "</tmp/unit-tests-stderr.$pid") || die("$!");
+               while(<ERR>)
+               {
+                   &print_line(*STDOUT, "stderr", "$_");
+               }
+               close(ERR) || die("$!");
+               unlink("/tmp/unit-tests-stderr.$pid");
        }
-       close(ERR) || die("$!");
-    }
-       unlink("/tmp/unit-tests-stderr");
 }
+