ada: C_Pass_By_Copy convention incorrectly ignored

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.

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 9de4fa409c0f60866a66967e344347ee01bcbbcb..346789ff7573231d0dd86d3aac78cee1696d0919 100644 (file)
--- 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 5978d6779586427975c86dfa989811de30e58e74..293682eef39dd249dd7be3658d33dd6cd143043e 100644 (file)
--- 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;