From 148039493e600cab023cb778b4fa9a0b7eaeed0a Mon Sep 17 00:00:00 2001
From: Arnaud Charlet <charlet@adacore.com>
Date: Mon, 30 Nov 2020 05:22:56 -0500
Subject: [PATCH] [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.
---
 gcc/ada/exp_ch7.adb  | 25 +++++++++++++++++++++++--
 gcc/ada/sem_util.ads |  2 +-
 2 files changed, 24 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 43920993ff9..615cc4137c0 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 d812b295fca..60ed0e8f941 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;
-- 
2.30.2