sqc

这是一个基于HMM 模型的生物多序列比对算法的linux实现版本。hmmer

    print "sqc: after path subst, cmd is: $cmd\n" if $verbose;

    # Output redirection substitution.
    # stdout is sent to /dev/null unless command already is handling it.
    # stderr is saved in a tmp file.
    # (stderr from the old cmd2 of a regression test is sent to /dev/null)
    #
    if ($cmd !~ />/) { 
	$cmd  = "$cmd  > /dev/null";
	$cmd2 = "$cmd2 > /dev/null"  if ($testtype eq "regression");
    }
    $cmd  = "$cmd  2> $tmp.stderr";
    $cmd2 = "$cmd2 2> /dev/null"     if ($testtype eq "regression");
    print "sqc: after output subst, cmd is: $cmd\n" if $verbose;

    # Run the commands and collect exit status.
    $startclock = (times)[2];
    print "sqc: running cmd: $cmd\n" if $verbose;
    system "$cmd";
    $status1 = $?;
    if ($testtype eq "regression") {
	system "$cmd2";
	$status2 = $?;
    }
    $stopclock = (times)[2];
	

    # Deal with exit status and output.
    if ($testtype eq "prep") {
	if ($status1 != 0) {
	    die "prep command at line $linenum failed with status $status1\n";
	}
    } elsif ($testtype eq "exercise") {
	if ($do_memtest) {
	    ($have_ccmalloc, $garbage) = &check_ccmalloc_status("$tmp.stderr");
	    $nmem++ if ($have_ccmalloc);
	    if ($garbage != 0) {
		print "FAILED [leak, $garbage bytes]\n";
		$badtest++;
		next;
	    }
	} elsif (($status1&255) != 0) {
	    print "FAILED [crash!]\n";
	    $badtest++;
	    next;
	} elsif (($status1>>8) != 0) {
	    $code = ($status1 >>8);
	    print "FAILED [nonzero code $code]\n";
	    $badtest++;
	    next;
	}
	print "ok.\n";
    } elsif ($testtype eq "regression") {
	if (($status1&255) != 0) {
	    print "FAILED [new crashed!]\n";
	    $badtest++;
	    next;
	} elsif (($status1>>8) != 0) {
	    $code = ($status1 >>8);
	    print "FAILED [new code $code]\n";
	    $badtest++;
	    next;
	} elsif (($status2&255) != 0) {
	    print "FAILED [old crashed!]\n";
	    $badtest++;
	    next;
	} elsif (($status2>>8) != 0) {
	    $code = ($status2 >>8);
	    print "FAILED [old code $code]\n";
	    $badtest++;
	    next;
	}
	
	system("diff $tmp.REGRESSION.1 $tmp.REGRESSION.2 > /dev/null");
	if ($? != 0) {
	    print "FAILED [regressions differ]\n";
	    $badtest++;
	    next;
	}
	print "ok.\n";
    } elsif ($testtype eq "benchmark") {
	if ($status1 != 0) {
	    die "benchmark at line $linenum failed with status $status1\n";
	}
	$elapsed = $stopclock - $startclock;
	printf "%5.1f sec\n", $elapsed;
	$tot_benchtime += $elapsed;
	$nbench++;
    } elsif ($testtype eq "fail") {
	if (($status1&255) != 0) {
	    print "FAILED [crash!]\n";
	    $badtest++;
	    next;
	} elsif (($status1>>8) == 0) {
	    print "FAILED [0 status]\n";
	    $badtest++;
	    next;
	}
	print "ok.\n";
    }
}

# Summarize output.
if ($badtest > 0) {
    print "\n$badtest of $ntest exercises at level <= $setlevel FAILED.\n";
} else {
    print "\nAll $ntest exercises at level <= $setlevel passed.\n";
}
if ($nbench > 0) {
    printf "\nTotal of %d benchmarks: %.1f sec\n", $nbench, $tot_benchtime;
}
if ($do_memtest && $nmem == 0) {
    print "warning: -m selected, but no ccmalloc reports found\n";
}

# Print info on system, date, etc.
#
print "\n\nSystem information:\n";
print `date`;
print `uname -a`;


