From 9fc2854deca262d8a469dea2d0a32fc6e9572c9e Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 22 Oct 2010 16:44:16 +0200 Subject: [PATCH] [multiple changes] 2010-10-22 Thomas Quinot * uname.adb (Get_Unit_Name.Add_Node_Name): If encountering an error node in the unit name, propagate Program_Error to guard against cascaded errors. 2010-10-22 Javier Miranda * sem_ch8.adb (Find_Selected_Component): Do not generate a subtype for selected components of dispatch table wrappers. 2010-10-22 Ed Schonberg * exp_ch9.adb (Make_Initialize_Protection): A protected type that implements an interface must be treated as if it has entries, to support dispatching select statements. 2010-10-22 Robert Dewar * sem_aggr.adb, sem_ch3.adb: Minor reformatting. From-SVN: r165831 --- gcc/ada/ChangeLog | 21 +++++++++++++++++++++ gcc/ada/exp_ch9.adb | 10 +++++++++- gcc/ada/sem_aggr.adb | 2 +- gcc/ada/sem_ch3.adb | 6 +++--- gcc/ada/sem_ch8.adb | 26 +++++++++++++++++++++++--- gcc/ada/uname.adb | 6 +++--- 6 files changed, 60 insertions(+), 11 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4984482bc82..52be441e179 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2010-10-22 Thomas Quinot + + * uname.adb (Get_Unit_Name.Add_Node_Name): If encountering an error + node in the unit name, propagate Program_Error to guard against + cascaded errors. + +2010-10-22 Javier Miranda + + * sem_ch8.adb (Find_Selected_Component): Do not generate a subtype for + selected components of dispatch table wrappers. + +2010-10-22 Ed Schonberg + + * exp_ch9.adb (Make_Initialize_Protection): A protected type that + implements an interface must be treated as if it has entries, to + support dispatching select statements. + +2010-10-22 Robert Dewar + + * sem_aggr.adb, sem_ch3.adb: Minor reformatting. + 2010-10-22 Javier Miranda * sem_aggr.adb (Resolve_Array_Aggregate.Add): If the type of the diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index ec1dd818610..f9cbec8c775 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -12343,6 +12343,11 @@ package body Exp_Ch9 is -- is a pointer to the record generated by the compiler to represent -- the protected object. + -- A protected type without entries that covers an interface and + -- overrides the abstract routines with protected procedures is + -- considered equivalent to a protected type with entries in the + -- context of dispatching select statements. + if Has_Entry or else Has_Interrupt_Handler (Ptyp) or else Has_Attach_Handler (Ptyp) @@ -12368,7 +12373,10 @@ package body Exp_Ch9 is raise Program_Error; end case; - if Has_Entry or else not Restricted then + if Has_Entry + or else not Restricted + or else Has_Interfaces (Protect_Rec) + then Append_To (Args, Make_Attribute_Reference (Loc, Prefix => Make_Identifier (Loc, Name_uInit), diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 0a43e858bd6..e66d15b3a5e 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -892,7 +892,7 @@ package body Sem_Aggr is procedure Resolve_Aggregate (N : Node_Id; Typ : Entity_Id) is Loc : constant Source_Ptr := Sloc (N); - Pkind : constant Node_Kind := Nkind (Parent (N)); + Pkind : constant Node_Kind := Nkind (Parent (N)); Aggr_Subtyp : Entity_Id; -- The actual aggregate subtype. This is not necessarily the same as Typ diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index ab7ce65ac2c..ddbb77f1a3a 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -5035,9 +5035,9 @@ package body Sem_Ch3 is -- The new type has fewer discriminants, so we need to create a new -- corresponding record, which is derived from the corresponding -- record of the parent, and has a stored constraint that captures - -- the values of the discriminant constraints. - -- The corresponding record is needed only if expander is active - -- and code generation is enabled. + -- the values of the discriminant constraints. The corresponding + -- record is needed only if expander is active and code generation is + -- enabled. -- The type declaration for the derived corresponding record has the -- same discriminant part and constraints as the current declaration. diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 10b76643314..81c65087a3b 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -5368,9 +5368,29 @@ package body Sem_Ch8 is and then (not Is_Entity_Name (P) or else Chars (Entity (P)) /= Name_uInit) then - C_Etype := - Build_Actual_Subtype_Of_Component ( - Etype (Selector), N); + -- Do not build the subtype when referencing components of + -- dispatch table wrappers. Required to avoid generating + -- elaboration code with HI runtimes. + + if RTU_Loaded (Ada_Tags) + and then RTE_Available (RE_Dispatch_Table_Wrapper) + and then Scope (Selector) = RTE (RE_Dispatch_Table_Wrapper) + then + C_Etype := Empty; + + elsif RTU_Loaded (Ada_Tags) + and then RTE_Available (RE_No_Dispatch_Table_Wrapper) + and then Scope (Selector) + = RTE (RE_No_Dispatch_Table_Wrapper) + then + C_Etype := Empty; + + else + C_Etype := + Build_Actual_Subtype_Of_Component ( + Etype (Selector), N); + end if; + else C_Etype := Empty; end if; diff --git a/gcc/ada/uname.adb b/gcc/ada/uname.adb index 17d99ac60e4..8ddc5a6c01d 100644 --- a/gcc/ada/uname.adb +++ b/gcc/ada/uname.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -225,10 +225,10 @@ package body Uname is Kind : constant Node_Kind := Nkind (Node); begin - -- Just ignore an error node (someone else will give a message) + -- Bail out on error node (guard against parse error) if Node = Error then - return; + raise Program_Error; -- Otherwise see what kind of node we have -- 2.30.2