diff --git a/cos/event/Makefile.am b/cos/event/Makefile.am index 1bcfff460..714afcdcb 100644 --- a/cos/event/Makefile.am +++ b/cos/event/Makefile.am @@ -2,20 +2,20 @@ AUTOMAKE_OPTIONS = no-dependencies include $(srcdir)/../Makefile.common -#COS_GNATMAKE_FLAGS = -I$(srcdir) \ -# -I../naming \ -# -I$(srcdir)/../naming \ -# -I$(COS_ROOT)/event \ -# -I$(COS_ROOT)/naming \ -# -I../../src \ -# -I$(srcdir)/../../src - -COS_GNATMAKE_FLAGS=-I../../idls/cos/naming \ - -I../naming \ - -I../../idls/cos/event -# le fichier que l'on veut générer -# pour l'instant il s'agit d'un fichier qui fait des tests -PROGS=test_event +corba_exe=test_event + +COS_GNATMAKE_FLAGS = \ + -I$(srcdir) \ + -I../naming \ + -I$(srcdir)/../naming \ + -I$(COS_ROOT)/event \ + -I$(COS_ROOT)/naming \ + -I../../src \ + -I$(srcdir)/../../src \ + -I../../idls/cos/naming \ + -I../../idls/cos/event + +PROGS=@APPLI_EXES@ FORCE= force diff --git a/cos/event/README b/cos/event/README new file mode 100644 index 000000000..4d7734d83 --- /dev/null +++ b/cos/event/README @@ -0,0 +1,22 @@ +README for PolyORB's COS Event Service +--------------------------------------- + +$Id: //droopi/main/cos/event/README#1 $ + +PolyORB provides a default implementation of the CORBA COS Event +Service. + +The executable test_event tests its functionnalities. + +test_event can be started in + +- interactive mode, an online help details the various commande + + ./test_event + +- batch mode, + + ./test_event + +script_file is a text file containing the same commands as in +interactive mode, see online help or supplier.cmd file for more details. diff --git a/cos/event/auto_print.adb b/cos/event/auto_print.adb index ff4d1fd4d..989c22ab1 100644 --- a/cos/event/auto_print.adb +++ b/cos/event/auto_print.adb @@ -1,25 +1,56 @@ -with Ada.Exceptions; use Ada.Exceptions; +------------------------------------------------------------------------------ +-- -- +-- POLYORB COMPONENTS -- +-- -- +-- A U T O _ P R I N T -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1999-2003 Free Software Fundation -- +-- -- +-- PolyORB is free software; you can redistribute it and/or modify it -- +-- under terms of the GNU General Public License as published by the Free -- +-- Software Foundation; either version 2, or (at your option) any later -- +-- version. PolyORB is distributed in the hope that it will be useful, -- +-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- +-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -- +-- License for more details. You should have received a copy of the GNU -- +-- General Public License distributed with PolyORB; see file COPYING. If -- +-- not, write to the Free Software Foundation, 59 Temple Place - Suite 330, -- +-- Boston, MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- PolyORB is maintained by ENST Paris University. -- +-- -- +------------------------------------------------------------------------------ -with CosEventComm.PushConsumer.Impl; -use CosEventComm.PushConsumer.Impl; +-- $Id$ -with CosEventComm.PushConsumer; - -with PortableServer; use PortableServer; -pragma Warnings (Off, PortableServer); +with Ada.Exceptions; with Ada.Text_IO; -with Ada.Exceptions; use Ada.Exceptions; +with CosEventComm.PushConsumer.Impl; -with CORBA; -use CORBA; package body Auto_Print is + use Ada.Text_IO; + use Ada.Exceptions; + + use CORBA; + use CosEventComm.PushConsumer.Impl; --------------------------- -- Ensure_Initialization -- --------------------------- + T_Initialized : Boolean := False; + procedure Ensure_Initialization is begin if T_Initialized then @@ -30,45 +61,41 @@ package body Auto_Print is T_Initialized := True; end Ensure_Initialization; - ------------------------- -- Thread Auto_Display -- ------------------------- + procedure Auto_Display + is + Got_Msg : CORBA.Boolean; + Msg : CORBA.Any; + Ptr : PushConsumer.Impl.Object_Ptr; - procedure Auto_Display is begin - declare - B : CORBA.Boolean; - A : CORBA.Any; - Ptr : PushConsumer.Impl.Object_Ptr; - begin - Ada.Text_IO.Put ("début"); - Ensure_Initialization; - Ptr := PushConsumer.Impl.Object_Ptr (A_S); - -- A_S is a global variable used to pass an argument to this task - -- Ptr is initialized - -- we can let For_Consumers go - Enter (Session_Mutex); - Signal (Session_Taken); - Leave (Session_Mutex); - loop - exit when EndDisplay = True; - delay 0.1; - Try_Pull (Ptr, B, A); - if B then - Ada.Text_IO.Put_Line ( - To_Standard_String (From_Any (A))); - else - Ada.Text_IO.Put (""); - end if; - end loop; - EndDisplay := False; - exception - when E : others => - Ada.Text_IO.Put_Line ("raise "& Exception_Name (E)); - Ada.Text_IO.Put_Line (Exception_Message (E)); - Ada.Text_IO.Put_Line (Exception_Information (E)); - end; + Ptr := PushConsumer.Impl.Object_Ptr (A_S); + Enter (Session_Mutex); + Signal (Session_Taken); + Leave (Session_Mutex); + + Put_Line ("AutoDisplay setup"); + loop + exit when EndDisplay = True; + + delay 0.1; + + Try_Pull (Ptr, Got_Msg, Msg); + + if Got_Msg then + Ada.Text_IO.Put_Line (To_Standard_String (From_Any (Msg))); + end if; + end loop; + + EndDisplay := False; + + exception + when E : others => + Ada.Text_IO.Put_Line ("raised "& Exception_Name (E)); + Ada.Text_IO.Put_Line (Exception_Message (E)); + Ada.Text_IO.Put_Line (Exception_Information (E)); end Auto_Display; end Auto_Print; diff --git a/cos/event/auto_print.ads b/cos/event/auto_print.ads index b36e34017..46232955f 100644 --- a/cos/event/auto_print.ads +++ b/cos/event/auto_print.ads @@ -1,27 +1,57 @@ -with CosEventComm; use CosEventComm; +------------------------------------------------------------------------------ +-- -- +-- POLYORB COMPONENTS -- +-- -- +-- A U T O _ P R I N T -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1999-2003 Free Software Fundation -- +-- -- +-- PolyORB is free software; you can redistribute it and/or modify it -- +-- under terms of the GNU General Public License as published by the Free -- +-- Software Foundation; either version 2, or (at your option) any later -- +-- version. PolyORB is distributed in the hope that it will be useful, -- +-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- +-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -- +-- License for more details. You should have received a copy of the GNU -- +-- General Public License distributed with PolyORB; see file COPYING. If -- +-- not, write to the Free Software Foundation, 59 Temple Place - Suite 330, -- +-- Boston, MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- PolyORB is maintained by ENST Paris University. -- +-- -- +------------------------------------------------------------------------------ -with CORBA; +-- $Id$ + +with CosEventComm; with CORBA.Impl; - with PolyORB.Tasking.Mutexes; with PolyORB.Tasking.Condition_Variables; -use PolyORB.Tasking.Condition_Variables; -use PolyORB.Tasking.Mutexes; - - package Auto_Print is + use CosEventComm; + + use PolyORB.Tasking.Condition_Variables; + use PolyORB.Tasking.Mutexes; + procedure Auto_Display; procedure Ensure_Initialization; pragma Inline (Ensure_Initialization); -- Ensure that the Mutexes are initialized - T_Initialized : Boolean := False; - Session_Mutex : Mutex_Access; Session_Taken : Condition_Access; -- Synchornisation of task initialization. diff --git a/cos/event/coseventchanneladmin-consumeradmin-impl.adb b/cos/event/coseventchanneladmin-consumeradmin-impl.adb index 6ab75aa3c..d245e5d2a 100644 --- a/cos/event/coseventchanneladmin-consumeradmin-impl.adb +++ b/cos/event/coseventchanneladmin-consumeradmin-impl.adb @@ -31,7 +31,14 @@ -- -- ------------------------------------------------------------------------------ -with CosEventChannelAdmin; use CosEventChannelAdmin; +with CORBA.Impl; +pragma Warnings (Off, CORBA.Impl); + +with CORBA.Sequences.Unbounded; + +with PortableServer; + +with CosEventChannelAdmin; with CosEventChannelAdmin.ProxyPullSupplier; with CosEventChannelAdmin.ProxyPullSupplier.Helper; @@ -45,25 +52,24 @@ with CosEventChannelAdmin.ConsumerAdmin.Helper; pragma Elaborate (CosEventChannelAdmin.ConsumerAdmin.Helper); pragma Warnings (Off, CosEventChannelAdmin.ConsumerAdmin.Helper); - with CosEventChannelAdmin.ConsumerAdmin.Skel; pragma Elaborate (CosEventChannelAdmin.ConsumerAdmin.Skel); pragma Warnings (Off, CosEventChannelAdmin.ConsumerAdmin.Skel); -with PolyORB.CORBA_P.Server_Tools; use PolyORB.CORBA_P.Server_Tools; -with PolyORB.Tasking.Soft_Links; use PolyORB.Tasking.Soft_Links; +with PolyORB.CORBA_P.Server_Tools; +with PolyORB.Tasking.Mutexes; -with CORBA.Sequences.Unbounded; - -with CORBA.Impl; -pragma Warnings (Off, CORBA.Impl); - -with PortableServer; use PortableServer; with PolyORB.Log; package body CosEventChannelAdmin.ConsumerAdmin.Impl is - use PolyORB.Log; + use CosEventChannelAdmin; + use PortableServer; + + use PolyORB.CORBA_P.Server_Tools; + use PolyORB.Tasking.Mutexes; + + use PolyORB.Log; package L is new PolyORB.Log.Facility_Log ("consumeradmin"); procedure O (Message : in Standard.String; Level : Log_Level := Debug) renames L.Output; @@ -74,13 +80,31 @@ package body CosEventChannelAdmin.ConsumerAdmin.Impl is package PullSuppliers is new CORBA.Sequences.Unbounded (ProxyPullSupplier.Impl.Object_Ptr); - type Consumer_Admin_Record is - record - This : Object_Ptr; - Channel : EventChannel.Impl.Object_Ptr; - Pushs : PushSuppliers.Sequence; - Pulls : PullSuppliers.Sequence; - end record; + type Consumer_Admin_Record is record + This : Object_Ptr; + Channel : EventChannel.Impl.Object_Ptr; + Pushs : PushSuppliers.Sequence; + Pulls : PullSuppliers.Sequence; + end record; + + --------------------------- + -- Ensure_Initialization -- + --------------------------- + + procedure Ensure_Initialization; + pragma Inline (Ensure_Initialization); + -- Ensure that the Mutexes are initialized. + + T_Initialized : Boolean := False; + Self_Mutex : Mutex_Access; + + procedure Ensure_Initialization is + begin + if not T_Initialized then + Create (Self_Mutex); + T_Initialized := True; + end if; + end Ensure_Initialization; ------------ -- Create -- @@ -95,11 +119,12 @@ package body CosEventChannelAdmin.ConsumerAdmin.Impl is begin pragma Debug (O ("create consumer admin")); - Consumer := new Object; - Consumer.X := new Consumer_Admin_Record; + Consumer := new Object; + Consumer.X := new Consumer_Admin_Record; Consumer.X.This := Consumer; Consumer.X.Channel := Channel; Initiate_Servant (Servant (Consumer), My_Ref); + return Consumer; end Create; @@ -117,11 +142,15 @@ package body CosEventChannelAdmin.ConsumerAdmin.Impl is begin pragma Debug (O ("obtain proxy pull supplier from consumer admin")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); Supplier := ProxyPullSupplier.Impl.Create (Self.X.This); PullSuppliers.Append (Self.X.Pulls, Supplier); - Leave_Critical_Section; + Leave (Self_Mutex); + Servant_To_Reference (Servant (Supplier), Its_Ref); + return Its_Ref; end Obtain_Pull_Supplier; @@ -139,11 +168,15 @@ package body CosEventChannelAdmin.ConsumerAdmin.Impl is begin pragma Debug (O ("obtain proxy push supplier from consumer admin")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); Supplier := ProxyPushSupplier.Impl.Create (Self.X.This); PushSuppliers.Append (Self.X.Pushs, Supplier); - Leave_Critical_Section; + Leave (Self_Mutex); + Servant_To_Reference (Servant (Supplier), Its_Ref); + return Its_Ref; end Obtain_Push_Supplier; @@ -153,24 +186,28 @@ package body CosEventChannelAdmin.ConsumerAdmin.Impl is procedure Post (Self : access Object; - Data : in CORBA.Any) is + Data : in CORBA.Any) is begin - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); declare Pulls : constant PullSuppliers.Element_Array := PullSuppliers.To_Element_Array (Self.X.Pulls); Pushs : constant PushSuppliers.Element_Array := PushSuppliers.To_Element_Array (Self.X.Pushs); begin - Leave_Critical_Section; + Leave (Self_Mutex); + pragma Debug (O ("post new data to proxy pull suppliers")); - for I in Pulls'Range loop - ProxyPullSupplier.Impl.Post (Pulls (I), Data); + for J in Pulls'Range loop + ProxyPullSupplier.Impl.Post (Pulls (J), Data); end loop; + pragma Debug (O ("post new data to proxy push suppliers")); - for I in Pushs'Range loop - ProxyPushSupplier.Impl.Post (Pushs (I), Data); + for J in Pushs'Range loop + ProxyPushSupplier.Impl.Post (Pushs (J), Data); end loop; end; end Post; diff --git a/cos/event/coseventchanneladmin-consumeradmin-impl.ads b/cos/event/coseventchanneladmin-consumeradmin-impl.ads index 65c72c637..54bfda9a7 100644 --- a/cos/event/coseventchanneladmin-consumeradmin-impl.ads +++ b/cos/event/coseventchanneladmin-consumeradmin-impl.ads @@ -40,9 +40,7 @@ with PortableServer; package CosEventChannelAdmin.ConsumerAdmin.Impl is - type Object is - new PortableServer.Servant_Base with private; - + type Object is new PortableServer.Servant_Base with private; type Object_Ptr is access all Object'Class; function Obtain_Push_Supplier @@ -59,7 +57,7 @@ package CosEventChannelAdmin.ConsumerAdmin.Impl is procedure Post (Self : access Object; - Data : in CORBA.Any); + Data : in CORBA.Any); function Create (Channel : CosEventChannelAdmin.EventChannel.Impl.Object_Ptr) @@ -70,9 +68,8 @@ private type Consumer_Admin_Record; type Consumer_Admin_Access is access all Consumer_Admin_Record; - type Object is new PortableServer.Servant_Base with - record - X : Consumer_Admin_Access; - end record; + type Object is new PortableServer.Servant_Base with record + X : Consumer_Admin_Access; + end record; end CosEventChannelAdmin.ConsumerAdmin.Impl; diff --git a/cos/event/coseventchanneladmin-eventchannel-impl.adb b/cos/event/coseventchanneladmin-eventchannel-impl.adb index 4dbabca05..07ed88773 100644 --- a/cos/event/coseventchanneladmin-eventchannel-impl.adb +++ b/cos/event/coseventchanneladmin-eventchannel-impl.adb @@ -31,6 +31,11 @@ -- -- ------------------------------------------------------------------------------ +with CORBA.Impl; +pragma Warnings (Off, CORBA.Impl); + +with PortableServer; + with CosEventChannelAdmin.SupplierAdmin; with CosEventChannelAdmin.SupplierAdmin.Impl; @@ -48,44 +53,30 @@ pragma Elaborate (CosEventChannelAdmin.EventChannel.Skel); pragma Warnings (Off, CosEventChannelAdmin.EventChannel.Skel); with PolyORB.CORBA_P.Server_Tools; - -with PortableServer; use PortableServer; - -with CORBA.Impl; -pragma Warnings (Off, CORBA.Impl); - with PolyORB.Log; package body CosEventChannelAdmin.EventChannel.Impl is - use PolyORB.CORBA_P.Server_Tools; - - ----------- - -- Debug -- - ----------- - - use PolyORB.Log; + use PortableServer; + use PolyORB.CORBA_P.Server_Tools; + use PolyORB.Log; package L is new PolyORB.Log.Facility_Log ("eventchannel"); procedure O (Message : in Standard.String; Level : Log_Level := Debug) renames L.Output; - ------------- - -- Channel -- - ------------- - - type Event_Channel_Record is - record - This : Object_Ptr; - Consumer : ConsumerAdmin.Impl.Object_Ptr; - Supplier : SupplierAdmin.Impl.Object_Ptr; - end record; + type Event_Channel_Record is record + This : Object_Ptr; + Consumer : ConsumerAdmin.Impl.Object_Ptr; + Supplier : SupplierAdmin.Impl.Object_Ptr; + end record; ------------ -- Create -- ------------ - function Create return Object_Ptr + function Create + return Object_Ptr is Channel : Object_Ptr; My_Ref : EventChannel.Ref; @@ -155,7 +146,7 @@ package body CosEventChannelAdmin.EventChannel.Impl is procedure Post (Self : access Object; - Data : in CORBA.Any) is + Data : in CORBA.Any) is begin ConsumerAdmin.Impl.Post (Self.X.Consumer, Data); end Post; diff --git a/cos/event/coseventchanneladmin-eventchannel-impl.ads b/cos/event/coseventchanneladmin-eventchannel-impl.ads index c74ae7245..6a2d92b12 100644 --- a/cos/event/coseventchanneladmin-eventchannel-impl.ads +++ b/cos/event/coseventchanneladmin-eventchannel-impl.ads @@ -34,15 +34,11 @@ with CosEventChannelAdmin.SupplierAdmin; with CosEventChannelAdmin.ConsumerAdmin; --- with CosEventChannelAdmin.EventChannel; - with PortableServer; package CosEventChannelAdmin.EventChannel.Impl is - type Object is - new PortableServer.Servant_Base with private; - + type Object is new PortableServer.Servant_Base with private; type Object_Ptr is access all Object'Class; function For_Consumers @@ -62,7 +58,7 @@ package CosEventChannelAdmin.EventChannel.Impl is procedure Post (Self : access Object; - Data : in CORBA.Any); + Data : in CORBA.Any); function Create return Object_Ptr; @@ -71,10 +67,8 @@ private type Event_Channel_Record; type Event_Channel_Access is access Event_Channel_Record; - type Object is - new PortableServer.Servant_Base with - record - X : Event_Channel_Access; - end record; + type Object is new PortableServer.Servant_Base with record + X : Event_Channel_Access; + end record; end CosEventChannelAdmin.EventChannel.Impl; diff --git a/cos/event/coseventchanneladmin-proxypullconsumer-impl.adb b/cos/event/coseventchanneladmin-proxypullconsumer-impl.adb index 71a2a4734..72e9486a9 100644 --- a/cos/event/coseventchanneladmin-proxypullconsumer-impl.adb +++ b/cos/event/coseventchanneladmin-proxypullconsumer-impl.adb @@ -31,11 +31,16 @@ -- -- ------------------------------------------------------------------------------ -with CosEventComm; use CosEventComm; +with CORBA.Object; +pragma Warnings (Off, CORBA.Object); + +with PortableServer; + +with CosEventComm; with CosEventComm.PullSupplier; -with CosEventChannelAdmin; use CosEventChannelAdmin; +with CosEventChannelAdmin; with CosEventChannelAdmin.SupplierAdmin.Impl; @@ -49,14 +54,7 @@ pragma Warnings (Off, CosEventChannelAdmin.ProxyPullConsumer.Skel); with CosEventChannelAdmin.SupplierAdmin.Impl; -with PolyORB.CORBA_P.Server_Tools; use PolyORB.CORBA_P.Server_Tools; -with PolyORB.Tasking.Soft_Links; use PolyORB.Tasking.Soft_Links; - -with PortableServer; use PortableServer; - -with CORBA.Object; -pragma Warnings (Off, CORBA.Object); - +with PolyORB.CORBA_P.Server_Tools; with PolyORB.Log; @@ -64,19 +62,32 @@ with PolyORB.Tasking.Threads; with PolyORB.Tasking.Mutexes; with PolyORB.Tasking.Condition_Variables; - package body CosEventChannelAdmin.ProxyPullConsumer.Impl is + use CosEventComm; + use CosEventChannelAdmin; + + use PortableServer; + use PolyORB.Tasking.Condition_Variables; use PolyORB.Tasking.Mutexes; use PolyORB.Tasking.Threads; + use PolyORB.CORBA_P.Server_Tools; - use PolyORB.Log; + use PolyORB.Log; package L is new PolyORB.Log.Facility_Log ("proxypullconsumer"); procedure O (Message : in Standard.String; Level : Log_Level := Debug) renames L.Output; + type Proxy_Pull_Consumer_Record is record + This : Object_Ptr; + Peer : PullSupplier.Ref; + Admin : SupplierAdmin.Impl.Object_Ptr; + Engin_Launched : Boolean := False; + -- is there a thread launch for the engine + end record; + A_S : Object_Ptr := null; -- This variable is used to initialize the threads local variable. -- it is used to replace the 'accept' statement. @@ -85,6 +96,9 @@ package body CosEventChannelAdmin.ProxyPullConsumer.Impl is Session_Taken : Condition_Access; -- Synchornisation of task initialization. + Peer_Mutex : Mutex_Access; + -- Protect access on a peer component + T_Initialized : Boolean := False; procedure Ensure_Initialization; @@ -102,31 +116,18 @@ package body CosEventChannelAdmin.ProxyPullConsumer.Impl is end if; Create (Session_Mutex); Create (Session_Taken); + Create (Peer_Mutex); + T_Initialized := True; end Ensure_Initialization; - -- task type Proxy_Pull_Consumer_Engin is - -- entry Connect (Consumer : in Object_Ptr); - -- end Proxy_Pull_Consumer_Engin; - --- type Proxy_Pull_Consumer_Engin_Access is access Proxy_Pull_Consumer_Engin; - - - type Proxy_Pull_Consumer_Record is - record - This : Object_Ptr; - Peer : PullSupplier.Ref; - Admin : SupplierAdmin.Impl.Object_Ptr; - Engin_Launch : Boolean := False; - -- is there a thread launch for the engine - end record; - ------------------------------- -- Proxy_Pull_Consumer_Engin -- ------------------------------- - procedure Proxy_Pull_Consumer_Engin; - procedure Proxy_Pull_Consumer_Engin + procedure Proxy_Pull_Consumer_Engine; + + procedure Proxy_Pull_Consumer_Engine is This : Object_Ptr; Peer : PullSupplier.Ref; @@ -150,9 +151,9 @@ package body CosEventChannelAdmin.ProxyPullConsumer.Impl is loop -- Session thread main loop. - Enter_Critical_Section; + Enter (Peer_Mutex); Peer := This.X.Peer; - Leave_Critical_Section; + Leave (Peer_Mutex); exit when PullSupplier.Is_Nil (Peer); @@ -170,53 +171,9 @@ package body CosEventChannelAdmin.ProxyPullConsumer.Impl is SupplierAdmin.Impl.Post (This.X.Admin, Event); end loop; - This.X.Engin_Launch := False; - end Proxy_Pull_Consumer_Engin; - - --- task body Proxy_Pull_Consumer_Engin --- is --- This : Object_Ptr; --- Peer : PullSupplier.Ref; --- Event : CORBA.Any; - --- begin --- loop --- select --- accept Connect --- (Consumer : Object_Ptr) --- do --- This := Consumer; --- end Connect; --- or --- terminate; --- end select; --- --- loop --- Enter_Critical_Section; --- Peer := This.X.Peer; --- Leave_Critical_Section; --- --- exit when PullSupplier.Is_Nil (Peer); --- --- pragma Debug --- (O ("pull new data from proxy pull consumer engin")); --- --- begin --- Event := PullSupplier.pull (Peer); --- exception when others => --- exit; --- end; --- --- pragma Debug --- (O ("post new data from proxy pull consumer to admin")); --- --- SupplierAdmin.Impl.Post (This.X.Admin, Event); --- end loop; --- end loop; --- end Proxy_Pull_Consumer_Engin; - + This.X.Engin_Launched := False; + end Proxy_Pull_Consumer_Engine; --------------------------- -- Connect_Pull_Supplier -- @@ -224,10 +181,12 @@ package body CosEventChannelAdmin.ProxyPullConsumer.Impl is procedure Connect_Pull_Supplier (Self : access Object; - Pull_Supplier : in CosEventComm.PullSupplier.Ref) is + Pull_Supplier : in CosEventComm.PullSupplier.Ref) is begin pragma Debug (O ("connect pull supplier to proxy pull consumer")); + Ensure_Initialization; + Enter (Session_Mutex); if not PullSupplier.Is_Nil (Self.X.Peer) then Leave (Session_Mutex); @@ -238,9 +197,9 @@ package body CosEventChannelAdmin.ProxyPullConsumer.Impl is A_S := Self.X.This; -- Start engin - if Self.X.Engin_Launch = False then - Create_Task (Proxy_Pull_Consumer_Engin'Access); - Self.X.Engin_Launch := True; + if not Self.X.Engin_Launched then + Create_Task (Proxy_Pull_Consumer_Engine'Access); + Self.X.Engin_Launched := True; -- thread created end if; @@ -248,39 +207,15 @@ package body CosEventChannelAdmin.ProxyPullConsumer.Impl is Wait (Session_Taken, Session_Mutex); Leave (Session_Mutex); - end Connect_Pull_Supplier; - - - -- procedure Connect_Pull_Supplier - -- (Self : access Object; - -- Pull_Supplier : in CosEventComm.PullSupplier.Ref) is - -- begin - -- pragma Debug (O ("connect pull supplier to proxy pull consumer")); - - -- Enter_Critical_Section; - -- if not PullSupplier.Is_Nil (Self.X.Peer) then - -- Leave_Critical_Senction; - -- raise AlreadyConnected; - -- end if; - - -- Self.X.Peer := Pull_Supplier; - - -- Start engin - -- if Self.X.Engin = null then - -- Self.X.Engin := new Proxy_Pull_Consumer_Engin; - -- end if; - - -- Self.X.Engin.Connect (Self.X.This); - -- Leave_Critical_Section; - -- end Connect_Pull_Supplier; - ------------ -- Create -- ------------ - function Create (Admin : SupplierAdmin.Impl.Object_Ptr) return Object_Ptr + function Create + (Admin : SupplierAdmin.Impl.Object_Ptr) + return Object_Ptr is Consumer : Object_Ptr; My_Ref : ProxyPullConsumer.Ref; @@ -309,10 +244,10 @@ package body CosEventChannelAdmin.ProxyPullConsumer.Impl is begin pragma Debug (O ("disconnect proxy pull consumer")); - Enter_Critical_Section; + Enter (Peer_Mutex); Peer := Self.X.Peer; Self.X.Peer := Nil_Ref; - Leave_Critical_Section; + Leave (Peer_Mutex); if not PullSupplier.Is_Nil (Peer) then PullSupplier.disconnect_pull_supplier (Peer); diff --git a/cos/event/coseventchanneladmin-proxypullconsumer-impl.ads b/cos/event/coseventchanneladmin-proxypullconsumer-impl.ads index 066764f2c..a277eff39 100644 --- a/cos/event/coseventchanneladmin-proxypullconsumer-impl.ads +++ b/cos/event/coseventchanneladmin-proxypullconsumer-impl.ads @@ -47,7 +47,7 @@ package CosEventChannelAdmin.ProxyPullConsumer.Impl is procedure Connect_Pull_Supplier (Self : access Object; - Pull_Supplier : in CosEventComm.PullSupplier.Ref); + Pull_Supplier : in CosEventComm.PullSupplier.Ref); ------------------ -- PullConsumer -- @@ -69,9 +69,8 @@ private type Proxy_Pull_Consumer_Record; type Proxy_Pull_Consumer_Access is access all Proxy_Pull_Consumer_Record; - type Object is new PortableServer.Servant_Base with - record - X : Proxy_Pull_Consumer_Access; - end record; + type Object is new PortableServer.Servant_Base with record + X : Proxy_Pull_Consumer_Access; + end record; end CosEventChannelAdmin.ProxyPullConsumer.Impl; diff --git a/cos/event/coseventchanneladmin-proxypullsupplier-impl.adb b/cos/event/coseventchanneladmin-proxypullsupplier-impl.adb index b16b54262..eb00b7bcf 100644 --- a/cos/event/coseventchanneladmin-proxypullsupplier-impl.adb +++ b/cos/event/coseventchanneladmin-proxypullsupplier-impl.adb @@ -31,11 +31,14 @@ -- -- ------------------------------------------------------------------------------ -with CosEventComm; use CosEventComm; +with CORBA.Object; +pragma Warnings (Off, CORBA.Object); + +with PortableServer; with CosEventComm.PullConsumer; -with CosEventChannelAdmin; use CosEventChannelAdmin; +with CosEventChannelAdmin; with CosEventChannelAdmin.ProxyPullSupplier.Helper; pragma Elaborate (CosEventChannelAdmin.ProxyPullSupplier.Helper); @@ -47,22 +50,24 @@ pragma Warnings (Off, CosEventChannelAdmin.ProxyPullSupplier.Skel); with CosEventChannelAdmin.ConsumerAdmin.Impl; -with PolyORB.CORBA_P.Server_Tools; use PolyORB.CORBA_P.Server_Tools; -with PolyORB.Tasking.Soft_Links; use PolyORB.Tasking.Soft_Links; - -with PolyORB.Tasking.Semaphores; use PolyORB.Tasking.Semaphores; - -with PortableServer; use PortableServer; - -with CORBA.Object; -pragma Warnings (Off, CORBA.Object); - with PolyORB.Log; +with PolyORB.CORBA_P.Server_Tools; +with PolyORB.Tasking.Mutexes; +with PolyORB.Tasking.Semaphores; with PolyORB.Utils.Chained_Lists; package body CosEventChannelAdmin.ProxyPullSupplier.Impl is + use PortableServer; + + use CosEventComm; + use CosEventChannelAdmin; + + use PolyORB.CORBA_P.Server_Tools; + use PolyORB.Tasking.Mutexes; + use PolyORB.Tasking.Semaphores; + use PolyORB.Log; package L is new PolyORB.Log.Facility_Log ("proxypullsupplier"); procedure O (Message : in Standard.String; Level : Log_Level := Debug) @@ -74,14 +79,32 @@ package body CosEventChannelAdmin.ProxyPullSupplier.Impl is subtype Event_Queue is Event_Queues.List; - type Proxy_Pull_Supplier_Record is - record - This : Object_Ptr; - Peer : PullConsumer.Ref; - Admin : ConsumerAdmin.Impl.Object_Ptr; - Queue : Event_Queue; - Semaphore : Semaphore_Access; - end record; + type Proxy_Pull_Supplier_Record is record + This : Object_Ptr; + Peer : PullConsumer.Ref; + Admin : ConsumerAdmin.Impl.Object_Ptr; + Queue : Event_Queue; + Semaphore : Semaphore_Access; + end record; + + --------------------------- + -- Ensure_Initialization -- + --------------------------- + + procedure Ensure_Initialization; + pragma Inline (Ensure_Initialization); + -- Ensure that the Mutexes are initialized + + T_Initialized : Boolean := False; + Self_Mutex : Mutex_Access; + + procedure Ensure_Initialization is + begin + if not T_Initialized then + Create (Self_Mutex); + T_Initialized := True; + end if; + end Ensure_Initialization; --------------------------- -- Connect_Pull_Consumer -- @@ -89,25 +112,30 @@ package body CosEventChannelAdmin.ProxyPullSupplier.Impl is procedure Connect_Pull_Consumer (Self : access Object; - Pull_Consumer : in PullConsumer.Ref) is - + Pull_Consumer : in PullConsumer.Ref) is begin pragma Debug (O ("connect pull consumer to proxy pull supplier")); + Ensure_Initialization; + + Enter (Self_Mutex); - Enter_Critical_Section; if not PullConsumer.Is_Nil (Self.X.Peer) then - Leave_Critical_Section; + Leave (Self_Mutex); raise AlreadyConnected; end if; + Self.X.Peer := Pull_Consumer; - Leave_Critical_Section; + + Leave (Self_Mutex); end Connect_Pull_Consumer; ------------ -- Create -- ------------ - function Create (Admin : ConsumerAdmin.Impl.Object_Ptr) return Object_Ptr + function Create + (Admin : ConsumerAdmin.Impl.Object_Ptr) + return Object_Ptr is Supplier : Object_Ptr; My_Ref : ProxyPullSupplier.Ref; @@ -120,7 +148,9 @@ package body CosEventChannelAdmin.ProxyPullSupplier.Impl is Supplier.X.This := Supplier; Supplier.X.Admin := Admin; Create (Supplier.X.Semaphore); + Initiate_Servant (Servant (Supplier), My_Ref); + return Supplier; end Create; @@ -137,11 +167,14 @@ package body CosEventChannelAdmin.ProxyPullSupplier.Impl is begin pragma Debug (O ("disconnect proxy pull supplier")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); Peer := Self.X.Peer; Self.X.Peer := Nil_Ref; + Leave (Self_Mutex); + V (Self.X.Semaphore); - Leave_Critical_Section; if not PullConsumer.Is_Nil (Peer) then PullConsumer.disconnect_pull_consumer (Peer); @@ -154,16 +187,17 @@ package body CosEventChannelAdmin.ProxyPullSupplier.Impl is procedure Post (Self : access Object; - Data : in CORBA.Any) is - + Data : in CORBA.Any) is begin pragma Debug (O ("post new data to proxy pull supplier")); - Enter_Critical_Section; - Append (Self.X.Queue, Data); - V (Self.X.Semaphore); - Leave_Critical_Section; + Ensure_Initialization; + Enter (Self_Mutex); + Append (Self.X.Queue, Data); + Leave (Self_Mutex); + + V (Self.X.Semaphore); end Post; ---------- @@ -180,18 +214,25 @@ package body CosEventChannelAdmin.ProxyPullSupplier.Impl is pragma Debug (O ("attempt to pull new data from proxy pull supplier")); + Ensure_Initialization; + P (Self.X.Semaphore); - Enter_Critical_Section; + + Enter (Self_Mutex); + if PullConsumer.Is_Nil (Self.X.Peer) then - Leave_Critical_Section; + Leave (Self_Mutex); raise Disconnected; end if; if State (Self.X.Semaphore) >= 0 then Extract_First (Self.X.Queue, Event); + pragma Debug (O ("succeed to pull data from proxy pull supplier")); end if; - Leave_Critical_Section; - pragma Debug (O ("succeed to pull new data from proxy pull supplier")); + + Leave (Self_Mutex); + + -- XXX what if nothing was pulled ? return Event; end Pull; @@ -202,26 +243,29 @@ package body CosEventChannelAdmin.ProxyPullSupplier.Impl is procedure Try_Pull (Self : access Object; - Has_Event : out CORBA.Boolean; - Returns : out CORBA.Any) is - + Has_Event : out CORBA.Boolean; + Returns : out CORBA.Any) is begin pragma Debug (O ("try to pull new data from proxy pull supplier")); - Enter_Critical_Section; + + Ensure_Initialization; + + Enter (Self_Mutex); + if PullConsumer.Is_Nil (Self.X.Peer) then - Leave_Critical_Section; + Leave (Self_Mutex); raise Disconnected; end if; - if State (Self.X.Semaphore) <= 0 then - Has_Event := False; + Has_Event := State (Self.X.Semaphore) > 0; - else - Has_Event := True; + if Has_Event then Extract_First (Self.X.Queue, Returns); + Leave (Self_Mutex); + P (Self.X.Semaphore); end if; - Leave_Critical_Section; + end Try_Pull; end CosEventChannelAdmin.ProxyPullSupplier.Impl; diff --git a/cos/event/coseventchanneladmin-proxypullsupplier-impl.ads b/cos/event/coseventchanneladmin-proxypullsupplier-impl.ads index 72fed4df3..7b16581a8 100644 --- a/cos/event/coseventchanneladmin-proxypullsupplier-impl.ads +++ b/cos/event/coseventchanneladmin-proxypullsupplier-impl.ads @@ -37,14 +37,13 @@ with CosEventChannelAdmin.ConsumerAdmin.Impl; package CosEventChannelAdmin.ProxyPullSupplier.Impl is - type Object is - new PortableServer.Servant_Base with private; + type Object is new PortableServer.Servant_Base with private; type Object_Ptr is access all Object'Class; procedure Connect_Pull_Consumer (Self : access Object; - Pull_Consumer : in CosEventComm.PullConsumer.Ref); + Pull_Consumer : in CosEventComm.PullConsumer.Ref); function Pull (Self : access Object) @@ -52,8 +51,8 @@ package CosEventChannelAdmin.ProxyPullSupplier.Impl is procedure Try_Pull (Self : access Object; - Has_Event : out CORBA.Boolean; - Returns : out CORBA.Any); + Has_Event : out CORBA.Boolean; + Returns : out CORBA.Any); procedure Disconnect_Pull_Supplier (Self : access Object); @@ -64,7 +63,7 @@ package CosEventChannelAdmin.ProxyPullSupplier.Impl is procedure Post (Self : access Object; - Data : in CORBA.Any); + Data : in CORBA.Any); function Create (Admin : CosEventChannelAdmin.ConsumerAdmin.Impl.Object_Ptr) @@ -75,10 +74,8 @@ private type Proxy_Pull_Supplier_Record; type Proxy_Pull_Supplier_Access is access all Proxy_Pull_Supplier_Record; - type Object is - new PortableServer.Servant_Base with - record - X : Proxy_Pull_Supplier_Access; - end record; + type Object is new PortableServer.Servant_Base with record + X : Proxy_Pull_Supplier_Access; + end record; end CosEventChannelAdmin.ProxyPullSupplier.Impl; diff --git a/cos/event/coseventchanneladmin-proxypushconsumer-impl.adb b/cos/event/coseventchanneladmin-proxypushconsumer-impl.adb index 18936dc3d..f092c5a99 100644 --- a/cos/event/coseventchanneladmin-proxypushconsumer-impl.adb +++ b/cos/event/coseventchanneladmin-proxypushconsumer-impl.adb @@ -31,11 +31,16 @@ -- -- ------------------------------------------------------------------------------ -with CosEventComm; use CosEventComm; +with CORBA.Object; +pragma Warnings (Off, CORBA.Object); + +with PortableServer; + +with CosEventComm; with CosEventComm.PushSupplier; -with CosEventChannelAdmin; use CosEventChannelAdmin; +with CosEventChannelAdmin; with CosEventChannelAdmin.ProxyPushConsumer.Helper; pragma Elaborate (CosEventChannelAdmin.ProxyPushConsumer.Helper); @@ -47,29 +52,49 @@ pragma Warnings (Off, CosEventChannelAdmin.ProxyPushConsumer.Skel); with CosEventChannelAdmin.SupplierAdmin.Impl; -with PolyORB.CORBA_P.Server_Tools; use PolyORB.CORBA_P.Server_Tools; -with PolyORB.Tasking.Soft_Links; use PolyORB.Tasking.Soft_Links; - -with PortableServer; use PortableServer; - -with CORBA.Object; -pragma Warnings (Off, CORBA.Object); - +with PolyORB.CORBA_P.Server_Tools; with PolyORB.Log; +with PolyORB.Tasking.Mutexes; package body CosEventChannelAdmin.ProxyPushConsumer.Impl is + use PortableServer; + + use CosEventComm; + use CosEventChannelAdmin; + + use PolyORB.CORBA_P.Server_Tools; + use PolyORB.Tasking.Mutexes; + use PolyORB.Log; package L is new PolyORB.Log.Facility_Log ("proxypushconsumer"); procedure O (Message : in Standard.String; Level : Log_Level := Debug) renames L.Output; - type Proxy_Push_Consumer_Record is - record - This : Object_Ptr; - Peer : PushSupplier.Ref; - Admin : SupplierAdmin.Impl.Object_Ptr; - end record; + type Proxy_Push_Consumer_Record is record + This : Object_Ptr; + Peer : PushSupplier.Ref; + Admin : SupplierAdmin.Impl.Object_Ptr; + end record; + + --------------------------- + -- Ensure_Initialization -- + --------------------------- + + procedure Ensure_Initialization; + pragma Inline (Ensure_Initialization); + -- Ensure that the Mutexes are initialized + + T_Initialized : Boolean := False; + Self_Mutex : Mutex_Access; + + procedure Ensure_Initialization is + begin + if not T_Initialized then + Create (Self_Mutex); + T_Initialized := True; + end if; + end Ensure_Initialization; --------------------------- -- Connect_Push_Supplier -- @@ -77,24 +102,30 @@ package body CosEventChannelAdmin.ProxyPushConsumer.Impl is procedure Connect_Push_Supplier (Self : access Object; - Push_Supplier : in CosEventComm.PushSupplier.Ref) is + Push_Supplier : in CosEventComm.PushSupplier.Ref) is begin pragma Debug (O ("connect push supplier to proxy push consumer")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); if not PushSupplier.Is_Nil (Self.X.Peer) then - Leave_Critical_Section; + Leave (Self_Mutex); raise AlreadyConnected; end if; + Self.X.Peer := Push_Supplier; - Leave_Critical_Section; + + Leave (Self_Mutex); end Connect_Push_Supplier; ------------ -- Create -- ------------ - function Create (Admin : SupplierAdmin.Impl.Object_Ptr) return Object_Ptr + function Create + (Admin : SupplierAdmin.Impl.Object_Ptr) + return Object_Ptr is Consumer : Object_Ptr; My_Ref : ProxyPushConsumer.Ref; @@ -106,7 +137,9 @@ package body CosEventChannelAdmin.ProxyPushConsumer.Impl is Consumer.X := new Proxy_Push_Consumer_Record; Consumer.X.This := Consumer; Consumer.X.Admin := Admin; + Initiate_Servant (Servant (Consumer), My_Ref); + return Consumer; end Create; @@ -123,10 +156,12 @@ package body CosEventChannelAdmin.ProxyPushConsumer.Impl is begin pragma Debug (O ("disconnect proxy push consumer")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); Peer := Self.X.Peer; Self.X.Peer := Nil_Ref; - Leave_Critical_Section; + Leave (Self_Mutex); if not PushSupplier.Is_Nil (Peer) then PushSupplier.disconnect_push_supplier (Peer); @@ -139,7 +174,7 @@ package body CosEventChannelAdmin.ProxyPushConsumer.Impl is procedure Push (Self : access Object; - Data : in CORBA.Any) is + Data : in CORBA.Any) is begin pragma Debug (O ("push new data from proxy push consumer to supplier admin")); diff --git a/cos/event/coseventchanneladmin-proxypushconsumer-impl.ads b/cos/event/coseventchanneladmin-proxypushconsumer-impl.ads index 20d7bed78..42f512f16 100644 --- a/cos/event/coseventchanneladmin-proxypushconsumer-impl.ads +++ b/cos/event/coseventchanneladmin-proxypushconsumer-impl.ads @@ -37,8 +37,7 @@ with CosEventChannelAdmin.SupplierAdmin.Impl; package CosEventChannelAdmin.ProxyPushConsumer.Impl is - type Object is - new PortableServer.Servant_Base with private; + type Object is new PortableServer.Servant_Base with private; type Object_Ptr is access all Object'Class; @@ -66,10 +65,8 @@ private type Proxy_Push_Consumer_Record; type Proxy_Push_Consumer_Access is access all Proxy_Push_Consumer_Record; - type Object is - new PortableServer.Servant_Base with - record - X : Proxy_Push_Consumer_Access; - end record; + type Object is new PortableServer.Servant_Base with record + X : Proxy_Push_Consumer_Access; + end record; end CosEventChannelAdmin.ProxyPushConsumer.Impl; diff --git a/cos/event/coseventchanneladmin-proxypushsupplier-impl.adb b/cos/event/coseventchanneladmin-proxypushsupplier-impl.adb index df783f1f4..2f4fac6b4 100644 --- a/cos/event/coseventchanneladmin-proxypushsupplier-impl.adb +++ b/cos/event/coseventchanneladmin-proxypushsupplier-impl.adb @@ -31,12 +31,13 @@ -- -- ------------------------------------------------------------------------------ -with CosEventComm; use CosEventComm; +with CORBA.Object; +pragma Warnings (Off, CORBA.Object); + +with PortableServer; with CosEventComm.PushConsumer; -with CosEventChannelAdmin; use CosEventChannelAdmin; - with CosEventChannelAdmin.ConsumerAdmin; with CosEventChannelAdmin.ProxyPushSupplier.Helper; @@ -47,30 +48,50 @@ with CosEventChannelAdmin.ProxyPushSupplier.Skel; pragma Elaborate (CosEventChannelAdmin.ProxyPushSupplier.Skel); pragma Warnings (Off, CosEventChannelAdmin.ProxyPushSupplier.Skel); -with PolyORB.CORBA_P.Server_Tools; use PolyORB.CORBA_P.Server_Tools; -with PolyORB.Tasking.Soft_Links; use PolyORB.Tasking.Soft_Links; - - -with PortableServer; use PortableServer; - -with CORBA.Object; -pragma Warnings (Off, CORBA.Object); +with PolyORB.CORBA_P.Server_Tools; +with PolyORB.Tasking.Mutexes; with PolyORB.Log; package body CosEventChannelAdmin.ProxyPushSupplier.Impl is + use PortableServer; + + use CosEventComm; + use CosEventChannelAdmin; + + use PolyORB.CORBA_P.Server_Tools; + use PolyORB.Tasking.Mutexes; + use PolyORB.Log; package L is new PolyORB.Log.Facility_Log ("proxypushsupplier"); procedure O (Message : in Standard.String; Level : Log_Level := Debug) renames L.Output; - type Proxy_Push_Supplier_Record is - record - This : Object_Ptr; - Peer : PushConsumer.Ref; - Admin : ConsumerAdmin.Impl.Object_Ptr; - end record; + type Proxy_Push_Supplier_Record is record + This : Object_Ptr; + Peer : PushConsumer.Ref; + Admin : ConsumerAdmin.Impl.Object_Ptr; + end record; + + --------------------------- + -- Ensure_Initialization -- + --------------------------- + + procedure Ensure_Initialization; + pragma Inline (Ensure_Initialization); + -- Ensure that the Mutexes are initialized + + T_Initialized : Boolean := False; + Self_Mutex : Mutex_Access; + + procedure Ensure_Initialization is + begin + if not T_Initialized then + Create (Self_Mutex); + T_Initialized := True; + end if; + end Ensure_Initialization; --------------------------- -- Connect_Push_Consumer -- @@ -78,24 +99,31 @@ package body CosEventChannelAdmin.ProxyPushSupplier.Impl is procedure Connect_Push_Consumer (Self : access Object; - Push_Consumer : in CosEventComm.PushConsumer.Ref) is + Push_Consumer : in CosEventComm.PushConsumer.Ref) is begin pragma Debug (O ("connect push consumer to proxy push supplier")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); + if not PushConsumer.Is_Nil (Self.X.Peer) then - Leave_Critical_Section; + Leave (Self_Mutex); raise AlreadyConnected; end if; + Self.X.Peer := Push_Consumer; - Leave_Critical_Section; + + Leave (Self_Mutex); end Connect_Push_Consumer; ------------ -- Create -- ------------ - function Create (Admin : ConsumerAdmin.Impl.Object_Ptr) return Object_Ptr + function Create + (Admin : ConsumerAdmin.Impl.Object_Ptr) + return Object_Ptr is Supplier : ProxyPushSupplier.Impl.Object_Ptr; My_Ref : ProxyPushSupplier.Ref; @@ -107,7 +135,9 @@ package body CosEventChannelAdmin.ProxyPushSupplier.Impl is Supplier.X := new Proxy_Push_Supplier_Record; Supplier.X.This := Supplier; Supplier.X.Admin := Admin; + Initiate_Servant (Servant (Supplier), My_Ref); + return Supplier; end Create; @@ -124,10 +154,12 @@ package body CosEventChannelAdmin.ProxyPushSupplier.Impl is begin pragma Debug (O ("disconnect proxy push supplier")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); Peer := Self.X.Peer; Self.X.Peer := Nil_Ref; - Leave_Critical_Section; + Leave (Self_Mutex); if PushConsumer.Is_Nil (Peer) then PushConsumer.disconnect_push_consumer (Peer); @@ -140,15 +172,17 @@ package body CosEventChannelAdmin.ProxyPushSupplier.Impl is procedure Post (Self : access Object; - Data : in CORBA.Any) is + Data : in CORBA.Any) is begin pragma Debug (O ("post new data from proxy push supplier to push consumer")); begin PushConsumer.push (Self.X.Peer, Data); - exception when others => - null; + exception + when others => + pragma Debug (O ("Got exception in Post")); + raise; end; end Post; diff --git a/cos/event/coseventchanneladmin-proxypushsupplier-impl.ads b/cos/event/coseventchanneladmin-proxypushsupplier-impl.ads index 50da77cff..3a9749bfd 100644 --- a/cos/event/coseventchanneladmin-proxypushsupplier-impl.ads +++ b/cos/event/coseventchanneladmin-proxypushsupplier-impl.ads @@ -37,8 +37,7 @@ with CosEventChannelAdmin.ConsumerAdmin.Impl; package CosEventChannelAdmin.ProxyPushSupplier.Impl is - type Object is - new PortableServer.Servant_Base with private; + type Object is new PortableServer.Servant_Base with private; type Object_Ptr is access all Object'Class; @@ -55,7 +54,7 @@ package CosEventChannelAdmin.ProxyPushSupplier.Impl is procedure Post (Self : access Object; - Data : in CORBA.Any); + Data : in CORBA.Any); function Create (Admin : CosEventChannelAdmin.ConsumerAdmin.Impl.Object_Ptr) @@ -66,10 +65,8 @@ private type Proxy_Push_Supplier_Record; type Proxy_Push_Supplier_Access is access Proxy_Push_Supplier_Record; - type Object is - new PortableServer.Servant_Base with - record - X : Proxy_Push_Supplier_Access; - end record; + type Object is new PortableServer.Servant_Base with record + X : Proxy_Push_Supplier_Access; + end record; end CosEventChannelAdmin.ProxyPushSupplier.Impl; diff --git a/cos/event/coseventchanneladmin-supplieradmin-impl.adb b/cos/event/coseventchanneladmin-supplieradmin-impl.adb index c598123b1..90c4e530c 100644 --- a/cos/event/coseventchanneladmin-supplieradmin-impl.adb +++ b/cos/event/coseventchanneladmin-supplieradmin-impl.adb @@ -31,7 +31,12 @@ -- -- ------------------------------------------------------------------------------ -with CosEventChannelAdmin; use CosEventChannelAdmin; +with CORBA.Impl; +pragma Warnings (Off, CORBA.Impl); + +with CORBA.Sequences.Unbounded; + +with PortableServer; with CosEventChannelAdmin.EventChannel.Impl; @@ -51,23 +56,20 @@ with CosEventChannelAdmin.SupplierAdmin.Skel; pragma Elaborate (CosEventChannelAdmin.SupplierAdmin.Skel); pragma Warnings (Off, CosEventChannelAdmin.SupplierAdmin.Skel); -with PolyORB.CORBA_P.Server_Tools; use PolyORB.CORBA_P.Server_Tools; -with PolyORB.Tasking.Soft_Links; use PolyORB.Tasking.Soft_Links; - -with CORBA.Impl; -pragma Warnings (Off, CORBA.Impl); - -with CORBA.Sequences.Unbounded; - -with PortableServer; use PortableServer; - +with PolyORB.CORBA_P.Server_Tools; +with PolyORB.Tasking.Mutexes; with PolyORB.Log; package body CosEventChannelAdmin.SupplierAdmin.Impl is + use CosEventChannelAdmin; + use PortableServer; + + use PolyORB.CORBA_P.Server_Tools; + use PolyORB.Tasking.Mutexes; use PolyORB.Log; - package L is new PolyORB.Log.Facility_Log ("consumeradmin"); + package L is new PolyORB.Log.Facility_Log ("supplieradmin"); procedure O (Message : in Standard.String; Level : Log_Level := Debug) renames L.Output; @@ -77,13 +79,31 @@ package body CosEventChannelAdmin.SupplierAdmin.Impl is package PushConsumers is new CORBA.Sequences.Unbounded (ProxyPushConsumer.Impl.Object_Ptr); - type Supplier_Admin_Record is - record - This : Object_Ptr; - Channel : EventChannel.Impl.Object_Ptr; - Pushs : PushConsumers.Sequence; - Pulls : PullConsumers.Sequence; - end record; + type Supplier_Admin_Record is record + This : Object_Ptr; + Channel : EventChannel.Impl.Object_Ptr; + Pushs : PushConsumers.Sequence; + Pulls : PullConsumers.Sequence; + end record; + + --------------------------- + -- Ensure_Initialization -- + --------------------------- + + procedure Ensure_Initialization; + pragma Inline (Ensure_Initialization); + -- Ensure that the Mutexes are initialized + + T_Initialized : Boolean := False; + Self_Mutex : Mutex_Access; + + procedure Ensure_Initialization is + begin + if not T_Initialized then + Create (Self_Mutex); + T_Initialized := True; + end if; + end Ensure_Initialization; ------------ -- Create -- @@ -98,11 +118,13 @@ package body CosEventChannelAdmin.SupplierAdmin.Impl is begin pragma Debug (O ("create supplier admin")); - Supplier := new Object; - Supplier.X := new Supplier_Admin_Record; + Supplier := new Object; + Supplier.X := new Supplier_Admin_Record; Supplier.X.This := Supplier; Supplier.X.Channel := Channel; + Initiate_Servant (Servant (Supplier), My_Ref); + return Supplier; end Create; @@ -120,11 +142,15 @@ package body CosEventChannelAdmin.SupplierAdmin.Impl is begin pragma Debug (O ("obtain proxy pull consumer from supplier admin")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); Consumer := ProxyPullConsumer.Impl.Create (Self.X.This); PullConsumers.Append (Self.X.Pulls, Consumer); - Leave_Critical_Section; + Leave (Self_Mutex); + Servant_To_Reference (Servant (Consumer), Its_Ref); + return Its_Ref; end Obtain_Pull_Consumer; @@ -142,11 +168,15 @@ package body CosEventChannelAdmin.SupplierAdmin.Impl is begin pragma Debug (O ("obtain proxy push consumer from supplier admin")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); Consumer := ProxyPushConsumer.Impl.Create (Self.X.This); PushConsumers.Append (Self.X.Pushs, Consumer); - Leave_Critical_Section; + Leave (Self_Mutex); + Servant_To_Reference (Servant (Consumer), Its_Ref); + return Its_Ref; end Obtain_Push_Consumer; @@ -156,7 +186,7 @@ package body CosEventChannelAdmin.SupplierAdmin.Impl is procedure Post (Self : access Object; - Data : in CORBA.Any) is + Data : in CORBA.Any) is begin pragma Debug (O ("post new data from supplier admin to channel")); diff --git a/cos/event/coseventchanneladmin-supplieradmin-impl.ads b/cos/event/coseventchanneladmin-supplieradmin-impl.ads index a69c12238..17ae40786 100644 --- a/cos/event/coseventchanneladmin-supplieradmin-impl.ads +++ b/cos/event/coseventchanneladmin-supplieradmin-impl.ads @@ -38,8 +38,7 @@ with PortableServer; package CosEventChannelAdmin.SupplierAdmin.Impl is - type Object is - new PortableServer.Servant_Base with private; + type Object is new PortableServer.Servant_Base with private; type Object_Ptr is access all Object'Class; @@ -61,17 +60,15 @@ package CosEventChannelAdmin.SupplierAdmin.Impl is procedure Post (Self : access Object; - Data : in CORBA.Any); + Data : in CORBA.Any); private type Supplier_Admin_Record; type Supplier_Admin_Access is access all Supplier_Admin_Record; - type Object is - new PortableServer.Servant_Base with - record - X : Supplier_Admin_Access; - end record; + type Object is new PortableServer.Servant_Base with record + X : Supplier_Admin_Access; + end record; end CosEventChannelAdmin.SupplierAdmin.Impl; diff --git a/cos/event/coseventcomm-pullconsumer-impl.adb b/cos/event/coseventcomm-pullconsumer-impl.adb index 8df67d62f..b507eb472 100644 --- a/cos/event/coseventcomm-pullconsumer-impl.adb +++ b/cos/event/coseventcomm-pullconsumer-impl.adb @@ -31,6 +31,11 @@ -- -- ------------------------------------------------------------------------------ +with CORBA.Impl; +pragma Warnings (Off, CORBA.Impl); + +with PortableServer; + with CosEventComm.PullConsumer.Helper; pragma Elaborate (CosEventComm.PullConsumer.Helper); pragma Warnings (Off, CosEventComm.PullConsumer.Helper); @@ -39,32 +44,50 @@ with CosEventComm.PullConsumer.Skel; pragma Elaborate (CosEventComm.PullConsumer.Skel); pragma Warnings (Off, CosEventComm.PullConsumer.Skel); -with CosEventChannelAdmin; use CosEventChannelAdmin; +with CosEventChannelAdmin; with CosEventChannelAdmin.ProxyPullSupplier; -with PolyORB.CORBA_P.Server_Tools; use PolyORB.CORBA_P.Server_Tools; -with PolyORB.Tasking.Soft_Links; use PolyORB.Tasking.Soft_Links; - -with CORBA.Impl; -pragma Warnings (Off, CORBA.Impl); - -with PortableServer; use PortableServer; - +with PolyORB.CORBA_P.Server_Tools; +with PolyORB.Tasking.Mutexes; with PolyORB.Log; package body CosEventComm.PullConsumer.Impl is + use CosEventChannelAdmin; + use PortableServer; + + use PolyORB.CORBA_P.Server_Tools; + use PolyORB.Tasking.Mutexes; + use PolyORB.Log; package L is new PolyORB.Log.Facility_Log ("pullconsumer"); procedure O (Message : in Standard.String; Level : Log_Level := Debug) renames L.Output; - type Pull_Consumer_Record is - record - This : Object_Ptr; - Peer : ProxyPullSupplier.Ref; - end record; + type Pull_Consumer_Record is record + This : Object_Ptr; + Peer : ProxyPullSupplier.Ref; + end record; + + --------------------------- + -- Ensure_Initialization -- + --------------------------- + + procedure Ensure_Initialization; + pragma Inline (Ensure_Initialization); + -- Ensure that the Mutexes are initialized + + T_Initialized : Boolean := False; + Self_Mutex : Mutex_Access; + + procedure Ensure_Initialization is + begin + if not T_Initialized then + Create (Self_Mutex); + T_Initialized := True; + end if; + end Ensure_Initialization; --------------------------------- -- Connect_Proxy_Pull_Supplier -- @@ -79,13 +102,15 @@ package body CosEventComm.PullConsumer.Impl is begin pragma Debug (O ("connect proxy pull consumer to pull supplier")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); if not ProxyPullSupplier.Is_Nil (Self.X.Peer) then - Leave_Critical_Section; + Leave (Self_Mutex); raise AlreadyConnected; end if; Self.X.Peer := Proxy; - Leave_Critical_Section; + Leave (Self_Mutex); Servant_To_Reference (Servant (Self.X.This), My_Ref); ProxyPullSupplier.connect_pull_consumer (Proxy, My_Ref); @@ -106,7 +131,9 @@ package body CosEventComm.PullConsumer.Impl is Consumer := new Object; Consumer.X := new Pull_Consumer_Record; Consumer.X.This := Consumer; + Initiate_Servant (Servant (Consumer), My_Ref); + return Consumer; end Create; @@ -123,10 +150,12 @@ package body CosEventComm.PullConsumer.Impl is begin pragma Debug (O ("disconnect pull consumer")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); Peer := Self.X.Peer; Self.X.Peer := Nil_Ref; - Leave_Critical_Section; + Leave (Self_Mutex); if not ProxyPullSupplier.Is_Nil (Peer) then ProxyPullSupplier.disconnect_pull_supplier (Peer); @@ -137,16 +166,20 @@ package body CosEventComm.PullConsumer.Impl is -- Pull -- ---------- - function Pull (Self : access Object) return CORBA.Any + function Pull + (Self : access Object) + return CORBA.Any is Peer : ProxyPullSupplier.Ref; begin pragma Debug (O ("pull new data from pull consumer")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); Peer := Self.X.Peer; - Leave_Critical_Section; + Leave (Self_Mutex); if ProxyPullSupplier.Is_Nil (Peer) then raise Disconnected; @@ -161,17 +194,19 @@ package body CosEventComm.PullConsumer.Impl is procedure Try_Pull (Self : access Object; - Done : out CORBA.Boolean; - Returns : out CORBA.Any) + Done : out CORBA.Boolean; + Returns : out CORBA.Any) is Peer : ProxyPullSupplier.Ref; begin pragma Debug (O ("try to pull new data from pull consumer")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); Peer := Self.X.Peer; - Leave_Critical_Section; + Leave (Self_Mutex); if ProxyPullSupplier.Is_Nil (Peer) then raise Disconnected; diff --git a/cos/event/coseventcomm-pullconsumer-impl.ads b/cos/event/coseventcomm-pullconsumer-impl.ads index 46e37a43e..b86e5993a 100644 --- a/cos/event/coseventcomm-pullconsumer-impl.ads +++ b/cos/event/coseventcomm-pullconsumer-impl.ads @@ -40,8 +40,7 @@ package CosEventComm.PullConsumer.Impl is -- This implementation is supposed to be application -- dependent. This is an example used to test the event service. - type Object is - new PortableServer.Servant_Base with private; + type Object is new PortableServer.Servant_Base with private; type Object_Ptr is access all Object'Class; @@ -66,8 +65,8 @@ package CosEventComm.PullConsumer.Impl is procedure Try_Pull (Self : access Object; - Done : out CORBA.Boolean; - Returns : out CORBA.Any); + Done : out CORBA.Boolean; + Returns : out CORBA.Any); -- Call by application to try to consume an event private @@ -75,10 +74,8 @@ private type Pull_Consumer_Record; type Pull_Consumer_Access is access Pull_Consumer_Record; - type Object is - new PortableServer.Servant_Base with - record - X : Pull_Consumer_Access; - end record; + type Object is new PortableServer.Servant_Base with record + X : Pull_Consumer_Access; + end record; end CosEventComm.PullConsumer.Impl; diff --git a/cos/event/coseventcomm-pullsupplier-impl.adb b/cos/event/coseventcomm-pullsupplier-impl.adb index 4e6dfd429..ddacdb5d0 100644 --- a/cos/event/coseventcomm-pullsupplier-impl.adb +++ b/cos/event/coseventcomm-pullsupplier-impl.adb @@ -31,10 +31,11 @@ -- -- ------------------------------------------------------------------------------ -with CORBA; with CORBA.Impl; pragma Warnings (Off, CORBA.Impl); +with PortableServer; + with CosEventComm.PullSupplier.Helper; pragma Elaborate (CosEventComm.PullSupplier.Helper); pragma Warnings (Off, CosEventComm.PullSupplier.Helper); @@ -43,35 +44,54 @@ with CosEventComm.PullSupplier.Skel; pragma Elaborate (CosEventComm.PullSupplier.Skel); pragma Warnings (Off, CosEventComm.PullSupplier.Skel); -with CosEventChannelAdmin; use CosEventChannelAdmin; - with CosEventChannelAdmin.ProxyPullConsumer; -with PolyORB.CORBA_P.Server_Tools; use PolyORB.CORBA_P.Server_Tools; -with PolyORB.Tasking.Soft_Links; use PolyORB.Tasking.Soft_Links; +with PolyORB.CORBA_P.Server_Tools; +with PolyORB.Tasking.Semaphores; +with PolyORB.Tasking.Mutexes; with PolyORB.Log; -with PolyORB.Tasking.Semaphores; use PolyORB.Tasking.Semaphores; - -with PortableServer; use PortableServer; - package body CosEventComm.PullSupplier.Impl is + use CosEventChannelAdmin; + use PortableServer; - use PolyORB.Log; + use PolyORB.CORBA_P.Server_Tools; + use PolyORB.Tasking.Semaphores; + use PolyORB.Tasking.Mutexes; + + use PolyORB.Log; package L is new PolyORB.Log.Facility_Log ("pullsupplier"); procedure O (Message : in Standard.String; Level : Log_Level := Debug) renames L.Output; - type Pull_Supplier_Record is - record - This : Object_Ptr; - Peer : ProxyPullConsumer.Ref; - Empty : Boolean; - Event : CORBA.Any; - Semaphore : Semaphore_Access; - end record; + type Pull_Supplier_Record is record + This : Object_Ptr; + Peer : ProxyPullConsumer.Ref; + Empty : Boolean; + Event : CORBA.Any; + Semaphore : Semaphore_Access; + end record; + + --------------------------- + -- Ensure_Initialization -- + --------------------------- + + procedure Ensure_Initialization; + pragma Inline (Ensure_Initialization); + -- Ensure that the Mutexes are initialized + + T_Initialized : Boolean := False; + Self_Mutex : Mutex_Access; + + procedure Ensure_Initialization is + begin + if not T_Initialized then + Create (Self_Mutex); + T_Initialized := True; + end if; + end Ensure_Initialization; --------------------------------- -- Connect_Proxy_Pull_Consumer -- @@ -79,20 +99,22 @@ package body CosEventComm.PullSupplier.Impl is procedure Connect_Proxy_Pull_Consumer (Self : access Object; - Proxy : in CosEventChannelAdmin.ProxyPullConsumer.Ref) + Proxy : in CosEventChannelAdmin.ProxyPullConsumer.Ref) is My_Ref : PullSupplier.Ref; begin pragma Debug (O ("connect proxy pull supplier to pull consumer")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); if not ProxyPullConsumer.Is_Nil (Self.X.Peer) then - Leave_Critical_Section; + Leave (Self_Mutex); raise AlreadyConnected; end if; Self.X.Peer := Proxy; - Leave_Critical_Section; + Leave (Self_Mutex); Servant_To_Reference (Servant (Self.X.This), My_Ref); ProxyPullConsumer.connect_pull_supplier (Proxy, My_Ref); @@ -102,7 +124,8 @@ package body CosEventComm.PullSupplier.Impl is -- Create -- ------------ - function Create return Object_Ptr + function Create + return Object_Ptr is Supplier : Object_Ptr; My_Ref : PullSupplier.Ref; @@ -115,7 +138,9 @@ package body CosEventComm.PullSupplier.Impl is Supplier.X.This := Supplier; Supplier.X.Empty := True; Create (Supplier.X.Semaphore); + Initiate_Servant (Servant (Supplier), My_Ref); + return Supplier; end Create; @@ -132,11 +157,14 @@ package body CosEventComm.PullSupplier.Impl is begin pragma Debug (O ("disconnect pull supplier")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); Peer := Self.X.Peer; Self.X.Peer := Nil_Ref; + Leave (Self_Mutex); + V (Self.X.Semaphore); - Leave_Critical_Section; if not ProxyPullConsumer.Is_Nil (Peer) then ProxyPullConsumer.disconnect_pull_consumer (Peer); @@ -154,23 +182,27 @@ package body CosEventComm.PullSupplier.Impl is Event : CORBA.Any; begin + + Ensure_Initialization; + loop pragma Debug (O ("attempt to pull new data from pull supplier")); + P (Self.X.Semaphore); - Enter_Critical_Section; + Enter (Self_Mutex); if ProxyPullConsumer.Is_Nil (Self.X.Peer) then - Leave_Critical_Section; + Leave (Self_Mutex); raise Disconnected; end if; if not Self.X.Empty then Event := Self.X.Event; Self.X.Empty := True; - Leave_Critical_Section; + Leave (Self_Mutex); exit; end if; - Leave_Critical_Section; - P (Self.X.Semaphore); + + Leave (Self_Mutex); end loop; pragma Debug (O ("succeed to pull new data from pull supplier")); @@ -184,16 +216,18 @@ package body CosEventComm.PullSupplier.Impl is procedure Push (Self : access Object; - Data : in CORBA.Any) is - + Data : in CORBA.Any) is begin pragma Debug (O ("push new data to pull supplier")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); Self.X.Empty := False; Self.X.Event := Data; + Leave (Self_Mutex); + V (Self.X.Semaphore); - Leave_Critical_Section; end Push; -------------- @@ -202,26 +236,27 @@ package body CosEventComm.PullSupplier.Impl is procedure Try_Pull (Self : access Object; - Has_Event : out CORBA.Boolean; - Returns : out CORBA.Any) is + Has_Event : out CORBA.Boolean; + Returns : out CORBA.Any) is begin pragma Debug (O ("try to pull new data from pull supplier")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); if ProxyPullConsumer.Is_Nil (Self.X.Peer) then - Leave_Critical_Section; + Leave (Self_Mutex); raise Disconnected; end if; - if Self.X.Empty then - Has_Event := False; + Has_Event := not Self.X.Empty; - else - Has_Event := True; + if Has_Event then Returns := Self.X.Event; Self.X.Empty := True; end if; - Leave_Critical_Section; + + Leave (Self_Mutex); end Try_Pull; end CosEventComm.PullSupplier.Impl; diff --git a/cos/event/coseventcomm-pullsupplier-impl.ads b/cos/event/coseventcomm-pullsupplier-impl.ads index beb726c61..dc94c0b85 100644 --- a/cos/event/coseventcomm-pullsupplier-impl.ads +++ b/cos/event/coseventcomm-pullsupplier-impl.ads @@ -42,8 +42,7 @@ package CosEventComm.PullSupplier.Impl is -- This implementation is supposed to be application -- dependent. This is an example used to test the event service. - type Object is - new PortableServer.Servant_Base with private; + type Object is new PortableServer.Servant_Base with private; type Object_Ptr is access all Object'Class; @@ -58,8 +57,8 @@ package CosEventComm.PullSupplier.Impl is procedure Try_Pull (Self : access Object; - Has_Event : out CORBA.Boolean; - Returns : out CORBA.Any); + Has_Event : out CORBA.Boolean; + Returns : out CORBA.Any); -- Call by proxy to try yo pull an event ------------------------ @@ -68,7 +67,7 @@ package CosEventComm.PullSupplier.Impl is procedure Connect_Proxy_Pull_Consumer (Self : access Object; - Proxy : in CosEventChannelAdmin.ProxyPullConsumer.Ref); + Proxy : in CosEventChannelAdmin.ProxyPullConsumer.Ref); -- Call by application to connect object with proxy function Create return Object_Ptr; @@ -76,7 +75,7 @@ package CosEventComm.PullSupplier.Impl is procedure Push (Self : access Object; - Data : in CORBA.Any); + Data : in CORBA.Any); -- Call by application to produce an event private @@ -84,10 +83,8 @@ private type Pull_Supplier_Record; type Pull_Supplier_Access is access Pull_Supplier_Record; - type Object is - new PortableServer.Servant_Base with - record - X : Pull_Supplier_Access; - end record; + type Object is new PortableServer.Servant_Base with record + X : Pull_Supplier_Access; + end record; end CosEventComm.PullSupplier.Impl; diff --git a/cos/event/coseventcomm-pushconsumer-impl.adb b/cos/event/coseventcomm-pushconsumer-impl.adb index 19c945c8a..60ecd14b6 100644 --- a/cos/event/coseventcomm-pushconsumer-impl.adb +++ b/cos/event/coseventcomm-pushconsumer-impl.adb @@ -31,9 +31,12 @@ -- -- ------------------------------------------------------------------------------ -with CORBA; +with CORBA.Impl; +pragma Warnings (Off, CORBA.Impl); -with CosEventChannelAdmin; use CosEventChannelAdmin; +with PortableServer; + +with CosEventChannelAdmin; with CosEventChannelAdmin.ProxyPushSupplier; @@ -45,33 +48,52 @@ with CosEventComm.PushConsumer.Skel; pragma Elaborate (CosEventComm.PushConsumer.Skel); pragma Warnings (Off, CosEventComm.PushConsumer.Skel); -with PolyORB.CORBA_P.Server_Tools; use PolyORB.CORBA_P.Server_Tools; -with PolyORB.Tasking.Soft_Links; use PolyORB.Tasking.Soft_Links; +with PolyORB.CORBA_P.Server_Tools; +with PolyORB.Tasking.Mutexes; +with PolyORB.Tasking.Semaphores; with PolyORB.Log; -with PolyORB.Tasking.Semaphores; use PolyORB.Tasking.Semaphores; - -with CORBA.Impl; -pragma Warnings (Off, CORBA.Impl); - -with PortableServer; use PortableServer; - package body CosEventComm.PushConsumer.Impl is + use PortableServer; + + use CosEventChannelAdmin; + + use PolyORB.CORBA_P.Server_Tools; + use PolyORB.Tasking.Mutexes; + use PolyORB.Tasking.Semaphores; use PolyORB.Log; package L is new PolyORB.Log.Facility_Log ("pushconsumer"); procedure O (Message : in Standard.String; Level : Log_Level := Debug) renames L.Output; - type Push_Consumer_Record is - record - This : Object_Ptr; - Peer : ProxyPushSupplier.Ref; - Empty : Boolean; - Event : CORBA.Any; - Semaphore : Semaphore_Access; - end record; + type Push_Consumer_Record is record + This : Object_Ptr; + Peer : ProxyPushSupplier.Ref; + Empty : Boolean; + Event : CORBA.Any; + Semaphore : Semaphore_Access; + end record; + + --------------------------- + -- Ensure_Initialization -- + --------------------------- + + procedure Ensure_Initialization; + pragma Inline (Ensure_Initialization); + -- Ensure that the Mutexes are initialized + + T_Initialized : Boolean := False; + Self_Mutex : Mutex_Access; + + procedure Ensure_Initialization is + begin + if not T_Initialized then + Create (Self_Mutex); + T_Initialized := True; + end if; + end Ensure_Initialization; --------------------------------- -- Connect_Proxy_Push_Supplier -- @@ -79,20 +101,22 @@ package body CosEventComm.PushConsumer.Impl is procedure Connect_Proxy_Push_Supplier (Self : access Object; - Proxy : in CosEventChannelAdmin.ProxyPushSupplier.Ref) + Proxy : in CosEventChannelAdmin.ProxyPushSupplier.Ref) is My_Ref : PushConsumer.Ref; begin pragma Debug (O ("connect proxy push consumer to push supplier")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); if not ProxyPushSupplier.Is_Nil (Self.X.Peer) then - Leave_Critical_Section; + Leave (Self_Mutex); raise AlreadyConnected; end if; Self.X.Peer := Proxy; - Leave_Critical_Section; + Leave (Self_Mutex); Servant_To_Reference (Servant (Self.X.This), My_Ref); ProxyPushSupplier.connect_push_consumer (Proxy, My_Ref); @@ -102,7 +126,8 @@ package body CosEventComm.PushConsumer.Impl is -- Create -- ------------ - function Create return Object_Ptr + function Create + return Object_Ptr is Consumer : Object_Ptr; My_Ref : PushConsumer.Ref; @@ -132,11 +157,14 @@ package body CosEventComm.PushConsumer.Impl is begin pragma Debug (O ("disconnect push consumer")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); Peer := Self.X.Peer; Self.X.Peer := Nil_Ref; + Leave (Self_Mutex); + V (Self.X.Semaphore); - Leave_Critical_Section; if not ProxyPushSupplier.Is_Nil (Peer) then ProxyPushSupplier.disconnect_push_supplier (Peer); @@ -148,28 +176,32 @@ package body CosEventComm.PushConsumer.Impl is ---------- function Pull - (Self : access Object) return CORBA.Any + (Self : access Object) + return CORBA.Any is Event : CORBA.Any; begin + Ensure_Initialization; + loop pragma Debug (O ("attempt to pull new data from push consumer")); + P (Self.X.Semaphore); - Enter_Critical_Section; + Enter (Self_Mutex); if ProxyPushSupplier.Is_Nil (Self.X.Peer) then - Leave_Critical_Section; + Leave (Self_Mutex); raise Disconnected; end if; if not Self.X.Empty then Self.X.Empty := True; Event := Self.X.Event; - Leave_Critical_Section; + Leave (Self_Mutex); exit; end if; - Leave_Critical_Section; - P (Self.X.Semaphore); + + Leave (Self_Mutex); end loop; pragma Debug (O ("succeed to pull new data from push consumer")); @@ -182,15 +214,17 @@ package body CosEventComm.PushConsumer.Impl is procedure Push (Self : access Object; - Data : in CORBA.Any) is + Data : in CORBA.Any) is begin pragma Debug (O ("push new data to push consumer")); + Ensure_Initialization; - Enter_Critical_Section; + Enter (Self_Mutex); Self.X.Empty := False; Self.X.Event := Data; + Leave (Self_Mutex); + V (Self.X.Semaphore); - Leave_Critical_Section; end Push; -------------- @@ -199,26 +233,28 @@ package body CosEventComm.PushConsumer.Impl is procedure Try_Pull (Self : access Object; - Done : out CORBA.Boolean; - Data : out CORBA.Any) is + Done : out CORBA.Boolean; + Data : out CORBA.Any) is begin pragma Debug (O ("try to pull new data from push consumer")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); + if ProxyPushSupplier.Is_Nil (Self.X.Peer) then - Leave_Critical_Section; + Leave (Self_Mutex); raise Disconnected; end if; - if Self.X.Empty then - Done := False; + Done := not Self.X.Empty; - else - Done := True; + if Done then Self.X.Empty := True; Data := Self.X.Event; end if; - Leave_Critical_Section; + + Leave (Self_Mutex); end Try_Pull; end CosEventComm.PushConsumer.Impl; diff --git a/cos/event/coseventcomm-pushconsumer-impl.ads b/cos/event/coseventcomm-pushconsumer-impl.ads index 15b113c54..00e9efb18 100644 --- a/cos/event/coseventcomm-pushconsumer-impl.ads +++ b/cos/event/coseventcomm-pushconsumer-impl.ads @@ -42,14 +42,13 @@ package CosEventComm.PushConsumer.Impl is -- This implementation is supposed to be application -- dependent. This is an example used to test the event service. - type Object is - new PortableServer.Servant_Base with private; + type Object is new PortableServer.Servant_Base with private; type Object_Ptr is access all Object'Class; procedure Push (Self : access Object; - Data : in CORBA.Any); + Data : in CORBA.Any); -- Call by proxy to push an event procedure Disconnect_Push_Consumer @@ -62,7 +61,7 @@ package CosEventComm.PushConsumer.Impl is procedure Connect_Proxy_Push_Supplier (Self : access Object; - Proxy : in CosEventChannelAdmin.ProxyPushSupplier.Ref); + Proxy : in CosEventChannelAdmin.ProxyPushSupplier.Ref); -- Call by application to connect object with proxy function Create return Object_Ptr; @@ -74,8 +73,8 @@ package CosEventComm.PushConsumer.Impl is procedure Try_Pull (Self : access Object; - Done : out CORBA.Boolean; - Data : out CORBA.Any); + Done : out CORBA.Boolean; + Data : out CORBA.Any); -- Call by application to try to consume an event private @@ -83,10 +82,8 @@ private type Push_Consumer_Record; type Push_Consumer_Access is access Push_Consumer_Record; - type Object is - new PortableServer.Servant_Base with - record - X : Push_Consumer_Access; - end record; + type Object is new PortableServer.Servant_Base with record + X : Push_Consumer_Access; + end record; end CosEventComm.PushConsumer.Impl; diff --git a/cos/event/coseventcomm-pushsupplier-impl.adb b/cos/event/coseventcomm-pushsupplier-impl.adb index bc5c24440..21fe27b93 100644 --- a/cos/event/coseventcomm-pushsupplier-impl.adb +++ b/cos/event/coseventcomm-pushsupplier-impl.adb @@ -31,6 +31,11 @@ -- -- ------------------------------------------------------------------------------ +with CORBA.Impl; +pragma Warnings (Off, CORBA.Impl); + +with PortableServer; + with CosEventComm.PushSupplier.Helper; pragma Elaborate (CosEventComm.PushSupplier.Helper); pragma Warnings (Off, CosEventComm.PushSupplier.Helper); @@ -39,33 +44,51 @@ with CosEventComm.PushSupplier.Skel; pragma Elaborate (CosEventComm.PushSupplier.Skel); pragma Warnings (Off, CosEventComm.PushSupplier.Skel); -with CosEventChannelAdmin; use CosEventChannelAdmin; +with CosEventChannelAdmin; with CosEventChannelAdmin.ProxyPushConsumer; - -with PolyORB.CORBA_P.Server_Tools; use PolyORB.CORBA_P.Server_Tools; -with PolyORB.Tasking.Soft_Links; use PolyORB.Tasking.Soft_Links; - -with CORBA.Impl; -pragma Warnings (Off, CORBA.Impl); - -with PortableServer; use PortableServer; - +with PolyORB.CORBA_P.Server_Tools; +with PolyORB.Tasking.Mutexes; with PolyORB.Log; package body CosEventComm.PushSupplier.Impl is - use PolyORB.Log; + use CosEventChannelAdmin; + + use PortableServer; + + use PolyORB.CORBA_P.Server_Tools; + use PolyORB.Tasking.Mutexes; + + use PolyORB.Log; package L is new PolyORB.Log.Facility_Log ("pushsupplier"); procedure O (Message : in Standard.String; Level : Log_Level := Debug) renames L.Output; - type Push_Supplier_Record is - record - This : Object_Ptr; - Peer : ProxyPushConsumer.Ref; - end record; + type Push_Supplier_Record is record + This : Object_Ptr; + Peer : ProxyPushConsumer.Ref; + end record; + + --------------------------- + -- Ensure_Initialization -- + --------------------------- + + procedure Ensure_Initialization; + pragma Inline (Ensure_Initialization); + -- Ensure that the Mutexes are initialized + + T_Initialized : Boolean := False; + Self_Mutex : Mutex_Access; + + procedure Ensure_Initialization is + begin + if not T_Initialized then + Create (Self_Mutex); + T_Initialized := True; + end if; + end Ensure_Initialization; --------------------------------- -- Connect_Proxy_Push_Consumer -- @@ -73,20 +96,22 @@ package body CosEventComm.PushSupplier.Impl is procedure Connect_Proxy_Push_Consumer (Self : access Object; - Proxy : in CosEventChannelAdmin.ProxyPushConsumer.Ref) + Proxy : in CosEventChannelAdmin.ProxyPushConsumer.Ref) is My_Ref : PushSupplier.Ref; begin pragma Debug (O ("connect proxy push supplier to push consumer")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); if not ProxyPushConsumer.Is_Nil (Self.X.Peer) then - Leave_Critical_Section; + Leave (Self_Mutex); raise AlreadyConnected; end if; Self.X.Peer := Proxy; - Leave_Critical_Section; + Leave (Self_Mutex); Servant_To_Reference (Servant (Self.X.This), My_Ref); ProxyPushConsumer.connect_push_supplier (Proxy, My_Ref); @@ -104,10 +129,12 @@ package body CosEventComm.PushSupplier.Impl is begin pragma Debug (O ("create push supplier")); - Supplier := new Object; - Supplier.X := new Push_Supplier_Record; + Supplier := new Object; + Supplier.X := new Push_Supplier_Record; Supplier.X.This := Supplier; + Initiate_Servant (Servant (Supplier), My_Ref); + return Supplier; end Create; @@ -124,10 +151,12 @@ package body CosEventComm.PushSupplier.Impl is begin pragma Debug (O ("disconnect push supplier")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); Peer := Self.X.Peer; Self.X.Peer := Nil_Ref; - Leave_Critical_Section; + Leave (Self_Mutex); if not ProxyPushConsumer.Is_Nil (Peer) then ProxyPushConsumer.disconnect_push_consumer (Peer); @@ -140,16 +169,18 @@ package body CosEventComm.PushSupplier.Impl is procedure Push (Self : access Object; - Data : in CORBA.Any) + Data : in CORBA.Any) is Peer : ProxyPushConsumer.Ref; begin pragma Debug (O ("push new data to push supplier")); - Enter_Critical_Section; + Ensure_Initialization; + + Enter (Self_Mutex); Peer := Self.X.Peer; - Leave_Critical_Section; + Leave (Self_Mutex); if ProxyPushConsumer.Is_Nil (Peer) then raise Disconnected; diff --git a/cos/event/coseventcomm-pushsupplier-impl.ads b/cos/event/coseventcomm-pushsupplier-impl.ads index 601e06988..621bb7141 100644 --- a/cos/event/coseventcomm-pushsupplier-impl.ads +++ b/cos/event/coseventcomm-pushsupplier-impl.ads @@ -42,8 +42,7 @@ package CosEventComm.PushSupplier.Impl is -- This implementation is supposed to be application -- dependent. This is an example used to test the event service. - type Object is - new PortableServer.Servant_Base with private; + type Object is new PortableServer.Servant_Base with private; type Object_Ptr is access all Object'Class; @@ -56,23 +55,21 @@ package CosEventComm.PushSupplier.Impl is procedure Connect_Proxy_Push_Consumer (Self : access Object; - Proxy : in CosEventChannelAdmin.ProxyPushConsumer.Ref); + Proxy : in CosEventChannelAdmin.ProxyPushConsumer.Ref); function Create return Object_Ptr; procedure Push (Self : access Object; - Data : in CORBA.Any); + Data : in CORBA.Any); private type Push_Supplier_Record; type Push_Supplier_Access is access Push_Supplier_Record; - type Object is - new PortableServer.Servant_Base with - record - X : Push_Supplier_Access; - end record; + type Object is new PortableServer.Servant_Base with record + X : Push_Supplier_Access; + end record; end CosEventComm.PushSupplier.Impl; diff --git a/cos/event/supplier.cmd b/cos/event/supplier.cmd index 078bc7c13..112ddf0e1 100644 --- a/cos/event/supplier.cmd +++ b/cos/event/supplier.cmd @@ -11,4 +11,4 @@ sleep 6 produce "running test 3" in pls sleep 6 produce "running test 4" in pls - +quit diff --git a/cos/event/test_event.adb b/cos/event/test_event.adb index d94bf9347..ebd5e9e9c 100644 --- a/cos/event/test_event.adb +++ b/cos/event/test_event.adb @@ -1,21 +1,21 @@ ------------------------------------------------------------------------------ -- -- --- ADABROKER SERVICES -- +-- POLYORB COMPONENTS -- -- -- -- T E S T _ E V E N T -- -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2000 ENST Paris University, France. -- +-- Copyright (C) 1999-2003 Free Software Fundation -- -- -- --- AdaBroker is free software; you can redistribute it and/or modify it -- +-- PolyORB is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- --- version. AdaBroker is distributed in the hope that it will be useful, -- +-- version. PolyORB is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -- -- License for more details. You should have received a copy of the GNU -- --- General Public License distributed with AdaBroker; see file COPYING. If -- +-- General Public License distributed with PolyORB; see file COPYING. If -- -- not, write to the Free Software Foundation, 59 Temple Place - Suite 330, -- -- Boston, MA 02111-1307, USA. -- -- -- @@ -26,24 +26,34 @@ -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- --- AdaBroker is maintained by ENST Paris University. -- --- (email: broker@inf.enst.fr) -- +-- PolyORB is maintained by ENST Paris University. -- -- -- ------------------------------------------------------------------------------ -with CosNaming; use CosNaming; -with CosNaming.NamingContext; -with CosNaming.NamingContext.Impl; -with CosNaming.NamingContext.Helper; +-- Test PolyORB COS event capabilities. + +-- $Id$ + +with Ada.Command_Line; +with Ada.Exceptions; +with Ada.Text_IO; + +with CORBA.Impl; +with CORBA.Object; +with CORBA.ORB; + +with PortableServer; with CosNaming.BindingIterator; -with CosEventChannelAdmin; use CosEventChannelAdmin; +with CosNaming.NamingContext.Impl; +with CosNaming.NamingContext.Helper; + +with CosEventChannelAdmin.ConsumerAdmin; -with CosEventChannelAdmin.EventChannel; with CosEventChannelAdmin.EventChannel.Impl; with CosEventChannelAdmin.EventChannel.Helper; -with CosEventChannelAdmin.ConsumerAdmin; + with CosEventChannelAdmin.SupplierAdmin; with CosEventChannelAdmin.ProxyPullConsumer; @@ -51,69 +61,55 @@ with CosEventChannelAdmin.ProxyPullSupplier; with CosEventChannelAdmin.ProxyPushConsumer; with CosEventChannelAdmin.ProxyPushSupplier; -with CosEventComm; use CosEventComm; - -with CosEventComm.PullConsumer; -with CosEventComm.PullSupplier; -with CosEventComm.PushConsumer; -with CosEventComm.PushSupplier; - with CosEventComm.PullConsumer.Helper; -with CosEventComm.PullSupplier.Helper; -with CosEventComm.PushConsumer.Helper; -with CosEventComm.PushSupplier.Helper; - with CosEventComm.PullConsumer.Impl; + +with CosEventComm.PullSupplier.Helper; with CosEventComm.PullSupplier.Impl; + +with CosEventComm.PushConsumer.Helper; with CosEventComm.PushConsumer.Impl; + +with CosEventComm.PushSupplier.Helper; with CosEventComm.PushSupplier.Impl; -use CosEventComm.PushConsumer.Impl; --- with PolyORB.Setup.No_Tasking_Server; --- pragma Elaborate_All (PolyORB.Setup.No_Tasking_Server); --- pragma Warnings (Off, PolyORB.Setup.No_Tasking_Server); +with PolyORB.CORBA_P.Server_Tools; + +with PolyORB.Tasking.Condition_Variables; +with PolyORB.Tasking.Mutexes; +with PolyORB.Tasking.Threads; with PolyORB.Setup.Thread_Pool_Server; pragma Elaborate_All (PolyORB.Setup.Thread_Pool_Server); pragma Warnings (Off, PolyORB.Setup.Thread_Pool_Server); -with CORBA; -with CORBA.Object; -with CORBA.Impl; -with CORBA.ORB; - -with PolyORB.CORBA_P.Server_Tools; -use PolyORB.CORBA_P.Server_Tools; - -with PolyORB.Log; - -with PortableServer; use PortableServer; - -with Menu; use Menu; - -with Ada.Text_IO; -with Ada.Exceptions; use Ada.Exceptions; - -with PolyORB.Tasking.Threads; -with PolyORB.Tasking.Mutexes; -with PolyORB.Tasking.Condition_Variables; - with Auto_Print; +-- Auxiliary code to output pushconsumer incoming messages. + +with Menu; +-- From COS Naming, provide text interface. + +with GNAT.OS_Lib; procedure Test_Event is - use Auto_Print; + use Ada.Exceptions; + use Auto_Print; + use Menu; + + use PortableServer; + + use CosNaming; + use CosEventChannelAdmin; + use CosEventComm; + use CosEventComm.PushConsumer.Impl; + + use PolyORB.CORBA_P.Server_Tools; use PolyORB.Tasking.Condition_Variables; use PolyORB.Tasking.Mutexes; use PolyORB.Tasking.Threads; - use PolyORB.Log; - package L is new PolyORB.Log.Facility_Log ("testevent"); - procedure O (Message : in Standard.String; Level : Log_Level := Debug) - renames L.Output; - - type Command is (Help, Quit, @@ -128,25 +124,19 @@ procedure Test_Event is Syntax_Error : exception; - function M (S : String) return String_Access; - function M (S : String) return String_Access is - begin - return new String'(S); - end M; - Help_Messages : constant array (Command) of String_Access - := (Help => M (ASCII.HT & "print this message"), - Quit => M (ASCII.HT & "quit this shell"), - Run => - M (ASCII.HT & "run M (ASCII.HT & "sleep "), - Create => M (ASCII.HT & "create "), - Connect => M (ASCII.HT & "connect to "), - Consume => M (ASCII.HT & "consume in "), - TryConsume => M ("tryconsume in "), - AutoDisplay => M ("autodisplay "), - Produce => M - (ASCII.HT & "produce in [ times]")); + := (Help => +(ASCII.HT & "print this message"), + Quit => +(ASCII.HT & "quit this shell"), + Run => +(ASCII.HT + & "run "), + Sleep => +(ASCII.HT & "sleep "), + Create => +(ASCII.HT & "create "), + Connect => +(ASCII.HT & "connect to "), + Consume => +(ASCII.HT & "consume in "), + TryConsume => +("tryconsume in "), + AutoDisplay => +("autodisplay "), + Produce => +(ASCII.HT + & "produce in [ times]")); type Entity_Kind is (K_Channel, @@ -164,14 +154,15 @@ procedure Test_Event is Ctx : NamingContext.Ref; - -------------------- -- Connect_Entity -- -------------------- + procedure Connect_Entity (Entity : in CORBA.Object.Ref; Kind : in Entity_Kind; Channel : in EventChannel.Ref); + procedure Connect_Entity (Entity : in CORBA.Object.Ref; Kind : in Entity_Kind; @@ -249,6 +240,7 @@ procedure Test_Event is ------------------- -- Consume_Event -- ------------------- + function Consume_Event (Entity : CORBA.Object.Ref; Kind : Entity_Kind) @@ -294,6 +286,7 @@ procedure Test_Event is ----------------------- -- Try_Consume_Event -- ----------------------- + function Try_Consume_Event (Entity : CORBA.Object.Ref; Kind : Entity_Kind) @@ -349,13 +342,14 @@ procedure Test_Event is ------------------- -- Create_Entity -- ------------------- - procedure Create_Entity - (Entity : out CORBA.Object.Ref; - Kind : in Entity_Kind); procedure Create_Entity (Entity : out CORBA.Object.Ref; - Kind : in Entity_Kind) is + Kind : in Entity_Kind); + + procedure Create_Entity + (Entity : out CORBA.Object.Ref; + Kind : in Entity_Kind) is begin case Kind is when K_Channel => @@ -408,13 +402,14 @@ procedure Test_Event is ----------------- -- Find_Entity -- ----------------- + procedure Find_Entity - (Name : in String_Access; + (Name : in String_Access; Entity : out CORBA.Object.Ref; Kind : out Entity_Kind); procedure Find_Entity - (Name : in String_Access; + (Name : in String_Access; Entity : out CORBA.Object.Ref; Kind : out Entity_Kind) is @@ -450,6 +445,7 @@ procedure Test_Event is ------------------- -- Produce_Event -- ------------------- + procedure Produce_Event (Entity : CORBA.Object.Ref; Kind : Entity_Kind; @@ -474,9 +470,12 @@ procedure Test_Event is begin S := PullSupplier.Helper.To_Ref (Entity); Reference_To_Servant (S, Servant (O)); - for I in 1 .. Times loop + Ada.Text_IO.New_Line; + for J in 1 .. Times loop PullSupplier.Impl.Push (PullSupplier.Impl.Object_Ptr (O), A); + Ada.Text_IO.Put ("."); end loop; + Ada.Text_IO.New_Line; end; when K_PushSupplier => @@ -486,9 +485,12 @@ procedure Test_Event is begin S := PushSupplier.Helper.To_Ref (Entity); Reference_To_Servant (S, Servant (O)); - for I in 1 .. Times loop + Ada.Text_IO.New_Line; + for J in 1 .. Times loop PushSupplier.Impl.Push (PushSupplier.Impl.Object_Ptr (O), A); + Ada.Text_IO.Put ("."); end loop; + Ada.Text_IO.New_Line; end; when others => @@ -496,10 +498,10 @@ procedure Test_Event is end case; end Produce_Event; - ------------- -- To_Name -- ------------- + function To_Name (S : String_Access; K : Entity_Kind) @@ -520,236 +522,275 @@ procedure Test_Event is return Result; end To_Name; - ----------- - -- Usage -- - ----------- - procedure Usage; - procedure Usage is + ------------------ + -- Display_Help -- + ------------------ + + procedure Display_Help; + + procedure Display_Help is begin for C in Help_Messages'Range loop Ada.Text_IO.Put_Line (C'Img & ASCII.HT & ASCII.HT & Help_Messages (C).all); + if C = Create then Ada.Text_IO.Put (ASCII.HT & " in"); for E in Entity_Kind'Range loop declare - I : constant String := E'Img; + I : constant String := Entity_Kind'Image (E); begin Ada.Text_IO.Put (' ' & I (3 .. I'Last)); end; end loop; Ada.Text_IO.New_Line; end if; + end loop; Ada.Text_IO.New_Line; - end Usage; + end Display_Help; - ---------------- - -- Test_Event -- - ---------------- - Argc : Natural; - Entity : CORBA.Object.Ref; - Channel : EventChannel.Ref; - Kind : Entity_Kind; + -------------- + -- Exit_All -- + -------------- -begin + procedure Exit_All; - CORBA.ORB.Initialize ("ORB"); - pragma Debug (O ("ORB Initialized")); - Initiate_Server (True); - pragma Debug (O ("Initiate_Server completed")); + procedure Exit_All is + begin + GNAT.OS_Lib.OS_Exit (1); + end Exit_All; - if Count ("enter naming IOR [otherwise create one]: ") = 0 then - Servant_To_Reference (Servant (NamingContext.Impl.Create), Ctx); - Ada.Text_IO.Put_Line - (CORBA.To_Standard_String - (CORBA.Object.Object_To_String - (CORBA.Object.Ref (Ctx)))); + --------------- + -- Main_Loop -- + --------------- - else - declare - Obj : CORBA.Object.Ref; + procedure Main_Loop; - begin - CORBA.ORB.String_To_Object - (CORBA.To_CORBA_String (Argument (1).all), Obj); - Ctx := NamingContext.Helper.To_Ref (Obj); - end; - end if; + procedure Main_Loop + is + Argc : Natural; + Entity : CORBA.Object.Ref; + Channel : EventChannel.Ref; + Kind : Entity_Kind; + begin + loop + Argc := Count; + if Argc > 0 + and then Argument (1)(Argument (1)'First) /= '#' + then + begin + case Command'Value (Argument (1).all) is + when Help => + Display_Help; - pragma Debug (O ("naming service created")); + when Quit => + Exit_All; - -- print menu - Usage; - - loop - Argc := Count; - if Argc > 0 - and then Argument (1)(Argument (1)'First) /= '#' - then - begin - case Command'Value (Argument (1).all) is - when Help => - Usage; - - when Quit => - exit; - - when Create => - if Argc /= 3 then - raise Syntax_Error; - end if; - - Kind := Entity_Kind'Value ("K_" & Argument (2).all); - declare - EK : Entity_Kind; - - begin - Find_Entity (Argument (3), Entity, EK); - - if EK /= Kind then - Ada.Text_IO.Put_Line - ("entity " & Argument (3).all & - " is a " & EK'Img); + when Create => + if Argc /= 3 then raise Syntax_Error; end if; - exception - when NamingContext.NotFound => - Create_Entity (Entity, Kind); - NamingContext.bind - (Ctx, To_Name (Argument (3), Kind), Entity); - end; + Kind := Entity_Kind'Value ("K_" & Argument (2).all); + declare + EK : Entity_Kind; - when Connect => - if Argc /= 4 then - raise Syntax_Error; - end if; + begin + Find_Entity (Argument (3), Entity, EK); - if Argument (3).all /= "to" then - raise Syntax_Error; - end if; - - Find_Entity (Argument (4), Entity, Kind); - if Kind /= K_Channel then - raise Syntax_Error; - end if; - Channel := EventChannel.Helper.To_Ref (Entity); - - Find_Entity (Argument (2), Entity, Kind); - Connect_Entity (Entity, Kind, Channel); - - when Consume => - if Argc /= 3 then - raise Syntax_Error; - end if; - - if Argument (2).all /= "in" then - raise Syntax_Error; - end if; - - Find_Entity (Argument (3), Entity, Kind); - Ada.Text_IO.Put_Line (Consume_Event (Entity, Kind)); - - when TryConsume => - if Argc /= 3 then - raise Syntax_Error; - end if; - - if Argument (2).all /= "in" then - raise Syntax_Error; - end if; - - Find_Entity (Argument (3), Entity, Kind); - Ada.Text_IO.Put_Line (Try_Consume_Event (Entity, Kind)); - - when Produce => - -- produce in [ times] [with priority ] - if Argc /= 4 and Argc /= 6 then - raise Syntax_Error; - end if; - - declare - N : Natural := 1; - begin - if Argc = 6 then - if Argument (6).all = "times" then - N := Natural'Value (Argument (5).all); - else + if EK /= Kind then + Ada.Text_IO.Put_Line + ("entity " & Argument (3).all & + " is a " & EK'Img); raise Syntax_Error; end if; - end if; - if Argument (3).all /= "in" then + exception + when NamingContext.NotFound => + Create_Entity (Entity, Kind); + NamingContext.bind + (Ctx, To_Name (Argument (3), Kind), Entity); + end; + + when Connect => + if Argc /= 4 + or else Argument (3).all /= "to" + then raise Syntax_Error; end if; Find_Entity (Argument (4), Entity, Kind); - Produce_Event (Entity, Kind, Argument (2), N); - end; - - when Run => - if Argc /= 2 then - raise Syntax_Error; - end if; - - Menu.Set_Input (Argument (2)); - - when Sleep => - if Argc /= 2 then - raise Syntax_Error; - end if; - - declare - N : constant Natural := Natural'Value (Argument (2).all); - begin - delay Duration (N); - end; - - when AutoDisplay => - if Argc /= 2 then - raise Syntax_Error; - end if; - - declare - Item : String (1 .. 255); - Last : Natural; - C : PushConsumer.Ref; - O : CORBA.Impl.Object_Ptr; - - begin - Find_Entity (Argument (2), Entity, Kind); - if Kind /= K_PushConsumer then - Ada.Text_IO.Put_Line ( - "Can be called only with a PushSupplier"); - else - C := PushConsumer.Helper.To_Ref (Entity); - Reference_To_Servant (C, Servant (O)); - Ensure_Initialization; - Enter (Session_Mutex); - A_S := O; - Create_Task (Auto_Display'Access); - Wait (Session_Taken, Session_Mutex); - -- wait A_S initialization in Priority_Queue_Engine - Leave (Session_Mutex); - - Ada.Text_IO.Get_Line (Item, Last); - EndDisplay := True; + if Kind /= K_Channel then + raise Syntax_Error; end if; - end; - end case; + Channel := EventChannel.Helper.To_Ref (Entity); - exception - when Syntax_Error => - Ada.Text_IO.Put_Line ("syntax error"); + Find_Entity (Argument (2), Entity, Kind); + Connect_Entity (Entity, Kind, Channel); - when E : others => - Ada.Text_IO.Put_Line ("raise "& Exception_Name (E)); - Ada.Text_IO.Put_Line (Exception_Message (E)); - Ada.Text_IO.Put_Line (Exception_Information (E)); + when Consume => + if Argc /= 3 + or else Argument (2).all /= "in" + then + raise Syntax_Error; + end if; + + Find_Entity (Argument (3), Entity, Kind); + Ada.Text_IO.Put_Line (Consume_Event (Entity, Kind)); + + when TryConsume => + if Argc /= 3 + or else Argument (2).all /= "in" + then + raise Syntax_Error; + end if; + + Find_Entity (Argument (3), Entity, Kind); + Ada.Text_IO.Put_Line (Try_Consume_Event (Entity, Kind)); + + when Produce => + if (Argc /= 4 + and then Argc /= 6) + or else Argument (3).all /= "in" + then + raise Syntax_Error; + end if; + + declare + N : Natural := 1; + begin + if Argc = 6 then + if Argument (6).all = "times" then + N := Natural'Value (Argument (5).all); + else + raise Syntax_Error; + end if; + end if; + + Find_Entity (Argument (4), Entity, Kind); + Produce_Event (Entity, Kind, Argument (2), N); + end; + + when Run => + if Argc /= 2 then + raise Syntax_Error; + end if; + + Set_Input (Argument (2)); + + when Sleep => + if Argc /= 2 then + raise Syntax_Error; + end if; + + declare + N : constant Natural + := Natural'Value (Argument (2).all); + begin + delay Duration (N); + end; + + when AutoDisplay => + if Argc /= 2 then + raise Syntax_Error; + end if; + + declare + Item : String (1 .. 255); + Last : Natural; + C : PushConsumer.Ref; + O : CORBA.Impl.Object_Ptr; + + begin + Find_Entity (Argument (2), Entity, Kind); + if Kind /= K_PushConsumer then + Ada.Text_IO.Put_Line + ("Can be called only with a PushConsumer"); + else + C := PushConsumer.Helper.To_Ref (Entity); + Reference_To_Servant (C, Servant (O)); + Ensure_Initialization; + Enter (Session_Mutex); + A_S := O; + Create_Task (Auto_Display'Access); + Wait (Session_Taken, Session_Mutex); + Leave (Session_Mutex); + + Ada.Text_IO.Get_Line (Item, Last); + EndDisplay := True; + end if; + end; + end case; + + exception + when Syntax_Error => + Ada.Text_IO.Put_Line ("syntax error"); + + when E : others => + Ada.Text_IO.Put_Line ("raise "& Exception_Name (E)); + Ada.Text_IO.Put_Line (Exception_Message (E)); + Ada.Text_IO.Put_Line (Exception_Information (E)); + end; + end if; + end loop; + end Main_Loop; + + -- main procedure begins here. + +begin + + CORBA.ORB.Initialize ("ORB"); + + Initiate_Server (True); + + if Ada.Command_Line.Argument_Count = 0 then + + -- Test_Event is used in interactive mode. + + if Count ("enter naming IOR [otherwise create one]: ") = 0 then + Servant_To_Reference (Servant (NamingContext.Impl.Create), Ctx); + Ada.Text_IO.Put_Line + (CORBA.To_Standard_String + (CORBA.Object.Object_To_String + (CORBA.Object.Ref (Ctx)))); + + else + declare + Obj : CORBA.Object.Ref; + + begin + CORBA.ORB.String_To_Object + (CORBA.To_CORBA_String (Argument (1).all), Obj); + Ctx := NamingContext.Helper.To_Ref (Obj); end; end if; - end loop; + Display_Help; + Main_Loop; + + else + + -- Test_Event is used in batch mode. + + if Ada.Command_Line.Argument_Count /= 2 then + Ada.Text_IO.New_Line; + Ada.Text_IO.Put_Line + ("usage: test_event [ ]"); + Exit_All; + end if; + + declare + Obj : CORBA.Object.Ref; + begin + CORBA.ORB.String_To_Object + (CORBA.To_CORBA_String (Ada.Command_Line.Argument (1)), Obj); + Ctx := NamingContext.Helper.To_Ref (Obj); + end; + + Set_Input (+Ada.Command_Line.Argument (2)); + + Main_Loop; + end if; end Test_Event;