https://gcc.gnu.org/g:c58ef269c7a0461f8d2f751565ab58036410252a
commit r16-1944-gc58ef269c7a0461f8d2f751565ab58036410252a
Author: Denis Mazzucato <mazzuc...@adacore.com>
Date: Fri Jun 6 07:53:00 2025 +0000
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:
---
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 d13367659ac2..9d03eff55c76 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 ed8f054fc634..74de26a933a5 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;
-------------------------------
