#!/usr/bin/perl -w
# $Id: tbrun 1097 2018-12-29 11:20:14Z mueller $
#
# Copyright 2016-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
#
# This program is free software; you may redistribute and/or modify it under
# the terms of the GNU General Public License as published by the Free
# Software Foundation, either version 3, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY, without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for complete details.
#
#  Revision History:
# Date         Rev Version  Comment
# 2018-12-29  1097   1.1.2  show correct 'found count' in summary message
# 2018-11-16  1069   1.1.1  add --all
# 2018-11-09  1066   1.1    add and use bailout; update exit code usage
# 2017-04-15   875   1.0.1  add --help option
# 2016-09-17   808   1.0    Initial version
# 2016-08-09   796   0.1    First draft
#

use 5.14.0;                                 # require Perl 5.14 or higher
use strict;                                 # require strict checking

use Getopt::Long;
use FileHandle;
use YAML::XS;
use Cwd;
use IO::Select;
use Time::HiRes qw(gettimeofday);

my %opts = ();

GetOptions(\%opts, "tag=s@", "exclude=s@", "mode=s", "all",
           "jobs=i", "tee=s", "tmax=i", "dry", "trace",
           "nomake", "norun",
           "rlmon", "rbmon", "bwait=i", "swait=i",
           "help"
          )
  or bailout("bad command options");

my @tlist;
my @olist;
my @wlist;


my %keys_include = ( include => { mode => 'm', ref => ''},
                     tag     => { mode => 'o', ref => 'ARRAY'}
                   );
my %keys_default = ( default => { mode => 'm', ref => 'HASH'}
                   );
my %keys_defhash = ( tag     => { mode => 'o', ref => 'ARRAY'},
                     mode    => { mode => 'o', ref => ''}
                   );
my %keys_itest   = ( test    => { mode => 'm', ref => ''},
                     tag     => { mode => 'o', ref => 'ARRAY'},
                     mode    => { mode => 'o', ref => ''}
                   );

my $nseen = 0;
my $ntest = 0;
my $ndone = 0;
my $nfail = 0;
my $inicwd = getcwd();
my %gblvars;

$gblvars{ise_modes} = '[bsft]sim,ISim_[bsft]sim';
$gblvars{ise_modes_noisim} = '[bsft]sim';             # when ISim not possible
$gblvars{ise_modes_nossim} = 'bsim,ISim_bsim';        # when ssim not available
#
$gblvars{viv_modes} = '[bsor]sim,XSim_[bsorept]sim';
$gblvars{viv_modes_nossim} = 'bsim,XSim_bsim';        # when ssim not available

if ($opts{help}) {
  print_usage();
  exit 0;
}

autoflush STDOUT 1 if -p STDOUT || -t STDOUT;
my $ticker_on = -t STDOUT;

my $fh_tee;
if (defined $opts{tee} && $opts{tee} ne '') {
  $fh_tee = new FileHandle;
  $fh_tee->open($opts{tee},'>')
    or bailout("failed to open for write '$opts{tee}': $!");
}

if ($opts{all}) {
  bailout("-all not compatible with --tag options") if  defined $opts{tag};
  $opts{tag}  = ['.*']
}

$opts{tag}  = ['default'] unless defined $opts{tag};
$opts{mode} = 'bsim'      unless defined $opts{mode};

my %modecache;
my @modelist;
foreach (split /,/,$opts{mode}) {
  $_ .= '_bsim' if m/^[IX]Sim$/;
  push @modelist, $_;
}

push @ARGV, 'tbrun.yml' unless scalar( @ARGV);

my @tagincl = setup_tagfilter($opts{tag});
my @tagexcl = setup_tagfilter($opts{exclude});

foreach my $fnam (@ARGV) {
  include_file($fnam);
}

$ntest = scalar(@tlist);
unless ($ntest) {
  tpre(sprintf "tbrun-E: %d tests found, none selected\n", $nseen);
  exit 1;
}

