[gcc r12-6299] [Ada] Spurious error when using current instance of type

[gcc r12-6299] [Ada] Spurious error when using current instance of type

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:1f26ff11b688e3cec00da85b13f6f33e23fc7410

commit r12-6299-g1f26ff11b688e3cec00da85b13f6f33e23fc7410
Author: Justin Squirek <squirek@adacore.com>
Date:   Tue Nov 30 23:40:40 2021 +0000

    [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:
---
 gcc/ada/exp_ch3.adb  | 19 +++++++++++++++++++
 gcc/ada/sem_attr.adb | 10 +++++++++-
 gcc/ada/sem_ch4.adb  | 18 ++++++++++++++++++
 gcc/ada/sem_util.adb | 13 ++++++++++++-
 4 files changed, 58 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index eb386e4250a..265799115c6 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 434488536d6..30bd335ef83 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 951decbcfbd..46e259d26ef 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 5c05e844e40..acd2f2f3d38 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;