[multiple changes]

2017-04-25  Bob Duff  <duff@adacore.com>

	* s-osinte-linux.ads (pthread_mutexattr_setprotocol,
	pthread_mutexattr_setprioceiling): Add new interfaces for these
	pthread operations.
	* s-taprop-linux.adb (Initialize_Lock, Initialize_TCB): Set
	protocols as appropriate for Locking_Policy 'C' and 'I'.
	* s-taprop-posix.adb: Minor reformatting to make it more similar
	to s-taprop-linux.adb.

2017-04-25  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Get_Discriminant_Value, Search_Derivation_Levels):
	Handle properly a multi- level derivation involving both renamed
	and constrained parent discriminants, when the type to be
	constrained has fewer discriminants that the ultimate ancestor.

2017-04-25  Bob Duff  <duff@adacore.com>

	* sem_util.adb (Is_Object_Reference): In the
	case of N_Explicit_Dereference, return False if it came from a
	conditional expression.

2017-04-25  Bob Duff  <duff@adacore.com>

	* par-ch4.adb (P_Case_Expression): If a semicolon
	is followed by "when", assume that ";" was meant to be ",".

From-SVN: r247139

7 files changed, 214 insertions, 40 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a9ded59..e06d758 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,31 @@
+2017-04-25  Bob Duff  <duff@adacore.com>
+
+	* s-osinte-linux.ads (pthread_mutexattr_setprotocol,
+	pthread_mutexattr_setprioceiling): Add new interfaces for these
+	pthread operations.
+	* s-taprop-linux.adb (Initialize_Lock, Initialize_TCB): Set
+	protocols as appropriate for Locking_Policy 'C' and 'I'.
+	* s-taprop-posix.adb: Minor reformatting to make it more similar
+	to s-taprop-linux.adb.
+
+2017-04-25  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Get_Discriminant_Value, Search_Derivation_Levels):
+	Handle properly a multi- level derivation involving both renamed
+	and constrained parent discriminants, when the type to be
+	constrained has fewer discriminants that the ultimate ancestor.
+
+2017-04-25  Bob Duff  <duff@adacore.com>
+
+	* sem_util.adb (Is_Object_Reference): In the
+	case of N_Explicit_Dereference, return False if it came from a
+	conditional expression.
+
+2017-04-25  Bob Duff  <duff@adacore.com>
+
+	* par-ch4.adb (P_Case_Expression): If a semicolon
+	is followed by "when", assume that ";" was meant to be ",".
+
 2017-04-25  Gary Dismukes  <dismukes@adacore.com>
 
 	* sem_ch9.adb, sem_ch10.adb, sem_util.adb: Minor reformatting and typo
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index e9a3a23..4e6c8a7 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -3199,6 +3199,20 @@ package body Ch4 is
          if Token = Tok_When then
             T_Comma;
 
+         --  A semicolon followed by "when" is probably meant to be a comma
+
+         elsif Token = Tok_Semicolon then
+            Save_Scan_State (Save_State);
+            Scan; -- past the semicolon
+
+            if Token /= Tok_When then
+               Restore_Scan_State (Save_State);
+               exit;
+            end if;
+
+            Error_Msg_SP -- CODEFIX
+              ("|"";"" should be "",""");
+
          --  If comma/WHEN, skip comma and we have another alternative
 
          elsif Token = Tok_Comma then
diff --git a/gcc/ada/s-osinte-linux.ads b/gcc/ada/s-osinte-linux.ads
index b0ba229..fa1e060 100644
--- a/gcc/ada/s-osinte-linux.ads
+++ b/gcc/ada/s-osinte-linux.ads
@@ -452,6 +452,20 @@ package System.OS_Interface is
    -- POSIX.1c  Section 13 --
    --------------------------
 
