[COMMITTED 21/27] ada: C_Pass_By_Copy convention incorrectly ignored

[Marc Poulhiès]

From: Steve Baird <ba...@adacore.com>

In some cases involving a convention-C anonymous access-to-subprogram type
with a parameter whose type has a convention of C_Pass_By_Copy, that
C_Pass_By_Copy convention is incorrectly ignored.

gcc/ada/ChangeLog:

        * freeze.adb (Freeze_Entity): In the case of an anonymous
        access-to-subprogram type where Do_Freeze_Profile is True, freeze
        the designated subprogram type.
        (Should_Freeze_Type): Do not call Unit_Declaration_Node with
        a parentless argument.
        * sem_ch3.adb (Analyze_Object_Declaration): When calling
        Freeze_Before, override the default value for Do_Freeze_Profile.
        This is needed in some cases to prevent premature freezing in the
        case of an object of an anonymous access-to-subprogram type.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/freeze.adb  | 26 +++++++++++++++++++++++++-
 gcc/ada/sem_ch3.adb |  5 ++++-
 2 files changed, 29 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 9de4fa409c0f..346789ff7573 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -6790,6 +6790,27 @@ package body Freeze is
 
       Set_Is_Frozen (E);
 
+      --  Freeze profile of anonymous access-to-subprogram type
+
+      if Do_Freeze_Profile
+        and then Ekind (E) = E_Anonymous_Access_Subprogram_Type
+      then
+         declare
+            Skip_Because_In_Generic : constant Boolean :=
+              In_Generic_Scope (E) or else
+                (Is_Itype (E)
+                  and then Nkind (Parent (Associated_Node_For_Itype (E)))
+                    = N_Generic_Subprogram_Declaration);
+         begin
+            if not Skip_Because_In_Generic then
+               if not Freeze_Profile (Designated_Type (E)) then
+                  goto Leave;
+               end if;
+               Freeze_Subprogram (Designated_Type (E));
+            end if;
+         end;
+      end if;
+
       --  Case of entity being frozen is other than a type
 
       if not Is_Type (E) then
@@ -11032,7 +11053,10 @@ package body Freeze is
       E   : Entity_Id;
       N   : Node_Id) return Boolean
    is
-      Decl : constant Node_Id := Original_Node (Unit_Declaration_Node (E));
+      Decl : constant Node_Id :=
+        (if Ekind (E) = E_Subprogram_Type and then No (Parent (E))
+          then Empty
+          else Original_Node (Unit_Declaration_Node (E)));
 
       function Is_Dispatching_Call_Or_Tagged_Result_Or_Aggregate
         (N : Node_Id) return Traverse_Result;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 5978d6779586..293682eef39d 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4632,7 +4632,10 @@ package body Sem_Ch3 is
             Set_Has_Delayed_Freeze (T);
 
          elsif not Preanalysis_Active then
-            Freeze_Before (N, T);
+            --  Do_Freeze_Profile matters in the case of an object
+            --  of an anonymous access-to-subprogram type.
+
+            Freeze_Before (N, T, Do_Freeze_Profile => False);
          end if;
       end if;
 
-- 
2.43.0