]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Cope with Sem_Util.Enclosing_Declaration oddness.
authorSteve Baird <baird@adacore.com>
Tue, 21 Nov 2023 19:00:37 +0000 (11:00 -0800)
committerMarc Poulhiès <poulhies@adacore.com>
Tue, 19 Dec 2023 14:27:48 +0000 (15:27 +0100)
Sem_Util.Enclosing_Declaration can return a non-empty result which is not
a declaration; clients may need to compensate for the case where an
N_Subprogram_Specification node is returned. One such client is the function
Is_Actual_Subp_Of_Inst.

gcc/ada/

* sem_ch8.adb (Is_Actual_Subp_Of_Inst): After calling
Enclosing_Declaration, add a check for the case where one more
Parent call is needed to get the enclosing declaration.

gcc/ada/sem_ch8.adb

index c5bf08646719d7fde8bdedc295051be32ddf9f5e..2e6b1b6d78557d0be7c1beef0e59a7da80bd41ac 100644 (file)
@@ -2691,7 +2691,7 @@ package body Sem_Ch8 is
                --  Each attempt to find a suitable primitive of a particular
                --  type operates on its own copy of the original renaming.
                --  As a result the original renaming is kept decoration and
-               --  side-effect-free.
+               --  side-effect free.
 
                --  Inherit the overloaded status of the renamed subprogram name
 
@@ -6550,6 +6550,16 @@ package body Sem_Ch8 is
 
                      Decl := Enclosing_Declaration (E);
 
+                     --  Enclosing_Declaration does not always return a
+                     --  declaration; cope with this irregularity.
+                     if Decl in N_Subprogram_Specification_Id
+                       and then Nkind (Parent (Decl)) in
+                         N_Subprogram_Body | N_Subprogram_Declaration
+                           | N_Subprogram_Renaming_Declaration
+                     then
+                        Decl := Parent (Decl);
+                     end if;
+
                      --  Look for the suprogram renaming declaration built
                      --  for a generic actual subprogram. Unclear why
                      --  Original_Node call is needed, but sometimes it is.