ada: Fix wrong finalization with private unconstrained array type

The address passed to the routine attaching a controlled object to the
finalization master must be that of its dope vector for an object whose
nominal subtype is an unconstrained array type, but this is not the case
when this subtype has a private declaration.

gcc/ada/ChangeLog:

	* exp_ch7.adb (Make_Address_For_Finalize): Look at the underlying
	subtype to detect the unconstrained array type case.
	* sprint.adb (Write_Itype) <E_Private_Subtype>: New case.

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index d3cc6c70d974a485c19e35d6e2e422601ada7eca..be281e3519df76ceeb2cb7bf7bba37c7dd5ebba8 100644 (file)
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -5514,6 +5514,8 @@ package body Exp_Ch7 is
       Obj_Ref : Node_Id;
       Obj_Typ : Entity_Id) return Node_Id
    is
+      Utyp : constant Entity_Id := Underlying_Type (Obj_Typ);
+
       Obj_Addr : Node_Id;
 
    begin
@@ -5529,13 +5531,13 @@ package body Exp_Ch7 is
       --  but the address of the object is still that of its elements,
       --  so we need to shift it.
 
-      if Is_Array_Type (Obj_Typ)
-        and then not Is_Constrained (First_Subtype (Obj_Typ))
+      if Is_Array_Type (Utyp)
+        and then not Is_Constrained (First_Subtype (Utyp))
       then
          --  Shift the address from the start of the elements to the
          --  start of the dope vector:
 
-         --    V - (Obj_Typ'Descriptor_Size / Storage_Unit)
+         --    V - (Utyp'Descriptor_Size / Storage_Unit)
 
          Obj_Addr :=
            Make_Function_Call (Loc,
@@ -5552,7 +5554,7 @@ package body Exp_Ch7 is
                Make_Op_Divide (Loc,
                  Left_Opnd  =>
                    Make_Attribute_Reference (Loc,
-                     Prefix         => New_Occurrence_Of (Obj_Typ, Loc),
+                     Prefix         => New_Occurrence_Of (Utyp, Loc),
                      Attribute_Name => Name_Descriptor_Size),
                  Right_Opnd =>
                    Make_Integer_Literal (Loc, System_Storage_Unit))));

diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index 614bcc17b14e383177cc89c47577279ba77ed52b..67259b9831cfc8ec611591adc989766f7e4dfd27 100644 (file)
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -4712,6 +4712,10 @@ package body Sprint is
                         Write_Str (");");
                      end;
 
+                  when E_Private_Subtype =>
+                     Write_Header (False);
+                     Write_Name_With_Col_Check (Chars (Full_View (Typ)));
+
                   --  For all other Itypes, print a triple ? (fill in later
                   --  if needed).