From 54c16824f0f05313bfc7df5e625f108b4ff7c636 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Fri, 8 Sep 2023 11:53:44 +0000 Subject: [PATCH] ada: Crash processing type invariants on child subprogram gcc/ada/ * contracts.adb (Has_Public_Visibility_Of_Subprogram): Add missing support for child subprograms. --- gcc/ada/contracts.adb | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) 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; -- 2.47.2