if (defined $opts{jobs}) {
  run_tests_multi();
} else {
  run_tests_single();
}

if (defined $opts{dry}) {
  tpr(sprintf "#tbrun-I: %d tests found, %d selected\n", $nseen,$ntest);
} else {

  if ($nfail) {
    tpr(sprintf "tbrun-I: %d tests failed of %d tests executed\n",$nfail,$ndone);
  } else {
    tpr(sprintf "tbrun-I: all tests passed, %d tests selected from %d found\n",
        $ndone,$nseen);
  }
}

exit ($nfail ? 2 : 0);

#-------------------------------------------------------------------------------
sub setup_tagfilter {
  my ($targlist) = @_;
  return () unless defined $targlist;
  my @tagfiltlist;
  foreach my $targ (@$targlist) {
    my @tagfilt = map { "^($_)\$" } split /,/, $targ;
    push @tagfiltlist, \@tagfilt;
  }
  return @tagfiltlist;
}

#-------------------------------------------------------------------------------
sub check_tagfilter {
  my ($tfiltlist,$tlist) = @_;
  foreach my $tfilt (@$tfiltlist) {         # loop over filters
    my $fok = 1;
    foreach my $tfele (@$tfilt) {           # loop over filter elements
      my $match = 0;
      foreach my $tag (@$tlist) {           # loop over tags
        $match = $tag =~ m/$tfele/;         # tag matchs filter element
        last if $match;
      }
      $fok = 0 unless $match;               # filter missed if one element missed
    }
    return 1 if $fok;                       # return ok of one filter matched
  }
  return 0;                                 # here if no filter matched
}

#-------------------------------------------------------------------------------
sub check_modefilter {
  my ($mode,$mlist) = @_;
  unless (exists $modecache{$mlist}) {
    my %mh;
    foreach my $mi (split /,/,$mlist) {
      if ($mi =~ m/^(.*)\[([a-z]+)\](.*)$/) {
        foreach (split //,$2) {
          $mh{$1.$_.$3} = 1;
        }
      } else {
        $mh{$mi} = 1;
      }
    }
    $modecache{$mlist} = \%mh;
  }

  my $rmh = $modecache{$mlist};
  return exists $$rmh{$mode};
}

#-------------------------------------------------------------------------------
sub include_file {
  my ($fnam) = @_;
  my $fdat = read_file($fnam);
  exit 1 unless defined $fdat;
  my $ylst = load_yaml($fdat, $fnam);
  exit 1 unless defined $ylst;

  my $oldcwd = getcwd();

  if ($fnam =~ m|^(.*)/(.*)$|) {
    chdir $1 or bailout("chdir to '$1' failed with '$!'");
  }

  my %defhash;
  foreach my $yele (@$ylst) {
    if (exists $yele->{include}) {
      handle_include($yele);
    } elsif (exists $yele->{default}) {
      handle_default($yele, \%defhash);
    } elsif (exists $yele->{test}) {
      handle_itest($yele, \%defhash);
    } else {
      tpr(sprintf "tbrun-E: unknown list element in '%s'\n  found keys: %s\n",
            $fnam, join(',',sort keys %$yele));
      exit 1;
    }
  }

  chdir $oldcwd or bailout("chdir to '$oldcwd' failed with '$!'");
  return;
}

#-------------------------------------------------------------------------------
sub read_file {
  my ($fnam) = @_;
  my $fh = new FileHandle;
  if (not open $fh, '<', $fnam) {
    my $err = $!;
    tpre(sprintf "tbrun-E: failed to open '%s'\n  cwd: %s\n  error: %s\n",
           $fnam, getcwd(), $err);
    return undef;
  }
  # nice trick to slurp the whole file into a variable
  my $fdat = do {
    local $/ = undef;
    <$fh>;
  };
  close $fh;
  return $fdat;
}

