]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Fix bogus error on allocator in instantiation with private derived types
authorEric Botcazou <ebotcazou@adacore.com>
Mon, 17 Jun 2024 19:22:06 +0000 (21:22 +0200)
committerMarc Poulhiès <dkm@gcc.gnu.org>
Tue, 2 Jul 2024 13:20:34 +0000 (15:20 +0200)
The problem is that the call to Convert_View made from Make_Init_Call does
nothing because the Etype is not set on the second argument.

gcc/ada/

* exp_ch7.adb (Convert_View): Add third parameter Typ and use it if
the second parameter does not have an Etype.
(Make_Adjust_Call): Remove obsolete setting of Etype and pass Typ in
call to Convert_View.
(Make_Final_Call): Likewise.
(Make_Init_Call): Pass Typ in call to Convert_View.

gcc/ada/exp_ch7.adb

index 149715f94da9e610830e0145c340f8a7f5232f8e..f4a707034c14130a6730d0cc747e7b824c2b1b93 100644 (file)
@@ -563,12 +563,16 @@ package body Exp_Ch7 is
    --  Check recursively whether a loop or block contains a subprogram that
    --  may need an activation record.
 
-   function Convert_View (Proc : Entity_Id; Arg  : Node_Id) return Node_Id;
-   --  Proc is one of the Initialize/Adjust/Finalize operations, and Arg is the
-   --  argument being passed to it. This function will, if necessary, generate
-   --  a conversion between the partial and full view of Arg to match the type
-   --  of the formal of Proc, or force a conversion to the class-wide type in
-   --  the case where the operation is abstract.
+   function Convert_View
+     (Proc : Entity_Id;
+      Arg  : Node_Id;
+      Typ  : Entity_Id) return Node_Id;
+   --  Proc is one of the Initialize/Adjust/Finalize operations, Arg is the one
+   --  argument being passed to it, and Typ is its expected type. This function
+   --  will, if necessary, generate a conversion between the partial and full
+   --  views of Arg to match the type of the formal of Proc, or else force a
+   --  conversion to the class-wide type in the case where the operation is
+   --  abstract.
 
    function Make_Call
      (Loc       : Source_Ptr;
@@ -4023,7 +4027,11 @@ package body Exp_Ch7 is
    -- Convert_View --
    ------------------
 
-   function Convert_View (Proc : Entity_Id; Arg  : Node_Id) return Node_Id is
+   function Convert_View
+     (Proc : Entity_Id;
+      Arg  : Node_Id;
+      Typ  : Entity_Id) return Node_Id
+   is
       Ftyp : constant Entity_Id := Etype (First_Formal (Proc));
 
       Atyp : Entity_Id;
@@ -4031,8 +4039,10 @@ package body Exp_Ch7 is
    begin
       if Nkind (Arg) in N_Type_Conversion | N_Unchecked_Type_Conversion then
          Atyp := Entity (Subtype_Mark (Arg));
-      else
+      elsif Present (Etype (Arg)) then
          Atyp := Etype (Arg);
+      else
+         Atyp := Typ;
       end if;
 
       if Is_Abstract_Subprogram (Proc) and then Is_Tagged_Type (Ftyp) then
@@ -5452,21 +5462,11 @@ package body Exp_Ch7 is
       end if;
 
       if Present (Adj_Id) then
-
-         --  If the object is unanalyzed, set its expected type for use in
-         --  Convert_View in case an additional conversion is needed.
-
-         if No (Etype (Ref))
-           and then Nkind (Ref) /= N_Unchecked_Type_Conversion
-         then
-            Set_Etype (Ref, Typ);
-         end if;
-
          --  The object reference may need another conversion depending on the
          --  type of the formal and that of the actual.
 
          if not Is_Class_Wide_Type (Typ) then
-            Ref := Convert_View (Adj_Id, Ref);
+            Ref := Convert_View (Adj_Id, Ref, Typ);
          end if;
 
          return
@@ -7849,16 +7849,7 @@ package body Exp_Ch7 is
                end if;
             end;
 
-            --  If the object is unanalyzed, set its expected type for use in
-            --  Convert_View in case an additional conversion is needed.
-
-            if No (Etype (Ref))
-              and then Nkind (Ref) /= N_Unchecked_Type_Conversion
-            then
-               Set_Etype (Ref, Typ);
-            end if;
-
-            Ref := Convert_View (Fin_Id, Ref);
+            Ref := Convert_View (Fin_Id, Ref, Typ);
          end if;
 
          return
@@ -8314,7 +8305,7 @@ package body Exp_Ch7 is
       --  The object reference may need another conversion depending on the
       --  type of the formal and that of the actual.
 
-      Ref := Convert_View (Proc, Ref);
+      Ref := Convert_View (Proc, Ref, Typ);
 
       --  Generate:
       --    [Deep_]Initialize (Ref);