diff options
| author | Justin Squirek <squirek@adacore.com> | 2021-10-12 14:04:16 -0400 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2021-10-20 10:17:05 +0000 |
| commit | 9267014b351edf5aa0d0951545ec405edec5e3f5 (patch) | |
| tree | 035d0893a1ca9b62217cb1bf626fee0722f681ba /gcc | |
| parent | 0f074aa4aa248e9602765155acff57604c1d9778 (diff) | |
| download | gcc-9267014b351edf5aa0d0951545ec405edec5e3f5.zip gcc-9267014b351edf5aa0d0951545ec405edec5e3f5.tar.gz gcc-9267014b351edf5aa0d0951545ec405edec5e3f5.tar.bz2 | |
[Ada] Crash on object of protected type with defaulted access component
gcc/ada/
* exp_ch7.adb (Make_Final_Call): Detect expanded protected types
and use original protected type in order to calculate
appropriate finalization routine.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/exp_ch7.adb | 28 |
1 files changed, 21 insertions, 7 deletions
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 59c9c44..cd9ff21 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -8953,11 +8953,12 @@ package body Exp_Ch7 is Typ : Entity_Id; Skip_Self : Boolean := False) return Node_Id is - Loc : constant Source_Ptr := Sloc (Obj_Ref); - Atyp : Entity_Id; - Fin_Id : Entity_Id := Empty; - Ref : Node_Id; - Utyp : Entity_Id; + Loc : constant Source_Ptr := Sloc (Obj_Ref); + Atyp : Entity_Id; + Prot_Typ : Entity_Id := Empty; + Fin_Id : Entity_Id := Empty; + Ref : Node_Id; + Utyp : Entity_Id; begin Ref := Obj_Ref; @@ -9035,6 +9036,19 @@ package body Exp_Ch7 is Set_Assignment_OK (Ref); end if; + -- Detect if Typ is a protected type or an expanded protected type and + -- store the relevant type within Prot_Typ for later processing. + + if Is_Protected_Type (Typ) then + Prot_Typ := Typ; + + elsif Ekind (Typ) = E_Record_Type + and then Present (Corresponding_Concurrent_Type (Typ)) + and then Is_Protected_Type (Corresponding_Concurrent_Type (Typ)) + then + Prot_Typ := Corresponding_Concurrent_Type (Typ); + end if; + -- 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 [Deep_]Finalize -- primitive to call. @@ -9080,7 +9094,7 @@ package body Exp_Ch7 is -- Protected types: these also require finalization even though they -- are not marked controlled explicitly. - elsif Is_Protected_Type (Typ) then + elsif Present (Prot_Typ) then -- Protected objects do not need to be finalized on restricted -- runtimes. @@ -9090,7 +9104,7 @@ package body Exp_Ch7 is -- ??? Only handle the simple case for now. Will not support a record -- or array containing protected objects. - elsif Is_Simple_Protected_Type (Typ) then + elsif Is_Simple_Protected_Type (Prot_Typ) then Fin_Id := RTE (RE_Finalize_Protection); else raise Program_Error; |