#-------------------------------------------------------------------------------
sub load_yaml {
  my ($fdat,$fnam) = @_;
  my $ylst;
  eval { $ylst = YAML::XS::Load($fdat); };
  if ($@ ne '') {
    my $err = $@;
    tpre(sprintf "tbrun-E: failed to yaml load '%s'\n  cwd: %s\n  error: %s\n",
           $fnam, getcwd(), $err);
    return undef;
  }
  if (ref $ylst ne 'ARRAY') {
    tpre(sprintf "tbrun-E: top level yaml is not a list but '%s'\n", ref $ylst);
    return undef;
  }
  foreach my $yele (@$ylst) {
    if (ref $yele ne 'HASH') {
      tpre(sprintf "tbrun-E: second level yaml is not a hash '%s'\n", ref $yele);
      return undef;
    }
  }
  return $ylst;
}

#-------------------------------------------------------------------------------
sub check_keys {
  my ($yele, $href) = @_;
  foreach my $keyele ( keys %$yele ) {
    if (not exists $href->{$keyele}) {
      tpre(sprintf "tbrun-E: unexpected key '%s'\n", $keyele);
      return 0;
    }
    my $ref = ref $yele->{$keyele};
    if ($ref ne $href->{$keyele}->{ref}) {
      tpre(sprintf "tbrun-E: key '%s' is type'%s', expected '%s'\n",
             $keyele, $ref, $href->{$keyele}->{ref});
      return 0;
    }
  }
  foreach my $keyref ( keys %$href ) {
    next if $href->{$keyref}->{mode} eq 'o';
    if (not exists $yele->{$keyref}) {
      tpre(sprintf "tbrun-E: key '%s' missing\n", $keyref);
      return 0;
    }
  }
  return 1;
}

#-------------------------------------------------------------------------------
sub lookup_var {
  my ($vnam,$hrefs) = @_;
  return $gblvars{$vnam} if exists $gblvars{$vnam};
  if ($vnam =~ m/[A-Z][A-Z0-9_]*/) {
    return $ENV{$vnam} if exists $ENV{$vnam};
  }
  tpre(sprintf "tbrun-E: can't replace '$vnam'\n");
  exit 1;
}

