[gcc r13-588] [Ada] Freezing too strict in instances

[gcc r13-588] [Ada] Freezing too strict in instances

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:54cf6609e0c52123db5c600db197647491c33395

commit r13-588-g54cf6609e0c52123db5c600db197647491c33395
Author: Arnaud Charlet <charlet@adacore.com>
Date:   Wed Mar 30 19:00:27 2022 +0000

    [Ada] Freezing too strict in instances
    
    Should_Freeze_Type is relaxed to only take the relevant case into
    account (entities denoted by generic actual parameters as per
    13.14(5/3), as well as profile of any subprograms named as per
    13.14(10.2/4)), instead of being overly conservative wrt instances and
    as a result, wrongly rejecting some legal code.
    
    In practice this means we only need to worry about profile of
    subprograms named as part of instances.
    
    gcc/ada/
    
            * freeze.adb (Should_Freeze_Type): Fix handling of freezing in
            instances.

Diff:
---
 gcc/ada/freeze.adb | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index b75f9ef07d5..4ff70367014 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -184,9 +184,11 @@ package body Freeze is
    --  the designated type. Otherwise freezing the access type does not freeze
    --  the designated type.
 
-   function Should_Freeze_Type (Typ : Entity_Id; E : Entity_Id) return Boolean;
-   --  If Typ is in the current scope or in an instantiation, then return True.
-   --  ???Expression functions (represented by E) shouldn't freeze types in
+   function Should_Freeze_Type
+     (Typ : Entity_Id; E : Entity_Id; N : Node_Id) return Boolean;
+   --  If Typ is in the current scope, then return True.
+   --  N is a node whose source location corresponds to the freeze point.
+   --  ??? Expression functions (represented by E) shouldn't freeze types in
    --  general, but our current expansion and freezing model requires an early
    --  freezing when the dispatch table is needed or when building an aggregate
    --  with a subtype of Typ, so return True also in this case.
@@ -198,7 +200,7 @@ package body Freeze is
    ------------------------
 
    function Should_Freeze_Type
-     (Typ : Entity_Id; E : Entity_Id) return Boolean
+     (Typ : Entity_Id; E : Entity_Id; N : Node_Id) return Boolean
    is
       function Is_Dispatching_Call_Or_Aggregate
         (N : Node_Id) return Traverse_Result;
@@ -244,7 +246,8 @@ package body Freeze is
 
    begin
       return Within_Scope (Typ, Current_Scope)
-        or else In_Instance
+        or else (Nkind (N) = N_Subprogram_Renaming_Declaration
+                 and then Present (Corresponding_Formal_Spec (N)))
         or else (Present (Decl)
                  and then Nkind (Decl) = N_Expression_Function
                  and then Need_Dispatch_Table (Expression (Decl)) = Abandon);
@@ -4606,7 +4609,7 @@ package body Freeze is
             end if;
 
             if not From_Limited_With (F_Type)
-              and then Should_Freeze_Type (F_Type, E)
+              and then Should_Freeze_Type (F_Type, E, N)
             then
                Freeze_And_Append (F_Type, N, Result);
             end if;
@@ -4786,7 +4789,7 @@ package body Freeze is
                Set_Etype (E, R_Type);
             end if;
 
-            if Should_Freeze_Type (R_Type, E) then
+            if Should_Freeze_Type (R_Type, E, N) then
                Freeze_And_Append (R_Type, N, Result);
             end if;