diff options
Diffstat (limited to 'TAO/orbsvcs/tests/Notify/Ordering/run_test.pl')
| -rwxr-xr-x | TAO/orbsvcs/tests/Notify/Ordering/run_test.pl | 221 |
1 files changed, 221 insertions, 0 deletions
diff --git a/TAO/orbsvcs/tests/Notify/Ordering/run_test.pl b/TAO/orbsvcs/tests/Notify/Ordering/run_test.pl new file mode 100755 index 00000000000..5039cf66d1a --- /dev/null +++ b/TAO/orbsvcs/tests/Notify/Ordering/run_test.pl @@ -0,0 +1,221 @@ +eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' + & eval 'exec perl -S $0 $argv:q' + if 0; + +# $Id$ +# -*- perl -*- + +use lib "$ENV{ACE_ROOT}/bin"; +use PerlACE::Run_Test; + +PerlACE::check_privilege_group(); + +$ior = PerlACE::LocalFile ("supplier.ior"); +$notifyior = PerlACE::LocalFile ("notify.ior"); +$naming_ior = PerlACE::LocalFile ("naming.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); + } +} + +$port = PerlACE::uniqueid () + 10001; +$NS = new PerlACE::Process ("../../../Naming_Service/Naming_Service", + "-ORBEndpoint iiop://localhost:$port -o $naming_ior"); +$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"; + +unlink $notifyior; +unlink $naming_ior; + +$NS->Spawn (); +if (PerlACE::waitforfile_timed ($naming_ior, 20) == -1) { + print STDERR "ERROR: waiting for the naming service to start\n"; + $NS->Kill (); + exit 1; +} + +$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; +} + +if ($deadline) { + ## @@todo : Add combinations of deadline ordering. +} + +# Although the TAO notify service supports OrderPolicy on the supplier side +# QoS, this setting typically serves no practical purpose, and is not testable. +# This is because we have no way to force the supplier-side queue to back up, and +# the OrderPolicy will have no affect. +# Therefore we don't test setting this policy on the supplier side. + +print "**** Structured Supplier (fifo) -> Structured Consumer (none) *****\n"; +unlink $ior; +$STS->Arguments($STS->Arguments() . " -d fifo"); +$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; + exit 1; +} +$STC->Arguments($client_args . " -d fifo"); +$client = $STC->SpawnWaitKill (20); +if ($client != 0) { + $STS->Kill (); + $TS->Kill (); + $NS->Kill (); + exit 1; +} +$server = $STS->WaitKill(5); +if ($server != 0) { + $TS->Kill (); + $NS->Kill (); + exit 1; +} + +print "**** Structured Supplier (fifo) -> Structured Consumer (priority) *****\n"; +unlink $ior; +$STS->Arguments($STS->Arguments() . " -d fifo"); +$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; + exit 1; +} +$STC->Arguments($client_args . " -d priority -o"); +$client = $STC->SpawnWaitKill (20); +if ($client != 0) { + $STS->Kill (); + $TS->Kill (); + $NS->Kill (); + exit 1; +} +$server = $STS->WaitKill(5); +if ($server != 0) { + $TS->Kill (); + $NS->Kill (); + exit 1; +} + +print "**** Structured Supplier (fifo) -> Sequence Consumer (priority) *****\n"; +unlink $ior; +$STS->Arguments($STS->Arguments() . " -d fifo"); +$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; + exit 1; +} +$SEC->Arguments($client_args . " -d priority -o"); +$client = $SEC->SpawnWaitKill (20); +if ($client != 0) { + $STS->Kill (); + $TS->Kill (); + $NS->Kill (); + exit 1; +} +$server = $STS->WaitKill(5); +if ($server != 0) { + $TS->Kill (); + $NS->Kill (); + exit 1; +} + +print "**** Sequence Supplier (fifo) -> Structured Consumer (priority) *****\n"; +unlink $ior; +$SES->Arguments($SES->Arguments() . " -d fifo"); +$SES->Spawn (); +if (PerlACE::waitforfile_timed ($ior, 20) == -1) { + $SES->Kill (); + $TS->Kill (); + $NS->Kill (); + $status = 1; + exit 1; +} +$STC->Arguments($client_args . " -d priority -o"); +$client = $STC->SpawnWaitKill (20); +if ($client != 0) { + $SES->Kill (); + $TS->Kill (); + $NS->Kill (); + exit 1; +} +$server = $SES->WaitKill(5); +if ($server != 0) { + $TS->Kill (); + $NS->Kill (); + exit 1; +} + +print "**** Sequence Supplier (fifo) -> Sequence Consumer (priority) *****\n"; +unlink $ior; +$SES->Arguments($SES->Arguments() . " -d fifo"); +$SES->Spawn (); +if (PerlACE::waitforfile_timed ($ior, 20) == -1) { + $SES->Kill (); + $TS->Kill (); + $NS->Kill (); + $status = 1; + exit 1; +} +$SEC->Arguments($client_args . " -d priority -o"); +$client = $SEC->SpawnWaitKill (20); +if ($client != 0) { + $SES->Kill (); + $TS->Kill (); + $NS->Kill (); + exit 1; +} +$server = $SES->WaitKill(5); +if ($server != 0) { + $TS->Kill (); + $NS->Kill (); + exit 1; +} + + +$TS->Kill (); +$NS->Kill (); + +unlink $ior; +unlink $notifyior; +unlink $naming_ior; + +exit $status; |