From 37c312486186ed9dc2561b2e341fd81f4f1627ec Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 5 May 2025 12:58:58 +0200 Subject: Ada: Fix assertion failure on Finalizable aspect for tagged record type This is a (benign) assertion failure on the mainline for the new Finalizable aspect put on a tagged record type when not all the primitives are declared. This compiles and runs on the 15 branch because assertions are disabled. gcc/ada/ PR ada/120104 * exp_ch3.adb (Expand_Freeze_Record_Type): For a controlled tagged type, freeze only the controlled primitives that are present. gcc/testsuite/ * gnat.dg/specs/finalizable1.ads: New test. --- gcc/ada/exp_ch3.adb | 30 ++++++++++++++++++---------- gcc/testsuite/gnat.dg/specs/finalizable1.ads | 11 ++++++++++ 2 files changed, 30 insertions(+), 11 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/specs/finalizable1.ads (limited to 'gcc') diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 0dfd810..bc46fd3 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -6321,19 +6321,27 @@ package body Exp_Ch3 is -- frozen inside. if Is_Controlled (Typ) then - Append_Freeze_Actions (Typ, - Freeze_Entity - (Find_Controlled_Prim_Op (Typ, Name_Initialize), Typ)); + declare + Prim : Entity_Id; - if not Is_Limited_Type (Typ) then - Append_Freeze_Actions (Typ, - Freeze_Entity - (Find_Controlled_Prim_Op (Typ, Name_Adjust), Typ)); - end if; + begin + Prim := Find_Controlled_Prim_Op (Typ, Name_Initialize); + if Present (Prim) then + Append_Freeze_Actions (Typ, Freeze_Entity (Prim, Typ)); + end if; - Append_Freeze_Actions (Typ, - Freeze_Entity - (Find_Controlled_Prim_Op (Typ, Name_Finalize), Typ)); + if not Is_Limited_Type (Typ) then + Prim := Find_Controlled_Prim_Op (Typ, Name_Adjust); + if Present (Prim) then + Append_Freeze_Actions (Typ, Freeze_Entity (Prim, Typ)); + end if; + end if; + + Prim := Find_Controlled_Prim_Op (Typ, Name_Finalize); + if Present (Prim) then + Append_Freeze_Actions (Typ, Freeze_Entity (Prim, Typ)); + end if; + end; end if; -- Freeze rest of primitive operations. There is no need to handle diff --git a/gcc/testsuite/gnat.dg/specs/finalizable1.ads b/gcc/testsuite/gnat.dg/specs/finalizable1.ads new file mode 100644 index 0000000..5fa8f5c --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/finalizable1.ads @@ -0,0 +1,11 @@ +-- { dg-do compile } +-- { dg-options "-gnatX0" } + +package Finalizable1 is + + type Root is abstract tagged null record + with Finalizable => (Finalize => Finalize); + + procedure Finalize (This : in out Root) is abstract; + +end Finalizable1; -- cgit v1.1