From b60be63da23e0db9435e8620fab9edd531e4ed6b Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Fri, 27 Dec 2019 15:01:33 -0500 Subject: [PATCH] [Ada] Compiler crash processing controlled type primitive 2020-06-02 Javier Miranda 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. --- gcc/ada/sem_util.adb | 53 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 064e613b4fc..6b54b5e77ec 100644 --- 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); -- 2.30.2