[multiple changes]

2017-01-06  Ed Schonberg  <schonberg@adacore.com>

	* checks.adb (Ensure_Valid): Do not generate a validity check
	within a generated predicate function, validity checks will have
	been applied earlier when required.

2017-01-06  Tristan Gingold  <gingold@adacore.com>

	* s-tpoben.ads (Protection_Entries): Add comment and reorder
	components for performances.
	* s-tpobop.adb (PO_Do_Or_Queue): Implement Max_Queue_Length runtime
	semantic.

From-SVN: r244136

gcc/ada/ChangeLog

@@ -1,3 +1,16 @@
+2017-01-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* checks.adb (Ensure_Valid): Do not generate a validity check
+	within a generated predicate function, validity checks will have
+	been applied earlier when required.
+
+2017-01-06  Tristan Gingold  <gingold@adacore.com>
+
+	* s-tpoben.ads (Protection_Entries): Add comment and reorder
+	components for performances.
+	* s-tpobop.adb (PO_Do_Or_Queue): Implement Max_Queue_Length runtime
+	semantic.
+
 2017-01-06  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_eval.adb (Check_Expression_Against_Static_Predicate):

gcc/ada/checks.adb

@@ -5709,6 +5709,14 @@ package body Checks is
       elsif Expr_Known_Valid (Expr) then
          return;
 
+      --  No check needed within a generated predicate function. Validity
+      --  of input value will have been checked earlier.
+
+      elsif Ekind (Current_Scope) = E_Function
+        and then Is_Predicate_Function (Current_Scope)
+      then
+         return;
+
       --  Ignore case of enumeration with holes where the flag is set not to
       --  worry about holes, since no special validity check is needed
 

gcc/ada/s-tpoben.ads

@@ -148,8 +148,6 @@ package System.Tasking.Protected_Objects.Entries is
       --  A function which maps the entry index in a call (which denotes the
       --  queue of the proper entry) into the body of the entry.
 
-      Entry_Queues : Protected_Entry_Queue_Array (1 .. Num_Entries);
-
       Entry_Queue_Maxes : Protected_Entry_Queue_Max_Access;
       --  Access to an array of naturals representing the max value for each
       --  entry's queue length. A value of 0 signifies no max.
@@ -158,6 +156,9 @@ package System.Tasking.Protected_Objects.Entries is
       --  An array of string names which denotes entry [family member] names.
       --  The structure is indexed by protected entry index and contains Num_
       --  Entries components.
+
+      Entry_Queues : Protected_Entry_Queue_Array (1 .. Num_Entries);
+      --  Action and barrier subprograms for the protected type.
    end record;
 
    --  No default initial values for this type, since call records will need to

gcc/ada/s-tpobop.adb

@@ -292,17 +292,17 @@ package body System.Tasking.Protected_Objects.Operations is
    is
       E             : constant Protected_Entry_Index :=
                         Protected_Entry_Index (Entry_Call.E);
+      Index         : constant Protected_Entry_Index :=
+                        Object.Find_Body_Index (Object.Compiler_Info, E);
       Barrier_Value : Boolean;
-
+      Queue_Length  : Natural;
    begin
       --  When the Action procedure for an entry body returns, it is either
       --  completed (having called [Exceptional_]Complete_Entry_Body) or it
       --  is queued, having executed a requeue statement.
 
       Barrier_Value :=
-        Object.Entry_Bodies (
+        Object.Entry_Bodies (Index).Barrier (Object.Compiler_Info, E);
-          Object.Find_Body_Index (Object.Compiler_Info, E)).
-            Barrier (Object.Compiler_Info, E);
 
       if Barrier_Value then
 
@@ -316,8 +316,7 @@ package body System.Tasking.Protected_Objects.Operations is
 
          pragma Debug
           (Debug.Trace (Self_ID, "PODOQ: start entry body", 'P'));
-         Object.Entry_Bodies (
+         Object.Entry_Bodies (Index).Action (
-           Object.Find_Body_Index (Object.Compiler_Info, E)).Action (
              Object.Compiler_Info, Entry_Call.Uninterpreted_Data, E);
 
          if Object.Call_In_Progress /= null then
@@ -346,11 +345,23 @@ package body System.Tasking.Protected_Objects.Operations is
         or else not Entry_Call.With_Abort
       then
          if Run_Time_Restrictions.Set (Max_Entry_Queue_Length)
-           and then Run_Time_Restrictions.Value (Max_Entry_Queue_Length) <=
+           or else Object.Entry_Queue_Maxes /= null
-                      Queuing.Count_Waiting (Object.Entry_Queues (E))
          then
-            --  This violates the Max_Entry_Queue_Length restriction, raise
+            --  Need to check the queue length. Computing the length is an
-            --  Program_Error.
+            --  unusual case and is slow (need to walk the queue)
+
+            Queue_Length := Queuing.Count_Waiting (Object.Entry_Queues (E));
+
+            if (Run_Time_Restrictions.Set (Max_Entry_Queue_Length)
+                and then Queue_Length >=
+                   Run_Time_Restrictions.Value (Max_Entry_Queue_Length))
+              or else
+              (Object.Entry_Queue_Maxes /= null
+                 and then Object.Entry_Queue_Maxes (Index) /= 0
+                 and then Queue_Length >= Object.Entry_Queue_Maxes (Index))
+            then
+               --  This violates the Max_Entry_Queue_Length restriction or the
+               --  Max_Queue_Length bound, raise Program_Error.
 
                Entry_Call.Exception_To_Raise := Program_Error'Identity;
 
@@ -365,10 +376,17 @@ package body System.Tasking.Protected_Objects.Operations is
                if Single_Lock then
                   STPO.Unlock_RTS;
                end if;
-         else
+
+               return;
+            end if;
+         end if;
+
+         --  Do the work: queue the call
+
          Queuing.Enqueue (Object.Entry_Queues (E), Entry_Call);
          Update_For_Queue_To_PO (Entry_Call, Entry_Call.With_Abort);
-         end if;
+
+         return;
       else
          --  Conditional_Call and With_Abort