diff --git a/idls/CORBA_IDL/CORBA_StandardExceptions.idl b/idls/CORBA_IDL/CORBA_StandardExceptions.idl index 3ed4ca29b..00d1b4115 100644 --- a/idls/CORBA_IDL/CORBA_StandardExceptions.idl +++ b/idls/CORBA_IDL/CORBA_StandardExceptions.idl @@ -1,7 +1,7 @@ // File: CORBA_StandardExceptions.idl // CORBA 3.0, Chapter 4 -//PolyORB:NI: const unsigned long OMGVMCID = 0x4f4d0000; + const unsigned long OMGVMCID = 0x4f4d0000; #define ex_body {unsigned long minor; completion_status completed;} diff --git a/src/corba/corba.adb b/src/corba/corba.adb index c0b944384..7e2ec5227 100644 --- a/src/corba/corba.adb +++ b/src/corba/corba.adb @@ -100,6 +100,18 @@ package body CORBA is return TC; end TC_Completion_Status; + procedure Raise_From_Error + (Error : in out PolyORB.Errors.Error_Container); + -- Raise the exception associated with the current state of Error. + -- If Error is an empty Error Container, no exception is raised. + + procedure Raise_System_Exception + (Excp : Ada.Exceptions.Exception_Id; + Excp_Memb : System_Exception_Members; + Or_OMGVMCD : Boolean := False); + pragma No_Return (Raise_System_Exception); + -- Raise any system exception + --------------------------------- -- String conversion functions -- --------------------------------- @@ -235,8 +247,9 @@ package body CORBA is ---------------------------- procedure Raise_System_Exception - (Excp : in Ada.Exceptions.Exception_Id; - Excp_Memb : in System_Exception_Members) + (Excp : in Ada.Exceptions.Exception_Id; + Excp_Memb : in System_Exception_Members; + Or_OMGVMCD : in Boolean := False) is Str : Standard.String (1 .. 5); Val : CORBA.Unsigned_Long; @@ -249,6 +262,10 @@ package body CORBA is Str (5) := Character'Val (Completion_Status'Pos (Excp_Memb.Completed)); Val := Excp_Memb.Minor; + if Or_OMGVMCD then + Val := Val or OMGVMCID; + end if; + for J in 1 .. 4 loop Str (J) := Character'Val (Val / 2 ** 24); Val := (Val mod 2 ** 24) * 256; @@ -268,8 +285,10 @@ package body CORBA is ------------------- procedure Raise_Unknown (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 3; + begin - Raise_System_Exception (Unknown'Identity, Excp_Memb); + Raise_System_Exception (Unknown'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Unknown; --------------------- @@ -277,8 +296,10 @@ package body CORBA is --------------------- procedure Raise_Bad_Param (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 41; + begin - Raise_System_Exception (Bad_Param'Identity, Excp_Memb); + Raise_System_Exception (Bad_Param'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Bad_Param; --------------------- @@ -295,8 +316,10 @@ package body CORBA is --------------------- procedure Raise_Imp_Limit (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor = 1; + begin - Raise_System_Exception (Imp_Limit'Identity, Excp_Memb); + Raise_System_Exception (Imp_Limit'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Imp_Limit; ------------------------ @@ -331,8 +354,10 @@ package body CORBA is -------------------- procedure Raise_Internal (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 2; + begin - Raise_System_Exception (Internal'Identity, Excp_Memb); + Raise_System_Exception (Internal'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Internal; ------------------- @@ -340,8 +365,10 @@ package body CORBA is ------------------- procedure Raise_Marshal (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 7; + begin - Raise_System_Exception (Marshal'Identity, Excp_Memb); + Raise_System_Exception (Marshal'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Marshal; ---------------------- @@ -349,8 +376,10 @@ package body CORBA is ---------------------- procedure Raise_Initialize (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor = 1; + begin - Raise_System_Exception (Initialize'Identity, Excp_Memb); + Raise_System_Exception (Initialize'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Initialize; ------------------------ @@ -358,8 +387,10 @@ package body CORBA is ------------------------ procedure Raise_No_Implement (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 7; + begin - Raise_System_Exception (No_Implement'Identity, Excp_Memb); + Raise_System_Exception (No_Implement'Identity, Excp_Memb, Or_OMGVMCD); end Raise_No_Implement; ------------------------ @@ -367,8 +398,10 @@ package body CORBA is ------------------------ procedure Raise_Bad_TypeCode (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 3; + begin - Raise_System_Exception (Bad_TypeCode'Identity, Excp_Memb); + Raise_System_Exception (Bad_TypeCode'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Bad_TypeCode; ------------------------- @@ -376,8 +409,10 @@ package body CORBA is ------------------------- procedure Raise_Bad_Operation (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 2; + begin - Raise_System_Exception (Bad_Operation'Identity, Excp_Memb); + Raise_System_Exception (Bad_Operation'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Bad_Operation; ------------------------ @@ -385,8 +420,10 @@ package body CORBA is ------------------------ procedure Raise_No_Resources (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 2; + begin - Raise_System_Exception (No_Resources'Identity, Excp_Memb); + Raise_System_Exception (No_Resources'Identity, Excp_Memb, Or_OMGVMCD); end Raise_No_Resources; ----------------------- @@ -412,8 +449,10 @@ package body CORBA is ------------------------- procedure Raise_Bad_Inv_Order (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 20; + begin - Raise_System_Exception (Bad_Inv_Order'Identity, Excp_Memb); + Raise_System_Exception (Bad_Inv_Order'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Bad_Inv_Order; --------------------- @@ -421,8 +460,10 @@ package body CORBA is --------------------- procedure Raise_Transient (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 4; + begin - Raise_System_Exception (Transient'Identity, Excp_Memb); + Raise_System_Exception (Transient'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Transient; -------------------- @@ -457,8 +498,10 @@ package body CORBA is --------------------- procedure Raise_Intf_Repos (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 2; + begin - Raise_System_Exception (Intf_Repos'Identity, Excp_Memb); + Raise_System_Exception (Intf_Repos'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Intf_Repos; ----------------------- @@ -466,8 +509,10 @@ package body CORBA is ----------------------- procedure Raise_Bad_Context (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 2; + begin - Raise_System_Exception (Bad_Context'Identity, Excp_Memb); + Raise_System_Exception (Bad_Context'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Bad_Context; ----------------------- @@ -475,8 +520,10 @@ package body CORBA is ----------------------- procedure Raise_Obj_Adapter (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 7; + begin - Raise_System_Exception (Obj_Adapter'Identity, Excp_Memb); + Raise_System_Exception (Obj_Adapter'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Obj_Adapter; --------------------------- @@ -484,8 +531,10 @@ package body CORBA is --------------------------- procedure Raise_Data_Conversion (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 2; + begin - Raise_System_Exception (Data_Conversion'Identity, Excp_Memb); + Raise_System_Exception (Data_Conversion'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Data_Conversion; ---------------------------- @@ -494,8 +543,11 @@ package body CORBA is procedure Raise_Object_Not_Exist (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 4; + begin - Raise_System_Exception (Object_Not_Exist'Identity, Excp_Memb); + Raise_System_Exception + (Object_Not_Exist'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Object_Not_Exist; -------------------------------- @@ -516,8 +568,11 @@ package body CORBA is procedure Raise_Transaction_Rolledback (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 3; + begin - Raise_System_Exception (Transaction_Rolledback'Identity, Excp_Memb); + Raise_System_Exception + (Transaction_Rolledback'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Transaction_Rolledback; ------------------------------- @@ -538,8 +593,10 @@ package body CORBA is procedure Raise_Inv_Policy (Excp_Memb : in System_Exception_Members) is + Or_OMGVMCD : constant Boolean := Excp_Memb.Minor in 1 .. 3; + begin - Raise_System_Exception (Inv_Policy'Identity, Excp_Memb); + Raise_System_Exception (Inv_Policy'Identity, Excp_Memb, Or_OMGVMCD); end Raise_Inv_Policy; -------------------------------- diff --git a/src/corba/corba.ads b/src/corba/corba.ads index e6ac99e3e..5ea855214 100644 --- a/src/corba/corba.ads +++ b/src/corba/corba.ads @@ -190,6 +190,11 @@ package CORBA is -- System Exceptions -- ----------------------- + OMGVMCID : constant CORBA.Unsigned_Long := 16#4f4d0000#; + -- The CORBA speficiations mandate that the actual value for the + -- minor field of system exceptions is obtained by or-ing the + -- value with this constant, for all values defined in CORBA A.5. + Unknown : exception; -- unknown exception Bad_Param : exception; -- an invalid parameter was passed No_Memory : exception; -- dynamic memory allocation failure @@ -242,17 +247,6 @@ package CORBA is To : out System_Exception_Members); -- Return the member corresponding to a system exception occurence. - procedure Raise_From_Error - (Error : in out PolyORB.Errors.Error_Container); - -- Raise the exception associated with the current state of Error. - -- If Error is an empty Error Container, no exception is raised. - - procedure Raise_System_Exception - (Excp : Ada.Exceptions.Exception_Id; - Excp_Memb : System_Exception_Members); - pragma No_Return (Raise_System_Exception); - -- Raise any system exception - -- The following procedures are used to raise specific system exceptions procedure Raise_Unknown diff --git a/src/giop/polyorb-giop_p-exceptions.adb b/src/giop/polyorb-giop_p-exceptions.adb index 026486bdb..d2f0a89ca 100644 --- a/src/giop/polyorb-giop_p-exceptions.adb +++ b/src/giop/polyorb-giop_p-exceptions.adb @@ -53,7 +53,51 @@ package body PolyORB.GIOP_P.Exceptions is CORBA_Exc_Root : constant String := "IDL:omg.org/CORBA/"; CORBA_Exc_Version : constant String := ":1.0"; - -- CORBA exceptions root and version. + -- CORBA exceptions root and version + + OMGVMCID : constant PolyORB.Types.Unsigned_Long := 16#4f4d0000#; + -- The CORBA speficiations mandate that the actual value for the + -- minor field of system exceptions is obtained by or-ing the + -- value with this constant, for all values defined in CORBA A.5. + + Exception_Code_Upper_Bounds : constant array (ORB_System_Error'Range) + of Unsigned_Long := + (Unknown_E => 3, + Bad_Param_E => 41, + No_Memory_E => 0, + Imp_Limit_E => 1, + Comm_Failure_E => 0, + Inv_Objref_E => 2, + No_Permission_E => 0, + Internal_E => 2, + Marshal_E => 7, + Initialize_E => 1, + No_Implement_E => 7, + Bad_TypeCode_E => 3, + Bad_Operation_E => 2, + No_Resources_E => 2, + No_Response_E => 0, + Persist_Store_E => 0, + Bad_Inv_Order_E => 20, + Transient_E => 4, + Free_Mem_E => 0, + Inv_Ident_E => 0, + Inv_Flag_E => 0, + Intf_Repos_E => 2, + Bad_Context_E => 2, + Obj_Adapter_E => 7, + Data_Conversion_E => 2, + Object_Not_Exist_E => 4, + Transaction_Required_E => 0, + Transaction_Rolledback_E => 3, + Invalid_Transaction_E => 1, + Inv_Policy_E => 3, + Codeset_Incompatible_E => 0, + Rebind_E => 0, + Timeout_E => 0, + Transaction_Unavailable_E => 0, + Transaction_Mode_E => 0, + Bad_Qos_E => 0); function To_CORBA_Exception_TypeCode (TC : PolyORB.Any.TypeCode.Object) @@ -137,25 +181,25 @@ package body PolyORB.GIOP_P.Exceptions is Colon1 : constant Integer := Find (Name, Name'First, '/'); Colon2 : constant Integer := Find (Name, Colon1 + 1, ':'); - Internal_Name : constant String := Name (Colon1 + 1 .. Colon2 - 1); + Internal_Name : constant PolyORB.Types.String + := To_PolyORB_String (Name (Colon1 + 1 .. Colon2 - 1)); + + New_Name : constant PolyORB.Types.String := CORBA_Root_PTS + & Internal_Name + & CORBA_Exc_Version_PTS; - New_Name : PolyORB.Types.String; Result_TC : TypeCode.Object := TypeCode.TC_Except; begin pragma Debug (O ("Exception name was : " & Name)); + pragma Debug (O ("New exception name is : " + & To_Standard_String (New_Name))); -- Name - TypeCode.Add_Parameter - (Result_TC, To_Any (To_PolyORB_String (Internal_Name))); + TypeCode.Add_Parameter (Result_TC, To_Any (Internal_Name)); - New_Name := CORBA_Root_PTS - & To_PolyORB_String (Internal_Name) - & CORBA_Exc_Version_PTS; - - pragma Debug (O ("New exception name is : " - & To_Standard_String (New_Name))); + -- Id TypeCode.Add_Parameter (Result_TC, To_Any (New_Name)); @@ -199,16 +243,44 @@ package body PolyORB.GIOP_P.Exceptions is Result_TC := To_CORBA_Exception_TypeCode (Exc_TC); if Exc_TC /= Result_TC then - pragma Debug (O ("Must modify exception typeCode")); + pragma Debug (O ("Must modify exception content")); Set_Type (Result, Result_TC); Result := Get_Empty_Any_Aggregate (Result_TC); - Add_Aggregate_Element - (Result, - Get_Aggregate_Element (Exc, - TypeCode.TC_Unsigned_Long, - Types.Unsigned_Long (0))); + pragma Debug (O (Image (Result_TC))); + + declare + Exception_Name : constant String + := To_Standard_String + (From_Any + (TypeCode.Get_Parameter + (Result_TC, PolyORB.Types.Unsigned_Long (0)))); + Id : constant Error_Id := Error_Id'Value (Exception_Name & "_E"); + + Minor : constant Types.Unsigned_Long + := From_Any (Get_Aggregate_Element + (Exc, + TypeCode.TC_Unsigned_Long, + Types.Unsigned_Long (0))); + + begin + pragma Debug (O ("Exception Name: " & Exception_Name)); + if Id in ORB_System_Error then + if Minor in 1 .. Exception_Code_Upper_Bounds (Id) then + Add_Aggregate_Element (Result, To_Any (OMGVMCID or Minor)); + -- Or'ing with OMGVMCID as required by CORBA A.5 + + else + Add_Aggregate_Element + (Result, + Get_Aggregate_Element + (Exc, + TypeCode.TC_Unsigned_Long, + Types.Unsigned_Long (0))); + end if; + end if; + end; Add_Aggregate_Element (Result, @@ -220,7 +292,7 @@ package body PolyORB.GIOP_P.Exceptions is return Result; else - pragma Debug (O ("No need to modify exception typeCode")); + pragma Debug (O ("No need to modify exception TypeCode")); pragma Debug (O ("To_CORBA_Exception: leave")); return Exc; diff --git a/testsuite/corba/all_exceptions/all_exceptions-impl.adb b/testsuite/corba/all_exceptions/all_exceptions-impl.adb index 0a9e55f60..5f9372ca1 100644 --- a/testsuite/corba/all_exceptions/all_exceptions-impl.adb +++ b/testsuite/corba/all_exceptions/all_exceptions-impl.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2004-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 -- @@ -26,8 +26,8 @@ -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- --- PolyORB is maintained by ACT Europe. -- --- (email: sales@act-europe.fr) -- +-- PolyORB is maintained by AdaCore -- +-- (email: sales@adacore.com) -- -- -- ------------------------------------------------------------------------------ @@ -53,7 +53,7 @@ package body all_exceptions.Impl is Member : CORBA.Bad_Param_Members; begin - Member := (Minor => 101, Completed => CORBA.Completed_Maybe); + Member := (Minor => 1, Completed => CORBA.Completed_Maybe); CORBA.Raise_Bad_Param (Member); end Bad_Param_exception_test; diff --git a/testsuite/corba/all_exceptions/client.adb b/testsuite/corba/all_exceptions/client.adb index aa159a345..c71f5d86d 100644 --- a/testsuite/corba/all_exceptions/client.adb +++ b/testsuite/corba/all_exceptions/client.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2004-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 -- @@ -26,8 +26,8 @@ -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- --- PolyORB is maintained by ACT Europe. -- --- (email: sales@act-europe.fr) -- +-- PolyORB is maintained by AdaCore -- +-- (email: sales@adacore.com) -- -- -- ------------------------------------------------------------------------------ @@ -88,7 +88,7 @@ begin when E : Bad_Param => CORBA.Get_Members (E, Member); Ok := (Member.Completed = Completed_Maybe) - and then (Member.Minor = 101); + and then (Member.Minor = (1 or CORBA.OMGVMCID)); when others => null;