run_test.pl

来自「这是广泛使用的通信开源项目,对于大容量,高并发的通讯要求完全能够胜任,他广泛可用」· PL 代码 · 共 360 行
360 行
eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
    & eval 'exec perl -S $0 $argv:q'
    if 0;

# run_test.pl,v 1.10 2003/05/08 03:50:03 bala Exp
# -*- perl -*-

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

$iorfile = PerlACE::LocalFile ("test.ior");
$middlefile = PerlACE::LocalFile ("middle.ior");
$dum_core = PerlACE::LocalFile ("core");
$status = 0;

$SV = new PerlACE::Process ("server", "-o $iorfile");
$SV1 = new PerlACE::Process ("server", "-ORBSvcConf server.conf -o $iorfile");
$CL = new PerlACE::Process ("client", "");
$MD = new PerlACE::Process ("middle", "-o $middlefile -k file://$iorfile");
$PI = new PerlACE::Process ("ping", "-o $iorfile");
$PO = new PerlACE::Process ("pong", "-k file://$iorfile -p 100 -i 60 -t 30");

###############################################################################
print STDERR "################ Default ORB Config###############\n";
print STDERR "===== Base test, no crashes\n";

unlink $iorfile;
$SV->Spawn ();

if (PerlACE::waitforfile_timed ($iorfile, 15) == -1) {
    print STDERR "ERROR: cannot find file <$iorfile>\n";
    $SV->Kill ();
    exit 1;
}

$CL->Arguments ("-k file://$iorfile -i 100");

$client = $CL->SpawnWaitKill (20);

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

###############################################################################
print STDERR "===== Client crash (abort) during upcall\n";

$CL->Arguments ("-k file://$iorfile -i 100 -s");

$client = $CL->SpawnWaitKill (20);

# since the client crashes, skip check for $client != 0
if ($client == -1) {
    $status = 1;
}

###############################################################################
print STDERR "===== Client crash during upcall\n";

$CL->Arguments ("-k file://$iorfile -i 100 -z");

$client = $CL->SpawnWaitKill (20);

# since the client crashes, skip check for $client != 0
if ($client == -1) {
    $status = 1;
}

###############################################################################
print STDERR "===== Server crash (abort) during upcall\n";

$CL->Arguments ("-k file://$iorfile -i 100 -a");

$client = $CL->SpawnWaitKill (20);

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

$server = $SV->WaitKill (20);

# since the server crashes, skip check for $server != 0
if ($server == -1) {
    $status = 1;
}

###############################################################################
print STDERR "===== Server crash during upcall\n";

unlink $iorfile;
$SV->Spawn ();

if (PerlACE::waitforfile_timed ($iorfile, 15) == -1) {
    print STDERR "ERROR: cannot find file <$iorfile>\n";
    $SV->Kill (); 
    exit 1;
}

$CL->Arguments ("-k file://$iorfile -i 100 -c");

$client = $CL->SpawnWaitKill (20);

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

$server = $SV->WaitKill (20);

# since the server crashes, skip check for $server != 0
if ($server == -1) {
    $status = 1;
}

###############################################################################
print STDERR "===== Three-way test, client crashes and server detects\n";

unlink $iorfile;
$SV->Spawn ();

if (PerlACE::waitforfile_timed ($iorfile, 15) == -1) {
    print STDERR "ERROR: cannot find file <$iorfile>\n";
    $SV->Kill (); 
    exit 1;
}

unlink $middlefile;
$MD->Spawn ();

if (PerlACE::waitforfile_timed ($middlefile, 15) == -1) {
    print STDERR "ERROR: cannot find file <$middlefile>\n";
    $MD->Kill (); 
    exit 1;
}

$CL->Arguments ("-k file://$middlefile -i 100 -s");

$client = $CL->SpawnWaitKill (100);

# since the client crashes, skip check for $client != 0
if ($client == -1) {
    $status = 1;
}

$CL->Arguments (" -k file://$middlefile -i 10 -x");

$client = $CL->SpawnWaitKill (100);

# since the client crashes, skip check for $client != 0
if ($client == -1) {
    $status = 1;
}

$server = $SV->WaitKill (20);

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

$middle = $MD->WaitKill (20);

if ($middle != 0) {
    print STDERR "ERROR: the middle test failed, middle returned $middle\n";
    $status = 1;
}

###############################################################################
print STDERR "===== Ping-pong test, server crashes but client continues\n";

unlink $iorfile;
$PI->Spawn ();

