summaryrefslogtreecommitdiff
path: root/TAO/examples/POA/Forwarding/run_test.pl
blob: afb11d01a92cb3ac60f75a40325215e92b997dba (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
    & eval 'exec perl -S $0 $argv:q'
    if 0;

# $Id$
# -*- perl -*-

use lib "../../../../bin";
require ACEutils;

$brace="\#\#\#\#\#";

# There are three ways to run the test with different results, requiring
# different numbers of servers and with variable arguments, hence the
# arrays

# Servers 1 and 2 are used in all tests
@server1arglist = ("-o server1",
                   "-p server1",
                   "-o server1");
@server2arglist = ("-f server1 -o server2",
                   "-g server1 -p server2",
                   "-g server1 -p server2");

# The third server is only needed for the last test, but I'm making it
# a list in case anyone wants to run it in multiple tests, rather than
# just one
@server3arglist = ("",
                   "",
                   "-f server2 -o server3");

# The client is run for all tests
@clientarglist = ("-f server2 -i 5",
                  "-f server2 -i 5",
                  "-f server3 -i 8");

# Descriptions of the tests
@testlist = ("POA approach",
             "servant locator approach",
             "dual POA and servant locator approaches");

$testtype = "";

# The strings to hold the arguments for the client and servers
$server1args = "";
$server2args = "";
$server3args = "";
$clientargs = "";

# Set STDERR to autoflush (weird unbufferd output stuff)
$| = 1;

# Make pretty look thing
print STDERR "\n";

# There's a cleaner way to do this, but I don't know what it is
sub argshift
{
    $server1args = shift (@server1arglist);
    $server2args = shift (@server2arglist);
    $server3args = shift (@server3arglist);
    $clientargs = shift (@clientarglist);
    $testtype = shift (@testlist);
}

# IOR files must be cleaned up before next run
sub cleanup_ior
{
    unlink "server1", "server2", "server3";
}

# Run the test in it's three forms
sub run_test
{
    print STDERR "\n$brace Test of $testtype BEGUN\n";

    # Remove stale IOR files...
    cleanup_ior ();

    # Run the servers
    $SRV1 = Process::Create  (".".$DIR_SEPARATOR."server".$EXE_EXT,
                             "$server1args");
    print STDERR ("server $server1args\n");

    if (ACE::waitforfile_timed ("server1", 5) == -1) {
      print STDERR "ERROR: cannot find file <server1> or <server2>\n";
      $SRV1->Kill (); $SRV1->TimedWait (1);
      exit 1;
    }

    $SRV2 = Process::Create  (".".$DIR_SEPARATOR."server".$EXE_EXT,
                             "$server2args");
    print STDERR ("server $server2args\n");

    if (ACE::waitforfile_timed ("server2", 5) == -1) {
      print STDERR "ERROR: cannot find file <server1> or <server2>\n";
      $SRV1->Kill (); $SRV1->TimedWait (1);
      $SRV2->Kill (); $SRV2->TimedWait (1);
      exit 1;
    }

    if ($server3args ne "") {
      $SRV3 = Process::Create (".".$DIR_SEPARATOR."server".$EXE_EXT,
			       "$server3args");

      if (ACE::waitforfile_timed ("server3", 5) == -1) {
	print STDERR "ERROR: cannot find file <server3>\n";
	$SRV1->Kill (); $SRV1->TimedWait (1);
	$SRV2->Kill (); $SRV2->TimedWait (1);
	$SRV3->Kill (); $SRV3->TimedWait (1);
	exit 1;
      }
    }

    # Run the client and block until completion
    $CL = Process::Create ($EXEPREFIX."client".$EXE_EXT,
			   " $clientargs");
    print STDERR ("client $clientargs\n");

    $client = $CL->TimedWait (60);
    if ($client == -1) {
      print STDERR "ERROR: client timedout\n";
      $CL->Kill (); $CL->TimedWait (1);
    }

    # Now that the client has finished, kill off the servers

    $SRV1->Kill (); $SRV1->TimedWait (1);
    $SRV2->Kill (); $SRV2->TimedWait (1);

    if ($server3args ne "")
    {
        $SRV3->Kill (); $SRV3->TimedWait (1);
    }

    if ($client != 0) {
      print STDERR ("\n$brace Test of $testtype FAILED\n");
      $status = -1;
    } else {
      print STDERR ("\n$brace Test of $testtype SUCCEEDED\n");
    }
    return $status;
}


for ($q = 0; $q < 3; $q++)
{
    argshift ();
    run_test ();
    if ($q < 2)
    {
        print STDERR ("\n\t\t Waiting for things to stabilize...\n");
        sleep ($ACE::sleeptime);
    }
}

cleanup_ior ();