[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 43920993ff997cf2943aca2db1a928a1918f2943..615cc4137c05f276c4ce1cd626f6c8d0bfcd9c24 100644 (file)
--- 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 d812b295fcaa1880c2146f8df7b89124aef0ee16..60ed0e8f941476a5b66525ef229da33eb9ca24f9 100644 (file)
--- 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;