From 3424be4f3696da60615587e68062d43fb63b7739 Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 29 Aug 2011 14:26:53 +0000 Subject: [PATCH] 2011-08-29 Thomas Quinot * a-except.adb, a-except-2005.adb: Minor comment rewording and reformatting. 2011-08-29 Yannick Moy * sem_ch3.adb (Array_Type_Declaration): Remove insertion of declaration for Itypes in Alfa mode. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178246 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 10 +++++++ gcc/ada/a-except-2005.adb | 40 ++++++++++++++++--------- gcc/ada/a-except.adb | 20 +++++++++---- gcc/ada/sem_ch3.adb | 74 ----------------------------------------------- 4 files changed, 50 insertions(+), 94 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a9ae7fc..b89a0f8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2011-08-29 Thomas Quinot + + * a-except.adb, a-except-2005.adb: Minor comment rewording and + reformatting. + +2011-08-29 Yannick Moy + + * sem_ch3.adb (Array_Type_Declaration): Remove insertion of + declaration for Itypes in Alfa mode. + 2011-08-29 Robert Dewar * a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb, diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb index 8315a9d..509ea924 100644 --- a/gcc/ada/a-except-2005.adb +++ b/gcc/ada/a-except-2005.adb @@ -422,7 +422,6 @@ package body Ada.Exceptions is procedure Rcheck_19 (File : System.Address; Line : Integer); procedure Rcheck_20 (File : System.Address; Line : Integer); procedure Rcheck_21 (File : System.Address; Line : Integer); - procedure Rcheck_22 (File : System.Address; Line : Integer); procedure Rcheck_23 (File : System.Address; Line : Integer); procedure Rcheck_24 (File : System.Address; Line : Integer); procedure Rcheck_25 (File : System.Address; Line : Integer); @@ -445,6 +444,14 @@ package body Ada.Exceptions is procedure Rcheck_12_Ext (File : System.Address; Line, Column, Index, First, Last : Integer); + procedure Rcheck_22 (File : System.Address; Line : Integer); + -- This routine is separated out because it has quite different behavior + -- from the others. This is the "finalize/adjust raised exception". This + -- subprogram is always called with abort deferred, unlike all other + -- Rcheck_* routines, it needs to call Raise_Exception_No_Defer. + -- + -- It should probably have a distinguished name ??? + pragma Export (C, Rcheck_00, "__gnat_rcheck_00"); pragma Export (C, Rcheck_01, "__gnat_rcheck_01"); pragma Export (C, Rcheck_02, "__gnat_rcheck_02"); @@ -1151,19 +1158,6 @@ package body Ada.Exceptions is Raise_Program_Error_Msg (File, Line, Rmsg_21'Address); end Rcheck_21; - procedure Rcheck_22 (File : System.Address; Line : Integer) is - E : constant Exception_Id := Program_Error_Def'Access; - begin - -- This is "finalize/adjust raised exception". - -- As this exception is only raised with aborts defered, it must - -- call Raise_Exception_No_Defer, contrary to all other Rcheck - -- subprograms (which defer aborts). - -- This is coherent with Raise_From_Controlled_Operation. - - Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address); - Raise_Current_Excep (E); - end Rcheck_22; - procedure Rcheck_23 (File : System.Address; Line : Integer) is begin Raise_Program_Error_Msg (File, Line, Rmsg_23'Address); @@ -1262,6 +1256,24 @@ package body Ada.Exceptions is Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address); end Rcheck_12_Ext; + --------------- + -- Rcheck_22 -- + --------------- + + procedure Rcheck_22 (File : System.Address; Line : Integer) is + E : constant Exception_Id := Program_Error_Def'Access; + + begin + -- This is "finalize/adjust raised exception". This subprogram is always + -- called with abort deferred, unlike all other Rcheck_* routines, it + -- needs to call Raise_Exception_No_Defer. + + -- This is consistent with Raise_From_Controlled_Operation + + Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address); + Raise_Current_Excep (E); + end Rcheck_22; + ------------- -- Reraise -- ------------- diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb index 6805bf4..f34d497 100644 --- a/gcc/ada/a-except.adb +++ b/gcc/ada/a-except.adb @@ -381,7 +381,6 @@ package body Ada.Exceptions is procedure Rcheck_19 (File : System.Address; Line : Integer); procedure Rcheck_20 (File : System.Address; Line : Integer); procedure Rcheck_21 (File : System.Address; Line : Integer); - procedure Rcheck_22 (File : System.Address; Line : Integer); procedure Rcheck_23 (File : System.Address; Line : Integer); procedure Rcheck_24 (File : System.Address; Line : Integer); procedure Rcheck_25 (File : System.Address; Line : Integer); @@ -395,6 +394,14 @@ package body Ada.Exceptions is procedure Rcheck_33 (File : System.Address; Line : Integer); procedure Rcheck_34 (File : System.Address; Line : Integer); + procedure Rcheck_22 (File : System.Address; Line : Integer); + -- This routine is separated out because it has quite different behavior + -- from the others. This is the "finalize/adjust raised exception". This + -- subprogram is always called with abort deferred, unlike all other + -- Rcheck_* routines, it needs to call Raise_Exception_No_Defer. + -- + -- It should probably have a distinguished name ??? + pragma Export (C, Rcheck_00, "__gnat_rcheck_00"); pragma Export (C, Rcheck_01, "__gnat_rcheck_01"); pragma Export (C, Rcheck_02, "__gnat_rcheck_02"); @@ -1084,12 +1091,13 @@ package body Ada.Exceptions is procedure Rcheck_22 (File : System.Address; Line : Integer) is E : constant Exception_Id := Program_Error_Def'Access; + begin - -- This is "finalize/adjust raised exception". - -- As this exception is only raised with aborts defered, it must - -- call Raise_Exception_No_Defer, contrary to all other Rcheck - -- subprograms (which defer aborts). - -- This is coherent with Raise_From_Controlled_Operation. + -- This is "finalize/adjust raised exception". This subprogram is always + -- called with abort deferred, unlike all other Rcheck_* routines, it + -- needs to call Raise_Exception_No_Defer. + + -- This is consistent with Raise_From_Controlled_Operation Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address); Raise_Current_Excep (E); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 5a3c570..d21e8a1 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4741,41 +4741,6 @@ package body Sem_Ch3 is Make_Index (Index, P, Related_Id, Nb_Index); - -- In formal verification mode, create an explicit declaration for - -- Itypes created for index types. Having a declaration for all type - -- entities facilitates the task of the formal verification back-end. - -- Notice that this declaration is not attached to the tree. - - if ALFA_Mode - and then Is_Itype (Etype (Index)) - then - declare - Loc : constant Source_Ptr := Sloc (Def); - Sub_Ind : Node_Id; - Decl : Entity_Id; - - begin - if Nkind (Index) = N_Subtype_Indication then - Sub_Ind := Relocate_Node (Index); - else - Sub_Ind := - Make_Subtype_Indication (Loc, - Subtype_Mark => - New_Occurrence_Of (Base_Type (Etype (Index)), Loc), - Constraint => - Make_Range_Constraint (Loc, - Range_Expression => Relocate_Node (Index))); - end if; - - Decl := - Make_Subtype_Declaration (Loc, - Defining_Identifier => Etype (Index), - Subtype_Indication => Sub_Ind); - - Analyze (Decl); - end; - end if; - -- Check error of subtype with predicate for index type Bad_Predicated_Subtype_Use @@ -4793,24 +4758,6 @@ package body Sem_Ch3 is if Present (Component_Typ) then Element_Type := Process_Subtype (Component_Typ, P, Related_Id, 'C'); - -- In formal verification mode, create an explicit declaration for - -- the Itype created for a component type. Having a declaration for - -- all type entities facilitates the task of the formal verification - -- back-end. Note: this declaration is not attached to the tree. - - if ALFA_Mode and then Is_Itype (Element_Type) then - declare - Loc : constant Source_Ptr := Sloc (Def); - Decl : Entity_Id; - begin - Decl := - Make_Subtype_Declaration (Loc, - Defining_Identifier => Element_Type, - Subtype_Indication => Relocate_Node (Component_Typ)); - Analyze (Decl); - end; - end if; - Set_Etype (Component_Typ, Element_Type); if not Nkind_In (Component_Typ, N_Identifier, N_Expanded_Name) then @@ -4897,27 +4844,6 @@ package body Sem_Ch3 is (Implicit_Base, Finalize_Storage_Only (Element_Type)); - -- In ALFA mode, generate a declaration for Itype T, so that the - -- formal verification back-end can use it. - - if ALFA_Mode and then Is_Itype (T) then - declare - Loc : constant Source_Ptr := Sloc (Def); - Decl : Node_Id; - begin - Decl := - Make_Full_Type_Declaration (Loc, - Defining_Identifier => T, - Type_Definition => - Make_Constrained_Array_Definition (Loc, - Discrete_Subtype_Definitions => - New_Copy_List (Discrete_Subtype_Definitions (Def)), - Component_Definition => - Relocate_Node (Component_Definition (Def)))); - Analyze (Decl); - end; - end if; - -- Unconstrained array case else -- 2.7.4