[multiple changes]

2010-06-22  Robert Dewar  <dewar@adacore.com>

	* s-rannum.adb: Minor reformatting.

2010-06-22  Javier Miranda  <miranda@adacore.com>

	* sem_aux.adb, sem_aux.ads, sem_util.adb, sem_util.ads, sem_elim.adb,
	exp_cg.adb: Minor code reorganization: Move routine Ultimate_Alias from
	package Sem_Util to package Sem_Aux.

2010-06-22  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Make_Secondary_DT, Make_DT): Minor code cleanup:
	remove useless restriction on imported routines when building the
	dispatch tables.

2010-06-22  Robert Dewar  <dewar@adacore.com>

	* cstand.adb (Create_Standard): Set Has_Pragma_Pack for standard string
	types.

2010-06-22  Javier Miranda  <miranda@adacore.com>

	* sem_ch4.adb (Collect_Generic_Type_Ops): Protect code that handles
	generic subprogram declarations to ensure proper context. Add missing
	support for generic actuals.
	(Try_Primitive_Operation): Add missing support for concurrent types that
	have no Corresponding_Record_Type. Required to diagnose errors compiling
	generics or when compiling with no code generation (-gnatc).
	* sem_ch9.adb (Analyze_Protected_Type, Analyze_Task_Type): Do not build
	the corresponding record type.
	* sem_disp.ads, sem_disp.adb (Check_Dispatching_Operation): Complete
	documentation. Do minimum decoration when processing a primitive of a
	concurrent tagged type that covers interfaces. Required to diagnose
	errors in the Object.Operation notation compiling generics or under
	-gnatc.
	* exp_ch9.ads, exp_ch9.adb (Build_Corresponding_Record): Add missing
	propagation of attribute Interface_List to the corresponding record.
	(Expand_N_Task_Type_Declaration): Code cleanup.
	(Expand_N_Protected_Type_Declaration): Code cleanup.

From-SVN: r161203

gcc/ada/ChangeLog

+2010-06-22  Robert Dewar  <dewar@adacore.com>
+
+	* s-rannum.adb: Minor reformatting.
+
+2010-06-22  Javier Miranda  <miranda@adacore.com>
+
+	* sem_aux.adb, sem_aux.ads, sem_util.adb, sem_util.ads, sem_elim.adb,
+	exp_cg.adb: Minor code reorganization: Move routine Ultimate_Alias from
+	package Sem_Util to package Sem_Aux.
+
+2010-06-22  Javier Miranda  <miranda@adacore.com>
+
+	* exp_disp.adb (Make_Secondary_DT, Make_DT): Minor code cleanup:
+	remove useless restriction on imported routines when building the
+	dispatch tables.
+
+2010-06-22  Robert Dewar  <dewar@adacore.com>
+
+	* cstand.adb (Create_Standard): Set Has_Pragma_Pack for standard string
+	types.
+
+2010-06-22  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch4.adb (Collect_Generic_Type_Ops): Protect code that handles
+	generic subprogram declarations to ensure proper context. Add missing
+	support for generic actuals.
+	(Try_Primitive_Operation): Add missing support for concurrent types that
+	have no Corresponding_Record_Type. Required to diagnose errors compiling
+	generics or when compiling with no code generation (-gnatc).
+	* sem_ch9.adb (Analyze_Protected_Type, Analyze_Task_Type): Do not build
+	the corresponding record type.
+	* sem_disp.ads, sem_disp.adb (Check_Dispatching_Operation): Complete
+	documentation. Do minimum decoration when processing a primitive of a
+	concurrent tagged type that covers interfaces. Required to diagnose
+	errors in the Object.Operation notation compiling generics or under
+	-gnatc.
+	* exp_ch9.ads, exp_ch9.adb (Build_Corresponding_Record): Add missing
+	propagation of attribute Interface_List to the corresponding record.
+	(Expand_N_Task_Type_Declaration): Code cleanup.
+	(Expand_N_Protected_Type_Declaration): Code cleanup.
+
 2010-06-22  Matthew Heaney  <heaney@adacore.com>
 
 	* a-convec.adb, a-coinve.adb: Removed 64-bit types Int and UInt.

gcc/ada/cstand.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, 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- --
@@ -688,12 +688,13 @@ package body CStand is
       Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
       Set_Type_Definition (Parent (Standard_String), Tdef_Node);
 
