]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Crash on call to a dispatching op with if_expr and tag-indeterminate calls
authorGary Dismukes <dismukes@adacore.com>
Thu, 16 Oct 2025 21:38:38 +0000 (21:38 +0000)
committerMarc Poulhiès <dkm@gcc.gnu.org>
Mon, 3 Nov 2025 14:15:17 +0000 (15:15 +0100)
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).

gcc/ada/sem_disp.adb

index 5a8bd58b8b81f94d8520be002e54c8e53cc2a6d4..4a940e7f30bd68a8b62c34a68d766ce20c1adecc 100644 (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);