From: Gary Dismukes <dismukes@adacore.com>
Date: Thu, 16 Oct 2025 21:38:38 +0000 (+0000)
Subject: ada: Crash on call to a dispatching op with if_expr and tag-indeterminate calls
X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=4ff0bd5f98728d14a91d62d44fe1fa4bdd0bee33;p=thirdparty%2Fgcc.git

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).
---

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 5a8bd58b8b8..4a940e7f30b 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -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);