ada: Crash on call to a dispatching op with if_expr and tag-indeterminate calls

The compiler can crash with a Storage_Error for a failed precondition
when compiling a call to a dispatching subprogram where an actual for a
controlling formal is given by an if_expression whose dependent expressions
are tag-indeterminate calls.  This problem showed up on a build of Alire
(on the compilation of alire-roots.adb) done during a build_gnat_world
mailserver (as well as having been noticed and reported separately by
another engineering team).

The code in Sem_Disp.Check_Dispatching_Call for checking nondispatching
procedure calls for actuals that are calls to abstract tag-indeterminate
functions did not account for conditional expressions, and attempted to
retrieve the (nonexistent) Expression field from an N_If_Expression node,
failing the precondition for Expression.  It was discovered that none of
the code checking for illegal calls to abstract tag-indeterminate functions
in procedure calls is needed, and the whole related "elsif" part is removed
by this change.  (Note that there is separate checking done separately
within Check_Dispatching_Call that will catch nondispatching calls to
abstract functions.)

gcc/ada/ChangeLog:

	* sem_disp.adb (Check_Dispatching_Call): Remove "elsif" that does error
	checking for abstract tag-indeterminate calls (seems to be no longer
	needed).
This commit is contained in:
Gary Dismukes
2025-10-16 21:38:38 +00:00
committed by Marc Poulhiès
parent 2c77eeb8d8
commit 4ff0bd5f98

View File

@@ -586,7 +586,6 @@ package body Sem_Disp is
Actual : Node_Id;
Formal : Entity_Id;
Control : Node_Id := Empty;
Func : Entity_Id;
Subp_Entity : constant Entity_Id := Entity (Name (N));
Indeterm_Ctrl_Type : Entity_Id := Empty;
@@ -1099,55 +1098,6 @@ package body Sem_Disp is
Check_Dispatching_Context (N);
elsif Nkind (N) /= N_Function_Call then
-- The call is not dispatching, so check that there aren't any
-- tag-indeterminate abstract calls left among its actuals.
Actual := First_Actual (N);
while Present (Actual) loop
if Is_Tag_Indeterminate (Actual) then
-- Function call case
if Nkind (Original_Node (Actual)) = N_Function_Call then
Func := Entity (Name (Original_Node (Actual)));
-- If the actual is an attribute then it can't be abstract
-- (the only current case of a tag-indeterminate attribute
-- is the stream Input attribute).
elsif Nkind (Original_Node (Actual)) = N_Attribute_Reference
then
Func := Empty;
-- Ditto if it is an explicit dereference
elsif Nkind (Original_Node (Actual)) = N_Explicit_Dereference
then
Func := Empty;
-- Only other possibility is a qualified expression whose
-- constituent expression is itself a call.
else
Func :=
Entity (Name (Original_Node
(Expression (Original_Node (Actual)))));
end if;
if Present (Func) and then Is_Abstract_Subprogram (Func) then
Error_Msg_N
("call to abstract function must be dispatching",
Actual);
end if;
end if;
Next_Actual (Actual);
end loop;
Check_Dispatching_Context (N);
elsif Nkind (Parent (N)) in N_Subexpr then
Check_Dispatching_Context (N);