From: Denis Mazzucato <mazzuc...@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_disp.adb | 3 +--
gcc/ada/sem_util.adb | 4 +++-
2 files changed, 4 insertions(+), 3 deletions(-)
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index d13367659ac..9d03eff55c7 100644
--- 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 ed8f054fc63..74de26a933a 100644
--- 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;
-------------------------------
--
2.43.0
