From: Justin Squirek <squirek@adacore.com>
Date: Tue, 30 Nov 2021 23:40:40 +0000 (+0000)
Subject: [Ada] Spurious error when using current instance of type
X-Git-Tag: basepoints/gcc-13~2014
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=1f26ff11b688e3cec00da85b13f6f33e23fc7410;p=thirdparty%2Fgcc.git

[Ada] Spurious error when using current instance of type

gcc/ada/

	* exp_ch3.adb (Build_Assignment): Replace current instance of
	type with Init_Proc formal.
	* sem_attr.adb (OK_Self_Reference): Handle recognition of
	Current_Instance to detect certain expansion.
	* sem_ch4.adb (Analyze_One_Call): Set actual's type when the
	actual in question is a current instance and its corresponding
	formal is an incomplete type.
	* sem_util.adb (Is_Current_Instance): Add check for incomplete
	views and add comment.
---

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index eb386e4250a2..265799115c60 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -2022,6 +2022,25 @@ package body Exp_Ch3 is
                          Elmt2 => Defining_Identifier (First
                                    (Parameter_Specifications
                                       (Parent (Proc_Id)))));
+
+               --  If the type has an incomplete view, a current instance
+               --  may have an incomplete type. In that case, it must also be
+               --  replaced by the formal of the Init_Proc.
+
+               if Nkind (Parent (Rec_Type)) = N_Full_Type_Declaration
+                 and then Present (Incomplete_View (Parent (Rec_Type)))
+               then
+                  Append_Elmt (
+                    N  => Defining_Identifier
+                            (Incomplete_View (Parent (Rec_Type))),
+                    To => Map);
+                  Append_Elmt (
+                    N  => Defining_Identifier
+                            (First
+                              (Parameter_Specifications
+                                (Parent (Proc_Id)))),
+                    To => Map);
+               end if;
             end if;
 
             Exp := New_Copy_Tree (Exp, New_Scope => Proc_Id, Map => Map);
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 434488536d69..30bd335ef836 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -989,7 +989,15 @@ package body Sem_Attr is
                   Set_Etype  (P, Typ);
                end if;
 
-               if Typ = Scop then
+               --  A current instance typically appears immediately within
+               --  the type declaration, but may be nested within an internally
+               --  generated temporary scope - as for an aggregate of a
+               --  discriminated component.
+
+               if Typ = Scop
+                 or else (In_Open_Scopes (Typ)
+                           and then not Comes_From_Source (Scop))
+               then
                   declare
                      Q : Node_Id := Parent (N);
 
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 951decbcfbd4..46e259d26efe 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -3727,6 +3727,24 @@ package body Sem_Ch4 is
                   Next_Actual (Actual);
                   Next_Formal (Formal);
 
+               --  A current instance used as an actual of a function,
+               --  whose body has not been seen, may include a formal
+               --  whose type is an incomplete view of an enclosing
+               --  type declaration containing the current call (e.g.
+               --  in the Expression for a component declaration).
+
+               --  In this case, update the signature of the subprogram
+               --  so the formal has the type of the full view.
+
+               elsif Inside_Init_Proc
+                 and then Nkind (Actual) = N_Identifier
+                 and then Ekind (Etype (Formal)) = E_Incomplete_Type
+                 and then Etype (Actual) = Full_View (Etype (Formal))
+               then
+                  Set_Etype (Formal, Etype (Actual));
+                  Next_Actual (Actual);
+                  Next_Formal (Formal);
+
                --  Handle failed type check
 
                else
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 5c05e844e40f..acd2f2f3d387 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -16680,7 +16680,18 @@ package body Sem_Util is
                           | N_Private_Type_Declaration
                           | N_Subtype_Declaration
               and then Comes_From_Source (P)
-              and then Defining_Entity (P) = Typ
+
+              --  If the type has a previous incomplete declaration, the
+              --  reference in the type definition may have the incomplete
+              --  view. So, here we detect if this incomplete view is a current
+              --  instance by checking if its full view is the entity of the
+              --  full declaration begin analyzed.
+
+              and then
+                (Defining_Entity (P) = Typ
+                  or else
+                   (Ekind (Typ) = E_Incomplete_Type
+                     and then Full_View (Typ) = Defining_Entity (P)))
             then
                return True;