sem_util.ads (Find_Specific_Type): Moved here from exp_disp.adb.

2014-07-31  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.ads (Find_Specific_Type): Moved here from exp_disp.adb.
	* sem_util.adb (Find_Specific_Type): If type is untagged private,
	retrieve full view so that primitive operations can be located.
	* exp_disp.adb Move Find_Specific_Type to sem_util.
	* exp_ch4.adb (Expand_N_Op_Eq): If operands are class-wide, use
	Find_Specific_Type to locate primitive equality.
	* exp_util.adb (Make_CW_Equivalent_Type): A class_wide equivalent
	type does not require initialization.
	* exp_attr.adb (Compile_Stream_Body_In_Scope): Within an instance
	body all visibility is established, and the enclosing package
	declarations must not be installed.

From-SVN: r213345

7 files changed, 65 insertions, 33 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1519eaa..f806a8b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+2014-07-31  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_util.ads (Find_Specific_Type): Moved here from exp_disp.adb.
+	* sem_util.adb (Find_Specific_Type): If type is untagged private,
+	retrieve full view so that primitive operations can be located.
+	* exp_disp.adb Move Find_Specific_Type to sem_util.
+	* exp_ch4.adb (Expand_N_Op_Eq): If operands are class-wide, use
+	Find_Specific_Type to locate primitive equality.
+	* exp_util.adb (Make_CW_Equivalent_Type): A class_wide equivalent
+	type does not require initialization.
+	* exp_attr.adb (Compile_Stream_Body_In_Scope): Within an instance
+	body all visibility is established, and the enclosing package
+	declarations must not be installed.
+
 2014-07-31  Yannick Moy  <moy@adacore.com>
 
 	* sem_parg.adb, sem_prag.ads (Collect_Subprogram_Inputs_Outputs):
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 9bdf92f..97ed887 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -106,6 +106,8 @@ package body Exp_Attr is
    --  We suppress checks for array/record reads, since the rule is that these
    --  are like assignments, out of range values due to uninitialized storage,
    --  or other invalid values do NOT cause a Constraint_Error to be raised.
+   --  If we are within an instance body all visibility has been established
+   --  already and there is no need to install the package.
 
    procedure Expand_Access_To_Protected_Op
      (N    : Node_Id;
@@ -630,6 +632,11 @@ package body Exp_Attr is
       if Is_Hidden (Arr)
         and then not In_Open_Scopes (Scop)
         and then Ekind (Scop) = E_Package
+
+        --  If we are within an instance body, then all visibility has been
+        --  established already and there is no need to install the package.
+
+        and then not In_Instance_Body
       then
          Push_Scope (Scop);
          Install_Visible_Declarations (Scop);
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 1fb35c1..92bde0d 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -7300,15 +7300,15 @@ package body Exp_Ch4 is
                Op_Name := Node (Prim);
 
             --  Find the type's predefined equality or an overriding
-            --  user- defined equality. The reason for not simply calling
+            --  user-defined equality. The reason for not simply calling
             --  Find_Prim_Op here is that there may be a user-defined
-            --  overloaded equality op that precedes the equality that we want,
-            --  so we have to explicitly search (e.g., there could be an
-            --  equality with two different parameter types).
+            --  overloaded equality op that precedes the equality that we
+            --  want, so we have to explicitly search (e.g., there could be
+            --  an equality with two different parameter types).
 
             else
                if Is_Class_Wide_Type (Typl) then
-                  Typl := Root_Type (Typl);
+                  Typl := Find_Specific_Type (Typl);
                end if;
 
                Prim := First_Elmt (Primitive_Operations (Typl));
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 69feaa7..99105e0 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -75,12 +75,6 @@ package body Exp_Disp is
    --  Ada 2005 (AI-251): Returns the fixed position in the dispatch table
    --  of the default primitive operations.
 
-   function Find_Specific_Type (CW : Entity_Id) return Entity_Id;
-   --  Find specific type of a class-wide type, and handle the case of an
-   --  incomplete type coming either from a limited_with clause or from an
-   --  incomplete type declaration. Shouldn't this be in Sem_Util? It seems
-   --  like a general purpose semantic routine ???
-
    function Has_DT (Typ : Entity_Id) return Boolean;
    pragma Inline (Has_DT);
    --  Returns true if we generate a dispatch table for tagged type Typ
@@ -1987,25 +1981,6 @@ package body Exp_Disp is
       end if;
    end Expand_Interface_Thunk;
 
-   ------------------------
-   -- Find_Specific_Type --
-   ------------------------
-
-   function Find_Specific_Type (CW : Entity_Id) return Entity_Id is
-      Typ : Entity_Id := Root_Type (CW);
-
-   begin
-      if Ekind (Typ) = E_Incomplete_Type then
-         if From_Limited_With (Typ) then
-            Typ := Non_Limited_View (Typ);
-         else
-            Typ := Full_View (Typ);
-         end if;
-      end if;
-
-      return Typ;
-   end Find_Specific_Type;
-
    --------------------------
    -- Has_CPP_Constructors --
    --------------------------
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index c50a6cd..a61efab 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -5860,10 +5860,14 @@ package body Exp_Util is
 
       Set_Is_Class_Wide_Equivalent_Type (Equiv_Type);
 
+      --  A class_wide equivalent type does not require initialization
+
+      Set_Suppress_Initialization (Equiv_Type);
+
       if not Is_Interface (Root_Typ) then
          Append_To (Comp_List,
            Make_Component_Declaration (Loc,
-             Defining_Identifier =>
+             Defining_Identifier  =>
                Make_Defining_Identifier (Loc, Name_uParent),
              Component_Definition =>
                Make_Component_Definition (Loc,
@@ -5882,9 +5886,9 @@ package body Exp_Util is
       Append_To (List_Def,
         Make_Full_Type_Declaration (Loc,
           Defining_Identifier => Equiv_Type,
-          Type_Definition =>
+          Type_Definition     =>
             Make_Record_Definition (Loc,
-              Component_List =>
+              Component_List  =>
                 Make_Component_List (Loc,
                   Component_Items => Comp_List,
                   Variant_Part    => Empty))));
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 8f24046..fb5068a 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5932,6 +5932,32 @@ package body Sem_Util is
       end loop;
    end Find_Placement_In_State_Space;
 
+   ------------------------
+   -- Find_Specific_Type --
+   ------------------------
+
+   function Find_Specific_Type (CW : Entity_Id) return Entity_Id is
+      Typ : Entity_Id := Root_Type (CW);
+
+   begin
+      if Ekind (Typ) = E_Incomplete_Type then
+         if From_Limited_With (Typ) then
+            Typ := Non_Limited_View (Typ);
+         else
+            Typ := Full_View (Typ);
+         end if;
+      end if;
+
+      if Is_Private_Type (Typ)
+        and then not Is_Tagged_Type (Typ)
+        and then Present (Full_View (Typ))
+      then
+         return Full_View (Typ);
+      else
+         return Typ;
+      end if;
+   end Find_Specific_Type;
+
    -----------------------------
    -- Find_Static_Alternative --
    -----------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index cac0fec..c9dc734 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -568,6 +568,12 @@ package Sem_Util is
    --  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_Specific_Type (CW : Entity_Id) return Entity_Id;
+   --  Find specific type of a class-wide type, and handle the case of an
+   --  incomplete type coming either from a limited_with clause or from an
+   --  incomplete type declaration. If resulting type is private return its
+   --  full view.
+
    function Find_Body_Discriminal
      (Spec_Discriminant : Entity_Id) return Entity_Id;
    --  Given a discriminant of the record type that implements a task or