blob: 9c98034a9d07f6f5ad98a60e95ec9b5669086a30 (
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
|
eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
& eval 'exec perl -S $0 $argv:q'
if 0;
# $Id$
# -*- perl -*-
use lib "../../../../../bin";
use PerlACE::Run_Test;
$ior = PerlACE::LocalFile ("supplier.ior");
$notifyior = PerlACE::LocalFile ("notify.ior");
$notify_conf = PerlACE::LocalFile ("notify$PerlACE::svcconf_ext");
$status = 0;
$deadline = 0;
foreach my $arg (@ARGV) {
if ($arg eq "-d") {
$deadline = 1;
}
else {
print "Usage: $0 [-d]\n" .
" -d specifies that deadline discarding be tested.\n";
exit(0);
}
}
unlink $notifyior;
$port = PerlACE::uniqueid () + 10001;
$NS = new PerlACE::Process ("../../../Naming_Service/Naming_Service",
"-ORBEndpoint iiop://localhost:$port");
$TS = new PerlACE::Process ("../../../Notify_Service/Notify_Service",
"-ORBInitRef NameService=iioploc://" .
"localhost:$port/NameService " .
"-IORoutput $notifyior -ORBSvcConf " .
"$notify_conf");
$STS = new PerlACE::Process ("Structured_Supplier",
"-ORBInitRef NameService=iioploc://" .
"localhost:$port/NameService");
$STC = new PerlACE::Process ("Structured_Consumer");
$SES = new PerlACE::Process ("Sequence_Supplier",
"-ORBInitRef NameService=iioploc://" .
"localhost:$port/NameService");
$SEC = new PerlACE::Process ("Sequence_Consumer");
$client_args = "-ORBInitRef NameService=iioploc://localhost:" .
"$port/NameService";
$NS->Spawn ();
$TS->Spawn ();
if (PerlACE::waitforfile_timed ($notifyior, 20) == -1) {
print STDERR "ERROR: waiting for the notify service to start\n";
$TS->Kill ();
$NS->Kill ();
exit 1;
}
@policies = ("fifo", "priority");
if ($deadline) {
push(@policies, "deadline");
}
for($i = 0; $i <= $#policies; $i++) {
$order_policy = $policies[$i];
print "************* Running Structured Consumer with the " .
"$order_policy policy ***********\n";
unlink $ior;
$STS->Arguments($STS->Arguments() . " -d $order_policy");
$STS->Spawn ();
if (PerlACE::waitforfile_timed ($ior, 20) == -1) {
print STDERR "ERROR: waiting for the supplier to start\n";
$STS->Kill ();
$TS->Kill ();
$NS->Kill ();
$status = 1;
last;
}
$STC->Arguments($client_args . " -d $order_policy");
$client = $STC->SpawnWaitKill (120);
$STS->Kill ();
if ($client != 0) {
print STDERR "ERROR: Structured_Consumer did not run properly\n";
$status = 1;
last;
}
}
## // pradeep: commented out priority policies temporarily till the sequences implementation is fixed.
@policies_seq = ("fifo");
if ($status == 0) {
for($i = 0; $i <= $#policies_seq; $i++) {
$order_policy = $policies_seq[$i];
print "************** Running Sequence Consumer with the " .
"$order_policy policy ************\n";
unlink $ior;
$SES->Arguments($SES->Arguments() . " -d $order_policy");
$SES->Spawn ();
if (PerlACE::waitforfile_timed ($ior, 20) == -1) {
print STDERR "ERROR: waiting for the supplier to start\n";
$SES->Kill ();
$TS->Kill ();
$NS->Kill ();
$status = 1;
last;
}
$SEC->Arguments($client_args . " -d $order_policy");
$client = $SEC->SpawnWaitKill (120);
$SES->Kill ();
if ($client != 0) {
print STDERR "ERROR: Sequence_Consumer did not run properly\n";
$status = 1;
last;
}
}
}
$TS->Kill ();
$NS->Kill ();
unlink $ior;
unlink $notifyior;
exit $status;
|
