[Ada] Crash on deallocating component with discriminated task

This patch modifies the generation of task deallocation code to examine
the underlying type for task components.

2019-07-05  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* exp_ch7.adb (Cleanup_Record): Use the underlying type when
	checking for components with tasks.

gcc/testsuite/

	* gnat.dg/task3.adb, gnat.dg/task3.ads, gnat.dg/task3_pkg1.ads,
	gnat.dg/task3_pkg2.ads: New testcase.

From-SVN: r273121

gcc/ada/ChangeLog

+2019-07-05  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch7.adb (Cleanup_Record): Use the underlying type when
+	checking for components with tasks.
+
 2019-07-05  Arnaud Charlet  <charlet@adacore.com>
 
 	* libgnarl/s-osinte__linux.ads: Link with -lrt before -lpthread.

gcc/ada/exp_ch7.adb

@@ -3893,11 +3893,12 @@ package body Exp_Ch7 is
       Typ  : Entity_Id) return List_Id
    is
       Loc   : constant Source_Ptr := Sloc (N);
-      Tsk   : Node_Id;
-      Comp  : Entity_Id;
       Stmts : constant List_Id    := New_List;
       U_Typ : constant Entity_Id  := Underlying_Type (Typ);
 
+      Comp : Entity_Id;
+      Tsk  : Node_Id;
+
    begin
       if Has_Discriminants (U_Typ)
         and then Nkind (Parent (U_Typ)) = N_Full_Type_Declaration
@@ -3918,7 +3919,7 @@ package body Exp_Ch7 is
          return New_List (Make_Null_Statement (Loc));
       end if;
 
-      Comp := First_Component (Typ);
+      Comp := First_Component (U_Typ);
       while Present (Comp) loop
          if Has_Task (Etype (Comp))
            or else Has_Simple_Protected_Object (Etype (Comp))
@@ -3937,8 +3938,8 @@ package body Exp_Ch7 is
 
             elsif Is_Record_Type (Etype (Comp)) then
 
-               --  Recurse, by generating the prefix of the argument to
-               --  the eventual cleanup call.
+               --  Recurse, by generating the prefix of the argument to the
+               --  eventual cleanup call.
 
                Append_List_To (Stmts, Cleanup_Record (N, Tsk, Etype (Comp)));
 

gcc/testsuite/ChangeLog

+2019-07-05  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* gnat.dg/task3.adb, gnat.dg/task3.ads, gnat.dg/task3_pkg1.ads,
+	gnat.dg/task3_pkg2.ads: New testcase.
+
 2019-07-05  Javier Miranda  <miranda@adacore.com>
 
 	* gnat.dg/access6.adb: New testcase.

gcc/testsuite/gnat.dg/task3.adb

+--  { dg-do compile }
+
+with Ada.Unchecked_Deallocation;
+
+package body Task3 is
+   procedure Destroy (Obj : in out Child_Wrapper) is
+      procedure Free is new Ada.Unchecked_Deallocation (Child, Child_Ptr);
+   begin
+      Free (Obj.Ptr);
+   end Destroy;
+end Task3;

gcc/testsuite/gnat.dg/task3.ads

+with Task3_Pkg2; use Task3_Pkg2;
+
+package Task3 is
+   type Child is new Root with null record;
+   type Child_Ptr is access Child;
+
+   type Child_Wrapper is record
+      Ptr : Child_Ptr := null;
+   end record;
+
+   procedure Destroy (Obj : in out Child_Wrapper);
+end Task3;

gcc/testsuite/gnat.dg/task3_pkg1.ads

+package Task3_Pkg1 is
+   type Task_Wrapper (Discr : Integer) is tagged limited private;
+
+private
+   task type Task_Typ (Discr : Integer) is
+   end Task_Typ;
+
+   type Task_Wrapper (Discr : Integer) is tagged limited record
+      Tsk : Task_Typ (Discr);
+   end record;
+end Task3_Pkg1;

gcc/testsuite/gnat.dg/task3_pkg2.ads

+with Task3_Pkg1; use Task3_Pkg1;
+
+package Task3_Pkg2 is
+   type Root (Discr : Integer) is tagged limited record
+      Wrap : Task_Wrapper (Discr);
+   end record;
+end Task3_Pkg2;