[multiple changes]

2010-10-22  Thomas Quinot  <quinot@adacore.com>

	* 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  <miranda@adacore.com>

	* sem_ch8.adb (Find_Selected_Component): Do not generate a subtype for
	selected components of dispatch table wrappers.

2010-10-22  Ed Schonberg  <schonberg@adacore.com>

	* 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  <dewar@adacore.com>

	* sem_aggr.adb, sem_ch3.adb: Minor reformatting.

From-SVN: r165831

6 files changed, 60 insertions, 11 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4984482..52be441 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+2010-10-22  Thomas Quinot  <quinot@adacore.com>
+
+	* 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  <miranda@adacore.com>
+
+	* sem_ch8.adb (Find_Selected_Component): Do not generate a subtype for
+	selected components of dispatch table wrappers.
+
+2010-10-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* 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  <dewar@adacore.com>
+
+	* sem_aggr.adb, sem_ch3.adb: Minor reformatting.
+
 2010-10-22  Javier Miranda  <miranda@adacore.com>
 
 	* 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 ec1dd81..f9cbec8 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 0a43e85..e66d15b3 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 ab7ce65..ddbb77f 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 10b7664..81c6508 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 17d99ac..8ddc5a6 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