sem_ch6.adb (Create_Extra_Formals): The type of the BIP_Object_Access formal…

sem_ch6.adb (Create_Extra_Formals): The type of the BIP_Object_Access formal must not have a designated type that...

2017-11-16  Bob Duff  <duff@adacore.com>

	* sem_ch6.adb (Create_Extra_Formals): The type of the BIP_Object_Access
	formal must not have a designated type that is the full view coming
	from a limited-with'ed package.
	* sem_util.adb,sem_util.ads (Incomplete_View_From_Limited_With): New
	function called from sem_ch6.
	* sem_ch5.adb (Analyze_Assignment): Treat user-defined concatenation
	specially for b-i-p cases.

From-SVN: r254801

gcc/ada/ChangeLog

+2017-11-16  Bob Duff  <duff@adacore.com>
+
+	* sem_ch6.adb (Create_Extra_Formals): The type of the BIP_Object_Access
+	formal must not have a designated type that is the full view coming
+	from a limited-with'ed package.
+	* sem_util.adb,sem_util.ads (Incomplete_View_From_Limited_With): New
+	function called from sem_ch6.
+	* sem_ch5.adb (Analyze_Assignment): Treat user-defined concatenation
+	specially for b-i-p cases.
+
 2017-11-10  Martin Sebor  <msebor@redhat.com>
 
 	PR c/81117

gcc/ada/sem_ch5.adb

@@ -552,6 +552,45 @@ package body Sem_Ch5 is
       --  in-place.
 
       if Should_Transform_BIP_Assignment (Typ => T1) then
+         --  In certain cases involving user-defined concatenation operators,
+         --  we need to resolve the right-hand side before transforming the
+         --  assignment.
+
+         case Nkind (Unqual_Conv (Rhs)) is
+            when N_Function_Call =>
+               declare
+                  Actual     : Node_Id :=
+                    First (Parameter_Associations (Unqual_Conv (Rhs)));
+                  Actual_Exp : Node_Id;
+
+               begin
+                  while Present (Actual) loop
+                     if Nkind (Actual) = N_Parameter_Association then
+                        Actual_Exp := Explicit_Actual_Parameter (Actual);
+                     else
+                        Actual_Exp := Actual;
+                     end if;
+
+                     if Nkind (Actual_Exp) = N_Op_Concat then
+                        Resolve (Rhs, T1);
+                        exit;
+                     end if;
+
+                     Next (Actual);
+                  end loop;
+               end;
+
+            when N_Op
+               | N_Expanded_Name
+               | N_Identifier
+               | N_Attribute_Reference
+            =>
+               null;
+
+            when others =>
+               raise Program_Error;
+         end case;
+
          Transform_BIP_Assignment (Typ => T1);
       end if;
 

gcc/ada/sem_ch6.adb

@@ -7840,7 +7840,7 @@ package body Sem_Ch6 is
 
          if No (First_Extra) then
             First_Extra := EF;
-            Set_Extra_Formals (Scope, First_Extra);
+            Set_Extra_Formals (Scope, EF);
          end if;
 
          if Present (Last_Extra) then
@@ -7890,7 +7890,7 @@ package body Sem_Ch6 is
 
       --  If Extra_Formals were already created, don't do it again. This
       --  situation may arise for subprogram types created as part of
-      --  dispatching calls (see Expand_Dispatching_Call)
+      --  dispatching calls (see Expand_Dispatching_Call).
 
       if Present (Last_Extra) and then Present (Extra_Formal (Last_Extra)) then
          return;
@@ -8028,9 +8028,7 @@ package body Sem_Ch6 is
             Full_Subt   : constant Entity_Id := Available_View (Result_Subt);
             Formal_Typ  : Entity_Id;
             Subp_Decl   : Node_Id;
-
-            Discard : Entity_Id;
-            pragma Warnings (Off, Discard);
+            Discard     : Entity_Id;
 
          begin
             --  In the case of functions with unconstrained result subtypes,
@@ -8094,7 +8092,14 @@ package body Sem_Ch6 is
             Formal_Typ :=
               Create_Itype (E_Anonymous_Access_Type, E, Scope_Id => Scope (E));
 
-            Set_Directly_Designated_Type (Formal_Typ, Result_Subt);
+            --  Incomplete_View_From_Limited_With is needed here because
+            --  gigi gets confused if the designated type is the full view
+            --  coming from a limited-with'ed package. In the normal case,
+            --  (no limited with) Incomplete_View_From_Limited_With
+            --  returns Result_Subt.
+
+            Set_Directly_Designated_Type
+              (Formal_Typ, Incomplete_View_From_Limited_With (Result_Subt));
             Set_Etype (Formal_Typ, Formal_Typ);
             Set_Depends_On_Private
               (Formal_Typ, Has_Private_Component (Formal_Typ));

gcc/ada/sem_util.adb

@@ -12213,6 +12213,40 @@ package body Sem_Util is
       return Empty;
    end Incomplete_Or_Partial_View;
 
+   ---------------------------------------
+   -- Incomplete_View_From_Limited_With --
+   ---------------------------------------
+
+   function Incomplete_View_From_Limited_With
+     (Typ : Entity_Id) return Entity_Id is
+   begin
+      --  It might make sense to make this an attribute in Einfo, and set it
+      --  in Sem_Ch10 in Build_Shadow_Entity. However, we're running short on
+      --  slots for new attributes, and it seems a bit simpler to just search
+      --  the Limited_View (if it exists) for an incomplete type whose
+      --  Non_Limited_View is Typ.
+
+      if Ekind (Scope (Typ)) = E_Package
+        and then Present (Limited_View (Scope (Typ)))
+      then
+         declare
+            Ent : Entity_Id := First_Entity (Limited_View (Scope (Typ)));
+         begin
+            while Present (Ent) loop
+               if Ekind (Ent) in Incomplete_Kind
+                 and then Non_Limited_View (Ent) = Typ
+               then
+                  return Ent;
+               end if;
+
+               Ent := Next_Entity (Ent);
+            end loop;
+         end;
+      end if;
+
+      return Typ;
+   end Incomplete_View_From_Limited_With;
+
    ----------------------------------
    -- Indexed_Component_Bit_Offset --
    ----------------------------------

gcc/ada/sem_util.ads

@@ -1425,6 +1425,12 @@ package Sem_Util is
    --  partial view of the same entity. Note that Id may not have a partial
    --  view in which case the function returns Empty.
 
+   function Incomplete_View_From_Limited_With
+     (Typ : Entity_Id) return Entity_Id;
+   --  Typ is a type entity. This normally returns Typ. However, if there is
+   --  an incomplete view of this entity that comes from a limited-with'ed
+   --  package, then this returns that incomplete view.
+
    function Indexed_Component_Bit_Offset (N : Node_Id) return Uint;
    --  Given an N_Indexed_Component node, return the first bit position of the
    --  component if it is known at compile time. A value of No_Uint means that