if (PerlACE::waitforfile_timed ($iorfile, 15) == -1) {
    print STDERR "ERROR: cannot find file <$iorfile>\n";
    $SV->Kill ();
    exit 1;
}

if ($PO->SpawnWaitKill (60) == -1) {
    $status = 1;
}

if ($PI->WaitKill (60) == -1) {
    $status = 1;
}

########################################################################
########################################################################
########################################################################
print STDERR "################ Thread-Per-Connection Config###############\n";
print STDERR "===== Base test, no crashes\n";

unlink $iorfile;
$SV1->Spawn ();

if (PerlACE::waitforfile_timed ($iorfile, 15) == -1) {
    print STDERR "ERROR: cannot find file <$iorfile>\n";
    $SV->Kill ();
    exit 1;
}

$CL->Arguments ("-k file://$iorfile -i 100");

$client = $CL->SpawnWaitKill (20);

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

###############################################################################
print STDERR "===== Client crash (abort) during upcall\n";

$CL->Arguments ("-k file://$iorfile -i 100 -s");

$client = $CL->SpawnWaitKill (20);

# since the client crashes, skip check for $client != 0
if ($client == -1) {
    $status = 1;
}

###############################################################################
print STDERR "===== Client crash during upcall\n";

$CL->Arguments ("-k file://$iorfile -i 100 -z");

$client = $CL->SpawnWaitKill (20);

# since the client crashes, skip check for $client != 0
if ($client == -1) {
    $status = 1;
}

###############################################################################
print STDERR "===== Server crash (abort) during upcall\n";

$CL->Arguments ("-k file://$iorfile -i 100 -a");

$client = $CL->SpawnWaitKill (20);

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

$server = $SV1->WaitKill (20);

# since the server crashes, skip check for $server != 0
if ($server == -1) {
    $status = 1;
}

###############################################################################
print STDERR "===== Server crash during upcall\n";

unlink $iorfile;
$SV1->Spawn ();

if (PerlACE::waitforfile_timed ($iorfile, 15) == -1) {
    print STDERR "ERROR: cannot find file <$iorfile>\n";
    $SV1->Kill (); 
    exit 1;
}

$CL->Arguments ("-k file://$iorfile -i 100 -c");

$client = $CL->SpawnWaitKill (20);

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

$server = $SV1->WaitKill (20);

# since the server crashes, skip check for $server != 0
if ($server == -1) {
    $status = 1;
}

###############################################################################
print STDERR "===== Three-way test, client crashes and server detects\n";

unlink $iorfile;
$SV1->Spawn ();

if (PerlACE::waitforfile_timed ($iorfile, 15) == -1) {
    print STDERR "ERROR: cannot find file <$iorfile>\n";
    $SV1->Kill (); 
    exit 1;
}

unlink $middlefile;
$MD->Spawn ();

if (PerlACE::waitforfile_timed ($middlefile, 15) == -1) {
    print STDERR "ERROR: cannot find file <$middlefile>\n";
    $MD->Kill (); 
    exit 1;
}

$CL->Arguments ("-k file://$middlefile -i 100 -s");

$client = $CL->SpawnWaitKill (100);

# since the client crashes, skip check for $client != 0
if ($client == -1) {
    $status = 1;
}

$CL->Arguments (" -k file://$middlefile -i 10 -x");

$client = $CL->SpawnWaitKill (100);

# since the client crashes, skip check for $client != 0
if ($client == -1) {
    $status = 1;
}

$server = $SV1->WaitKill (20);

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

$middle = $MD->WaitKill (20);

if ($middle != 0) {
    print STDERR "ERROR: the middle test failed, middle returned $middle\n";
    $status = 1;
}

###############################################################################
print STDERR "===== Ping-pong test, server crashes but client continues\n";

unlink $iorfile;
$PI->Spawn ();

if (PerlACE::waitforfile_timed ($iorfile, 15) == -1) {
    print STDERR "ERROR: cannot find file <$iorfile>\n";
    $SV1->Kill ();
    exit 1;
}

if ($PO->SpawnWaitKill (60) == -1) {
    $status = 1;
}

if ($PI->WaitKill (60) == -1) {
    $status = 1;
}

unlink $dum_core;

exit $status;
run_test.pl - 源码说明

本页面展示了「这是广泛使用的通信开源项目,对于大容量,高并发的通讯要求完全能够胜任,他广泛可用于网络游戏医学图像网关的高qos要求.更详细的内容可阅读相应的材料」中的 run_test.pl 源码文件，采用 PL 编程语言编写，共 360 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。
虫虫开发者社区收录了大量与通信框架相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。
⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?