diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2025-07-01 19:17:06 +0200 |
---|---|---|
committer | Eric Botcazou <ebotcazou@adacore.com> | 2025-07-01 19:18:46 +0200 |
commit | 8deef83915f9e0fb14f278c68527c95085461c41 (patch) | |
tree | f2382114a7bcf1b726d0fc6d4e46e978422bb49d /gcc | |
parent | f471ed487ab36651d48c6c31fb28d36a42a30829 (diff) | |
download | gcc-8deef83915f9e0fb14f278c68527c95085461c41.zip gcc-8deef83915f9e0fb14f278c68527c95085461c41.tar.gz gcc-8deef83915f9e0fb14f278c68527c95085461c41.tar.bz2 |
Ada: Fix assertion failure for Finalizable aspect on tagged type
This fixes an assertion failure for the Finalizable aspect applied on a
tagged type with discriminant-dependent component.
gcc/ada/
PR ada/120705
* exp_ch6.adb (Needs_BIP_Collection): Always return False if the
type has relaxed finalization.
gcc/testsuite/
* gnat.dg/specs/finalizable2.ads: New test.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/exp_ch6.adb | 5 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/specs/finalizable2.ads | 21 |
2 files changed, 23 insertions, 3 deletions
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 26302ba..6216192 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -9575,9 +9575,8 @@ package body Exp_Ch6 is -- such build-in-place functions, primitive or not. return not Restriction_Active (No_Finalization) - and then ((Needs_Finalization (Typ) - and then not Has_Relaxed_Finalization (Typ)) - or else Is_Tagged_Type (Typ)) + and then (Needs_Finalization (Typ) or else Is_Tagged_Type (Typ)) + and then not Has_Relaxed_Finalization (Typ) and then not Has_Foreign_Convention (Typ); end Needs_BIP_Collection; diff --git a/gcc/testsuite/gnat.dg/specs/finalizable2.ads b/gcc/testsuite/gnat.dg/specs/finalizable2.ads new file mode 100644 index 0000000..b4a6bb1 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/finalizable2.ads @@ -0,0 +1,21 @@ +-- { dg-do compile } +-- { dg-options "-gnatX0" } + +package Finalizable2 is + + type Root is abstract tagged limited null record + with Finalizable => (Initialize => Initialize); + + procedure Initialize (this : in out Root) is abstract; + + type Ext (L : Natural) is new Root with record + A : String (1 .. L); + end record; + + overriding procedure Initialize (this : in out Ext) is null; + + function Make return Ext is (L => 3, A => "asd"); + + Obj : Ext := Make; + +end Finalizable2; |