ada: Visibility bug in instance of generic with precondition on formal subprogram

The compiler may issue an error saying that a global entity referenced in
the precondition of a formal subprogram is not visible when the containing
generic is instantiated at a place where the entity is not directly visible.
This was due to the formal subprogram's contract not having been analyzed
in the generic template.  As a result, the nodes with global references were
not properly captured (by Save_Global_References).

An additional problem was exposed, which was that references within
contract aspect specifications of generic formals to other formals of the
same generic were not being properly analyzed/resolved, due to copying
the aspect specifications of the already-analyzed copy of the generic
formal when building subprogram wrappers for the contracts.  This could
lead to blowups in the back end due to references to the original formals
occurring in the expansion of the instantiation.  This is addressed by
copying the aspect specifications of the unanalyzed formals rather than
those that were analyzed in the copy of the generic template.

gcc/ada/ChangeLog:

	* contracts.adb (Analyze_Contracts): Add cases for formal subprogram
	Nkinds so that Analyze_Entry_Or_Subprogram_Contract will be called
	for them.
	* sem_attr.adb (Analyze_Attribute_Old_Result): Account for the cases
	of formal subprogram Nkinds, allowing Old attributes for those.
	* sem_ch12.adb (Build_Subprogram_Wrappers): Add a formal for passing
	the unanalyzed generic formal, and use it for copying any aspect
	specifications of the generic formal rather than copying the analyzed
	generic formal's aspects.
	(Analyze_One_Association): Pass Assoc.Un_Formal as an additional
	actual in the call to Build_Subprogram_Wrappers.

diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index 81a04facfc979bcd527f842e0019b711e4ad2b91..bde66171cbc0e40495986aadab28ce4941184e9d 100644 (file)
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -452,6 +452,8 @@ package body Contracts is
 
          if Nkind (Decl) in N_Abstract_Subprogram_Declaration
                           | N_Entry_Declaration
+                          | N_Formal_Abstract_Subprogram_Declaration
+                          | N_Formal_Concrete_Subprogram_Declaration
                           | N_Generic_Subprogram_Declaration
                           | N_Subprogram_Declaration
          then

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index e4fc782fcd92a679ead59fc9591a884012cf71ab..69166722692526fd4ead4cba2592327a03ca1c40 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1518,6 +1518,8 @@ package body Sem_Attr is
          if Nkind (Subp_Decl) not in N_Abstract_Subprogram_Declaration
                                    | N_Entry_Declaration
                                    | N_Expression_Function
+                                   | N_Formal_Abstract_Subprogram_Declaration
+                                   | N_Formal_Concrete_Subprogram_Declaration
                                    | N_Full_Type_Declaration
                                    | N_Generic_Subprogram_Declaration
                                    | N_Subprogram_Body

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index c0835cb39581869e3175557a108c7aeb268e7edd..5d8c8c3ca3468d80cd70c674c1d393fd45c8bd02 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -524,7 +524,10 @@ package body Sem_Ch12 is
    --  pre/postconditon checks added.
 
    procedure Build_Subprogram_Wrappers
-     (Match, Analyzed_Formal : Node_Id; Renamings : List_Id);
+     (Match             : Node_Id;
+      Analyzed_Formal   : Node_Id;
+      Unanalyzed_Formal : Node_Id;
+      Renamings         : List_Id);
    --  Ada 2022: AI12-0272 introduces pre/postconditions for formal
    --  subprograms. The implementation of making the formal into a renaming
    --  of the actual does not work, given that subprogram renaming cannot
@@ -534,6 +537,10 @@ package body Sem_Ch12 is
    --  The wrapper declaration and body are appended to Renamings.
    --  ???But renaming declarations CAN have aspects specs,
    --  and that was true from the start (see AI05-0183-1).
+   --
+   --  The procedure also copies the aspect specifications from the unanalyzed
+   --  formal subprogram to the wrapper subprogram for later analysis in the
+   --  context of the instantiation.
 
    procedure Check_Abbreviated_Instance
      (N                : Node_Id;
@@ -2753,7 +2760,10 @@ package body Sem_Ch12 is
                  and then (Expander_Active or GNATprove_Mode)
                then
                   Build_Subprogram_Wrappers
-                    (Match, Assoc.An_Formal, Result_Renamings);
+                    (Match             => Match,
+                     Analyzed_Formal   => Assoc.An_Formal,
+                     Unanalyzed_Formal => Assoc.Un_Formal,
+                     Renamings         => Result_Renamings);
                end if;
 
                --  An instantiation is a freeze point for the actuals,
@@ -7535,7 +7545,10 @@ package body Sem_Ch12 is
    -------------------------------
 
    procedure Build_Subprogram_Wrappers
-     (Match, Analyzed_Formal : Node_Id; Renamings : List_Id)
+     (Match             : Node_Id;
+      Analyzed_Formal   : Node_Id;
+      Unanalyzed_Formal : Node_Id;
+      Renamings         : List_Id)
    is
       function Adjust_Aspect_Sloc (N : Node_Id) return Traverse_Result;
       --  Adjust Sloc so that errors will be reported on the instance rather
@@ -7593,10 +7606,11 @@ package body Sem_Ch12 is
 
       Decl_Node := Build_Subprogram_Decl_Wrapper (Formal);
 
-      --  Transfer aspect specifications from formal subprogram to wrapper
+      --  Transfer aspect specifications from the unanalyzed formal subprogram
+      --  to the wrapper for later analysis.
 
       Set_Aspect_Specifications (Decl_Node,
-        New_Copy_List_Tree (Aspect_Specifications (Analyzed_Formal)));
+        New_Copy_List_Tree (Aspect_Specifications (Unanalyzed_Formal)));
 
       Aspect_Spec := First (Aspect_Specifications (Decl_Node));
       while Present (Aspect_Spec) loop