diff mbox series

[COMMITTED,10/22] ada: Cannot override inherited function with controlling result

Message ID 20240621085819.2485987-10-poulhies@adacore.com
State New
Headers show
Series [COMMITTED,01/22] ada: Spurious style error with mutiple square brackets | expand

Commit Message

Marc Poulhiès June 21, 2024, 8:58 a.m. UTC
From: Javier Miranda <miranda@adacore.com>

When a package has the declaration of a derived tagged
type T with private null extension that inherits a public
function F with controlling result, and a derivation of T
is declared in the public part of another package, overriding
function F may be rejected by the compiler.

gcc/ada/

	* sem_disp.adb (Find_Hidden_Overridden_Primitive): Check
	public dispatching primitives of ancestors; previously,
	only immediately-visible primitives were checked.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_disp.adb | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)
diff mbox series

Patch

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 9c498ee9a3f..fe822290e45 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -89,7 +89,9 @@  package body Sem_Disp is
    --  to the found entity; otherwise return Empty.
    --
    --  This routine does not search for non-hidden primitives since they are
-   --  covered by the normal Ada 2005 rules.
+   --  covered by the normal Ada 2005 rules. Its name was motivated by an
+   --  intermediate version of AI05-0125 where this term was proposed to
+   --  name these entities in the RM.
 
    function Is_Inherited_Public_Operation (Op : Entity_Id) return Boolean;
    --  Check whether a primitive operation is inherited from an operation
@@ -2403,7 +2405,7 @@  package body Sem_Disp is
                Orig_Prim := Original_Corresponding_Operation (Prim);
 
                if Orig_Prim /= Prim
-                 and then Is_Immediately_Visible (Orig_Prim)
+                 and then not Is_Hidden (Orig_Prim)
                then
                   Vis_Ancestor := First_Elmt (Vis_List);
                   while Present (Vis_Ancestor) loop