]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Fix incorrect free with Task_Info pragma
authorRonan Desplanques <desplanques@adacore.com>
Mon, 25 Mar 2024 09:12:17 +0000 (10:12 +0100)
committerMarc Poulhiès <poulhies@adacore.com>
Mon, 20 May 2024 07:47:03 +0000 (09:47 +0200)
Before this patch, on Linux, the procedure
System.Task_Primitives.Operations.Set_Task_Affinity called CPU_FREE on
instances of cpu_set_t_ptr that it didn't own when the obsolescent
Task_Info pragma was in play. This patch fixes that issue.

gcc/ada/

* libgnarl/s-taprop__linux.adb (Set_Task_Affinity): Fix
decision about whether to call CPU_FREE.

gcc/ada/libgnarl/s-taprop__linux.adb

index 1faa3d8914e58744b6bb39c6c429899ec9416d0c..0c09817739cecb8aa4ca2da27a7b3e468c50a192 100644 (file)
@@ -1466,12 +1466,13 @@ package body System.Task_Primitives.Operations is
         and then T.Common.LL.Thread /= Null_Thread_Id
       then
          declare
-            CPUs    : constant size_t :=
-                        C.size_t (Multiprocessors.Number_Of_CPUs);
-            CPU_Set : cpu_set_t_ptr := null;
-            Size    : constant size_t := CPU_ALLOC_SIZE (CPUs);
+            CPUs         : constant size_t :=
+              C.size_t (Multiprocessors.Number_Of_CPUs);
+            CPU_Set      : cpu_set_t_ptr := null;
+            Is_Set_Owned : Boolean := False;
+            Size         : constant size_t := CPU_ALLOC_SIZE (CPUs);
 
-            Result  : C.int;
+            Result       : C.int;
 
          begin
             --  We look at the specific CPU (Base_CPU) first, then at the
@@ -1483,6 +1484,7 @@ package body System.Task_Primitives.Operations is
                --  Set the affinity to an unique CPU
 
                CPU_Set := CPU_ALLOC (CPUs);
+               Is_Set_Owned := True;
                System.OS_Interface.CPU_ZERO (Size, CPU_Set);
                System.OS_Interface.CPU_SET
                  (int (T.Common.Base_CPU), Size, CPU_Set);
@@ -1499,6 +1501,7 @@ package body System.Task_Primitives.Operations is
                --  dispatching domain.
 
                CPU_Set := CPU_ALLOC (CPUs);
+               Is_Set_Owned := True;
                System.OS_Interface.CPU_ZERO (Size, CPU_Set);
 
                for Proc in T.Common.Domain'Range loop
@@ -1512,7 +1515,9 @@ package body System.Task_Primitives.Operations is
               pthread_setaffinity_np (T.Common.LL.Thread, Size, CPU_Set);
             pragma Assert (Result = 0);
 
-            CPU_FREE (CPU_Set);
+            if Is_Set_Owned then
+               CPU_FREE (CPU_Set);
+            end if;
          end;
       end if;
    end Set_Task_Affinity;