-      Set_Ekind          (Standard_String, E_String_Type);
-      Set_Etype          (Standard_String, Standard_String);
-      Set_Component_Type (Standard_String, Standard_Character);
-      Set_Component_Size (Standard_String, Uint_8);
-      Init_Size_Align    (Standard_String);
-      Set_Alignment      (Standard_String, Uint_1);
+      Set_Ekind           (Standard_String, E_String_Type);
+      Set_Etype           (Standard_String, Standard_String);
+      Set_Component_Type  (Standard_String, Standard_Character);
+      Set_Component_Size  (Standard_String, Uint_8);
+      Init_Size_Align     (Standard_String);
+      Set_Alignment       (Standard_String, Uint_1);
+      Set_Has_Pragma_Pack (Standard_String, True);
 
       --  On targets where a storage unit is larger than a byte (such as AAMP),
       --  pragma Pack has a real effect on the representation of type String,
@@ -731,11 +732,12 @@ package body CStand is
       Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
       Set_Type_Definition (Parent (Standard_Wide_String), Tdef_Node);
 
-      Set_Ekind          (Standard_Wide_String, E_String_Type);
-      Set_Etype          (Standard_Wide_String, Standard_Wide_String);
-      Set_Component_Type (Standard_Wide_String, Standard_Wide_Character);
-      Set_Component_Size (Standard_Wide_String, Uint_16);
-      Init_Size_Align    (Standard_Wide_String);
+      Set_Ekind           (Standard_Wide_String, E_String_Type);
+      Set_Etype           (Standard_Wide_String, Standard_Wide_String);
+      Set_Component_Type  (Standard_Wide_String, Standard_Wide_Character);
+      Set_Component_Size  (Standard_Wide_String, Uint_16);
+      Init_Size_Align     (Standard_Wide_String);
+      Set_Has_Pragma_Pack (Standard_Wide_String, True);
 
       --  Set index type of Wide_String
 
@@ -772,6 +774,7 @@ package body CStand is
       Set_Component_Size   (Standard_Wide_Wide_String, Uint_32);
       Init_Size_Align      (Standard_Wide_Wide_String);
       Set_Is_Ada_2005_Only (Standard_Wide_Wide_String);
+      Set_Has_Pragma_Pack  (Standard_Wide_Wide_String, True);
 
       --  Set index type of Wide_Wide_String
 

gcc/ada/exp_cg.adb

@@ -34,6 +34,7 @@ with Lib;      use Lib;
 with Namet;    use Namet;
 with Opt;      use Opt;
 with Output;   use Output;
+with Sem_Aux;  use Sem_Aux;
 with Sem_Disp; use Sem_Disp;
 with Sem_Type; use Sem_Type;
 with Sem_Util; use Sem_Util;

gcc/ada/exp_ch9.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- --
@@ -128,6 +128,14 @@ package body Exp_Ch9 is
    --  Build a specification for a function implementing the protected entry
    --  barrier of the specified entry body.
 
+   function Build_Corresponding_Record
+     (N    : Node_Id;
+      Ctyp : Node_Id;
+      Loc  : Source_Ptr) return Node_Id;
+   --  Common to tasks and protected types. Copy discriminant specifications,
+   --  build record declaration. N is the type declaration, Ctyp is the
+   --  concurrent entity (task type or protected type).
+
    function Build_Entry_Count_Expression
      (Concurrent_Type : Node_Id;
       Component_List  : List_Id;
@@ -1037,8 +1045,9 @@ package body Exp_Ch9 is
       --  record is "limited tagged". It is "limited" to reflect the underlying
       --  limitedness of the task or protected object that it represents, and
       --  ensuring for example that it is properly passed by reference. It is
-      --  "tagged" to give support to dispatching calls through interfaces (Ada
-      --  2005: AI-345)
+      --  "tagged" to give support to dispatching calls through interfaces. We
+      --  propagate here the list of interfaces covered by the concurrent type
+      --  (Ada 2005: AI-345).
 
       return
         Make_Full_Type_Declaration (Loc,
@@ -1051,6 +1060,7 @@ package body Exp_Ch9 is
                   Component_Items => Cdecls),
               Tagged_Present  =>
                  Ada_Version >= Ada_05 and then Is_Tagged_Type (Ctyp),
+              Interface_List  => Interface_List (N),
               Limited_Present => True));
    end Build_Corresponding_Record;
 
@@ -7682,11 +7692,6 @@ package body Exp_Ch9 is
 
       Cdecls := Component_Items (Component_List (Type_Definition (Rec_Decl)));
 
