aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2025-07-01 19:17:06 +0200
committerEric Botcazou <ebotcazou@adacore.com>2025-07-01 19:18:46 +0200
commit8deef83915f9e0fb14f278c68527c95085461c41 (patch)
treef2382114a7bcf1b726d0fc6d4e46e978422bb49d /gcc
parentf471ed487ab36651d48c6c31fb28d36a42a30829 (diff)
downloadgcc-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.adb5
-rw-r--r--gcc/testsuite/gnat.dg/specs/finalizable2.ads21
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;