[Ada] Compiler crash processing controlled type primitive

2020-06-02  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* sem_util.adb (Ensure_Minimum_Decoration): New subprogram that
	ensures the minimum decoration required by
	Requires_Transient_Scope() to provide its functionality when the
	entity is not frozen.

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 064e613b4fc1e81c71481658a246bc96569fb9cb..6b54b5e77ec6d83581609481282a3d04f787adb7 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -24370,11 +24370,64 @@ package body Sem_Util is
    function Requires_Transient_Scope (Id : Entity_Id) return Boolean is
       Old_Result : constant Boolean := Old_Requires_Transient_Scope (Id);
 
+      procedure Ensure_Minimum_Decoration (Typ : Entity_Id);
+      --  If Typ is not frozen then add to Typ the minimum decoration required
+      --  by Requires_Transient_Scope to reliably provide its functionality;
+      --  otherwise no action is performed.
+
+      -------------------------------
+      -- Ensure_Minimum_Decoration --
+      -------------------------------
+
+      procedure Ensure_Minimum_Decoration (Typ : Entity_Id) is
+      begin
+         --  Do not set Has_Controlled_Component on a class-wide equivalent
+         --  type. See Make_CW_Equivalent_Type.
+
+         if Present (Typ)
+           and then not Is_Frozen (Typ)
+           and then (Is_Record_Type (Typ)
+                       or else Is_Concurrent_Type (Typ)
+                       or else Is_Incomplete_Or_Private_Type (Typ))
+           and then not Is_Class_Wide_Equivalent_Type (Typ)
+         then
+            declare
+               Comp : Entity_Id;
+
+            begin
+               Comp := First_Component (Typ);
+               while Present (Comp) loop
+                  if Has_Controlled_Component (Etype (Comp))
+                    or else
+                      (Chars (Comp) /= Name_uParent
+                         and then Is_Controlled (Etype (Comp)))
+                    or else
+                      (Is_Protected_Type (Etype (Comp))
+                         and then
+                           Present (Corresponding_Record_Type (Etype (Comp)))
+                         and then
+                           Has_Controlled_Component
+                             (Corresponding_Record_Type (Etype (Comp))))
+                  then
+                     Set_Has_Controlled_Component (Typ);
+                     exit;
+                  end if;
+
+                  Next_Component (Comp);
+               end loop;
+            end;
+         end if;
+      end Ensure_Minimum_Decoration;
+
+   --  Start of processing for Requires_Transient_Scope
+
    begin
       if Debug_Flag_QQ then
          return Old_Result;
       end if;
 
+      Ensure_Minimum_Decoration (Id);
+
       declare
          New_Result : constant Boolean := New_Requires_Transient_Scope (Id);