diff --git a/MANIFEST b/MANIFEST index 4cd40a758..022b5cb28 100644 --- a/MANIFEST +++ b/MANIFEST @@ -586,6 +586,8 @@ src/corba/corba-nvlist.adb src/corba/corba-nvlist.ads src/corba/corba-object-helper.adb src/corba/corba-object-helper.ads +src/corba/corba-object-policies.adb +src/corba/corba-object-policies.ads src/corba/corba-object.adb src/corba/corba-object.ads src/corba/corba-orb.adb diff --git a/idls/CORBA_IDL/CORBA_DomainManager.idl b/idls/CORBA_IDL/CORBA_DomainManager.idl index 60085c0a4..1c51b9db2 100644 --- a/idls/CORBA_IDL/CORBA_DomainManager.idl +++ b/idls/CORBA_IDL/CORBA_DomainManager.idl @@ -15,6 +15,6 @@ //PolyORB:NI: in boolean constr_policy //PolyORB:NI: ); //PolyORB:NI: }; -//PolyORB:NI: -//PolyORB:NI: typedef sequence DomainManagersList; + + typedef sequence DomainManagersList; diff --git a/idls/CORBA_IDL/CORBA_Policy.idl b/idls/CORBA_IDL/CORBA_Policy.idl index 51f1ffdec..26b88fae7 100644 --- a/idls/CORBA_IDL/CORBA_Policy.idl +++ b/idls/CORBA_IDL/CORBA_Policy.idl @@ -12,6 +12,12 @@ typedef sequence PolicyList; typedef sequence PolicyTypeSeq; +//PolyORB:WACORBA: InvalidPolicies defined in CORBA 3.0.3 specification +//but not defined in OMG IDL files + exception InvalidPolicies { + sequence indices; + }; +//PolyORB:WACORBA: typedef short PolicyErrorCode; exception PolicyError {PolicyErrorCode reason;}; diff --git a/idls/CORBA_PIDL/CORBA_Object.idl b/idls/CORBA_PIDL/CORBA_Object.idl index dda36baa1..6f4dbca1b 100644 --- a/idls/CORBA_PIDL/CORBA_Object.idl +++ b/idls/CORBA_PIDL/CORBA_Object.idl @@ -44,28 +44,28 @@ in Flags req_flag ); -//PolyORB:NI: Policy get_policy ( -//PolyORB:NI: in PolicyType policy_type -//PolyORB:NI: ); -//PolyORB:NI: -//PolyORB:NI: DomainManagersList get_domain_managers (); -//PolyORB:NI: -//PolyORB:NI: Object set_policy_overrides( -//PolyORB:NI: in PolicyList policies, -//PolyORB:NI: in SetOverrideType set_add -//PolyORB:NI: ) raises(InvalidPolicies); -//PolyORB:NI: -//PolyORB:NI: Policy get_client_policy( -//PolyORB:NI: in PolicyType type -//PolyORB:NI: ); -//PolyORB:NI: -//PolyORB:NI: PolicyList get_policy_overrides( -//PolyORB:NI: in PolicyTypeSeq types -//PolyORB:NI: ); -//PolyORB:NI: + Policy get_policy ( + in PolicyType policy_type + ); + + DomainManagersList get_domain_managers (); + + Object set_policy_overrides( + in PolicyList policies, + in SetOverrideType set_add + ) raises(InvalidPolicies); + + Policy get_client_policy( + in PolicyType type + ); + + PolicyList get_policy_overrides( + in PolicyTypeSeq types + ); + //PolyORB:NI: boolean validate_connection( //PolyORB:NI: out PolicyList inconsistent_policies //PolyORB:NI: ); -//PolyORB:NI: + //PolyORB:NI: Object get_component (); }; diff --git a/src/corba/Makefile.am b/src/corba/Makefile.am index d23ba370a..34c8abbee 100644 --- a/src/corba/Makefile.am +++ b/src/corba/Makefile.am @@ -17,6 +17,7 @@ ADA_SPECS_WITH_BODY = \ corba-impl.ads \ corba-nvlist.ads \ corba-object-helper.ads \ + corba-object-policies.ads \ corba-object.ads \ corba-orb.ads \ corba-policy-helper.ads \ diff --git a/src/corba/corba-domainmanager-helper.adb b/src/corba/corba-domainmanager-helper.adb index 072e1c22b..26ee504df 100644 --- a/src/corba/corba-domainmanager-helper.adb +++ b/src/corba/corba-domainmanager-helper.adb @@ -35,12 +35,20 @@ with PolyORB.Initialization; with PolyORB.Utils.Strings; with CORBA.Object.Helper; +with PolyORB.Sequences.Unbounded.CORBA_Helper; package body CORBA.DomainManager.Helper is + package IDL_Sequence_CORBA_DomainManager_Helper is + new IDL_Sequence_CORBA_DomainManager.CORBA_Helper + (Element_To_Any => To_Any, + Element_From_Any => From_Any); + procedure Deferred_Initialization; - TC_DomainManager_Cache : TypeCode.Object; + TC_DomainManager_Cache : TypeCode.Object; + TC_IDL_Sequence_CORBA_DomainManager_Cache : TypeCode.Object; + TC_DomainManagersList_Cache : TypeCode.Object; ----------------------------- -- Deferred_Initialization -- @@ -54,12 +62,39 @@ package body CORBA.DomainManager.Helper is (TC_DomainManager_Cache, To_Any (To_CORBA_String ("DomainManager"))); TypeCode.Internals.Add_Parameter (TC_DomainManager_Cache, To_Any (To_CORBA_String (Repository_Id))); + + IDL_Sequence_CORBA_DomainManager_Helper.Initialize (TC_DomainManager); + TC_IDL_Sequence_CORBA_DomainManager_Cache := + IDL_Sequence_CORBA_DomainManager_Helper.Sequence_TC; + + TC_DomainManagersList_Cache := + TypeCode.Internals.To_CORBA_Object (PolyORB.Any.TypeCode.TC_Alias); + TypeCode.Internals.Add_Parameter + (TC_DomainManagersList_Cache, + To_Any (To_CORBA_String ("DomainManagersList"))); + TypeCode.Internals.Add_Parameter + (TC_DomainManagersList_Cache, + To_Any (To_CORBA_String ("IDL:CORBA_A/DomainManagersList:1.0"))); + TypeCode.Internals.Add_Parameter + (TC_DomainManagersList_Cache, + To_Any (TC_IDL_Sequence_CORBA_DomainManager)); end Deferred_Initialization; -------------- -- From_Any -- -------------- + function From_Any (Item : in Any) + return IDL_Sequence_CORBA_DomainManager.Sequence + renames IDL_Sequence_CORBA_DomainManager_Helper.From_Any; + + function From_Any (Item : in Any) return DomainManagersList is + Result : constant IDL_Sequence_CORBA_DomainManager.Sequence + := From_Any (Item); + begin + return DomainManagersList (Result); + end From_Any; + function From_Any (Item : in Any) return Ref is begin return To_Ref (Object.Helper.From_Any (Item)); @@ -74,10 +109,40 @@ package body CORBA.DomainManager.Helper is return TC_DomainManager_Cache; end TC_DomainManager; + --------------------------- + -- TC_DomainManagersList -- + --------------------------- + + function TC_DomainManagersList return TypeCode.Object is + begin + return TC_DomainManagersList_Cache; + end TC_DomainManagersList; + + ----------------------------------------- + -- TC_IDL_Sequence_CORBA_DomainManager -- + ----------------------------------------- + + function TC_IDL_Sequence_CORBA_DomainManager return TypeCode.Object is + begin + return TC_IDL_Sequence_CORBA_DomainManager_Cache; + end TC_IDL_Sequence_CORBA_DomainManager; + ------------ -- To_Any -- ------------ + function To_Any (Item : in IDL_Sequence_CORBA_DomainManager.Sequence) + return Any + renames IDL_Sequence_CORBA_DomainManager_Helper.To_Any; + + function To_Any (Item : in DomainManagersList) return Any is + Result : Any + := To_Any (IDL_Sequence_CORBA_DomainManager.Sequence (Item)); + begin + CORBA.Set_Type (Result, TC_DomainManagersList); + return Result; + end To_Any; + function To_Any (Item : in Ref) return Any is Result : Any := Object.Helper.To_Any (Object.Ref (Item)); begin diff --git a/src/corba/corba-domainmanager-helper.ads b/src/corba/corba-domainmanager-helper.ads index 9e8e3fe85..7103c0ed5 100644 --- a/src/corba/corba-domainmanager-helper.ads +++ b/src/corba/corba-domainmanager-helper.ads @@ -50,4 +50,21 @@ package CORBA.DomainManager.Helper is function To_Any (Item : in Ref) return Any; + -- DomainManager sequence + + function TC_IDL_Sequence_CORBA_DomainManager return TypeCode.Object; + + function From_Any (Item : in Any) + return IDL_Sequence_CORBA_DomainManager.Sequence; + + function To_Any + (Item : in IDL_Sequence_CORBA_DomainManager.Sequence) + return Any; + + function TC_DomainManagersList return TypeCode.Object; + + function From_Any (Item : in Any) return DomainManagersList; + + function To_Any (Item : in DomainManagersList) return Any; + end CORBA.DomainManager.Helper; diff --git a/src/corba/corba-domainmanager.ads b/src/corba/corba-domainmanager.ads index 49188be6e..76f6ab5ca 100644 --- a/src/corba/corba-domainmanager.ads +++ b/src/corba/corba-domainmanager.ads @@ -38,6 +38,7 @@ with CORBA.Object; with CORBA.Policy; +with CORBA.Sequences.Unbounded; package CORBA.DomainManager is @@ -51,7 +52,16 @@ package CORBA.DomainManager is function Is_A (Self : in Ref; Logical_Type_Id : in Standard.String) - return CORBA.Boolean; + return CORBA.Boolean; + + -- Implementation note: this Sequence type should be defined in + -- package CORBA. Yet, this would create circular dependencies + -- between CORBA and CORBA.Sequences. + + package IDL_Sequence_CORBA_DomainManager is + new CORBA.Sequences.Unbounded (Ref); + + type DomainManagersList is new IDL_Sequence_CORBA_DomainManager.Sequence; private diff --git a/src/corba/corba-object-policies.adb b/src/corba/corba-object-policies.adb new file mode 100644 index 000000000..f16452426 --- /dev/null +++ b/src/corba/corba-object-policies.adb @@ -0,0 +1,297 @@ +------------------------------------------------------------------------------ +-- -- +-- POLYORB COMPONENTS -- +-- -- +-- C O R B A . O B J E C T . P O L I C I E S -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2005 Free Software Foundation, Inc. -- +-- -- +-- 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 AdaCore -- +-- (email: sales@adacore.com) -- +-- -- +------------------------------------------------------------------------------ + +with PolyORB.Annotations; +with PolyORB.Any.NVList; +with PolyORB.ORB; +with PolyORB.Requests; +with PolyORB.Setup; +with PolyORB.Tasking.Threads.Annotations; + +with CORBA.DomainManager.Helper; +with PolyORB.CORBA_P.Exceptions; +with PolyORB.CORBA_P.Interceptors_Hooks; +with PolyORB.CORBA_P.Local; +with PolyORB.CORBA_P.Policy_Management; + +package body CORBA.Object.Policies is + + use PolyORB.Annotations; + use PolyORB.CORBA_P.Policy_Management; + + ----------------------- + -- Get_Client_Policy -- + ----------------------- + + function Get_Client_Policy + (Self : in Ref'Class; + The_Type : in PolicyType) + return CORBA.Policy.Ref + is + Npad : Notepad_Access; + Note : Policy_Manager_Note; + Result : CORBA.Policy.Ref; + + begin + if Is_Nil (Self) then + Raise_Inv_Objref (CORBA.Default_Sys_Member); + end if; + + if PolyORB.CORBA_P.Local.Is_Local (Self) then + Raise_No_Implement (No_Implement_Members'(Minor => 3, + Completed => Completed_No)); + end if; + + -- First, checking reference overrides + + Npad := + PolyORB.References.Notepad_Of (Internals.To_PolyORB_Ref (Ref (Self))); + Get_Note (Npad.all, Note, Empty_Policy_Manager_Note); + Result := Note.Overrides (The_Type); + + if not CORBA.Policy.Is_Null (Result) then + return Result; + end if; + + -- Second, checking thread overrides + + Npad := PolyORB.Tasking.Threads.Annotations.Get_Current_Thread_Notepad; + Get_Note (Npad.all, Note, Empty_Policy_Manager_Note); + Result := Note.Overrides (The_Type); + + if not CORBA.Policy.Is_Null (Result) then + return Result; + end if; + + -- Third, checking ORB overrides + + Npad := PolyORB.ORB.Notepad_Of (PolyORB.Setup.The_ORB); + Get_Note (Npad.all, Note, Empty_Policy_Manager_Note); + Result := Note.Overrides (The_Type); + + if not CORBA.Policy.Is_Null (Result) then + return Result; + end if; + + -- Last, try to find default value + + return Policy_System_Default_Value (The_Type); + end Get_Client_Policy; + + ------------------------- + -- Get_Domain_Managers -- + ------------------------- + + function Get_Domain_Managers + (Self : in Ref'Class) + return CORBA.DomainManager.DomainManagersList + is + Operation_Name : constant Standard.String := "get_domain_managers"; + + Request : PolyORB.Requests.Request_Access; + Arg_List : PolyORB.Any.NVList.Ref; + Result : PolyORB.Any.NamedValue; + Result_Name : CORBA.String := To_CORBA_String ("Result"); + + begin + if CORBA.Object.Is_Nil (Self) then + CORBA.Raise_Inv_Objref (Default_Sys_Member); + end if; + + PolyORB.Any.NVList.Create (Arg_List); + + Result := + (Name => PolyORB.Types.Identifier (Result_Name), + Argument => CORBA.Internals.To_PolyORB_Any + (Get_Empty_Any + (CORBA.DomainManager.Helper.TC_IDL_Sequence_CORBA_DomainManager)), + Arg_Modes => 0); + + PolyORB.Requests.Create_Request + (Target => Internals.To_PolyORB_Ref (Ref (Self)), + Operation => Operation_Name, + Arg_List => Arg_List, + Result => Result, + Req => Request); + + PolyORB.CORBA_P.Interceptors_Hooks.Client_Invoke + (Request, PolyORB.Requests.Flags (0)); + + if not PolyORB.Any.Is_Empty (Request.Exception_Info) then + Result.Argument := Request.Exception_Info; + PolyORB.Requests.Destroy_Request (Request); + PolyORB.CORBA_P.Exceptions.Raise_From_Any (Result.Argument); + end if; + + PolyORB.Requests.Destroy_Request (Request); + + return CORBA.DomainManager.Helper.From_Any + (CORBA.Internals.To_CORBA_Any (Result.Argument)); + end Get_Domain_Managers; + + ---------------- + -- Get_Policy -- + ---------------- + + function Get_Policy + (Self : in Ref; + Policy_Type : in PolicyType) + return CORBA.Policy.Ref + is + Result : CORBA.Policy.Ref; + + begin + Result := Get_Client_Policy (Self, Policy_Type); + + if not Policy.Is_Nil (Result) then + -- XXX Client policy should be reconcilied with value + -- defined in IOR. Not supported for now. + + return Result; + end if; + + if not Is_Domain_Policy (Policy_Type) then + return Result; + end if; + + -- Obtain domain list from Object + + declare + use CORBA.DomainManager; + + Managers : constant DomainManagersList := Get_Domain_Managers (Self); + begin + -- XXX For now we simply find the first domain manager which + -- hold information about the requested policy and return + -- policy value. This is not conformant with CORBA + -- specifications which require to resolve policy + -- overlapping conflicts but not define any way to do this + -- (CORBA 3.0.3 par. 4.10.1.4 Object Membership of Policy + -- Domains). + + for J in 1 .. Length (Managers) loop + begin + Result := + Get_Domain_Policy (Element_Of (Managers, J), Policy_Type); + + if not Policy.Is_Nil (Result) then + return Result; + end if; + + exception + when CORBA.Inv_Policy => + null; + end; + end loop; + end; + + Raise_Inv_Policy (Default_Sys_Member); + end Get_Policy; + + -------------------------- + -- Get_Policy_Overrides -- + -------------------------- + + function Get_Policy_Overrides + (Self : in Ref'Class; + Types : in CORBA.Policy.PolicyTypeSeq) + return CORBA.Policy.PolicyList + is + Npad : Notepad_Access; + Note : Policy_Manager_Note; + + begin + if Is_Nil (Self) then + Raise_Inv_Objref (CORBA.Default_Sys_Member); + end if; + + if PolyORB.CORBA_P.Local.Is_Local (Self) then + Raise_No_Implement (No_Implement_Members'(Minor => 3, + Completed => Completed_No)); + end if; + + Npad := + PolyORB.References.Notepad_Of (Internals.To_PolyORB_Ref (Ref (Self))); + Get_Note (Npad.all, Note, Empty_Policy_Manager_Note); + + return Get_Policy_Overrides (Note.Overrides, Types); + end Get_Policy_Overrides; + + -------------------------- + -- Set_Policy_Overrides -- + -------------------------- + + procedure Set_Policy_Overrides + (Self : in Ref'Class; + Policies : in CORBA.Policy.PolicyList; + Set_Add : in SetOverrideType) + is + Npad : Notepad_Access; + Note : Policy_Manager_Note; + Indexes : CORBA.Short; + + begin + if Is_Nil (Self) then + Raise_Inv_Objref (CORBA.Default_Sys_Member); + end if; + + if PolyORB.CORBA_P.Local.Is_Local (Self) then + Raise_No_Implement (No_Implement_Members'(Minor => 3, + Completed => Completed_No)); + end if; + + Npad := + PolyORB.References.Notepad_Of (Internals.To_PolyORB_Ref (Ref (Self))); + + if Set_Add = ADD_OVERRIDE then + Get_Note (Npad.all, Note, Empty_Policy_Manager_Note); + end if; + + Add_Policy_Overrides (Note.Overrides, Policies, Reference_Level); + + Check_Compatibility (Note.Overrides, Indexes); + + if Indexes /= 0 then + raise Program_Error; + -- XXX should raise the CORBA.InvalidPolicies exception + end if; + + Set_Note (Npad.all, Note); + end Set_Policy_Overrides; + +-- procedure Validate_Connection +-- (Self : in Ref; +-- Inconsistent_Policies : out CORBA.Policy.PolicyList; +-- Result : out Boolean); + +end CORBA.Object.Policies; diff --git a/src/corba/corba-object-policies.ads b/src/corba/corba-object-policies.ads new file mode 100644 index 000000000..1b3ac207b --- /dev/null +++ b/src/corba/corba-object-policies.ads @@ -0,0 +1,73 @@ +------------------------------------------------------------------------------ +-- -- +-- POLYORB COMPONENTS -- +-- -- +-- C O R B A . O B J E C T . P O L I C I E S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2005 Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the CORBA Specification, and adapted -- +-- for use with PolyORB. The copyright notice above, and the license -- +-- provisions that follow apply solely to the contents neither explicitely -- +-- nor implicitely specified by the CORBA Specification defined by the OMG. -- +-- -- +-- 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 AdaCore -- +-- (email: sales@adacore.com) -- +-- -- +------------------------------------------------------------------------------ + +with CORBA.DomainManager; +with CORBA.Policy; + +package CORBA.Object.Policies is + + function Get_Policy + (Self : in Ref; + Policy_Type : in PolicyType) + return CORBA.Policy.Ref; + + function Get_Domain_Managers + (Self : in Ref'Class) + return CORBA.DomainManager.DomainManagersList; + + procedure Set_Policy_Overrides + (Self : in Ref'Class; + Policies : in CORBA.Policy.PolicyList; + Set_Add : in SetOverrideType); + + function Get_Client_Policy + (Self : in Ref'Class; + The_Type : in PolicyType) + return CORBA.Policy.Ref; + + function Get_Policy_Overrides + (Self : in Ref'Class; + Types : in CORBA.Policy.PolicyTypeSeq) + return CORBA.Policy.PolicyList; + +-- procedure Validate_Connection +-- (Self : in Ref; +-- Inconsistent_Policies : out CORBA.Policy.PolicyList; +-- Result : out Boolean); + +end CORBA.Object.Policies; diff --git a/src/corba/polyorb-corba_p-policy_management.adb b/src/corba/polyorb-corba_p-policy_management.adb index 00811d787..08e2112d4 100644 --- a/src/corba/polyorb-corba_p-policy_management.adb +++ b/src/corba/polyorb-corba_p-policy_management.adb @@ -38,6 +38,7 @@ package body PolyORB.CORBA_P.Policy_Management is type Policy_Info is record Registered : Boolean := False; POA_Level : Boolean; + Domain_Level : Boolean; ORB_Level : Boolean; Thread_Level : Boolean; Reference_Level : Boolean; @@ -97,6 +98,9 @@ package body PolyORB.CORBA_P.Policy_Management is CORBA.Raise_No_Permission (CORBA.Default_Sys_Member); end if; + when Domain_Level => + raise Program_Error; + end case; To (The_Type) := Element_Of (Policies, J); @@ -179,6 +183,20 @@ package body PolyORB.CORBA_P.Policy_Management is return Result; end Get_Policy_Overrides; + ---------------------- + -- Is_Domain_Policy -- + ---------------------- + + function Is_Domain_Policy + (The_Type : in CORBA.PolicyType) + return Boolean + is + begin + pragma Assert (Policy_Registry (The_Type).Registered); + + return Policy_Registry (The_Type).Domain_Level; + end Is_Domain_Policy; + ------------------- -- Is_ORB_Policy -- ------------------- @@ -244,6 +262,20 @@ package body PolyORB.CORBA_P.Policy_Management is return Policy_Registry (The_Type).Thread_Level; end Is_Thread_Policy; + --------------------------------- + -- Policy_System_Default_Value -- + --------------------------------- + + function Policy_System_Default_Value + (The_Type : in CORBA.PolicyType) + return CORBA.Policy.Ref + is + begin + pragma Assert (Policy_Registry (The_Type).Registered); + + return Policy_Registry (The_Type).System_Default; + end Policy_System_Default_Value; + ----------------------- -- Raise_PolicyError -- ----------------------- @@ -267,6 +299,7 @@ package body PolyORB.CORBA_P.Policy_Management is ORB_Level : in Boolean := False; Thread_Level : in Boolean := False; Reference_Level : in Boolean := False; + Domain_Level : in Boolean := False; Factory : in Policy_Factory := null; Compatibility_Check : in Compatibility_Check_Proc := null; Reconciliation : in Reconciliation_Proc := null; @@ -276,6 +309,7 @@ package body PolyORB.CORBA_P.Policy_Management is Policy_Registry (The_Type) := (Registered => True, POA_Level => POA_Level, + Domain_Level => Domain_Level, ORB_Level => ORB_Level, Thread_Level => Thread_Level, Reference_Level => Reference_Level, diff --git a/src/corba/polyorb-corba_p-policy_management.ads b/src/corba/polyorb-corba_p-policy_management.ads index 5d04ffa52..a949e94b5 100644 --- a/src/corba/polyorb-corba_p-policy_management.ads +++ b/src/corba/polyorb-corba_p-policy_management.ads @@ -50,7 +50,7 @@ package PolyORB.CORBA_P.Policy_Management is Null_Policy : CORBA.Policy.Ref; type Policy_Override_Level is - (POA_Level, ORB_Level, Thread_Level, Reference_Level); + (POA_Level, Domain_Level, ORB_Level, Thread_Level, Reference_Level); -- Level of policy overrides type Policy_Factory is @@ -74,6 +74,11 @@ package PolyORB.CORBA_P.Policy_Management is return Boolean; -- Return True iff The_Type is a POA level policy + function Is_Domain_Policy + (The_Type : in CORBA.PolicyType) + return Boolean; + -- Return True iff The_Type is a Domain level policy + function Is_ORB_Policy (The_Type : in CORBA.PolicyType) return Boolean; @@ -89,6 +94,11 @@ package PolyORB.CORBA_P.Policy_Management is return Boolean; -- Return True iff The_Type is an object reference policy + function Policy_System_Default_Value + (The_Type : in CORBA.PolicyType) + return CORBA.Policy.Ref; + -- Return system default value for given policy type + procedure Add_Policy_Overrides (To : in out Policy_List; Policies : in CORBA.Policy.PolicyList; @@ -137,6 +147,7 @@ package PolyORB.CORBA_P.Policy_Management is ORB_Level : in Boolean := False; Thread_Level : in Boolean := False; Reference_Level : in Boolean := False; + Domain_Level : in Boolean := False; Factory : in Policy_Factory := null; Compatibility_Check : in Compatibility_Check_Proc := null; Reconciliation : in Reconciliation_Proc := null; @@ -144,6 +155,7 @@ package PolyORB.CORBA_P.Policy_Management is -- Register CORBA Policy and define allowed policy usage. -- - The_Type : policy id -- - POA_Level : policy is allowed at POA level + -- - Domain_Level : policy is allowed at Domain level -- - ORB_Level : policy is allowed at ORB level -- - Thread_Level : policy is allowed at thread level -- - Reference_Level : policy is allowed at object reference level