diff options
author | Arnaud Charlet <charlet@adacore.com> | 2020-11-30 05:22:56 -0500 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-12-17 05:49:20 -0500 |
commit | 148039493e600cab023cb778b4fa9a0b7eaeed0a (patch) | |
tree | b94f251dfc96af30530b96f8b01eaaad22a40ae5 | |
parent | 9ed2b86d1b367382be14dfbb7a083e10b1373f8f (diff) | |
download | gcc-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.adb | 25 | ||||
-rw-r--r-- | 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; |