#-------------------------------------------------------------------------------
sub expand_vars {
  my ($txt,$hrefs) = @_;
  my $res = '';
  while ($txt ne '') {
    if ($txt =~ m/\$\{([a-zA-Z][a-zA-Z0-9_]*)\}/) {
      my $vnam = $1;
      my $vrep = lookup_var($vnam, $hrefs);
      $res .= $`;
      $res .= $vrep;
      $txt  = $';
    } else {
      $res .= $txt;
      last;
    }
  }
  return $res;
}

#-------------------------------------------------------------------------------
sub merge_lines {
  my ($txt) = @_;
  $txt =~ s|\s*\\\n\s*| |mg;
  chomp $txt;
  return $txt;
}

#-------------------------------------------------------------------------------
sub merge_expand {
  my ($txt,$hrefs) = @_;
  return expand_vars(merge_lines($txt), $hrefs);
}

#-------------------------------------------------------------------------------
sub key_or_def {
  my ($tag,$yele,$defhash) = @_;
  return $yele->{$tag}    if exists $yele->{$tag};
  return $defhash->{$tag} if exists $defhash->{$tag};
  return undef;
}

#-------------------------------------------------------------------------------
sub handle_include {
  my ($yele) = @_;
  check_keys($yele, \%keys_include) or exit 1;

  my $fnam = merge_expand($yele->{include}, undef);
  include_file($fnam);

  return;
}

#-------------------------------------------------------------------------------
sub handle_default {
  my ($yele, $defhash) = @_;
  check_keys($yele, \%keys_default) or exit 1;
  check_keys($yele->{default}, \%keys_defhash) or exit 1;
  foreach my $key (keys %{$yele->{default}}) {
    $$defhash{$key} = $$yele{default}{$key};
  }
  return;
}

#-------------------------------------------------------------------------------
sub handle_itest {
  my ($yele, $defhash) = @_;
  check_keys($yele, \%keys_itest) or exit 1;

  $nseen += 1;

  my $tlist = key_or_def('tag', $yele, $defhash);
  if (defined $tlist) {
    return unless check_tagfilter(\@tagincl, $tlist);
    return     if check_tagfilter(\@tagexcl, $tlist);
  }

  my $mlist = merge_expand(key_or_def('mode', $yele, $defhash), undef);

  foreach my $mode (@modelist) {
    next unless check_modefilter($mode, $mlist);

    my $ms = '_' . $mode;
    $ms =~ s/_bsim$//;
    $gblvars{ms} = $ms;

    my $test = merge_expand($yele->{test}, undef);

    # forward options for tbrun_tbw or tbrun_tbwrri commands
    if ($test =~ m/^\s*(tbrun_tbw|tbrun_tbwrri)\s+(.*)$/) {
      my $cmd  = $1;
      my $rest = $2;
      $test  = $cmd;
      $test .= ' --nomake' if $opts{nomake};
      $test .= ' --norun'  if $opts{norun};
      if ($cmd eq 'tbrun_tbwrri') {
        $test .= ' --rlmon' if $opts{rlmon};
        $test .= ' --rbmon' if $opts{rbmon};
        $test .= ' --bwait '.$opts{bwait} if $opts{bwait};
        $test .= ' --swait '.$opts{swait} if $opts{swait};
      }
      $test .= ' ' . $rest;
    }

    my $tid  = scalar(@tlist);
    my $tmsg = sprintf "t%03d - tags: ", $tid;
    $tmsg .= join ',',@$tlist if defined $tlist;

    my %titem;
    $titem{id}   = $tid;
    $titem{cd}   = getcwd();
    $titem{test} = $test;
    $titem{tag}  = $tlist;
    $titem{tmsg} = $tmsg;

    push @{$titem{locks}}, $titem{cd};

    push @tlist, \%titem;

    delete $gblvars{ms};
  }

  return;
}

#-------------------------------------------------------------------------------
sub tpr {
  my ($txt) = @_;
  print $txt;
  print $fh_tee $txt if defined $fh_tee;
  return;
}

#-------------------------------------------------------------------------------
sub tpre {
  my ($txt) = @_;
  print STDERR $txt;
  print $fh_tee $txt if defined $fh_tee;
  return;
}

#-------------------------------------------------------------------------------
sub max {
  my ($a,$b) = @_;
  return ($a > $b) ? $a : $b;
}

#-------------------------------------------------------------------------------
sub open_job_fh {
  my ($cmd) = @_;
  my $fh = new FileHandle;

  # add STDERR->STDOUT redirect (create sub shell of needed)
  $cmd = '(' . $cmd . ')' if  $cmd =~ m/\n/g;
  $cmd .= ' 2>&1';

  # open returns pid of created process in case an in or out pipe is created
  my $pid = open $fh, '-|', $cmd;
  # print "+++1 $pid\n";

  if (not $pid) {
    my $err = $!;
    my $msg = sprintf "tbrun-E: failed to start '%s'\n  cwd: %s\n  error: %s\n",
                $cmd, getcwd(), $err;
    return (undef, undef, $msg);
  }
  return ($fh, $pid, undef);
}

#-------------------------------------------------------------------------------
sub run_tests_single {
  my $drycd = '';
  foreach my $titem (@tlist) {
    my $cdir = $titem->{cd};
    my $test = $titem->{test};

    chdir $inicwd or bailout("chdir to '$inicwd' failed with '$!'");

    if ($opts{dry}) {
      if ($cdir ne $drycd) {
        tpr("#------------------------------------------------------------\n");
        tpr("cd $cdir\n");
        $drycd = $cdir;
      }
      tpr("#----------------------------------------\n");
      tpr("# $titem->{tmsg}\n");
      tpr("$test\n");

    } else {
      tpr("#----------------------------------------\n");
      tpr("# $titem->{tmsg}\n");
      $ndone += 1;
      my $cmd = '';
      $cmd .= "cd $cdir";
      $cmd .= "\n";
      $cmd .= "$test";

      my ($fh,$pid,$msg) = open_job_fh($cmd);
      if (not defined $fh) {
        tpre($msg);
      } else {
        while (<$fh>) {
          print $_;
        }
        if (not close $fh) {
          my $err = $?;
          tpr(sprintf "tbrun-I: test FAILed with exit status %d,%d\n",
                ($err>>8), ($err&0xff));
          $nfail += 1;
        }
      }
    }
  }

  if ($opts{dry}) {
    tpr("#------------------------------------------------------------\n");
    tpr(sprintf "cd %s\n", $inicwd);
  }

  return;
}

#-------------------------------------------------------------------------------
sub print_ticker {
  return unless $ticker_on;

  my ($rwlist) = @_;
  my $msg = '';
  state $lastlength = 0;

  if (defined $rwlist) {
    my $time_now = gettimeofday();
    $msg = '#-I: ' . join '; ', map {
      sprintf('t%03d: %dl %3.1fs',
              $_->{id}, $_->{nlines}, $time_now-$_->{tstart})
      } @$rwlist;
    $msg = substr($msg,0,75) . ' ...' if  length($msg)  >79;
    unless (defined $opts{trace}) {
      my $suff = sprintf '(%dt,%dw,%do)',
                 scalar(@tlist), scalar(@wlist), scalar(@olist);
      if (length($suff) + length($msg) + 1 <= 79) {
        $msg .= ' ' . $suff;
      } else {
        $msg  = substr($msg,0,79-6-length($suff)) . ' ... ' . $suff;
      }
    }
  }
  my $newlength = length($msg);
  $msg .= ' ' x ($lastlength - $newlength) if $lastlength > $newlength;
  print $msg . "\r";
  $lastlength = $newlength;
  return;
}

#-------------------------------------------------------------------------------
sub print_jobs {
  while (defined $olist[0]->{exitcode}) {
    print_ticker();
    my $titem = shift @olist;
    tpr("#----------------------------------------\n");
    tpr("# $titem->{tmsg}\n");
    tpr($titem->{out});
  }
  return;
}

#-------------------------------------------------------------------------------
sub print_trace {
  my ($titem) = @_;
  my $pref = '';
  my $suff = sprintf '(%dt,%dw,%do)',
               scalar(@tlist), scalar(@wlist), scalar(@olist);
  if (defined $titem->{exitcode}) {
    $pref = ($titem->{exitcode}==0) ? 'pass ' : 'FAIL ';
  } else {
    $pref = 'start';
  }
  my $txt = '#-I: ' . $pref . ' ' . $titem->{tmsg};
  $txt .= ' ' . $suff;
  $txt .= "\n";
  print_ticker();
  tpr($txt);
  return;
}

#-------------------------------------------------------------------------------
sub start_jobs {

  # initialize lock hash
  my %locks;
  foreach my $titem (@wlist) {
    foreach my $lock (@{$titem->{locks}}) {
      $locks{$lock} = 1;
    }
  }

  # look for suitable tasks
  for (my $i=0; $i < scalar(@tlist) && scalar(@wlist) < $opts{jobs}; ) {
    my $titem = $tlist[$i];
    my $nlock = 0;
    foreach my $lock (@{$titem->{locks}}) {
      if ($locks{$lock}) {
        $nlock += 1;
        last;
      }
    }

    # suitable task found
    if ($nlock == 0) {
      my $cdir = $titem->{cd};
      my $test = $titem->{test};
      $ndone += 1;

      my $cmd = '';
      if ($opts{dry}) {
        $cmd .= "cd $cdir";
        $cmd .= "\n";
        $cmd .= "perl -e 'select(undef, undef, undef, 0.2+1.6*rand( 1.))'";
        $cmd .= "\n";
        $cmd .= "echo \"cd $cdir\"";
        $cmd .= "\n";
        $cmd .= "echo \"$test\"";
      } else {
        $cmd .= "cd $cdir";
        $cmd .= "\n";
        $cmd .= "$test";
      }

      # start job
      my ($fh,$pid,$msg) = open_job_fh($cmd);
      if (not defined $fh) {
        $titem->{out} = $msg;
        $titem->{exitcode} = 1;
        print_trace($titem) if $opts{trace};
        print_jobs();
      } else {
        $titem->{fh}     = $fh;
        $titem->{fd}     = fileno($fh);
        $titem->{pid}    = $pid;
        $titem->{out}    = '';
        $titem->{tstart} = gettimeofday();
        $titem->{nlines} = 0;
        push @wlist, $titem;
        foreach my $lock (@{$titem->{locks}}) {
          $locks{$lock} = 1;
        }
        print_trace($titem) if $opts{trace};
      }
      splice @tlist, $i, 1;                   # remove from tlist
      next;                                   # and re-test i'th list element
    } # if ($nlock == 0)

    $i += 1;                                # inspect nexyt list element
  } # for (my $i=0; ...
  return;
}

#-------------------------------------------------------------------------------
sub kill_job {
  my ($titem, $trun) = @_;
  my $pid  = $titem->{pid};
  my $pgid = getpgrp(0);
  my %phash;

  $titem->{killed} = $trun;

  # get process tree data (for whole user, no pgid filtering possible
  my $rank = 0;
  open PS,"ps -H -o pid,ppid,pgid,comm --user $ENV{USER}|";
  while (<PS>) {
    chomp;
    next unless m/^\s*(\d+)\s+(\d+)\s+(\d+)\s(.*)$/;
    my $cpid  = $1;
    my $cppid = $2;
    my $cpgid = $3;
    my $cargs = $4;
    next unless $cpgid == $pgid;            # only current process group
    next if $cargs =~ m/^\s*ps\s*$/;        # skip the 'ps' process itself
    $phash{$cpid}->{ppid} = $cppid;
    $phash{$cpid}->{pgid} = $cpgid;
    $phash{$cpid}->{args} = $cargs;
    $phash{$cpid}->{rank} = $rank++;
    push @{$phash{$cppid}->{childs}}, $cpid;
  }
  close PS;

  # sanity check 1: own tbrun process should be included
  unless (exists $phash{$$}) {
    print_ticker();
    printf "-E: tmax kill logic error: tbrun master pid not in phash\n";
    return;
  }
  # sanity check 2: job to be killed should be child of master tbrun
  unless ($phash{$pid}->{ppid} == $$) {
    print_ticker();
    printf "-E: tmax kill logic error: job not child of tbrun\n";
    return;
  }

  # determine number of leading blanks in master tbrun line
  my $nstrip = 0;
  $nstrip = length($1) if ($phash{$$}->{args} =~ m/^(\s*)/);

  # recursively mark all childs of job master
  my @pids = ($pid);
  while (scalar(@pids)) {
    my $cpid = shift @pids;
    if (not exists $phash{$cpid}) {
      print_ticker();
      printf "-E: tmax kill logic error: child pid not in phash\n";
      return;
    }
    $phash{$cpid}->{kill} = 1;
    if (exists $phash{$cpid}->{childs}) {
      push @pids, @{$phash{$cpid}->{childs}};
    }
  }

  # build list of pid to be killed, and trace message
  my @kpids;
  my @ktext;
  foreach my $cpid (sort {$phash{$a}->{rank} <=> $phash{$b}->{rank} }
                    grep {$phash{$_}->{kill}}
                    keys %phash) {
    push @kpids, $cpid;
    push @ktext, sprintf "#    %6d %6d %6d %s",
      $cpid, $phash{$cpid}->{ppid},
        $phash{$cpid}->{pgid},
        substr($phash{$cpid}->{args}, $nstrip);
  }

  # print trace message, if selected
  if ($opts{trace}) {
    print_ticker();
    printf "#-I: kill  t%03d after %3.1fs, kill proccesses:\n",
      $titem->{id}, $trun, join("\n");
    print  "#       pid   ppid   pgid   command\n";
    print  join("\n",@ktext) . "\n";
  }

  # and finally kill all processes of the job
  kill 'TERM', @kpids;

  return;
}

#-------------------------------------------------------------------------------
sub run_tests_multi {
  @olist = @tlist;

  while (scalar(@tlist) || scalar(@wlist)) { # while something to do
    # start new jobs, if available and job slots free
    start_jobs();

    my @fhlist = map { $_->{fh} } @wlist;
    my %fdhash;
    foreach my $titem (@wlist) {
      $fdhash{$titem->{fd}} = $titem;
    }

    my $sel = IO::Select->new(@fhlist);
    my $neof = 0;
    my $time_ticker = gettimeofday() + 0.1;

    while ($neof == 0) {
      my $wait_ticker = max(0.1, $time_ticker - gettimeofday() + 0.1);
      my @fhlist = $sel->can_read($wait_ticker);
      my $time_now = gettimeofday();
      if ($time_now >= $time_ticker) {
        print_ticker(\@wlist);
        $time_ticker = $time_now + 0.9;
      }
      foreach my $fh (@fhlist) {
        my $fd = fileno($fh);
        my $titem = $fdhash{$fd};
        my $buf = '';
        my $nb = sysread $fh, $buf, 1024;

        # data read
        if ($nb) {
          $titem->{out}    .= $buf;
          $titem->{nlines} += ($buf =~ tr/\n/\n/); # count \n in $buf

        # eof or error
        } else {
          if (defined $titem->{killed}) {
            $titem->{out} .= sprintf
              "tbrun-I: test killed after %3.1fs\n", $titem->{killed};
          }
          if (not close $fh) {
            my $err = $?;
            $titem->{out} .= sprintf
              "tbrun-I: test FAILed with exit status %d,%d\n",
                ($err>>8), ($err&0xff);
            $nfail += 1;
            $titem->{exitcode} = $err;
          } else {
            $titem->{exitcode} = 0;
          }

          $neof += 1;
          for (my $i=0; $i < scalar(@wlist); $i++) {
            next unless $wlist[$i]->{fd} == $fd;
            splice @wlist, $i, 1;
            last;
          }
          print_trace($titem) if $opts{trace};
        }
      } # foreach my $fh ...

      # handle tmax
      if (defined $opts{tmax}) {
        foreach my $titem (@wlist) {
          my $trun = $time_now - $titem->{tstart};
          if ($trun > $opts{tmax}) {
            kill_job($titem, $trun) unless defined $titem->{killed};
          }
        }
      }

    } # while ($neof == 0)
    # here if at least one job finished
    print_jobs();
  }

  return;
}

# ----------------------------------------------------------------------------
sub bailout {
  my ($msg) = @_;
  print STDERR "tbrun-F: $msg\n";
  exit 1;
}

# ----------------------------------------------------------------------------
sub print_usage {
  print "usage: tbrun [options] [dcsfile]\n";
  print "  --tag=<tlist>      list of tags to run (def='default')\n";
  print "  --exclude=<tlist>  tag combinations to exclude\n";
  print "  --mode=<mlist>     list of modes to run\n";
  print "  --jobs=<njob>      number of parallel jobs (def=1)\n";
  print "  --tee=<ofile>      addition logfile for al stdout output\n";
  print "  --dry              dry run, prints only the generated commands\n";
  print "  --trace            prints additional information on job control\n";
  print "  --nomake           don't execute make step of test bench\n";
  print "  --norun            don't execute run step of test bench\n";
  print "  --rlmon            enable the rlink monitor\n";
  print "  --rbmon            enable  the  rbus  monitor\n";
  print "  --bwait=<dt>       startup wait for behavioral simulations (in ns)\n";
  print "  --swait=<dt>       startup wait for post-* simulations (in ns)\n";
  print "  --help             print short help text\n";
  print "\n";
  print "  If no [dcsfile] is specified 'tbrun.yml' is used\n";
  return;
}