# Clean up.
#
foreach $tmpfile (keys(%used_tmpfile)) {
    unlink $tmpfile if -e $tmpfile;
}
unlink $tmp if -e $tmp;
unlink "$tmp.stderr" if -e "$tmp.stderr";



# filename_substitution(tmpprefix, command_template)
# 
# Uses a global, %used_tmpfile, which is a hash
# that is TRUE for each tmpfile names that we'll 
# try to delete upon exit.
sub
filename_substitution
{
    my ($tmp, $com) = @_;
    my ($token, $newname);
    
    while ($com =~ /%(\S+)%/) {
	$token    = $1;
	$newname  = "$tmp.$token";
	$com =~ s/%$token%/$newname/g;
	$used_tmpfile{$newname} = 1;
    }
    return $com;
}
    
sub
regression_substitution 
{
    my ($tmp, $com) = @_;
    my ($executable, $args, $cmd1, $cmd2);
    
    ($executable, $args) = split(' ', $com, 2);
    $cmd1 = "$executable --regress $tmp.REGRESSION.1 $args";
    $cmd2 = "$executable --regress $tmp.REGRESSION.2 $args";
    $used_tmpfile{"$tmp.REGRESSION.1"} = 1;
    $used_tmpfile{"$tmp.REGRESSION.2"} = 1;
    return ($cmd1, $cmd2);
}
    
sub
path_substitution
{
    my ($com, @dirs) = @_;
    
    $foundit = 0;
    while ($com =~ /\@(\S+)\@/) {
	$token    = $1;
	$foundit  = 0;
	foreach $dir (@dirs) {
	    if (-x "$dir/$token") {
		$newname = "$dir/$token";
		$com =~ s/\@$token\@/$newname/;
		$foundit = 1;
		last;
	    }
	}
	if (! $foundit) { last; }
    }
    return ($foundit, $com);
}
    
# Function: check_ccmalloc_status
# 
# Look at a file containing stderr from an executed command;
# find ccmalloc report; if present, parse out the number of 
# bytes leaked (e.g. garbage). 
#
# Return ($has_ccmalloc, $garbage):
#    $has_ccmalloc:  1 if report is present; else 0
#    $garbage:       number of bytes leaked (0 if none)
#
# If $file isn't present, returns (0,0) - e.g. that problem is
# silently ignored. The caller may realize that something's wrong
# if it expected $has_ccmalloc to be 1. 
#
# We can't check ccmalloc on all sqc exercises, because some
# of them (particularly bug tests) are scripts that cannot be
# instrumented by ccmalloc.
sub
check_ccmalloc_status
{
    my ($file) = @_;
    my ($has_ccmalloc, $has_garbage, $garbage);

    open(CCMALLOC, "$file") || return (0,0);
    $has_ccmalloc = $has_garbage = $garbage = 0;
    while (<CCMALLOC>) {
	if (/^\|=+ *ccmalloc-/) { $has_ccmalloc = 1; }
	if (/^\|\s*bytes\s*\|\s*\d+\s*\|\s*\d+\s*\|\s*(\d+)\s*\|/) {
	    $has_garbage = 1;
	    $garbage = $1;
	}
    }
    close CCMALLOC;

    # must have successfully parsed garbage line, in addition to 
    # ccmalloc header, to count as a present ccmalloc report.
    #
    if (! $has_garbage) { $has_ccmalloc = 0; } 
    return ($has_ccmalloc, $garbage);
}

# Function: tempname
#
# Returns a unique temporary filename. 
#
# Should be robust. Uses the pid as part of the temp name
# to prevent other processes from clashing. A two-letter
# code is also added, so a given process can request
# up to 676 temp file names (26*26). An "sre" code is
# also added to distinguish these temp files from those
# made by other programs.
#
# Returns nothing if it fails to get a temp file name.
#
# If TMPDIR is set, that directory is prepended to the
# name.
#
sub tempname {
    my ($dir, $name, $suffix);
    if ($TMPDIR) { $dir = $TMPDIR."/"; } else {$dir = "";}

    foreach $suffix ("aa".."zz") {
        $name = "$dir"."sre".$suffix.$$;
        if (! (-e $name)) { 
            open(TMP,">$name") || die; # Touch it to reserve it.
            close(TMP);
            return "$name"; 
        }
    }                           
}