+   PTHREAD_PRIO_NONE    : constant := 0;
+   PTHREAD_PRIO_INHERIT : constant := 1;
+   PTHREAD_PRIO_PROTECT : constant := 2;
+
+   function pthread_mutexattr_setprotocol
+     (attr     : access pthread_mutexattr_t;
+      protocol : int) return int;
+   pragma Import (C, pthread_mutexattr_setprotocol);
+
+   function pthread_mutexattr_setprioceiling
+     (attr        : access pthread_mutexattr_t;
+      prioceiling : int) return int;
+   pragma Import (C, pthread_mutexattr_setprioceiling);
+
    type struct_sched_param is record
       sched_priority : int;  --  scheduling priority
    end record;
diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb
index ad603d8..00cf9ce 100644
--- a/gcc/ada/s-taprop-linux.adb
+++ b/gcc/ada/s-taprop-linux.adb
@@ -111,6 +111,14 @@ 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 --
    --------------------
@@ -161,6 +169,11 @@ 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");
+
    -------------------
    -- Abort_Handler --
    -------------------
@@ -261,8 +274,6 @@ package body System.Task_Primitives.Operations is
      (Prio : System.Any_Priority;
       L    : not null access Lock)
    is
-      pragma Unreferenced (Prio);
-
    begin
       if Locking_Policy = 'R' then
          declare
@@ -291,36 +302,91 @@ package body System.Task_Primitives.Operations is
 
       else
          declare
+            Attributes : aliased pthread_mutexattr_t;
             Result : Interfaces.C.int;
 
          begin
