From: Arnaud Charlet Date: Tue, 2 Aug 2011 10:27:16 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=6320f5e18ed03cb41e65e640566d2a9cf1cd5690;p=gcc.git [multiple changes] 2011-08-02 Robert Dewar * sem_ch5.adb, sem_ch7.adb, einfo.ads, sem_util.adb, sem_util.ads, sem_res.adb, sem_ch6.adb: Minor reformatting. 2011-08-02 Jerome Guitton * a-except-2005.adb (Raise_Current_Excep): Remove obsolete dead code. From-SVN: r177127 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f865c0b7e60..2a62cee0070 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2011-08-02 Robert Dewar + + * sem_ch5.adb, sem_ch7.adb, einfo.ads, sem_util.adb, sem_util.ads, + sem_res.adb, sem_ch6.adb: Minor reformatting. + +2011-08-02 Jerome Guitton + + * a-except-2005.adb (Raise_Current_Excep): Remove obsolete dead code. + 2011-08-02 Ed Schonberg * sem_ch6.adb (New_Overloaded_Entity, Check_Overriding_Indicator): Do diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb index cbf1e4deb89..6441fd6d164 100644 --- a/gcc/ada/a-except-2005.adb +++ b/gcc/ada/a-except-2005.adb @@ -829,31 +829,6 @@ package body Ada.Exceptions is ------------------------- procedure Raise_Current_Excep (E : Exception_Id) is - - pragma Inspection_Point (E); - -- This is so the debugger can reliably inspect the parameter when - -- inserting a breakpoint at the start of this procedure. - - -- To provide support for breakpoints on unhandled exceptions, the - -- debugger will also need to be able to inspect the value of E from - -- inner frames so we need to make sure that its value is also spilled - -- on stack. We take the address and dereference using volatile local - -- objects for this purpose. - - -- The pragma Warnings (Off) are needed because the compiler knows that - -- these locals are not referenced and that this use of pragma Volatile - -- is peculiar! - - type EID_Access is access Exception_Id; - - Access_To_E : EID_Access := E'Unrestricted_Access; - pragma Volatile (Access_To_E); - pragma Warnings (Off, Access_To_E); - - Id : Exception_Id := Access_To_E.all; - pragma Volatile (Id); - pragma Warnings (Off, Id); - begin Debug_Raise_Exception (E => SSL.Exception_Data_Ptr (E)); Exception_Propagation.Propagate_Exception diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index a69ba1ac1ce..7368fdf64c7 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3233,7 +3233,11 @@ package Einfo is -- Overridden_Operation (Node26) -- Present in subprograms. For overriding operations, points to the --- user-defined parent subprogram that is being overridden. +-- user-defined parent subprogram that is being overridden. Note: this +-- attribute uses the same field as Static_Initialization. The latter +-- is only defined for internal initialization procedures, for which +-- Overridden_Operation is irrelevant. Thus this attribute must not be +-- set for init_procs. -- Package_Instantiation (Node26) -- Present in packages and generic packages. When present, this field @@ -3649,7 +3653,9 @@ package Einfo is -- initialized statically. The value of this attribute is a positional -- aggregate whose components are compile-time static values. Used -- when available in object declarations to eliminate the call to the --- initialization procedure, and to minimize elaboration code. +-- initialization procedure, and to minimize elaboration code. Note: +-- This attribute uses the same field as Overridden_Operation, which is +-- irrelevant in init_procs. -- Stored_Constraint (Elist23) -- Present in entities that can have discriminants (concurrent types diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 2bf33832515..fda070c4633 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -807,8 +807,8 @@ package body Sem_Ch5 is HSS : constant Node_Id := Handled_Statement_Sequence (N); begin - -- Only reject block statements that originate from a source block - -- statement, in formal mode. + -- In formal mode, we reject block statements. Note that the case of + -- block statements generated by the expander is fine. if Nkind (Original_Node (N)) = N_Block_Statement then Check_Formal_Restriction ("block statement is not allowed", N); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index a872e900f46..97f57a93353 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -8367,6 +8367,15 @@ package body Sem_Ch6 is then Set_Overridden_Operation (S, Alias (E)); + -- Normal case of setting entity as overridden + + -- Note: Static_Initialization and Overridden_Operation + -- attributes use the same field in subprogram entities. + -- Static_Initialization is only defined for internal + -- initialization procedures, where Overridden_Operation + -- is irrelevant. Therefore the setting of this attribute + -- must check whether the target is an init_proc. + elsif not Is_Init_Proc (S) then Set_Overridden_Operation (S, E); end if; diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 1fbaacd0b8d..caf2a73d04b 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -925,6 +925,7 @@ package body Sem_Ch7 is procedure Check_Decls (Decls : List_Id) is Decl : Node_Id; + begin Decl := First (Decls); while Present (Decl) loop @@ -933,6 +934,7 @@ package body Sem_Ch7 is then if No (Previous) then Previous := Decl; + else Error_Msg_Sloc := Sloc (Previous); Check_Formal_Restriction diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index fa938c188d1..072baf48362 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -3586,9 +3586,8 @@ package body Sem_Res is F_Typ := Etype (F); if Comes_From_Source (Original_Node (N)) - and then Nkind_In (Original_Node (N), - N_Function_Call, - N_Procedure_Call_Statement) + and then Nkind_In (Original_Node (N), N_Function_Call, + N_Procedure_Call_Statement) then -- In formal mode, check that actual parameters matching -- formals of tagged types are objects (or ancestor type diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 15e978f4892..1ef8b833729 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6855,16 +6855,14 @@ package body Sem_Util is return Present (Entity (N)) and then (Ekind_In (Entity (N), E_Constant, E_Variable) - or else Ekind (Entity (N)) in Formal_Kind); + or else Ekind (Entity (N)) in Formal_Kind); else - case Nkind (N) is - when N_Selected_Component => - return Is_SPARK_Object_Reference (Prefix (N)); - - when others => - return False; - end case; + if Nkind (N) = N_Selected_Component then + return Is_SPARK_Object_Reference (Prefix (N)); + else + return False; + end if; end if; end Is_SPARK_Object_Reference; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index c908d885361..d10b53f982a 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -355,10 +355,9 @@ package Sem_Util is Call : out Node_Id); -- Determines if the node N is an actual parameter of a function of a -- procedure call. If so, then Formal points to the entity for the formal - -- (whose Ekind is one of E_In_Parameter, E_Out_Parameter, - -- E_In_Out_Parameter) and Call is set to the node for the corresponding - -- call. If the node N is not an actual parameter then Formal and Call are - -- set to Empty. + -- (Ekind is E_In_Parameter, E_Out_Parameter, or E_In_Out_Parameter) and + -- Call is set to the node for the corresponding call. If the node N is not + -- an actual parameter then Formal and Call are set to Empty. function Find_Corresponding_Discriminant (Id : Node_Id; @@ -768,7 +767,7 @@ package Sem_Util is -- variable and constant objects return True (compare Is_Variable). function Is_SPARK_Object_Reference (N : Node_Id) return Boolean; - -- Determines if the tree referenced by N represents an object in SPARK. + -- Determines if the tree referenced by N represents an object in SPARK function Is_OK_Variable_For_Out_Formal (AV : Node_Id) return Boolean; -- Used to test if AV is an acceptable formal for an OUT or IN OUT formal.