Skip to content
Snippets Groups Projects
Commit c8ff8e55 authored by Izzard, Robert Dr (Maths & Physics)'s avatar Izzard, Robert Dr (Maths & Physics)
Browse files

update test_random to be better and show the PID of the valground processes

parent 3c8ab2e3
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
test_random.pl → src/perl/scripts2/test_random.pl
+ 86
− 35
View file @ c8ff8e55
#!/usr/bin/env perl
$|=1;
use strict;
use IO::Select;
use rob_misc;
......@@ -11,6 +12,7 @@ use Term::ReadKey;
use Term::ANSIScreen qw(cls :cursor);
use Text::ANSITable;
binmode(STDOUT, ":utf8");
use Time::HiRes qw/sleep/;
use Term::ANSIColor;
#
......@@ -20,6 +22,12 @@ use Term::ANSIColor;
# which is a little slow.
#
my %colours = (
'cyan' => color('bright_cyan'),
'yellow' => color('bright_yellow'),
'red' => color('bright_red'),
'reset' => color('reset')
);
my ($wchar, $hchar, $wpixels, $hpixels) = GetTerminalSize();
my $args = "@ARGV";
......@@ -33,24 +41,29 @@ my $logtimes = ($args=~/logtimes/) ? 1 : 0;
my $ignore_time = ($args=~/ignore_time=(\S+)/)[0] // 2.0; # do not log time if < this
my $exit_on_error = ($args=~/exit_on_error/) // 0;
my $newlogs = ($args=~/newlogs/) ? 1 : 0;
my $errorlogdir = ($args=~/errorlogdir=(\S+)/)[0] // '/tmp/binary_c_errorlogs';
mkdirhier($errorlogdir);
my $opener = $newlogs ? '>' : '>>';
open(my $log,$opener,"$ENV{HOME}/binary_c_test_random.log")||die;
open(my $logtimes_file,$opener,"$ENV{HOME}/binary_c_test_random.logtimes")||die;
my $locklog :shared;
$log->autoflush(1);
my $errorcount : shared;
$errorcount = 0;
my @screenlog : shared;
my $settle = ($args=~/(settle)/)[0] // 10; # wait this many seconds before output
my $sleeptime = ($args=~/sleeptime=(\S+)/)[0] // 0.25; # number of s to wait between checking for binary_c output
my $sleeptime = ($args=~/sleeptime=(\S+)/)[0] // 0.25; # number of s to wait between checking for binary_c output
my $updatetime = ($args=~/updatetime=(\S+)/)[0] // 1.0; # time between screen updates
my $twarn = ($args=~/twarn=(\S+)/)[0] // 180.0; # warn if no output for this time
my $warn_every = ($args=~/warn_every=(\S+)/)[0] // 10.0; # warn every this many seconds
my $n_binary_c_threads = ($args=~/threads=cpu/i) ? (rob_misc::ncpus()-1) : ($args=~/threads=(\d+)/)[0] // 1;
my $nstore = ($args=~/nstore=(\d+)/)[0] // 1000;# store this many lines of output
print "Options :
print "Options :
valgrind $valgrind
nice : $nice
timeout : $timeout
repeat : $repeat
repeat : $repeat
logtimes : $logtimes
ignore_time : $ignore_time
settle : $settle
......@@ -70,8 +83,6 @@ my $q = robqueue->new(
);
my $tsincewarn = 0;
while(1)
{
$q->q(1);
......@@ -82,19 +93,23 @@ $q->end();
sub runsystem
{
my $n = shift;
my $pid = 0;
if($n==0)
{
# first thread
# first thread
sleep 1;
while(1)
{
sleep 1;
sleep $updatetime;
outscreenlog();
}
}
else
{
my $s = IO::Select->new();
my $cmd = "stdbuf -i 0 -e 0 -o 0 $nice $timeout tbse $valgrind --repeat $repeat --random_systems 1 --log_filename /tmp/c_log-$n.dat 2>\&1 ";
my $cmd = "env VALGRIND_ARGS=\"--log-file=/dev/stdout\" stdbuf -i 0 -e 0 -o 0 $nice $timeout tbse $valgrind --repeat $repeat --random_systems 1 --log_filename /tmp/c_log-$n.dat 2>&1 ";
#print "CMD \n$cmd\n";
my $args;
my $logfile = "/tmp/binary_c_test_random_log.$n";
open(my $outlog,'>',$logfile)||confess("cannot open $logfile for output");
......@@ -107,13 +122,16 @@ sub runsystem
my $tsincewarn = $warn_every;
while(defined $f && $f)
{
my $haveset = 0;
my @can = $s->can_read(0.25);
#print localtime(),"Can ? ",scalar @can," \x0d";
if(scalar @can)
{
my $l = <$f>;
#print "L: $l";
if(!defined $l)
{
# EOF : command has finished
# EOF : command has finished
close $f;
$f = undef;
}
......@@ -121,7 +139,7 @@ sub runsystem
{
# line of data : process
print {$outlog} $l;
push(@r,$l);
# if we've exceeded the number of saved lines, remove the top one
......@@ -129,11 +147,16 @@ sub runsystem
{
shift @r;
}
if($l=~/(--M_1.*)/g)
{
$args = $1;
setlog($n,$tsince,"$args\n");
setlog($n,$tsince,$pid,"$args\n");
$haveset = 1;
}
elsif($l=~/==(\d+)==/)
{
$pid = $1;
}
elsif($l=~/runtime\s+=\s+(\S+)/)
{
......@@ -142,7 +165,7 @@ sub runsystem
{
state $logtimes_lock : shared;
printf {$logtimes_file} "%s %s\n",
$runtime,
$runtime,
$args;
}
}
......@@ -152,37 +175,55 @@ sub runsystem
else
{
$tsince += $sleeptime;
if($tsince >= $twarn)
{
if($tsincewarn >= $warn_every )
{
$tsincewarn = 0;
setlog($n,$tsince,"Warning : thread $n has had no output for $tsince seconds\n");
setlog($n,
$tsince,
$pid,
"Warning : thread $n has had no output for $tsince seconds\n");
$haveset = 1;
}
else
{
$tsincewarn += $sleeptime;
$tsincewarn += $sleeptime;
}
}
}
if(!$haveset)
{
setlog($n,$tsince,$pid,"$args\n");
}
}
close $f if(defined $f);
my $status = $?;
setlog($n, 0, "thread $n finished with status $status\n");
setlog($n, 0, $pid, "thread $n finished with status $status\n");
my $r = join("\n",@r);
if($status!=0 ||
$r =~ /Exit\ binary/ ||
$r =~ /action on error/ ||
$r =~ /jump or move depends on uninit/ ||
$r =~ /definitely lost/)
$r =~ /definitely lost/ ||
#$r =~/vgdb me/||
$r =~/SIGSEGV/)
{
my $file = '/tmp/test_random_error'.$n.'.out';
print "Error on thread $n (see $file)\n\n$args\n\n";
dumpfile($file,$r);
print {$log} "\n# Error on thread $n :\n# $args\n\n";
# dump to the errorlogdir also
if(defined $errorlogdir)
{
lock $locklog;
$file = "$errorlogdir/$errorcount.log";
print {$log} "\n# Error on thread $n (count $errorcount) :\n# $args\n\n";
dumpfile($file,$r);
$errorcount++;
}
if($exit_on_error)
{
exit(0);
......@@ -202,14 +243,10 @@ sub memuse
if($t > $first)
{
$mem = mem_usage(1,$$,1);
if($mem!=$prev)
{
printf "MEM %s MB\n",$mem;
}
if(!defined $prev || $mem>$prev)
{
lock $locklog;
printf {$log} "%s %s\n",time(),$mem;
printf {$log} "MEM %s %s %s\n",time(),$mem,scalar localtime();
$prev = $mem;
}
}
......@@ -232,27 +269,42 @@ sub setlog
{
# set log grid string
state $setlog_lock : shared;
lock $setlog_lock;
my ($n, $tsince, $s) = @_;
lock $setlog_lock;
my ($n, $tsince, $pid, $s) = @_;
chomp $s;
$screenlog[$n] = shared_clone([$tsince,$s]);
my $colour =
$tsince >= 5.0 ? $colours{'red'} :
$tsince >= 1.0 ? $colours{'yellow'} :
$colours{'cyan'};
my $tstring = sprintf '%s%6.2f',
$colour,
$tsince;
$screenlog[$n] = shared_clone([$tstring,$pid,$s]);
}
sub outscreenlog
{
# output log grid to screen
state $setlog_lock : shared;
lock $setlog_lock;
lock $setlog_lock;
my $h = 'test_random.pl '.$args.' : '.sprintf("%s",memuse()//'unknown');
my $t = Text::ANSITable->new;
$t->border_style('Default::bold'); # if not, a nice default is picked
$t->columns(["Thread","Tsince","Status"]);
#$t->border_style('Default::bold'); # if not, a nice default is picked
$t->border_style('UTF8::Brick');
$t->columns(["Thread","Tsince","PID","Status"]);
$t->set_column_style('Status',wrap=>0);
for(my $i=1;$i<=$#screenlog;$i++)
if(defined $screenlog[1])
{
$t->add_row([$i,$screenlog[$i]->[0],substr($screenlog[$i]->[1],0,$wchar-30)]);
for(my $i=1;$i<=$#screenlog;$i++)
{
$t->add_row([
$i,
$screenlog[$i]->[0],
$screenlog[$i]->[1],
substr($screenlog[$i]->[2],0,$wchar-30)]);
}
print cls(),locate(0,0),$h,"\n",$t->draw();
}
print cls(),locate(0,0),$h,"\n",$t->draw();
}
sub check_ps
......@@ -265,4 +317,3 @@ sub check_ps
exit;
}
}
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment