ada: Fix node copy with functions as actual parameters in dispatching DIC

When dispatching in a Default_Initial_Condition, copying the condition
node crashes if there is a, possibly nested, parameterless function as
actual parameter; there were two issues:
1. Subp_Entity in Check_Dispatching_call was uninitialized, a GNAT SAS
   finding.
2. The controlling argument update logic only tried to propagate the
   update by traversing the actual parameters, leading to a crash in
   case of parameterless functions.
This patch initializes Subp_Entity and allows the update of controlling
argument to succeed even when no traversal happened.

gcc/ada/ChangeLog:

	* sem_disp.adb (Check_Dispatching_call): Fix uninitialized Subp_Entity.
	* sem_util.adb (Update_Controlling_Argument): No need to replace controlling argument
	in case of functions.

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index d13367659ac264b82385842410e56792100963e9..9d03eff55c763ac0c7bf771fc4702f0e184d1745 100644 (file)
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -587,7 +587,7 @@ package body Sem_Disp is
       Formal                 : Entity_Id;
       Control                : Node_Id := Empty;
       Func                   : Entity_Id;
-      Subp_Entity            : Entity_Id;
+      Subp_Entity            : constant Entity_Id := Entity (Name (N));
 
       Indeterm_Ctrl_Type : Entity_Id := Empty;
       --  Type of a controlling formal whose actual is a tag-indeterminate call
@@ -968,7 +968,6 @@ package body Sem_Disp is
       --  Find a controlling argument, if any
 
       if Present (Parameter_Associations (N)) then
-         Subp_Entity := Entity (Name (N));
 
          Actual := First_Actual (N);
          Formal := First_Formal (Subp_Entity);

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index ed8f054fc6345b98048b979ceabc7556128fe68a..74de26a933a556cb8fc88503a4a7b43eafb1930b 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -24307,7 +24307,9 @@ package body Sem_Util is
             Next (Old_Act);
          end loop;
 
-         pragma Assert (Replaced);
+         if Nkind (Old_Call) /= N_Function_Call then
+            pragma Assert (Replaced);
+         end if;
       end Update_Controlling_Argument;
 
       -------------------------------