unit-tests/bin/make-recursive.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use Data::Dumper;
   5 use File::Find;
   6 use Cwd qw(realpath);
   7 use English;
   8
   9 my @args = @ARGV;
  10
  11 $ENV{'LD_NO_CLASSSIC_LINKER'} = '1';
  12 $ENV{'LD_NO_CLASSSIC_LINKER_STATIC'} = '1';
  13
  14 my $makefiles =
  15 {
  16     'makefile' => undef,
  17     'Makefile' => undef,
  18 };
  19
  20 my $find_opts =
  21 {
  22     'wanted' => \&find_callback,
  23 };
  24
  25 my $keywords =
  26 {
  27     'root'   => '',
  28     'cwd'    => '',
  29     'cmd'    => '',
  30     'exit'   => '',
  31     'stdout' => [],
  32     'stderr' => [],
  33 };
  34
  35 # Determine how many tests to run at a time in parallel. Default to cpu count.
  36 my $max_concurrent_tests = $ENV{'LD_UNIT_TEST_CONCURRENCY'};
  37 if (!defined $max_concurrent_tests) {
  38     # shell command returns cpu count in exit status
  39     system("/bin/csh", "-c", "set n=`sysctl hw.ncpu`; exit \$n[2]");
  40     if ($? == -1 || $? & 127) {
  41         die("could not determine cpu count");
  42     }
  43     $max_concurrent_tests = $? >> 8;
  44 }
  45
  46 my $keyword;
  47 my $max_keyword_len = 0;
  48 foreach $keyword (keys %$keywords)
  49 { if($max_keyword_len < length($keyword)) { $max_keyword_len = length($keyword); } }
  50 my $delim = ':';
  51 $max_keyword_len += length($delim) + length(' ');
  52
  53 my $last_keyword = '';
  54
  55 sub print_line
  56 {
  57     my ($file, $keyword, $val) = @_;
  58
  59     if(!exists($$keywords{$keyword}))
  60     {
  61         print STDERR "error: keyword $keyword not in \$keywords set\n";
  62         exit(1);
  63     }
  64
  65     my $keyword_len = 0;
  66
  67     if($keyword ne $last_keyword)
  68     {
  69         print($file "$keyword"); print($file $delim);
  70         $keyword_len = length($keyword) + length($delim);
  71     }
  72     if($max_keyword_len > $keyword_len)
  73     {
  74         my $num_spaces = $max_keyword_len - $keyword_len;
  75         print($file ' ' x $num_spaces);
  76     }
  77     print($file "$val");
  78     if(0)
  79     {
  80         $last_keyword = $keyword;
  81     }
  82 }
  83
  84 my $root = '.';
  85 $root = &realpath($root);
  86 print_line(*STDOUT, "root", "$root\n");
  87 my $running_test_count=0;
  88 find($find_opts, $root);
  89 while ( $running_test_count > 0 ) {
  90     &reaper;
  91 }
  92
  93 sub find_callback
  94 {
  95     if(exists($$makefiles{$_}))
  96     {
  97         my $makefile = $_;
  98         my $reldir = $File::Find::dir;
  99         $reldir =~ s|^$root/||;
 100
 101         my $cmd = [ "make" ];
 102
 103         my $arg; foreach $arg (@ARGV) { push @$cmd, $arg; } # better way to do this?
 104
 105         $ENV{UNIT_TEST_NAME} = $reldir;
 106         my $pid = fork();
 107         if (not defined $pid) {
 108             die "Couldn't fork"
 109         }
 110         elsif ($pid == 0) {
 111             # Child. Redirect stdout/stderr to files and exec test.
 112             open(STDOUT, ">/tmp/unit-tests-stdout.$PID") || die("$!");
 113             open(STDERR, ">/tmp/unit-tests-stderr.$PID") || die("$!");
 114             exec 'make', @ARGV;
 115             exit(-1);    #just to be sure
 116         }
 117
 118         # Write the test cwd/cmd to a temporary file associated with the child's pid, to be retrieved later.
 119         my $info;
 120         open($info, ">/tmp/unit-tests-info.$pid") || die("$!");
 121         &print_line($info, "cwd", "\$root/$reldir\n"); # post filtering depends on this line being first
 122         &print_line($info, "cmd", "@$cmd\n");
 123         close($info) || die("$!");
 124
 125         $running_test_count++;
 126         # if we have reached max # of concurrent tests, wait for one to exit
 127         if ( $running_test_count == $max_concurrent_tests ) {
 128             &reaper;
 129         }
 130     }
 131 }
 132
 133 sub reaper {
 134         if ( $running_test_count > 0 ) {
 135                 my $pid = wait;
 136         if ( $pid == -1 ) {
 137             die("no child\n");
 138         }
 139         my $exit = $?;
 140
 141                 $running_test_count--;
 142
 143                 open(INFO, "</tmp/unit-tests-info.$pid") || die("$!");
 144                 while(<INFO>)
 145                 {
 146             print $_;
 147                 }
 148                 close(INFO) || die("$!");
 149                 unlink("/tmp/unit-tests-info.$pid");
 150
 151         &print_line(*STDOUT, "exit", "$exit\n");
 152
 153                 open(OUT, "</tmp/unit-tests-stdout.$pid") || die("$!");
 154                 while(<OUT>)
 155                 {
 156                     &print_line(*STDOUT, "stdout", "$_");
 157                 }
 158                 close(OUT) || die("$!");
 159                 unlink("/tmp/unit-tests-stdout.$pid");
 160
 161                 open(ERR, "</tmp/unit-tests-stderr.$pid") || die("$!");
 162                 while(<ERR>)
 163                 {
 164                     &print_line(*STDOUT, "stderr", "$_");
 165                 }
 166                 close(ERR) || die("$!");
 167                 unlink("/tmp/unit-tests-stderr.$pid");
 168         }
 169 }
 170