[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

1 files changed, 40 insertions, 22 deletions

diff --git a/gcc/ada/s-tpobop.adb b/gcc/ada/s-tpobop.adb
index e242bb0..a6f6c99 100644
--- a/gcc/ada/s-tpobop.adb
+++ b/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.Find_Body_Index (Object.Compiler_Info, E)).
-            Barrier (Object.Compiler_Info, E);
+        Object.Entry_Bodies (Index).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.Find_Body_Index (Object.Compiler_Info, E)).Action (
+         Object.Entry_Bodies (Index).Action (
              Object.Compiler_Info, Entry_Call.Uninterpreted_Data, E);
 
          if Object.Call_In_Progress /= null then
@@ -346,29 +345,48 @@ 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) <=
-                      Queuing.Count_Waiting (Object.Entry_Queues (E))
+           or else Object.Entry_Queue_Maxes /= null
          then
-            --  This violates the Max_Entry_Queue_Length restriction, raise
-            --  Program_Error.
+            --  Need to check the queue length. Computing the length is an
+            --  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;
+               Entry_Call.Exception_To_Raise := Program_Error'Identity;
 
-            if Single_Lock then
-               STPO.Lock_RTS;
-            end if;
+               if Single_Lock then
+                  STPO.Lock_RTS;
+               end if;
 
-            STPO.Write_Lock (Entry_Call.Self);
-            Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Done);
-            STPO.Unlock (Entry_Call.Self);
+               STPO.Write_Lock (Entry_Call.Self);
+               Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Done);
+               STPO.Unlock (Entry_Call.Self);
 
-            if Single_Lock then
-               STPO.Unlock_RTS;
+               if Single_Lock then
+                  STPO.Unlock_RTS;
+               end if;
+
+               return;
             end if;
-         else
-            Queuing.Enqueue (Object.Entry_Queues (E), Entry_Call);
-            Update_For_Queue_To_PO (Entry_Call, Entry_Call.With_Abort);
          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);
+
+         return;
       else
          --  Conditional_Call and With_Abort