From 3695d433e565bc447d4e510f01417be21b1706ff Mon Sep 17 00:00:00 2001 From: Bechir Zalila Date: Thu, 2 Jun 2005 09:36:53 +0000 Subject: [PATCH] * backend-be_ada-skels.adb : Handling unknown and system exceptions * backend-be_ada-generator.adb : Added the possibility to generate "Variable_name : others". Minor reformatting * backend-be_ada-helpers.adb : Correct code generation for enumeration arrays. * backend-be_ada-runtime.ads : Added the runtime entity corresponding to the PolyORB.CORBA_P.Exceptions.System_Exception_To_Any function which is useful to catch unknown or system exceptions. [Imported from ENST Subversion rev. 7436] Subversion-branch: /import/ENST-iac-20061219 Subversion-revision: 41033 --- parsers/iac/backend-be_ada-generator.adb | 12 +++-- parsers/iac/backend-be_ada-helpers.adb | 36 ++++++++++++++- parsers/iac/backend-be_ada-runtime.ads | 3 ++ parsers/iac/backend-be_ada-skels.adb | 57 +++++++++++++++++++++++- 4 files changed, 102 insertions(+), 6 deletions(-) diff --git a/parsers/iac/backend-be_ada-generator.adb b/parsers/iac/backend-be_ada-generator.adb index be88b0588..c5881ec3e 100644 --- a/parsers/iac/backend-be_ada-generator.adb +++ b/parsers/iac/backend-be_ada-generator.adb @@ -307,8 +307,7 @@ package body Backend.BE_Ada.Generator is Write (Tok_Exception); Write_Eol; Increment_Indentation; - -- Replace the following by the generation of exception handler - -- BEGIN + -- Generation of the exception handler Write_Indentation; Excp_Handler_Alternative := First_Node (Exception_Handler (N)); while Present (Excp_Handler_Alternative) loop @@ -770,7 +769,14 @@ package body Backend.BE_Ada.Generator is end if; Write_Space; - Generate (Object_Definition (N)); + if Present (Object_Definition (N)) then + Generate (Object_Definition (N)); + else + -- This workaround doesn't affect the classic object declaration + -- because we must give a type. However it makes the generation + -- of case statement and exception handlers simpler. + Write (Tok_Others); + end if; if Present (Expression (N)) then Write_Space; diff --git a/parsers/iac/backend-be_ada-helpers.adb b/parsers/iac/backend-be_ada-helpers.adb index cfb846f86..20d6a01c7 100644 --- a/parsers/iac/backend-be_ada-helpers.adb +++ b/parsers/iac/backend-be_ada-helpers.adb @@ -1278,7 +1278,23 @@ package body Backend.BE_Ada.Helpers is (Type_Spec (Declaration (E))); - Helper := RE (RE_From_Any_0); + declare + Reference : constant Node_Id := FEN.Reference + (Type_Spec (Declaration (E))); + begin + -- As iac evolves, add the corresponding From_Any nodes + case FEN.Kind (Reference) is + when K_Enumeration_Type => + Helper := Helper_Node + (BE_Node (Identifier (Reference))); + -- The From_Any function is declared at the second + -- place in the Helper spec + Helper := Next_Node (Helper); + Helper := Defining_Identifier (Helper); + when others => + Helper := RE (RE_From_Any_0); + end case; + end; else raise Program_Error; end if; @@ -1875,7 +1891,23 @@ package body Backend.BE_Ada.Helpers is if Is_Base_Type (Type_Spec (Declaration (E))) then Helper := RE (RE_To_Any_0); elsif FEN.Kind (Type_Spec (Declaration (E))) = K_Scoped_Name then - Helper := RE (RE_To_Any_0); + declare + Reference : constant Node_Id := FEN.Reference + (Type_Spec (Declaration (E))); + begin + -- As iac evolves, add the corresponding To_Any nodes + case FEN.Kind (Reference) is + when K_Enumeration_Type => + Helper := Helper_Node + (BE_Node (Identifier (Reference))); + -- The From_Any function is declared at the third + -- place in the Helper spec + Helper := Next_Node (Next_Node (Helper)); + Helper := Defining_Identifier (Helper); + when others => + Helper := RE (RE_To_Any_0); + end case; + end; else raise Program_Error; end if; diff --git a/parsers/iac/backend-be_ada-runtime.ads b/parsers/iac/backend-be_ada-runtime.ads index c444127f0..c90fe89d0 100644 --- a/parsers/iac/backend-be_ada-runtime.ads +++ b/parsers/iac/backend-be_ada-runtime.ads @@ -166,6 +166,8 @@ package Backend.BE_Ada.Runtime is RE_To_PolyORB_String, -- PolyORB.Types.To_PolyORB_String RE_Client_Invoke, -- PolyORB.CORBA_P. -- Interceptors_Hooks.Client_Invoke + RE_System_Exception_To_Any, -- PolyORB.CORBA_P. + -- Exceptions.System_Exception_To_Any RE_Raise_From_Any, -- PolyORB.CORBA_P. -- Exceptions.Raise_From_Any RE_Add, -- PolyORB.Utils.Strings."+" @@ -284,6 +286,7 @@ package Backend.BE_Ada.Runtime is RE_User_Get_Members => RU_PolyORB_Exceptions, RE_User_Raise_Exception => RU_PolyORB_Exceptions, RE_Raise_From_Any => RU_PolyORB_CORBA_P_Exceptions, + RE_System_Exception_To_Any => RU_PolyORB_CORBA_P_Exceptions, RE_Client_Invoke => RU_PolyORB_CORBA_P_Interceptors_Hooks, RE_Module_Info => RU_PolyORB_Initialization, RE_Register_Module => RU_PolyORB_Initialization, diff --git a/parsers/iac/backend-be_ada-skels.adb b/parsers/iac/backend-be_ada-skels.adb index 2086eb679..14086868d 100644 --- a/parsers/iac/backend-be_ada-skels.adb +++ b/parsers/iac/backend-be_ada-skels.adb @@ -119,6 +119,7 @@ package body Backend.BE_Ada.Skels is function Is_A_Invoke_Part return Node_Id; function Servant_Is_A_Body return Node_Id; procedure Skeleton_Initialization (L : List_Id); + function Non_User_Exception_Handler return Node_Id; procedure Visit_Attribute_Declaration (E : Node_Id); procedure Visit_Interface_Declaration (E : Node_Id); @@ -224,6 +225,7 @@ package body Backend.BE_Ada.Skels is -- Getting the node corresponding to the declaration of the -- Get_Members procedure. -- This procedure is declared at the 4th place in the stub spec. + N := Stub_Node (BE_Node (Identifier (Reference (E)))); N := Next_Node (Next_Node (Next_Node (N))); @@ -238,7 +240,7 @@ package body Backend.BE_Ada.Skels is -- Getting the node corresponding to the declaration of the -- To_Any procedure in the helper package. -- This procedure is declared at the 3rd place in the helper spec. - -- Complete HERE + N := Helper_Node (BE_Node (Identifier (Reference (E)))); N := Next_Node (Next_Node ((N))); @@ -870,6 +872,49 @@ package body Backend.BE_Ada.Skels is Append_Node_To_List (N, L); end Skeleton_Initialization; + function Non_User_Exception_Handler return Node_Id is + Result : Node_Id; + Selector : Node_Id; + Expression : Node_Id; + N : Node_Id; + D : constant List_Id := New_List (K_List_Id); + S : constant List_Id := New_List (K_List_Id); + begin + -- Generation of the "E : others" statement + Selector := Make_Object_Declaration + (Defining_Identifier => + Make_Defining_Identifier (PN (P_E)), + Object_Definition => No_Node); + + -- Body of the exception handler + N := Make_Subprogram_Call + (RE (RE_System_Exception_To_Any), + Make_List_Id + (Make_Defining_Identifier (PN (P_E)))); + + N := Make_Subprogram_Call + (RE (RE_To_CORBA_Any), + Make_List_Id (N)); + + N := Make_Subprogram_Call + (RE (RE_Set_Exception), + Make_List_Id + (Make_Defining_Identifier (PN (P_Request)), N)); + Append_Node_To_List (N, S); + + N := Make_Return_Statement (No_Node); + Append_Node_To_List (N, S); + + Expression := Make_Block_Statement + (Declarative_Part => D, + Statements => S); + + Result := Make_Component_Association + (Selector, + Expression); + return Result; + end Non_User_Exception_Handler; + ----------- -- Visit -- ----------- @@ -938,6 +983,7 @@ package body Backend.BE_Ada.Skels is Then_Statements : constant List_Id := New_List (K_List_Id); Else_Statements : constant List_Id := New_List (K_List_Id); Invoke_Statements : constant List_Id := New_List (K_List_Id); + Exception_Handler : Node_Id; begin N := BEN.Parent (Stub_Node (BE_Node (Identifier (E)))); @@ -982,6 +1028,15 @@ package body Backend.BE_Ada.Skels is Then_Statements, Invoke_Elsif_Statements, Else_Statements); + + Exception_Handler := Non_User_Exception_Handler; + + N := Make_Block_Statement + (Declarative_Part => No_List, + Statements => + Make_List_Id (N), + Exception_Handler => + Make_List_Id (Exception_Handler)); Append_Node_To_List (N, Invoke_Statements); N := Servant_Is_A_Body;