diff --git a/test_random.pl b/src/perl/scripts2/test_random.pl similarity index 66% rename from test_random.pl rename to src/perl/scripts2/test_random.pl index 44802000aa321a1bffc2b790a42e45b69944febf..c2ccef4f65d6763f6e68a37275e7528271c47200 100755 --- a/test_random.pl +++ b/src/perl/scripts2/test_random.pl @@ -1,5 +1,6 @@ #!/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; } } -