run_test.pl

来自「这是广泛使用的通信开源项目,对于大容量,高并发的通讯要求完全能够胜任,他广泛可用」· PL 代码 · 共 135 行

eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
    & eval 'exec perl -S $0 $argv:q'
    if 0;

# run_test.pl,v 1.7 2003/04/16 17:57:34 irfan Exp
# -*- perl -*-

use lib '../../../../bin';
use PerlACE::Run_Test;

$status = 0;
$iorfile = "ior";

@configurations = 
    (
     {
         server => "-b empty_file -l empty_file", 
         client => "-b empty_file -p empty_file -x",
     },
     {
         server => "-b bands -l empty_file", 
         client => "-b empty_file -p empty_file -x",
     },
     {
         server => "-b empty_file -l lanes", 
         client => "-b empty_file -p empty_file -x",
     },
     {
         server => "-b bands -l lanes", 
         client => "-b empty_file -p empty_file -x",
     },
     {
         server => "-b empty_file -l empty_file", 
         client => "-b bands -p empty_file -x",
     },
     {
         server => "-b empty_file -l lanes", 
         client => "-b bands -p empty_file -x",
     },
     {
         server => "-b empty_file -l empty_file", 
         client => "-b empty_file -p invocation_priorities -x",
     },
     {
         server => "-b bands -l empty_file", 
         client => "-b empty_file -p invocation_priorities -x",
     },
     {
         server => "-b bands -l lanes", 
         client => "-b empty_file -p invocation_priorities -x",
     },
     {
         server => "-b empty_file -l empty_file", 
         client => "-b bands -p invocation_priorities -x",
     },
     {
         server => "-b empty_file -l lanes", 
         client => "-b bands -p invocation_priorities -x",
     },
     );

sub run_client
{
    $CL = new PerlACE::Process ("client", @_);

    $CL->Spawn ();
    
    $client = $CL->WaitKill (120);

    if ($client != 0) 
    {
        print STDERR "ERROR: client returned $client\n";
        $status = 1;
        zap_server (1);
    }
}

sub run_server 
{
    $SV = new PerlACE::Process ("server", @_);
    $SV->Spawn ();

    if (PerlACE::waitforfile_timed ($iorfile, 10) == -1)
    {
        check_supported_priorities ($SV);
	print STDERR "ERROR: cannot find ior file: $iorfile\n";
	$status = 1;
	zap_server (1);
    }
}

sub zap_server
{
    $server = $SV->WaitKill (5);
    
    if ($server != 0) 
    {
        print STDERR "ERROR: server returned $server\n";
        $status = 1;
    }

    unlink $iorfile;

    if ($_[0])
    {
        exit $status;
    }
}

sub check_supported_priorities
{
  $process = shift;
  $returnVal = $process->TimedWait (1);
  if ($returnVal == 2) {
    # Mark as no longer running to avoid errors on exit.
    $process->{RUNNING} = 0;
    exit 0;
  }
}

for $test (@configurations)
{
    print STDERR "\n******************************************************\n";

    unlink $iorfile;

    run_server ($test->{server});

    run_client ($test->{client});
    
    zap_server (0);
}

exit $status;