run_test.pl

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

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

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

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

$status = 0;

@iorfiles = 
    (
     "root",
     "child",
     "default_pool_no_bands_client_propagated",
     "default_pool_no_bands_server_declared",
     "no_lanes_no_bands_client_propagated",
     "no_lanes_no_bands_server_declared",
     "lanes_no_bands_client_propagated",
     "lanes_no_bands_server_declared",
     "default_pool_bands_client_propagated",
     "default_pool_bands_server_declared",
     "no_lanes_bands_client_propagated",
     "no_lanes_bands_server_declared",
     "lanes_bands_client_propagated",
     "lanes_bands_server_declared",
     );

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;
        goto kill_server;
    }
}

for $file (@iorfiles)
{
    unlink $file;
}

$SV = new PerlACE::Process ("server");
$SV->Spawn ();

for $file (@iorfiles)
{
    if (PerlACE::waitforfile_timed ($file, 10) == -1)
    {
        $server = $SV->TimedWait (1);
        if ($server == 2) 
        {
            # Mark as no longer running to avoid errors on exit.
            $SV->{RUNNING} = 0;
            exit $status;
        } 
        else
        {            
            print STDERR "ERROR: cannot find ior file: $file\n";
            $status = 1;
            goto kill_server;
        }
    }
      
    print STDERR "\n******************************************************\n";
    print STDERR "Invoking methods on servant in $file poa\n";
    print STDERR "******************************************************\n\n";
    
    run_client ("-k file://$file");
}

{
    print STDERR "\n**************************\n";
    print STDERR "Shutting down the server\n";
    print STDERR "**************************\n\n";
    
    run_client ("-k file://$iorfiles[0] -i 0 -x");
}

 kill_server:
    
{
    $server = $SV->WaitKill (5);
    
    if ($server != 0) 
    {
        print STDERR "ERROR: server returned $server\n";
        $status = 1;
    }
    
    for $file (@iorfiles)
    {
        unlink $file;
    }
}

exit $status;