[Bug ada/124225] New: Missing race condition protection for Search_Fall_Back_Handler

[liam at liampwll dot com via Gcc-bugs]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=124225

            Bug ID: 124225
           Summary: Missing race condition protection for
                    Search_Fall_Back_Handler
           Product: gcc
           Version: 15.2.1
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: ada
          Assignee: unassigned at gcc dot gnu.org
          Reporter: liam at liampwll dot com
                CC: dkm at gcc dot gnu.org
  Target Milestone: ---

Created attachment 63777
  --> https://gcc.gnu.org/bugzilla/attachment.cgi?id=63777&action=edit
fix

Search_Fall_Back_Handler recursively searches parents of a task to find a
fallback termination handler but it does not hold the lock for the tasks it
searches.

I came across this while debugging a different fallback handler issue and I
don't have any real code where this is broken, but it seems like an easy fix.

This was previously protected by an atomic which was seemingly mistakenly
removed without noticing Search_Fall_Back_Handler
(g:85a40c43fb6f09054f535bae43e8622c971bcc48), but an atomic there was always
broken anyway as demonstrated by the below program on x64 (where the variable
is implicitly atomic).

This patch here probably have the potential to deadlock some very weird code,
but you'd have to be explicitly trying to break the compiler to encounter that.

Reproducer below, this should print 10001 (beware this creates 10001 tasks):


pragma Ada_2022;

with Ada.Exceptions;
with Ada.Task_Identification;
with Ada.Task_Termination;
with Ada.Text_IO;

procedure Example is
   protected type Fallback_Hit_Counter_Type is
      procedure Handler
        (Cause : Ada.Task_Termination.Cause_Of_Termination;
         T     : Ada.Task_Identification.Task_Id;
         X     : Ada.Exceptions.Exception_Occurrence);
   private
      Count : Natural := 0;
   end Fallback_Hit_Counter_Type;

   protected body Fallback_Hit_Counter_Type is
      procedure Handler
        (Cause : Ada.Task_Termination.Cause_Of_Termination;
         T     : Ada.Task_Identification.Task_Id;
         X     : Ada.Exceptions.Exception_Occurrence) is
      begin
         Count := Count + 1;
         Ada.Text_IO.Put_Line (Count'Image);
      end Handler;
   end Fallback_Hit_Counter_Type;

   Fallback_Hit_Counter : access Fallback_Hit_Counter_Type :=
     new Fallback_Hit_Counter_Type;

   task T;

   task body T is
      task type T2;

      task body T2 is
      begin
         delay 1.0;
      end T2;

      Tasks : array (1 .. 10_000) of T2;
   begin
      for I in 1 .. 100_000_000 loop
         Ada.Task_Termination.Set_Dependents_Fallback_Handler (null);
         Ada.Task_Termination.Set_Dependents_Fallback_Handler
           (Fallback_Hit_Counter.all.Handler'Access);
      end loop;
   end T;
begin
   Ada.Task_Termination.Set_Dependents_Fallback_Handler
     (Fallback_Hit_Counter.all.Handler'Access);
end Example;