-      --  Ada 2005 (AI-345): Propagate the attribute that contains the list
-      --  of implemented interfaces.
-
-      Set_Interface_List (Type_Definition (Rec_Decl), Interface_List (N));
-
       Qualify_Entity_Names (N);
 
       --  If the type has discriminants, their occurrences in the declaration
@@ -9946,11 +9951,6 @@ package body Exp_Ch9 is
 
       Rec_Decl := Build_Corresponding_Record (N, Tasktyp, Loc);
 
-      --  Ada 2005 (AI-345): Propagate the attribute that contains the list
-      --  of implemented interfaces.
-
-      Set_Interface_List (Type_Definition (Rec_Decl), Interface_List (N));
-
       Rec_Ent  := Defining_Identifier (Rec_Decl);
       Cdecls   := Component_Items (Component_List
                                      (Type_Definition (Rec_Decl)));

gcc/ada/exp_ch9.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          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- --
@@ -50,14 +50,6 @@ package Exp_Ch9 is
    --  Task_Id of the associated task as the parameter. The caller is
    --  responsible for analyzing and resolving the resulting tree.
 
-   function Build_Corresponding_Record
-     (N    : Node_Id;
-      Ctyp : Node_Id;
-      Loc  : Source_Ptr) return Node_Id;
-   --  Common to tasks and protected types. Copy discriminant specifications,
-   --  build record declaration. N is the type declaration, Ctyp is the
-   --  concurrent entity (task type or protected type).
-
    function Build_Entry_Names (Conc_Typ : Entity_Id) return Node_Id;
    --  Create the statements which populate the entry names array of a task or
    --  protected type. The statements are wrapped inside a block due to a local

gcc/ada/exp_disp.adb

@@ -3968,12 +3968,9 @@ package body Exp_Disp is
                   --  are located in a separate dispatch table; skip also
                   --  abstract and eliminated primitives.
 
-                  --  Why do we skip imported primitives???
-
                   if not Is_Predefined_Dispatching_Operation (Prim)
                     and then Present (Interface_Alias (Prim))
                     and then not Is_Abstract_Subprogram (Alias (Prim))
-                    and then not Is_Imported (Alias (Prim))
                     and then not Is_Eliminated (Alias (Prim))
                     and then Find_Dispatching_Type
                                (Interface_Alias (Prim)) = Iface
@@ -5518,13 +5515,10 @@ package body Exp_Disp is
                   --  to build secondary dispatch tables; skip also abstract
                   --  and eliminated primitives.
 
-                  --  Why do we skip imported primitives???
-
                   if not Is_Predefined_Dispatching_Operation (Prim)
                     and then not Is_Predefined_Dispatching_Operation (E)
                     and then not Present (Interface_Alias (Prim))
                     and then not Is_Abstract_Subprogram (E)
-                    and then not Is_Imported (E)
                     and then not Is_Eliminated (E)
                   then
                      pragma Assert

gcc/ada/s-rannum.adb

@@ -86,9 +86,10 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Ada.Calendar;              use Ada.Calendar;
+with Ada.Calendar;             use Ada.Calendar;
 with Ada.Unchecked_Conversion;
-with Interfaces;                use Interfaces;
+
+with Interfaces; use Interfaces;
 
 use Ada;
 
@@ -122,7 +123,9 @@ package body System.Random_Numbers is
    Image_Numeral_Length : constant := Max_Image_Width / N;
    subtype Image_String is String (1 .. Max_Image_Width);
 
-   --  Utility functions
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
 
    procedure Init (Gen : out Generator; Initiator : Unsigned_32);
    --  Perform a default initialization of the state of Gen. The resulting
@@ -199,6 +202,10 @@ package body System.Random_Numbers is
    --  assuming that Unsigned is large enough to hold the bits of a mantissa
    --  for type Real.
 
+   ---------------------------
+   -- Random_Float_Template --
+   ---------------------------
+
    function Random_Float_Template (Gen : Generator) return Real is
 
       pragma Compile_Time_Error
@@ -232,6 +239,7 @@ package body System.Random_Numbers is
       if Real'Machine_Radix /= 2 then
          return Real'Machine
            (Real (Unsigned'(Random (Gen))) * 2.0**(-Unsigned'Size));
+
       else
          declare
             type Bit_Count is range 0 .. 4;
@@ -239,8 +247,8 @@ package body System.Random_Numbers is
             subtype T is Real'Base;
 
             Trailing_Ones : constant array (Unsigned_32 range 0 .. 15)
