From d86fb53f2099c77d14ce59f2dda30bcfeb1df328 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 2 May 2017 10:47:29 +0200 Subject: [PATCH] [multiple changes] 2017-05-02 Bob Duff * s-taprop-linux.adb (Prio_To_Linux_Prio): New function to correctly compute the linux priority from the Ada priority. Call this everywhere required. In particular, the previous version was not doing this computation when setting the ceiling priority in various places. It was just converting to C.int, which results in a ceiling that is off by 1. 2017-05-02 Ed Schonberg * sem_ch3.adb: Comment predicate inheritance. From-SVN: r247473 --- gcc/ada/ChangeLog | 13 ++ gcc/ada/s-taprop-linux.adb | 246 +++++++++++++++++++------------------ gcc/ada/sem_ch3.adb | 6 +- 3 files changed, 145 insertions(+), 120 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index dfe11024ec5..0d53e03c925 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2017-05-02 Bob Duff + + * s-taprop-linux.adb (Prio_To_Linux_Prio): New function to correctly + compute the linux priority from the Ada priority. Call this everywhere + required. In particular, the previous version was not doing this + computation when setting the ceiling priority in various places. It + was just converting to C.int, which results in a ceiling that is off + by 1. + +2017-05-02 Ed Schonberg + + * sem_ch3.adb: Comment predicate inheritance. + 2017-05-02 Tristan Gingold * s-trasym.ads: Add comment. diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index bc49f6828ac..1d829de6ee0 100644 --- a/gcc/ada/s-taprop-linux.adb +++ b/gcc/ada/s-taprop-linux.adb @@ -38,7 +38,7 @@ pragma Polling (Off); -- Turn off polling, we do not want ATC polling to take place during tasking -- operations. It causes infinite loops and other problems. -with Interfaces.C; +with Interfaces.C; use Interfaces; use type Interfaces.C.int; with System.Task_Info; with System.Tasking.Debug; @@ -60,7 +60,6 @@ package body System.Task_Primitives.Operations is use System.Tasking.Debug; use System.Tasking; - use Interfaces.C; use System.OS_Interface; use System.Parameters; use System.OS_Primitives; @@ -111,14 +110,6 @@ package body System.Task_Primitives.Operations is -- Constant to indicate that the thread identifier has not yet been -- initialized. - function geteuid return Integer; - pragma Import (C, geteuid, "geteuid"); - pragma Warnings (Off, "non-static call not allowed in preelaborated unit"); - Superuser : constant Boolean := geteuid = 0; - pragma Warnings (On, "non-static call not allowed in preelaborated unit"); - -- True if we are running as 'root'. On Linux, ceiling priorities work only - -- in that case, so if this is False, we ignore Locking_Policy = 'C'. - -------------------- -- Local Packages -- -------------------- @@ -170,17 +161,52 @@ package body System.Task_Primitives.Operations is procedure Abort_Handler (signo : Signal); function GNAT_pthread_condattr_setup - (attr : access pthread_condattr_t) return int; - pragma Import (C, - GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup"); + (attr : access pthread_condattr_t) return C.int; + pragma Import + (C, GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup"); + + function Prio_To_Linux_Prio (Prio : Any_Priority) return C.int is + (C.int (Prio) + 1); + -- Convert Ada priority to Linux priority. Priorities are 1 .. 99 on + -- GNU/Linux, so we map 0 .. 98 to 1 .. 99. + + function Get_Ceiling_Support return Boolean; + -- Get the value of the Ceiling_Support constant (see below). + -- ???For now, we're returning True only if running as superuser, + -- and ignore capabilities. + + function Get_Ceiling_Support return Boolean is + Ceiling_Support : Boolean := False; + begin + if Locking_Policy = 'C' then + declare + function geteuid return Integer; + pragma Import (C, geteuid, "geteuid"); + Superuser : constant Boolean := geteuid = 0; + begin + if Superuser then + Ceiling_Support := True; + end if; + end; + end if; + + return Ceiling_Support; + end Get_Ceiling_Support; + + pragma Warnings (Off, "non-static call not allowed in preelaborated unit"); + Ceiling_Support : constant Boolean := Get_Ceiling_Support; + pragma Warnings (On, "non-static call not allowed in preelaborated unit"); + -- True if the locking policy is Ceiling_Locking, and the current process + -- has permission to use this policy. The process has permission if it is + -- running as 'root', or if the capability was set by the setcap command, + -- as in "sudo /sbin/setcap cap_sys_nice=ep exe_file". If it doesn't have + -- permission, then a request for Ceiling_Locking is ignored. type RTS_Lock_Ptr is not null access all RTS_Lock; - function Init_Mutex - (L : RTS_Lock_Ptr; Prio : Any_Priority) - return Interfaces.C.int; - -- Initialize the mutex L. If the locking policy is Ceiling_Locking, then - -- set the ceiling to Prio. + function Init_Mutex (L : RTS_Lock_Ptr; Prio : Any_Priority) return C.int; + -- Initialize the mutex L. If Ceiling_Support is True, then set the ceiling + -- to Prio. Returns 0 for success, or ENOMEM for out-of-memory. ------------------- -- Abort_Handler -- @@ -190,7 +216,7 @@ package body System.Task_Primitives.Operations is pragma Unreferenced (signo); Self_Id : constant Task_Id := Self; - Result : Interfaces.C.int; + Result : C.int; Old_Set : aliased sigset_t; begin @@ -272,30 +298,26 @@ package body System.Task_Primitives.Operations is -- Init_Mutex -- ---------------- - function Init_Mutex - (L : RTS_Lock_Ptr; Prio : Any_Priority) - return Interfaces.C.int - is + function Init_Mutex (L : RTS_Lock_Ptr; Prio : Any_Priority) return C.int is Mutex_Attr : aliased pthread_mutexattr_t; - Result : Interfaces.C.int; + Result, Result_2 : C.int; + begin Result := pthread_mutexattr_init (Mutex_Attr'Access); - pragma Assert (Result = 0 or else Result = ENOMEM); + pragma Assert (Result in 0 | ENOMEM); if Result = ENOMEM then - return ENOMEM; + return Result; end if; - if Locking_Policy = 'C' then - if Superuser then - Result := pthread_mutexattr_setprotocol - (Mutex_Attr'Access, PTHREAD_PRIO_PROTECT); - pragma Assert (Result = 0); + if Ceiling_Support then + Result := pthread_mutexattr_setprotocol + (Mutex_Attr'Access, PTHREAD_PRIO_PROTECT); + pragma Assert (Result = 0); - Result := pthread_mutexattr_setprioceiling - (Mutex_Attr'Access, Interfaces.C.int (Prio)); - pragma Assert (Result = 0); - end if; + Result := pthread_mutexattr_setprioceiling + (Mutex_Attr'Access, Prio_To_Linux_Prio (Prio)); + pragma Assert (Result = 0); elsif Locking_Policy = 'I' then Result := pthread_mutexattr_setprotocol @@ -304,16 +326,11 @@ package body System.Task_Primitives.Operations is end if; Result := pthread_mutex_init (L, Mutex_Attr'Access); - pragma Assert (Result = 0 or else Result = ENOMEM); + pragma Assert (Result in 0 | ENOMEM); - if Result = ENOMEM then - Result := pthread_mutexattr_destroy (Mutex_Attr'Access); - return ENOMEM; - end if; - - Result := pthread_mutexattr_destroy (Mutex_Attr'Access); - pragma Assert (Result = 0); - return 0; + Result_2 := pthread_mutexattr_destroy (Mutex_Attr'Access); + pragma Assert (Result_2 = 0); + return Result; -- of pthread_mutex_init, not pthread_mutexattr_destroy end Init_Mutex; --------------------- @@ -327,14 +344,14 @@ package body System.Task_Primitives.Operations is -- routines should be able to be handled safely. procedure Initialize_Lock - (Prio : System.Any_Priority; + (Prio : Any_Priority; L : not null access Lock) is begin if Locking_Policy = 'R' then declare RWlock_Attr : aliased pthread_rwlockattr_t; - Result : Interfaces.C.int; + Result : C.int; begin -- Set the rwlock to prefer writer to avoid writers starvation @@ -349,7 +366,7 @@ package body System.Task_Primitives.Operations is Result := pthread_rwlock_init (L.RW'Access, RWlock_Attr'Access); - pragma Assert (Result = 0 or else Result = ENOMEM); + pragma Assert (Result in 0 | ENOMEM); if Result = ENOMEM then raise Storage_Error with "Failed to allocate a lock"; @@ -378,7 +395,7 @@ package body System.Task_Primitives.Operations is ------------------- procedure Finalize_Lock (L : not null access Lock) is - Result : Interfaces.C.int; + Result : C.int; begin if Locking_Policy = 'R' then Result := pthread_rwlock_destroy (L.RW'Access); @@ -389,7 +406,7 @@ package body System.Task_Primitives.Operations is end Finalize_Lock; procedure Finalize_Lock (L : not null access RTS_Lock) is - Result : Interfaces.C.int; + Result : C.int; begin Result := pthread_mutex_destroy (L); pragma Assert (Result = 0); @@ -403,7 +420,7 @@ package body System.Task_Primitives.Operations is (L : not null access Lock; Ceiling_Violation : out Boolean) is - Result : Interfaces.C.int; + Result : C.int; begin if Locking_Policy = 'R' then Result := pthread_rwlock_wrlock (L.RW'Access); @@ -413,15 +430,15 @@ package body System.Task_Primitives.Operations is -- The cause of EINVAL is a priority ceiling violation + pragma Assert (Result in 0 | EINVAL); Ceiling_Violation := Result = EINVAL; - pragma Assert (Result = 0 or else Ceiling_Violation); end Write_Lock; procedure Write_Lock (L : not null access RTS_Lock; Global_Lock : Boolean := False) is - Result : Interfaces.C.int; + Result : C.int; begin if not Single_Lock or else Global_Lock then Result := pthread_mutex_lock (L); @@ -430,7 +447,7 @@ package body System.Task_Primitives.Operations is end Write_Lock; procedure Write_Lock (T : Task_Id) is - Result : Interfaces.C.int; + Result : C.int; begin if not Single_Lock then Result := pthread_mutex_lock (T.Common.LL.L'Access); @@ -446,7 +463,7 @@ package body System.Task_Primitives.Operations is (L : not null access Lock; Ceiling_Violation : out Boolean) is - Result : Interfaces.C.int; + Result : C.int; begin if Locking_Policy = 'R' then Result := pthread_rwlock_rdlock (L.RW'Access); @@ -456,8 +473,8 @@ package body System.Task_Primitives.Operations is -- The cause of EINVAL is a priority ceiling violation + pragma Assert (Result in 0 | EINVAL); Ceiling_Violation := Result = EINVAL; - pragma Assert (Result = 0 or else Ceiling_Violation); end Read_Lock; ------------ @@ -465,7 +482,7 @@ package body System.Task_Primitives.Operations is ------------ procedure Unlock (L : not null access Lock) is - Result : Interfaces.C.int; + Result : C.int; begin if Locking_Policy = 'R' then Result := pthread_rwlock_unlock (L.RW'Access); @@ -479,7 +496,7 @@ package body System.Task_Primitives.Operations is (L : not null access RTS_Lock; Global_Lock : Boolean := False) is - Result : Interfaces.C.int; + Result : C.int; begin if not Single_Lock or else Global_Lock then Result := pthread_mutex_unlock (L); @@ -488,7 +505,7 @@ package body System.Task_Primitives.Operations is end Unlock; procedure Unlock (T : Task_Id) is - Result : Interfaces.C.int; + Result : C.int; begin if not Single_Lock then Result := pthread_mutex_unlock (T.Common.LL.L'Access); @@ -504,7 +521,7 @@ package body System.Task_Primitives.Operations is procedure Set_Ceiling (L : not null access Lock; - Prio : System.Any_Priority) + Prio : Any_Priority) is pragma Unreferenced (L, Prio); begin @@ -521,7 +538,7 @@ package body System.Task_Primitives.Operations is is pragma Unreferenced (Reason); - Result : Interfaces.C.int; + Result : C.int; begin pragma Assert (Self_ID = Self); @@ -535,7 +552,7 @@ package body System.Task_Primitives.Operations is -- EINTR is not considered a failure - pragma Assert (Result = 0 or else Result = EINTR); + pragma Assert (Result in 0 | EINTR); end Sleep; ----------------- @@ -560,7 +577,7 @@ package body System.Task_Primitives.Operations is Check_Time : Duration := Base_Time; Abs_Time : Duration; Request : aliased timespec; - Result : Interfaces.C.int; + Result : C.int; begin Timedout := True; @@ -588,7 +605,7 @@ package body System.Task_Primitives.Operations is Check_Time := Monotonic_Clock; exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; - if Result = 0 or else Result = EINTR then + if Result in 0 | EINTR then -- Somebody may have called Wakeup for us @@ -618,7 +635,7 @@ package body System.Task_Primitives.Operations is Abs_Time : Duration; Request : aliased timespec; - Result : Interfaces.C.int; + Result : C.int; pragma Warnings (Off, Result); begin @@ -651,9 +668,7 @@ package body System.Task_Primitives.Operations is Check_Time := Monotonic_Clock; exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; - pragma Assert (Result = 0 or else - Result = ETIMEDOUT or else - Result = EINTR); + pragma Assert (Result in 0 | ETIMEDOUT | EINTR); end loop; Self_ID.Common.State := Runnable; @@ -674,7 +689,7 @@ package body System.Task_Primitives.Operations is function Monotonic_Clock return Duration is TS : aliased timespec; - Result : int; + Result : C.int; begin Result := clock_gettime (clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access); @@ -689,7 +704,7 @@ package body System.Task_Primitives.Operations is function RT_Resolution return Duration is TS : aliased timespec; - Result : int; + Result : C.int; begin Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access); @@ -704,7 +719,7 @@ package body System.Task_Primitives.Operations is procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); - Result : Interfaces.C.int; + Result : C.int; begin Result := pthread_cond_signal (T.Common.LL.CV'Access); pragma Assert (Result = 0); @@ -715,7 +730,7 @@ package body System.Task_Primitives.Operations is ----------- procedure Yield (Do_Yield : Boolean := True) is - Result : Interfaces.C.int; + Result : C.int; pragma Unreferenced (Result); begin if Do_Yield then @@ -729,15 +744,15 @@ package body System.Task_Primitives.Operations is procedure Set_Priority (T : Task_Id; - Prio : System.Any_Priority; + Prio : Any_Priority; Loss_Of_Inheritance : Boolean := False) is pragma Unreferenced (Loss_Of_Inheritance); - Result : Interfaces.C.int; + Result : C.int; Param : aliased struct_sched_param; - function Get_Policy (Prio : System.Any_Priority) return Character; + function Get_Policy (Prio : Any_Priority) return Character; pragma Import (C, Get_Policy, "__gnat_get_specific_dispatching"); -- Get priority specific dispatching policy @@ -748,9 +763,7 @@ package body System.Task_Primitives.Operations is begin T.Common.Current_Priority := Prio; - -- Priorities are 1 .. 99 on GNU/Linux, so we map 0 .. 98 to 1 .. 99 - - Param.sched_priority := Interfaces.C.int (Prio) + 1; + Param.sched_priority := Prio_To_Linux_Prio (Prio); if Dispatching_Policy = 'R' or else Priority_Specific_Policy = 'R' @@ -776,14 +789,14 @@ package body System.Task_Primitives.Operations is SCHED_OTHER, Param'Access); end if; - pragma Assert (Result = 0 or else Result = EPERM); + pragma Assert (Result in 0 | EPERM | EINVAL); end Set_Priority; ------------------ -- Get_Priority -- ------------------ - function Get_Priority (T : Task_Id) return System.Any_Priority is + function Get_Priority (T : Task_Id) return Any_Priority is begin return T.Common.Current_Priority; end Get_Priority; @@ -817,7 +830,7 @@ package body System.Task_Primitives.Operations is Len : Natural := 0; -- Length of the task name contained in Task_Name - Result : int; + Result : C.int; -- Result from the prctl call begin Result := prctl (PR_GET_NAME, unsigned_long (Thread_Name'Address)); @@ -849,7 +862,7 @@ package body System.Task_Primitives.Operations is elsif Self_ID.Common.Task_Image_Len > 0 then declare Task_Name : String (1 .. Parameters.Max_Task_Image_Length + 1); - Result : int; + Result : C.int; begin Task_Name (1 .. Self_ID.Common.Task_Image_Len) := @@ -868,7 +881,7 @@ package body System.Task_Primitives.Operations is then declare Stack : aliased stack_t; - Result : Interfaces.C.int; + Result : C.int; begin Stack.ss_sp := Self_ID.Common.Task_Alternate_Stack; Stack.ss_size := Alternate_Stack_Size; @@ -903,7 +916,7 @@ package body System.Task_Primitives.Operations is -------------------- procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is - Result : Interfaces.C.int; + Result : C.int; Cond_Attr : aliased pthread_condattr_t; begin @@ -917,7 +930,7 @@ package body System.Task_Primitives.Operations is if not Single_Lock then if Init_Mutex - (Self_ID.Common.LL.L'Access, System.Any_Priority'Last) /= 0 + (Self_ID.Common.LL.L'Access, Any_Priority'Last) /= 0 then Succeeded := False; return; @@ -925,7 +938,7 @@ package body System.Task_Primitives.Operations is end if; Result := pthread_condattr_init (Cond_Attr'Access); - pragma Assert (Result = 0 or else Result = ENOMEM); + pragma Assert (Result in 0 | ENOMEM); if Result = 0 then Result := GNAT_pthread_condattr_setup (Cond_Attr'Access); @@ -934,7 +947,7 @@ package body System.Task_Primitives.Operations is Result := pthread_cond_init (Self_ID.Common.LL.CV'Access, Cond_Attr'Access); - pragma Assert (Result = 0 or else Result = ENOMEM); + pragma Assert (Result in 0 | ENOMEM); end if; if Result = 0 then @@ -960,14 +973,14 @@ package body System.Task_Primitives.Operations is (T : Task_Id; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; - Priority : System.Any_Priority; + Priority : Any_Priority; Succeeded : out Boolean) is Thread_Attr : aliased pthread_attr_t; - Adjusted_Stack_Size : Interfaces.C.size_t; - Result : Interfaces.C.int; + Adjusted_Stack_Size : C.size_t; + Result : C.int; - use type System.Multiprocessors.CPU_Range; + use type Multiprocessors.CPU_Range, Interfaces.C.size_t; begin -- Check whether both Dispatching_Domain and CPU are specified for @@ -975,7 +988,7 @@ package body System.Task_Primitives.Operations is -- processors for the domain. if T.Common.Domain /= null - and then T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU + and then T.Common.Base_CPU /= Multiprocessors.Not_A_Specific_CPU and then (T.Common.Base_CPU not in T.Common.Domain'Range or else not T.Common.Domain (T.Common.Base_CPU)) @@ -984,11 +997,10 @@ package body System.Task_Primitives.Operations is return; end if; - Adjusted_Stack_Size := - Interfaces.C.size_t (Stack_Size + Alternate_Stack_Size); + Adjusted_Stack_Size := C.size_t (Stack_Size + Alternate_Stack_Size); Result := pthread_attr_init (Thread_Attr'Access); - pragma Assert (Result = 0 or else Result = ENOMEM); + pragma Assert (Result in 0 | ENOMEM); if Result /= 0 then Succeeded := False; @@ -1013,16 +1025,15 @@ package body System.Task_Primitives.Operations is -- Do nothing if required support not provided by the operating system - if pthread_attr_setaffinity_np'Address = System.Null_Address then + if pthread_attr_setaffinity_np'Address = Null_Address then null; -- Support is available - elsif T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then + elsif T.Common.Base_CPU /= Multiprocessors.Not_A_Specific_CPU then declare CPUs : constant size_t := - Interfaces.C.size_t - (System.Multiprocessors.Number_Of_CPUs); + C.size_t (Multiprocessors.Number_Of_CPUs); CPU_Set : constant cpu_set_t_ptr := CPU_ALLOC (CPUs); Size : constant size_t := CPU_ALLOC_SIZE (CPUs); @@ -1061,8 +1072,7 @@ package body System.Task_Primitives.Operations is then declare CPUs : constant size_t := - Interfaces.C.size_t - (System.Multiprocessors.Number_Of_CPUs); + C.size_t (Multiprocessors.Number_Of_CPUs); CPU_Set : constant cpu_set_t_ptr := CPU_ALLOC (CPUs); Size : constant size_t := CPU_ALLOC_SIZE (CPUs); @@ -1103,8 +1113,7 @@ package body System.Task_Primitives.Operations is Thread_Body_Access (Wrapper), To_Address (T)); - pragma Assert - (Result = 0 or else Result = EAGAIN or else Result = ENOMEM); + pragma Assert (Result in 0 | EAGAIN | ENOMEM); if Result /= 0 then Succeeded := False; @@ -1126,7 +1135,7 @@ package body System.Task_Primitives.Operations is ------------------ procedure Finalize_TCB (T : Task_Id) is - Result : Interfaces.C.int; + Result : C.int; begin if not Single_Lock then @@ -1158,7 +1167,7 @@ package body System.Task_Primitives.Operations is ---------------- procedure Abort_Task (T : Task_Id) is - Result : Interfaces.C.int; + Result : C.int; ESRCH : constant := 3; -- No such process -- It can happen that T has already vanished, in which case pthread_kill @@ -1170,7 +1179,7 @@ package body System.Task_Primitives.Operations is pthread_kill (T.Common.LL.Thread, Signal (System.Interrupt_Management.Abort_Task_Interrupt)); - pragma Assert (Result = 0 or else Result = ESRCH); + pragma Assert (Result in 0 | ESRCH); end if; end Abort_Task; @@ -1179,7 +1188,7 @@ package body System.Task_Primitives.Operations is ---------------- procedure Initialize (S : in out Suspension_Object) is - Result : Interfaces.C.int; + Result : C.int; begin -- Initialize internal state (always to False (RM D.10(6))) @@ -1191,7 +1200,7 @@ package body System.Task_Primitives.Operations is Result := pthread_mutex_init (S.L'Access, null); - pragma Assert (Result = 0 or else Result = ENOMEM); + pragma Assert (Result in 0 | ENOMEM); if Result = ENOMEM then raise Storage_Error; @@ -1201,7 +1210,7 @@ package body System.Task_Primitives.Operations is Result := pthread_cond_init (S.CV'Access, null); - pragma Assert (Result = 0 or else Result = ENOMEM); + pragma Assert (Result in 0 | ENOMEM); if Result /= 0 then Result := pthread_mutex_destroy (S.L'Access); @@ -1218,7 +1227,7 @@ package body System.Task_Primitives.Operations is -------------- procedure Finalize (S : in out Suspension_Object) is - Result : Interfaces.C.int; + Result : C.int; begin -- Destroy internal mutex @@ -1249,7 +1258,7 @@ package body System.Task_Primitives.Operations is --------------- procedure Set_False (S : in out Suspension_Object) is - Result : Interfaces.C.int; + Result : C.int; begin SSL.Abort_Defer.all; @@ -1270,7 +1279,7 @@ package body System.Task_Primitives.Operations is -------------- procedure Set_True (S : in out Suspension_Object) is - Result : Interfaces.C.int; + Result : C.int; begin SSL.Abort_Defer.all; @@ -1305,7 +1314,7 @@ package body System.Task_Primitives.Operations is ------------------------ procedure Suspend_Until_True (S : in out Suspension_Object) is - Result : Interfaces.C.int; + Result : C.int; begin SSL.Abort_Defer.all; @@ -1343,7 +1352,7 @@ package body System.Task_Primitives.Operations is -- POSIX does not guarantee it so this may change in future. Result := pthread_cond_wait (S.CV'Access, S.L'Access); - pragma Assert (Result = 0 or else Result = EINTR); + pragma Assert (Result in 0 | EINTR); exit when not S.Waiting; end loop; @@ -1456,7 +1465,7 @@ package body System.Task_Primitives.Operations is act : aliased struct_sigaction; old_act : aliased struct_sigaction; Tmp_Set : aliased sigset_t; - Result : Interfaces.C.int; + Result : C.int; -- Whether to use an alternate signal stack for stack overflows function State @@ -1538,7 +1547,7 @@ package body System.Task_Primitives.Operations is ----------------------- procedure Set_Task_Affinity (T : ST.Task_Id) is - use type System.Multiprocessors.CPU_Range; + use type Multiprocessors.CPU_Range; begin -- Do nothing if there is no support for setting affinities or the @@ -1546,17 +1555,16 @@ package body System.Task_Primitives.Operations is -- yet been created then the proper affinity will be set during its -- creation. - if pthread_setaffinity_np'Address /= System.Null_Address + if pthread_setaffinity_np'Address /= Null_Address and then T.Common.LL.Thread /= Null_Thread_Id then declare CPUs : constant size_t := - Interfaces.C.size_t - (System.Multiprocessors.Number_Of_CPUs); + C.size_t (Multiprocessors.Number_Of_CPUs); CPU_Set : cpu_set_t_ptr := null; Size : constant size_t := CPU_ALLOC_SIZE (CPUs); - Result : Interfaces.C.int; + Result : C.int; begin -- We look at the specific CPU (Base_CPU) first, then at the diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 8f3cf1e6e0e..e92a954fe50 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3133,7 +3133,11 @@ package body Sem_Ch3 is when N_Derived_Type_Definition => Derived_Type_Declaration (T, N, T /= Def_Id); - if Ekind (T) /= E_Void and then Has_Predicates (T) then -- ???? + + -- Inherit predicates from parent, and protect against + -- illegal derivations. + + if Is_Type (T) and then Has_Predicates (T) then Set_Has_Predicates (Def_Id); end if; -- 2.30.2