-            Result := pthread_mutex_init (L.WO'Access, null);
+            Result := pthread_mutexattr_init (Attributes'Access);
+            pragma Assert (Result = 0 or else Result = ENOMEM);
 
+            if Result = ENOMEM then
+               raise Storage_Error;
+            end if;
+
+            if Locking_Policy = 'C' then
+               if Superuser then
+                  Result := pthread_mutexattr_setprotocol
+                    (Attributes'Access, PTHREAD_PRIO_PROTECT);
+                  pragma Assert (Result = 0);
+
+                  Result := pthread_mutexattr_setprioceiling
+                     (Attributes'Access, Interfaces.C.int (Prio));
+                  pragma Assert (Result = 0);
+               end if;
+
+            elsif Locking_Policy = 'I' then
+               Result := pthread_mutexattr_setprotocol
+                 (Attributes'Access, PTHREAD_PRIO_INHERIT);
+               pragma Assert (Result = 0);
+            end if;
+
+            Result := pthread_mutex_init (L.WO'Access, Attributes'Access);
             pragma Assert (Result = 0 or else Result = ENOMEM);
 
             if Result = ENOMEM then
+               Result := pthread_mutexattr_destroy (Attributes'Access);
                raise Storage_Error with "Failed to allocate a lock";
             end if;
+
+            Result := pthread_mutexattr_destroy (Attributes'Access);
+            pragma Assert (Result = 0);
          end;
       end if;
    end Initialize_Lock;
 
    procedure Initialize_Lock
-     (L     : not null access RTS_Lock;
-      Level : Lock_Level)
+     (L : not null access RTS_Lock; Level : Lock_Level)
    is
       pragma Unreferenced (Level);
 
-      Result : Interfaces.C.int;
+      Attributes : aliased pthread_mutexattr_t;
+      Result     : Interfaces.C.int;
 
    begin
-      Result := pthread_mutex_init (L, null);
+      Result := pthread_mutexattr_init (Attributes'Access);
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result = ENOMEM then
+         raise Storage_Error;
+      end if;
+
+      if Locking_Policy = 'C' then
+         if Superuser then
+            Result := pthread_mutexattr_setprotocol
+              (Attributes'Access, PTHREAD_PRIO_PROTECT);
+            pragma Assert (Result = 0);
+
+            Result := pthread_mutexattr_setprioceiling
+              (Attributes'Access, Interfaces.C.int (System.Any_Priority'Last));
+            pragma Assert (Result = 0);
+         end if;
+
+      elsif Locking_Policy = 'I' then
+         Result := pthread_mutexattr_setprotocol
+           (Attributes'Access, PTHREAD_PRIO_INHERIT);
+         pragma Assert (Result = 0);
+      end if;
 
+      Result := pthread_mutex_init (L, Attributes'Access);
       pragma Assert (Result = 0 or else Result = ENOMEM);
 
       if Result = ENOMEM then
+         Result := pthread_mutexattr_destroy (Attributes'Access);
          raise Storage_Error;
       end if;
+
+      Result := pthread_mutexattr_destroy (Attributes'Access);
+      pragma Assert (Result = 0);
    end Initialize_Lock;
 
    -------------------
@@ -361,11 +427,10 @@ package body System.Task_Primitives.Operations is
          Result := pthread_mutex_lock (L.WO'Access);
       end if;
 
-      Ceiling_Violation := Result = EINVAL;
-
-      --  Assume the cause of EINVAL is a priority ceiling violation
+      --  The cause of EINVAL is a priority ceiling violation
 
-      pragma Assert (Result = 0 or else Result = EINVAL);
+      Ceiling_Violation := Result = EINVAL;
+      pragma Assert (Result = 0 or else Ceiling_Violation);
    end Write_Lock;
 
    procedure Write_Lock
@@ -405,11 +470,10 @@ package body System.Task_Primitives.Operations is
          Result := pthread_mutex_lock (L.WO'Access);
       end if;
 
-      Ceiling_Violation := Result = EINVAL;
+      --  The cause of EINVAL is a priority ceiling violation
 
-      --  Assume the cause of EINVAL is a priority ceiling violation
-
-      pragma Assert (Result = 0 or else Result = EINVAL);
+      Ceiling_Violation := Result = EINVAL;
+      pragma Assert (Result = 0 or else Ceiling_Violation);
    end Read_Lock;
 
    ------------
@@ -855,8 +919,9 @@ package body System.Task_Primitives.Operations is
    --------------------
 
    procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is
-      Cond_Attr : aliased pthread_condattr_t;
+      Mutex_Attr : aliased pthread_mutexattr_t;
       Result    : Interfaces.C.int;
+      Cond_Attr : aliased pthread_condattr_t;
 
    begin
       --  Give the task a unique serial number
@@ -868,24 +933,63 @@ package body System.Task_Primitives.Operations is
       Self_ID.Common.LL.Thread := Null_Thread_Id;
 
       if not Single_Lock then
-         Result :=
-           pthread_mutex_init (Self_ID.Common.LL.L'Access, null);
+         Result := pthread_mutexattr_init (Mutex_Attr'Access);
          pragma Assert (Result = 0 or else Result = ENOMEM);
 
+         if Result = 0 then
+            if Locking_Policy = 'C' then
+               if Superuser 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 (System.Any_Priority'Last));
+                  pragma Assert (Result = 0);
+               end if;
+
+            elsif Locking_Policy = 'I' then
+               Result :=
+                 pthread_mutexattr_setprotocol
+                   (Mutex_Attr'Access,
+                    PTHREAD_PRIO_INHERIT);
+               pragma Assert (Result = 0);
+            end if;
+
+            Result :=
+              pthread_mutex_init
+                (Self_ID.Common.LL.L'Access,
+                 Mutex_Attr'Access);
+            pragma Assert (Result = 0 or else Result = ENOMEM);
+         end if;
+
          if Result /= 0 then
             Succeeded := False;
             return;
          end if;
+
+         Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+         pragma Assert (Result = 0);
       end if;
 
       Result := pthread_condattr_init (Cond_Attr'Access);
-      pragma Assert (Result = 0);
-
-      Result :=
-        pthread_cond_init (Self_ID.Common.LL.CV'Access, Cond_Attr'Access);
       pragma Assert (Result = 0 or else Result = ENOMEM);
 
       if Result = 0 then
+         Result := GNAT_pthread_condattr_setup (Cond_Attr'Access);
+         pragma Assert (Result = 0);
+
+         Result :=
+           pthread_cond_init
+             (Self_ID.Common.LL.CV'Access, Cond_Attr'Access);
+         pragma Assert (Result = 0 or else Result = ENOMEM);
+      end if;
+
+      if Result = 0 then
          Succeeded := True;
       else
          if not Single_Lock then
@@ -895,6 +999,9 @@ package body System.Task_Primitives.Operations is
 
          Succeeded := False;
       end if;
+
+      Result := pthread_condattr_destroy (Cond_Attr'Access);
+      pragma Assert (Result = 0);
    end Initialize_TCB;
 
    -----------------
@@ -1042,12 +1149,11 @@ package body System.Task_Primitives.Operations is
       --  safe to do this, since we know we have no problems with aliasing and
       --  Unrestricted_Access bypasses this check.
 
-      Result :=
-        pthread_create
-          (T.Common.LL.Thread'Unrestricted_Access,
-           Attributes'Access,
-           Thread_Body_Access (Wrapper),
-           To_Address (T));
+      Result := pthread_create
+        (T.Common.LL.Thread'Unrestricted_Access,
+         Attributes'Access,
+         Thread_Body_Access (Wrapper),
+         To_Address (T));
 
       pragma Assert
         (Result = 0 or else Result = EAGAIN or else Result = ENOMEM);
diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb
index 5ed7bad..fc647aa 100644
--- a/gcc/ada/s-taprop-posix.adb
+++ b/gcc/ada/s-taprop-posix.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -352,12 +352,11 @@ package body System.Task_Primitives.Operations is
    -- Initialize_Lock --
    ---------------------
 
-   --  Note: mutexes and cond_variables needed per-task basis are
-   --        initialized in Initialize_TCB and the Storage_Error is
-   --        handled. Other mutexes (such as RTS_Lock, Memory_Lock...)
-   --        used in RTS is initialized before any status change of RTS.
-   --        Therefore raising Storage_Error in the following routines
-   --        should be able to be handled safely.
+   --  Note: mutexes and cond_variables needed per-task basis are initialized
+   --  in Initialize_TCB and the Storage_Error is handled. Other mutexes (such
+   --  as RTS_Lock, Memory_Lock...) used in RTS is initialized before any
+   --  status change of RTS. Therefore raising Storage_Error in the following
+   --  routines should be able to be handled safely.
 
    procedure Initialize_Lock
      (Prio : System.Any_Priority;
@@ -474,10 +473,10 @@ package body System.Task_Primitives.Operations is
    begin
       Result := pthread_mutex_lock (L.WO'Access);
 
-      --  Assume that the cause of EINVAL is a priority ceiling violation
+      --  The cause of EINVAL is a priority ceiling violation
 
-      Ceiling_Violation := (Result = EINVAL);
-      pragma Assert (Result = 0 or else Result = EINVAL);
+      Ceiling_Violation := Result = EINVAL;
+      pragma Assert (Result = 0 or else Ceiling_Violation);
    end Write_Lock;
 
    procedure Write_Lock
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 7c3f7e6..0c3b08e 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -17660,7 +17660,12 @@ package body Sem_Ch3 is
          end if;
 
          while Present (Disc) loop
-            pragma Assert (Present (Assoc));
+            --  If no further associations return the discriminant, value
+            --  will be found on the second pass.
+
+            if No (Assoc) then
+               return Result;
+            end if;
 
             if Original_Record_Component (Disc) = Result_Entity then
                return Node (Assoc);
@@ -17690,6 +17695,8 @@ package body Sem_Ch3 is
       --  ??? This routine is a gigantic mess and will be deleted. For the
       --  time being just test for the trivial case before calling recurse.
 
+      --  We are now celebrating the 20th anniversary of this comment!
+
       if Base_Type (Scope (Discriminant)) = Base_Type (Typ_For_Constraint) then
          declare
             D : Entity_Id;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 0a09b16..f069055 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -13548,8 +13548,14 @@ package body Sem_Util is
                      (Is_Object_Reference (Prefix (N))
                        or else Is_Access_Type (Etype (Prefix (N))));
 
+            --  An explicit dereference denotes an object, except that a
+            --  conditional expression gets turned into an explicit dereference
+            --  in some cases, and conditional expressions are not object
+            --  names.
+
             when N_Explicit_Dereference =>
-               return True;
+               return not Nkind_In
+                 (Original_Node (N), N_If_Expression, N_Case_Expression);
 
             --  A view conversion of a tagged object is an object reference