freeze.adb (Generate_Prim_Op_References): New procedure, abstracted from Freeze_Entity.

2008-08-08  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Generate_Prim_Op_References): New procedure, abstracted
	from Freeze_Entity. Used to generate cross-reference information for
	types declared in generic packages.

From-SVN: r138881

2 files changed, 107 insertions, 61 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1f5e4e6..df7f18b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2008-08-08  Ed Schonberg  <schonberg@adacore.com>
+
+	* freeze.adb (Generate_Prim_Op_References): New procedure, abstracted
+	from Freeze_Entity. Used to generate cross-reference information for
+	types declared in generic packages.
+
 2008-08-08  Thomas Quinot  <quinot@adacore.com>
 
 	* gcc-interface/Makefile.in: Reintroduce g-soccon.ads as a
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 5a8f983..5e069f4 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -134,6 +134,11 @@ package body Freeze is
    --  the designated type. Otherwise freezing the access type does not freeze
    --  the designated type.
 
+   procedure Generate_Prim_Op_References
+     (Typ      : Entity_Id);
+   --  For a tagged type, generate implicit references to its primitive
+   --  operations, for source navigation.
+
    procedure Process_Default_Expressions
      (E     : Entity_Id;
       After : in out Node_Id);
@@ -2600,6 +2605,10 @@ package body Freeze is
                      --
                      --    type T is tagged;
                      --    function F (X : Boolean) return T; -- ERROR
+                     --  The type must be declared in the current scope
+                     --  for the use to be legal, and the full view
+                     --  must be available when the construct that mentions
+                     --  it is frozen.
 
                      elsif Ekind (Etype (E)) = E_Incomplete_Type
                        and then Is_Tagged_Type (Etype (E))
@@ -2608,7 +2617,7 @@ package body Freeze is
                      then
                         Error_Msg_N
                           ("(Ada 2005): invalid use of tagged incomplete type",
-                           E);
+                            E);
                      end if;
                   end if;
                end;
@@ -2635,10 +2644,30 @@ package body Freeze is
          --  Here for other than a subprogram or type
 
          else
+            --  For a generic package, freeze types within, so that proper
+            --  cross-reference information is generated for tagged types.
+            --  This is the only freeze processing needed for generic packages.
+
+            if Ekind (E) = E_Generic_Package then
+               declare
+                  T : Entity_Id;
+
+               begin
+                  T := First_Entity (E);
+
+                  while Present (T) loop
+                     if Is_Type (T) then
+                        Generate_Prim_Op_References (T);
+                     end if;
+
+                     Next_Entity (T);
+                  end loop;
+               end;
+
             --  If entity has a type, and it is not a generic unit, then
             --  freeze it first (RM 13.14(10)).
 
-            if Present (Etype (E))
+            elsif Present (Etype (E))
               and then Ekind (E) /= E_Generic_Function
             then
                Freeze_And_Append (Etype (E), Loc, Result);
@@ -3628,66 +3657,9 @@ package body Freeze is
             end if;
          end if;
 
-         --  Generate primitive operation references for a tagged type
-
-         if Is_Tagged_Type (E)
-           and then not Is_Class_Wide_Type (E)
-         then
-            declare
-               Prim_List : Elist_Id;
-               Prim      : Elmt_Id;
-               Ent       : Entity_Id;
-               Aux_E     : Entity_Id;
-
-            begin
-               --  Handle subtypes
+         --  Generate references to primitive operations for a tagged type
 
-               if Ekind (E) = E_Protected_Subtype
-                 or else Ekind (E) = E_Task_Subtype
-               then
-                  Aux_E := Etype (E);
-               else
-                  Aux_E := E;
-               end if;
-
-               --  Ada 2005 (AI-345): In case of concurrent type generate
-               --  reference to the wrapper that allow us to dispatch calls
-               --  through their implemented abstract interface types.
-
-               --  The check for Present here is to protect against previously
-               --  reported critical errors.
-
-               if Is_Concurrent_Type (Aux_E)
-                 and then Present (Corresponding_Record_Type (Aux_E))
-               then
-                  Prim_List := Primitive_Operations
-                                (Corresponding_Record_Type (Aux_E));
-               else
-                  Prim_List := Primitive_Operations (Aux_E);
-               end if;
-
-               --  Loop to generate references for primitive operations
-
-               if Present (Prim_List) then
-                  Prim := First_Elmt (Prim_List);
-                  while Present (Prim) loop
-
-                     --  If the operation is derived, get the original for
-                     --  cross-reference purposes (it is the original for
-                     --  which we want the xref, and for which the comes
-                     --  from source test needs to be performed).
-
-                     Ent := Node (Prim);
-                     while Present (Alias (Ent)) loop
-                        Ent := Alias (Ent);
-                     end loop;
-
-                     Generate_Reference (E, Ent, 'p', Set_Ref => False);
-                     Next_Elmt (Prim);
-                  end loop;
-               end if;
-            end;
-         end if;
+         Generate_Prim_Op_References (E);
 
          --  Now that all types from which E may depend are frozen, see if the
          --  size is known at compile time, if it must be unsigned, or if
@@ -5232,6 +5204,74 @@ package body Freeze is
    end Is_Fully_Defined;
 
    ---------------------------------
+   -- Generate_Prim_Op_References --
+   ---------------------------------
+
+   procedure Generate_Prim_Op_References
+     (Typ      : Entity_Id)
+   is
+      Base_T    : Entity_Id;
+      Prim      : Elmt_Id;
+      Prim_List : Elist_Id;
+      Ent       : Entity_Id;
+
+   begin
+      --  Handle subtypes of synchronized types.
+
+      if Ekind (Typ) = E_Protected_Subtype
+        or else Ekind (Typ) = E_Task_Subtype
+      then
+         Base_T := Etype (Typ);
+      else
+         Base_T := Typ;
+      end if;
+
+      --  References to primitive operations are only relevant for tagged types
+
+      if not Is_Tagged_Type (Base_T)
+           or else Is_Class_Wide_Type (Base_T)
+      then
+         return;
+      end if;
+
+      --  Ada 2005 (AI-345): For synchronized types generate reference
+      --  to the wrapper that allow us to dispatch calls through their
+      --  implemented abstract interface types.
+
+      --  The check for Present here is to protect against previously
+      --  reported critical errors.
+
+      if Is_Concurrent_Type (Base_T)
+        and then Present (Corresponding_Record_Type (Base_T))
+      then
+         Prim_List := Primitive_Operations
+                       (Corresponding_Record_Type (Base_T));
+      else
+         Prim_List := Primitive_Operations (Base_T);
+      end if;
+
+      if No (Prim_List) then
+         return;
+      end if;
+
+      Prim := First_Elmt (Prim_List);
+      while Present (Prim) loop
+
+         --  If the operation is derived, get the original for cross-reference
+         --  reference purposes (it is the original for which we want the xref
+         --  and for which the comes_from_source test must be performed).
+
+         Ent := Node (Prim);
+         while Present (Alias (Ent)) loop
+            Ent := Alias (Ent);
+         end loop;
+
+         Generate_Reference (Typ, Ent, 'p', Set_Ref => False);
+         Next_Elmt (Prim);
+      end loop;
+   end Generate_Prim_Op_References;
+
+   ---------------------------------
    -- Process_Default_Expressions --
    ---------------------------------