summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@adacore.com>2020-11-30 05:22:56 -0500
committerPierre-Marie de Rodat <derodat@adacore.com>2020-12-17 05:49:20 -0500
commit148039493e600cab023cb778b4fa9a0b7eaeed0a (patch)
treeb94f251dfc96af30530b96f8b01eaaad22a40ae5
parent9ed2b86d1b367382be14dfbb7a083e10b1373f8f (diff)
downloadgcc-148039493e600cab023cb778b4fa9a0b7eaeed0a.tar.gz
[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.
-rw-r--r--gcc/ada/exp_ch7.adb25
-rw-r--r--gcc/ada/sem_util.ads2
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;