-              of Bit_Count
-              :=  (2#00000# => 0, 2#00001# => 1, 2#00010# => 0, 2#00011# => 2,
+              of Bit_Count :=
+                  (2#00000# => 0, 2#00001# => 1, 2#00010# => 0, 2#00011# => 2,
                    2#00100# => 0, 2#00101# => 1, 2#00110# => 0, 2#00111# => 3,
                    2#01000# => 0, 2#01001# => 1, 2#01010# => 0, 2#01011# => 2,
                    2#01100# => 0, 2#01101# => 1, 2#01110# => 0, 2#01111# => 4);
@@ -255,21 +263,30 @@ package body System.Random_Numbers is
                          (Unsigned'Size - T'Machine_Mantissa + 1);
             --  Random bits left over after selecting mantissa
 
-            Mantissa   : Unsigned;
-            X          : Real;            -- Scaled mantissa
-            R          : Unsigned_32;     -- Supply of random bits
-            R_Bits     : Natural;         -- Number of bits left in R
+            Mantissa : Unsigned;
 
-            K          : Bit_Count;       -- Next decrement to exponent
-         begin
+            X : Real;
+            --  Scaled mantissa
+
+            R : Unsigned_32;
+            --  Supply of random bits
+
+            R_Bits : Natural;
+            --  Number of bits left in R
+
+            K : Bit_Count;
+            --  Next decrement to exponent
 
+         begin
             Mantissa := Random (Gen) / 2**Extra_Bits;
             R := Unsigned_32 (Mantissa mod 2**Extra_Bits);
             R_Bits := Extra_Bits;
             X := Real (2**(T'Machine_Mantissa - 1) + Mantissa); -- Exact
 
-            if Extra_Bits < 4 and then R < 2**Extra_Bits - 1 then
+            if Extra_Bits < 4 and then R < 2 ** Extra_Bits - 1 then
+
                --  We got lucky and got a zero in our few extra bits
+
                K := Trailing_Ones (R);
 
             else
@@ -305,12 +322,11 @@ package body System.Random_Numbers is
                end loop Find_Zero;
             end if;
 
-            --  K has the count of trailing ones not reflected yet in X.
-            --  The following multiplication takes care of that, as well
-            --  as the correction to move the radix point to the left of
-            --  the mantissa. Doing it at the end avoids repeated rounding
-            --  errors in the exceedingly unlikely case of ever having
-            --  a subnormal result.
+            --  K has the count of trailing ones not reflected yet in X. The
+            --  following multiplication takes care of that, as well as the
+            --  correction to move the radix point to the left of the mantissa.
+            --  Doing it at the end avoids repeated rounding errors in the
+            --  exceedingly unlikely case of ever having a subnormal result.
 
             X := X * Pow_Tab (K);
 
@@ -330,6 +346,10 @@ package body System.Random_Numbers is
       end if;
    end Random_Float_Template;
 
+   ------------
+   -- Random --
+   ------------
+
    function Random (Gen : Generator) return Float is
       function F is new Random_Float_Template (Unsigned_32, Float);
    begin
@@ -371,7 +391,7 @@ package body System.Random_Numbers is
             --  Ignore different-size warnings here; since GNAT's handling
             --  is correct.
 
-            pragma Warnings ("Z");
+            pragma Warnings ("Z");  -- better to use msg string! ???
             function Conv_To_Unsigned is
                new Unchecked_Conversion (Result_Subtype'Base, Unsigned_64);
             function Conv_To_Result is
@@ -489,7 +509,7 @@ package body System.Random_Numbers is
       I, J : Integer;
 
    begin
-      Init (Gen, 19650218);
+      Init (Gen, 19650218); -- please give this constant a name ???
       I := 1;
       J := 0;
 

gcc/ada/sem_aux.adb

@@ -799,4 +799,20 @@ package body Sem_Aux is
       Obsolescent_Warnings.Tree_Write;
    end Tree_Write;
 
+   --------------------
+   -- Ultimate_Alias --
+   --------------------
+
+   function Ultimate_Alias (Prim : Entity_Id) return Entity_Id is
+      E : Entity_Id := Prim;
+
+   begin
+      while Present (Alias (E)) loop
+         pragma Assert (Alias (E) /= E);
+         E := Alias (E);
+      end loop;
+
+      return E;
+   end Ultimate_Alias;
+
 end Sem_Aux;

gcc/ada/sem_aux.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          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- --
@@ -193,4 +193,9 @@ package Sem_Aux is
    function Number_Discriminants (Typ : Entity_Id) return Pos;
    --  Typ is a type with discriminants, yields number of discriminants in type
 
+   function Ultimate_Alias (Prim : Entity_Id) return Entity_Id;
+   pragma Inline (Ultimate_Alias);
+   --  Return the last entity in the chain of aliased entities of Prim. If Prim
+   --  has no alias return Prim.
+
 end Sem_Aux;

gcc/ada/sem_ch4.adb

@@ -6880,23 +6880,26 @@ package body Sem_Ch4 is
                --  Scan the list of generic formals to find subprograms
                --  that may have a first controlling formal of the type.
 
-               declare
-                  Decl : Node_Id;
-
-               begin
-                  Decl :=
-                    First (Generic_Formal_Declarations
-                            (Unit_Declaration_Node (Scope (T))));
-                  while Present (Decl) loop
-                     if Nkind (Decl) in N_Formal_Subprogram_Declaration then
-                        Subp := Defining_Entity (Decl);
-                        Check_Candidate;
-                     end if;
-
-                     Next (Decl);
-                  end loop;
-               end;
+               if Nkind (Unit_Declaration_Node (Scope (T)))
+                 = N_Generic_Subprogram_Declaration
+               then
+                  declare
+                     Decl : Node_Id;
+
+                  begin
+                     Decl :=
+                       First (Generic_Formal_Declarations
+                               (Unit_Declaration_Node (Scope (T))));
+                     while Present (Decl) loop
+                        if Nkind (Decl) in N_Formal_Subprogram_Declaration then
+                           Subp := Defining_Entity (Decl);
+                           Check_Candidate;
+                        end if;
 
+                        Next (Decl);
+                     end loop;
+                  end;
+               end if;
                return Candidates;
 
             else
@@ -6906,7 +6909,15 @@ package body Sem_Ch4 is
                --  declaration or body (either the one that declares T, or a
                --  child unit).
 
-               Subp := First_Entity (Scope (T));
+               --  For a subtype representing a generic actual type, go to the
+               --  base type.
+
+               if Is_Generic_Actual_Type (T) then
+                  Subp := First_Entity (Scope (Base_Type (T)));
+               else
+                  Subp := First_Entity (Scope (T));
+               end if;
+
                while Present (Subp) loop
                   if Is_Overloadable (Subp) then
                      Check_Candidate;
@@ -6979,13 +6990,14 @@ package body Sem_Ch4 is
          --  corresponding record (base) type.
 
          if Is_Concurrent_Type (Obj_Type) then
-            if not Present (Corresponding_Record_Type (Obj_Type)) then
-               return False;
+            if Present (Corresponding_Record_Type (Obj_Type)) then
+               Corr_Type := Base_Type (Corresponding_Record_Type (Obj_Type));
+               Elmt := First_Elmt (Primitive_Operations (Corr_Type));
+            else
+               Corr_Type := Obj_Type;
+               Elmt := First_Elmt (Collect_Generic_Type_Ops (Obj_Type));
             end if;
 
-            Corr_Type := Base_Type (Corresponding_Record_Type (Obj_Type));
-            Elmt := First_Elmt (Primitive_Operations (Corr_Type));
-
          elsif not Is_Generic_Type (Obj_Type) then
             Corr_Type := Obj_Type;
             Elmt := First_Elmt (Primitive_Operations (Obj_Type));

gcc/ada/sem_ch9.adb

@@ -1176,16 +1176,6 @@ package body Sem_Ch9 is
 
       Set_Is_Constrained (T, not Has_Discriminants (T));
 
-      --  Perform minimal expansion of protected type while inside a generic.
-      --  The corresponding record is needed for various semantic checks.
-
-      if Ada_Version >= Ada_05
-        and then Inside_A_Generic
-      then
-         Insert_After_And_Analyze (N,
-           Build_Corresponding_Record (N, T, Sloc (T)));
-      end if;
-
       Analyze (Protected_Definition (N));
 
       --  Protected types with entries are controlled (because of the
@@ -1976,15 +1966,6 @@ package body Sem_Ch9 is
 
       Set_Is_Constrained (T, not Has_Discriminants (T));
 
-      --  Perform minimal expansion of the task type while inside a generic
-      --  context. The corresponding record is needed for various semantic
-      --  checks.
-
-      if Inside_A_Generic then
-         Insert_After_And_Analyze (N,
-           Build_Corresponding_Record (N, T, Sloc (T)));
-      end if;
-
       if Present (Task_Definition (N)) then
          Analyze_Task_Definition (Task_Definition (N));
       end if;

gcc/ada/sem_disp.adb

@@ -677,18 +677,15 @@ package body Sem_Disp is
       Set_Is_Dispatching_Operation (Subp, False);
       Tagged_Type := Find_Dispatching_Type (Subp);
 
-      --  Ada 2005 (AI-345)
+      --  Ada 2005 (AI-345): Use the corresponding record (if available).
+      --  Required because primitives of concurrent types are be attached
+      --  to the corresponding record (not to the concurrent type).
 
       if Ada_Version >= Ada_05
         and then Present (Tagged_Type)
         and then Is_Concurrent_Type (Tagged_Type)
+        and then Present (Corresponding_Record_Type (Tagged_Type))
       then
-         --  Protect the frontend against previously detected errors
-
-         if No (Corresponding_Record_Type (Tagged_Type)) then
-            return;
-         end if;
-
          Tagged_Type := Corresponding_Record_Type (Tagged_Type);
       end if;
 
@@ -1068,6 +1065,18 @@ package body Sem_Disp is
             end if;
          end if;
 
+      --  If the tagged type is a concurrent type then we must be compiling
+      --  with no code generation (we are either compiling a generic unit or
+      --  compiling under -gnatc mode) because we have previously tested that
+      --  no serious errors has been reported. In this case we do not add the
+      --  primitive to the list of primitives of Tagged_Type but we leave the
+      --  primitive decorated as a dispatching operation to be able to analyze
+      --  and report errors associated with the Object.Operation notation.
+
+      elsif Is_Concurrent_Type (Tagged_Type) then
+         pragma Assert (not Expander_Active);
+         null;
+
       --  If no old subprogram, then we add this as a dispatching operation,
       --  but we avoid doing this if an error was posted, to prevent annoying
       --  cascaded errors.

gcc/ada/sem_disp.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, 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- --
@@ -46,7 +46,12 @@ package Sem_Disp is
    --  if it has a parameter of this type and is defined at a proper place for
    --  primitive operations (new primitives are only defined in package spec,
    --  overridden operation can be defined in any scope). If Old_Subp is not
-   --  Empty we are in the overriding case.
+   --  Empty we are in the overriding case. If the tagged type associated with
+   --  Subp is a concurrent type (case that occurs when the type is declared in
+   --  a generic because the analysis of generics disables generation of the
+   --  corresponding record) then this routine does does not add "Subp" to the
+   --  list of primitive operations but leaves Subp decorated as dispatching
+   --  operation to enable checks associated with the Object.Operation notation
 
    procedure Check_Operation_From_Incomplete_Type
      (Subp : Entity_Id;

gcc/ada/sem_elim.adb

@@ -31,6 +31,7 @@ with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Opt;      use Opt;
 with Sem;      use Sem;
+with Sem_Aux;  use Sem_Aux;
 with Sem_Prag; use Sem_Prag;
 with Sem_Util; use Sem_Util;
 with Sinput;   use Sinput;

gcc/ada/sem_util.adb

@@ -11125,22 +11125,6 @@ package body Sem_Util is
       return Scope_Depth (Enclosing_Dynamic_Scope (Btyp));
    end Type_Access_Level;
 
-   --------------------
-   -- Ultimate_Alias --
-   --------------------
-
-   function Ultimate_Alias (Prim : Entity_Id) return Entity_Id is
-      E : Entity_Id := Prim;
-
-   begin
-      while Present (Alias (E)) loop
-         pragma Assert (Alias (E) /= E);
-         E := Alias (E);
-      end loop;
-
-      return E;
-   end Ultimate_Alias;
-
    --------------------------
    -- Unit_Declaration_Node --
    --------------------------

gcc/ada/sem_util.ads

@@ -1260,11 +1260,6 @@ package Sem_Util is
    function Type_Access_Level (Typ : Entity_Id) return Uint;
    --  Return the accessibility level of Typ
 
-   function Ultimate_Alias (Prim : Entity_Id) return Entity_Id;
-   pragma Inline (Ultimate_Alias);
-   --  Return the last entity in the chain of aliased entities of Prim. If Prim
-   --  has no alias return Prim.
-
    function Unit_Declaration_Node (Unit_Id : Entity_Id) return Node_Id;
    --  Unit_Id is the simple name of a program unit, this function returns the
    --  corresponding xxx_Declaration node for the entity. Also applies to the