From: Javier Miranda <miranda@adacore.com>
Date: Fri, 8 Sep 2023 11:53:44 +0000 (+0000)
Subject: ada: Crash processing type invariants on child subprogram
X-Git-Tag: basepoints/gcc-15~6010
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=54c16824f0f05313bfc7df5e625f108b4ff7c636;p=thirdparty%2Fgcc.git

ada: Crash processing type invariants on child subprogram

gcc/ada/

	* contracts.adb
	(Has_Public_Visibility_Of_Subprogram): Add missing support for
	child subprograms.
---

diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index 77578dacc189..4aaa276495bf 100644
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -2484,7 +2484,7 @@ package body Contracts is
                --  declarations of the package containing the type, or in the
                --  visible declaration of a child unit of that package.
 
-               else
+               elsif Is_List_Member (Subp_Decl) then
                   declare
                      Decls      : constant List_Id   :=
                                     List_Containing (Subp_Decl);
@@ -2508,6 +2508,29 @@ package body Contracts is
                                  (Specification
                                    (Unit_Declaration_Node (Subp_Scope))));
                   end;
+
+               --  Determine whether the subprogram is a child subprogram of
+               --  of the package containing the type.
+
+               else
+                  pragma Assert
+                    (Nkind (Parent (Subp_Decl)) = N_Compilation_Unit);
+
+                  declare
+                     Subp_Scope : constant Entity_Id :=
+                                    Scope (Defining_Entity (Subp_Decl));
+                     Typ_Scope  : constant Entity_Id := Scope (Typ);
+
+                  begin
+                     return
+                       Ekind (Subp_Scope) = E_Package
+                         and then
+                           (Typ_Scope = Subp_Scope
+                              or else
+                                (Is_Child_Unit (Subp_Scope)
+                                   and then Is_Ancestor_Package
+                                              (Typ_Scope, Subp_Scope)));
+                  end;
                end if;
             end Has_Public_Visibility_Of_Subprogram;