From: Arnaud Charlet <charlet@adacore.com>
Date: Mon, 30 Nov 2020 10:22:56 +0000 (-0500)
Subject: [Ada] Compiler crash on protected component of controlled type
X-Git-Tag: upstream/12.2.0~10754
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=148039493e600cab023cb778b4fa9a0b7eaeed0a;p=platform%2Fupstream%2Fgcc.git

[Ada] Compiler crash on protected component of controlled type

gcc/ada/

	* exp_ch7.adb (Make_Final_Call, Make_Init_Call): Take protected
	types into account.
	* sem_util.ads: Fix typo.
---

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 4392099..615cc41 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -9037,6 +9037,24 @@ package body Exp_Ch7 is
       elsif Is_Tagged_Type (Utyp) then
          Fin_Id := Find_Optional_Prim_Op (Utyp, TSS_Deep_Finalize);
 
+      --  Protected types: these also require finalization even though they
+      --  are not marked controlled explicitly.
+
+      elsif Is_Protected_Type (Typ) then
+         --  Protected objects do not need to be finalized on restricted
+         --  runtimes.
+
+         if Restricted_Profile then
+            return Empty;
+
+         --  ??? Only handle the simple case for now. Will not support a record
+         --  or array containing protected objects.
+
+         elsif Is_Simple_Protected_Type (Typ) then
+            Fin_Id := RTE (RE_Finalize_Protection);
+         else
+            raise Program_Error;
+         end if;
       else
          raise Program_Error;
       end if;
@@ -9477,8 +9495,11 @@ package body Exp_Ch7 is
       --  The underlying type may not be present due to a missing full view.
       --  In this case freezing did not take place and there is no suitable
       --  [Deep_]Initialize primitive to call.
+      --  If Typ is protected then no additional processing is needed either.
 
-      if No (Utyp) then
+      if No (Utyp)
+        or else Is_Protected_Type (Typ)
+      then
          return Empty;
       end if;
 
@@ -9500,7 +9521,7 @@ package body Exp_Ch7 is
             and then Present (Alias (Proc))
             and then Is_Trivial_Subprogram (Alias (Proc)))
       then
-         return Make_Null_Statement (Loc);
+         return Empty;
       end if;
 
       --  The object reference may need another conversion depending on the
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index d812b29..60ed0e8 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2495,7 +2495,7 @@ package Sem_Util is
    --  entity E. If no such instance exits, return Empty.
 
    function Needs_Finalization (Typ : Entity_Id) return Boolean;
-   --  Determine whether type Typ is controlled and this requires finalization
+   --  Determine whether type Typ is controlled and thus requires finalization
    --  actions.
 
    function Needs_One_Actual (E : Entity_Id) return Boolean;