rc-p5

#!/usr/local/bin/perl
## benchmark Rosettacode programs, output and timings go in 'bench'
#c# 2018-06-30

#  Special designations
#  graphical - image output, usually tested against reference image
#  trivial - some have no tests, which is OK
#
#  Programs not tested:
#  toodamnslow - extract timings embedded in programs with:
#  nocode - have no runnable code
#  skiptest - hard to test
#  inprogress - WIP
#  interactive - requires user input
#  gui - requires windowing system (X11,Tk,GTK,SDL)
#  forever - hangs, never terminates
#  broken - hangs, never terminates

use warnings;

use Parallel::ForkManager;

# some programs to test run solo
%Solo = (
'A/Active_object' => 1,
);

chdir "$ENV{HOME}/perl5/Rosetta-Code" || die;

$dir = `date '+%Y-%m-%d'`; chomp $dir;
mkdir "bench/$dir"  if ! -e "bench/$dir";
unlink "bench/last" if   -e "bench/last";
system qq{cd bench; ln -s $dir last};

system "date";

my $skip = 'interactive|gui|toodamnslow|skiptest|inprogress|nocode|forever|broken';

# find Perl5 programs
for my $prog (@ARGV) {
    next if $prog =~ /\.(pl|[0-9])$/;
    next if $prog =~ m#/lib# || $prog =~ /^Temp-/;
    @status = `head -15 $prog`;
    next unless $status[0] =~ m#(env |bin/)perl#;
    next if grep { /^#t#.*($skip)/ } @status;
    next if grep { /^#p#.*BROKEN/i } @status;

    my($host) = `uname -a` =~ /\S+ (\S+)/;
    next if $host =~ /Mac-Pro/ && grep { /BROKEN on Mac-Pro/i } @status;
    next if $host =~ /iMac/    && grep { /BROKEN on iMac/i    } @status;
    next if $host =~ /osboxes/ && grep { /BROKEN on Ubuntu/i  } @status;

    next unless -e $prog;
    $clargs = `grep 'RC.cli' $prog`; chomp $clargs; 
    $clargs =~ s/^.*RC.cli:\s+//; 
    $clargs =~ s/"/\\"/g; 

    $precmd = `grep 'RC.prep:' $prog`; chomp $precmd; 
    $precmd =~ s/^.*RC.prep:\s+//; 
    $precmd =~ s/\s+$//;

    $pipe   = `grep 'RC.pipe:' $prog`; chomp $pipe;
    $pipe   =~ s/^.*RC.pipe:\s+//;
    $pipe   =~ s/\s+$//;
    $Pipe{$prog} =  $pipe   if $pipe   ne '';

    $difftest = `grep 'RC.file' $prog`; chomp $difftest; 
    $difftest =~ s/^.*RC.file:\s+//; 
    $difftest =~ s/\s+$//;
    $difftest =~ s/HOST/$host/;

    if (defined $Solo{$prog}) { push @P_one_at_a_time, $prog } else { push @Programs, $prog }
    $Ppre{$prog} =  $precmd if $precmd ne '';
    $Prun{$prog} =  $clargs if $clargs ne '';
    $Pfile{$prog} = $difftest if $difftest ne '';
}

for my $prog (@P_one_at_a_time) {
    my $run = $prog;
    my $exe  = 'perl';
    (my $pbase = $prog) =~ s/^..//;
    $run .= " $Prun{$prog}" if defined $Prun{$prog};

    system "$Ppre{$prog}" if defined $Ppre{$prog};
    system "bin/rc-runone '$exe $run' > bench/$dir/$pbase.out 2> bench/$dir/$pbase.err";
    system "diff -s -wb -q ref/$Pfile{$prog} run/$Pfile{$prog} >> bench/$dir/$pbase.out" if defined $Pfile{$prog};
}

# run in parallel 
my $pm = Parallel::ForkManager->new(8);
RUN:
for my $prog (@Programs) {
    $pm->start and next RUN;

    my $run = $prog;
    my $exe = 'perl';
    (my $pbase = $prog) =~ s/^..//;
    $run .= " $Prun{$prog}" if defined $Prun{$prog};

    system "$Ppre{$prog}" if defined $Ppre{$prog};

    $task = "bench/$dir/$pbase";
    if ($Pipe{$prog}) {
        $exe = qq[perl -e "print qq[$Pipe{$prog}]" | ] . $exe;
        ($u0,$s0) = cpu_time(); $r0 = (time());
        system qq{$exe $run 1> $task.out 2> $task.tmp};
        ($u1,$s1) = cpu_time(); $r1 = (time());
        if (! -z "$task.tmp") { system qq{echo '::STDERR::' >> $task.out; cat $task.tmp >> $task.out} }
        unlink "$task.tmp";
        open E, ">$task.err";
        printf E "real\t%.3f\nuser\t%.3f\nsys\t%.3f\n", 0.01+$r1-$r0, $u1-$u0, $s1-$s0;
        close E;
    } else {
        my $line1 = `head -1 $prog`;
        $exe = '/usr/local/bin/perl5.32.1' if $line1 =~ /perl5/;
        system "bin/rc-runone '$exe $run' > $task.out 2> $task.err";
    }
    system "diff -s -wb -q ref/$Pfile{$prog} run/$Pfile{$prog} >> $task.out" if defined $Pfile{$prog};

    $pm->finish;
}
$pm->wait_all_children;

# clean up
sleep 1;
system 'bin/rc-ts5';
system 'date';

sub cpu_time {
  my ($user,$system,$cuser,$csystem) = times;
  ($user+$cuser, $system+$csystem);
}