ada/PolyORB
0
0
Fork 0
mirror of https://github.com/AdaCore/PolyORB.git synced 2026-02-12 13:01:15 -08:00
Code Issues Packages Projects Releases Wiki Activity

CORBA specifications mandate that the actual value for the

Browse Source 
minor field of system exceptions is obtained by or-ing the
value with the OMGVMCID constant, for all values defined in
CORBA A.5.

(CORBA): move Raise_From_Error and Raise_System_Exception to
package body, add proper circuitery to or Minor members of
systems exceptions with OMGVMCID when raising an exception.

(PolyORB.GIOP_P.Exceptions): add proper circuitery to or Minor
members of systems exceptions with OMGVMCID when building a
CORBA Exception.

[Imported from Perforce change 9415 at 2006-12-01 21:44:02]

Subversion-branch: /trunk/polyorb
Subversion-revision: 36901
This commit is contained in:
Jérôme Hugues
2005-07-21 14:14:41 +00:00
parent 85d68b08ff
commit e07312d145
6 changed files with 182 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
idls/CORBA_IDL/CORBA_StandardExceptions.idl
View File

@@ -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;}

99
src/corba/corba.adb
View File

@@ -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;
--------------------------------

16
src/corba/corba.ads
View File

@@ -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

108
src/giop/polyorb-giop_p-exceptions.adb
View File

@@ -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;

8
testsuite/corba/all_exceptions/all_exceptions-impl.adb
View File

@@ -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;

8
testsuite/corba/all_exceptions/client.adb
View File

@@ -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;