[multiple changes]

2016-06-22  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Is_Predicate_Static): An inherited predicate
	can be static only if it applies to a scalar type.

2016-06-22  Ed Schonberg  <schonberg@adacore.com>

	* exp_util.adb (Adjust_Result_Type): Convert operand to base
	type to prevent spurious constraint checks on subtypes of Boolean.

2016-06-22  Bob Duff  <duff@adacore.com>

	* debug.adb: Document debug switch -gnatd.o.
	* sem_elab.adb (Check_Internal_Call): Debug switch -gnatd.o
	now causes a more conservative treatment of indirect calls,
	treating P'Access as a call to P in more cases. We Can't make
	this the default, because it breaks common idioms, for example
	the soft links.
	* sem_util.adb: Add an Assert.

2016-06-22  Bob Duff  <duff@adacore.com>

	* a-cuprqu.ads, a-cuprqu.adb: Completely rewrite this package. Use
	red-black trees, which gives O(lg N) worst-case performance on
	Enqueue and Dequeue. The previous version had O(N) Enqueue in
	the worst case.

2016-06-22  Arnaud Charlet  <charlet@adacore.com>

	* sem_warn.adb: minor style fix in comment.
	* spark_xrefs.ads (Scope_Num): type refined to positive integers.
	* lib-xref-spark_specific.adb (Detect_And_Add_SPARK_Scope):
	moved into scope of Collect_SPARK_Xrefs.
	(Add_SPARK_Scope): moved into scope of Collect_SPARK_Xrefs;
	now uses Dspec and Scope_Id from Collect_SPARK_Xrefs.
	(Collect_SPARK_Xrefs): refactored to avoid retraversing the list
	of scopes.
	* sem_ch3.adb (Build_Discriminal): Set Parent of the discriminal.

From-SVN: r237687

gcc/ada/ChangeLog

+2016-06-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Is_Predicate_Static): An inherited predicate
+	can be static only if it applies to a scalar type.
+
+2016-06-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_util.adb (Adjust_Result_Type): Convert operand to base
+	type to prevent spurious constraint checks on subtypes of Boolean.
+
+2016-06-22  Bob Duff  <duff@adacore.com>
+
+	* debug.adb: Document debug switch -gnatd.o.
+	* sem_elab.adb (Check_Internal_Call): Debug switch -gnatd.o
+	now causes a more conservative treatment of indirect calls,
+	treating P'Access as a call to P in more cases. We Can't make
+	this the default, because it breaks common idioms, for example
+	the soft links.
+	* sem_util.adb: Add an Assert.
+
+2016-06-22  Bob Duff  <duff@adacore.com>
+
+	* a-cuprqu.ads, a-cuprqu.adb: Completely rewrite this package. Use
+	red-black trees, which gives O(lg N) worst-case performance on
+	Enqueue and Dequeue. The previous version had O(N) Enqueue in
+	the worst case.
+
+2016-06-22  Arnaud Charlet  <charlet@adacore.com>
+
+	* sem_warn.adb: minor style fix in comment.
+	* spark_xrefs.ads (Scope_Num): type refined to positive integers.
+	* lib-xref-spark_specific.adb (Detect_And_Add_SPARK_Scope):
+	moved into scope of Collect_SPARK_Xrefs.
+	(Add_SPARK_Scope): moved into scope of Collect_SPARK_Xrefs;
+	now uses Dspec and Scope_Id from Collect_SPARK_Xrefs.
+	(Collect_SPARK_Xrefs): refactored to avoid retraversing the list
+	of scopes.
+	* sem_ch3.adb (Build_Discriminal): Set Parent of the discriminal.
+
 2016-06-22  Arnaud Charlet  <charlet@adacore.com>
 
 	* lib-xref-spark_specific.adb (Generate_Dereference): Assignment to not

gcc/ada/a-cuprqu.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2011-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2011-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -32,8 +32,8 @@
 ------------------------------------------------------------------------------
 
 with System;
+with Ada.Containers.Ordered_Sets;
 with Ada.Containers.Synchronized_Queue_Interfaces;
-with Ada.Finalization;
 
 generic
    with package Queue_Interfaces is
@@ -59,63 +59,44 @@ package Ada.Containers.Unbounded_Priority_Queues is
 
       pragma Implementation_Defined;
 
-      type List_Type is tagged limited private;
-
-      procedure Enqueue
-        (List     : in out List_Type;
-         New_Item : Queue_Interfaces.Element_Type);
-
-      procedure Dequeue
-        (List    : in out List_Type;
-         Element : out Queue_Interfaces.Element_Type);
-
-      procedure Dequeue
-        (List     : in out List_Type;
-         At_Least : Queue_Priority;
-         Element  : in out Queue_Interfaces.Element_Type;
-         Success  : out Boolean);
-
-      function Length (List : List_Type) return Count_Type;
+      --  We use an ordered set to hold the queue elements. This gives O(lg N)
+      --  performance in the worst case for Enqueue and Dequeue.
+      --  Sequence_Number is used to distinguish equivalent items. Each Enqueue
+      --  uses a higher Sequence_Number, so that a new item is placed after
+      --  already-enqueued equivalent items.
+      --
+      --  At any time, the first set element is the one to be dequeued next (if
+      --  the queue is not empty).
 
-      function Max_Length (List : List_Type) return Count_Type;
+      type Set_Elem is record
+         Sequence_Number : Count_Type;
+         Item : Queue_Interfaces.Element_Type;
+      end record;
 
-   private
+      function "=" (X, Y : Queue_Interfaces.Element_Type) return Boolean is
+         (not Before (Get_Priority (X), Get_Priority (Y))
+            and then not Before (Get_Priority (Y), Get_Priority (X)));
+      --  Elements are equal if neither is Before the other
 
-      --  List_Type is implemented as a circular doubly-linked list with a
-      --  dummy header node; Prev and Next are the links. The list is in
-      --  decreasing priority order, so the highest-priority item is always
-      --  first. (If there are multiple items with the highest priority, the
-      --  oldest one is first.) Header.Element is undefined and not used.
-      --
-      --  In addition, Next_Unequal points to the next item with a different
-      --  (i.e. strictly lower) priority. This is used to speed up the search
-      --  for the next lower-priority item, in cases where there are many items
-      --  with the same priority.
-      --
-      --  An empty list has Header.Prev, Header.Next, and Header.Next_Unequal
-      --  all pointing to Header. A nonempty list has Header.Next_Unequal
-      --  pointing to the first "real" item, and the last item has Next_Unequal
-      --  pointing back to Header.
-
-      type Node_Type;
-      type Node_Access is access all Node_Type;
-
-      type Node_Type is limited record
-         Element      : Queue_Interfaces.Element_Type;
-         Prev, Next   : Node_Access := Node_Type'Unchecked_Access;
-         Next_Unequal : Node_Access := Node_Type'Unchecked_Access;
-      end record;
+      function "=" (X, Y : Set_Elem) return Boolean is
+         (X.Sequence_Number = Y.Sequence_Number and then X.Item = Y.Item);
+      --  Set_Elems are equal if the elements are equal, and the
+      --  Sequence_Numbers are equal. This is passed to Ordered_Sets.
 
-      type List_Type is new Ada.Finalization.Limited_Controlled with record
-         Header     : aliased Node_Type;
-         Length     : Count_Type := 0;
-         Max_Length : Count_Type := 0;
-      end record;
+      function "<" (X, Y : Set_Elem) return Boolean is
+         (if X.Item = Y.Item
+            then X.Sequence_Number < Y.Sequence_Number
+            else Before (Get_Priority (X.Item), Get_Priority (Y.Item)));
+      --  If the items are equal, Sequence_Number breaks the tie. Otherwise,
+      --  use Before. This is passed to Ordered_Sets.
 
-      overriding procedure Finalize (List : in out List_Type);
+      pragma Suppress (Container_Checks);
+      package Sets is new Ada.Containers.Ordered_Sets (Set_Elem);
 
    end Implementation;
 
+   use Implementation, Implementation.Sets;
+
    protected type Queue (Ceiling : System.Any_Priority := Default_Ceiling)
    with
      Priority => Ceiling
@@ -142,7 +123,15 @@ package Ada.Containers.Unbounded_Priority_Queues is
       overriding function Peak_Use return Count_Type;
 
    private
-      List : Implementation.List_Type;
+      Q_Elems              : Set;
+      --  Elements of the queue
+
+      Max_Length           : Count_Type := 0;
+      --  The current length of the queue is the Length of Q_Elems. This is the
+      --  maximum value of that, so far. Updated by Enqueue.
+
+      Next_Sequence_Number : Count_Type := 0;
+      --  Steadily increasing counter
    end Queue;
 
 end Ada.Containers.Unbounded_Priority_Queues;

gcc/ada/debug.adb

@@ -105,7 +105,7 @@ package body Debug is
    --  d.l  Use Ada 95 semantics for limited function returns
    --  d.m  For -gnatl, print full source only for main unit
    --  d.n  Print source file names
-   --  d.o
+   --  d.o  Conservative elaboration order for indirect calls
    --  d.p
    --  d.q
    --  d.r  Enable OK_To_Reorder_Components in non-variant records
@@ -556,6 +556,9 @@ package body Debug is
    --       compiler has a bug -- these are the files that need to be included
    --       in a bug report.
 
+   --  d.o  Conservative elaboration order for indirect calls. This causes
+   --       P'Access to be treated as a call in more cases.
+
    --  d.r  Forces the flag OK_To_Reorder_Components to be set in all record
    --       base types that have no discriminants.
 

gcc/ada/exp_util.adb

@@ -355,12 +355,15 @@ package body Exp_Util is
                return;
 
             --  Otherwise we perform a conversion from the current type, which
-            --  must be Standard.Boolean, to the desired type.
+            --  must be Standard.Boolean, to the desired type. Use the base
+            --  type to prevent spurious constraint checks that are extraneous
+            --  to the transformation. The type and its base have the same
+            --  representation, standard or otherwise.
 
             else
                Set_Analyzed (N);
-               Rewrite (N, Convert_To (T, N));
-               Analyze_And_Resolve (N, T);
+               Rewrite (N, Convert_To (Base_Type (T), N));
+               Analyze_And_Resolve (N, Base_Type (T));
             end if;
          end;
       end if;

gcc/ada/sem_ch13.adb

@@ -8552,8 +8552,7 @@ package body Sem_Ch13 is
                         Expression => Expr))));
 
             --  If declaration has not been analyzed yet, Insert declaration
-            --  before freeze node.
-            --  Insert body after freeze node.
+            --  before freeze node.  Insert body itself after freeze node.
 
             if not Analyzed (FDecl) then
                Insert_Before_And_Analyze (N, FDecl);
@@ -11644,9 +11643,11 @@ package body Sem_Ch13 is
       --  to specify a static predicate for a subtype which is inheriting a
       --  dynamic predicate, so the static predicate validation here ignores
       --  the inherited predicate even if it is dynamic.
+      --  In all cases, a static predicate can only apply to a scalar type.
 
       elsif Nkind (Expr) = N_Function_Call
         and then Is_Predicate_Function (Entity (Name (Expr)))
+        and then Is_Scalar_Type (Etype (First_Entity (Entity (Name (Expr)))))
       then
          return True;
 

gcc/ada/sem_ch3.adb

@@ -9182,6 +9182,7 @@ package body Sem_Ch3 is
       Set_Mechanism (D_Minal, Default_Mechanism);
       Set_Etype     (D_Minal, Etype (Discrim));
       Set_Scope     (D_Minal, Current_Scope);
+      Set_Parent    (D_Minal, Parent (Discrim));
 
       Set_Discriminal (Discrim, D_Minal);
       Set_Discriminal_Link (D_Minal, Discrim);

gcc/ada/sem_elab.adb

@@ -2139,7 +2139,8 @@ package body Sem_Elab is
       --  node comes from source.
 
       if Nkind (N) = N_Attribute_Reference
-        and then (not Warn_On_Elab_Access or else not Comes_From_Source (N))
+        and then ((not Warn_On_Elab_Access and then not Debug_Flag_Dot_O)
+                    or else not Comes_From_Source (N))
       then
          return;
 

gcc/ada/sem_util.adb

@@ -6314,6 +6314,7 @@ package body Sem_Util is
          Encl_Unit := Library_Unit (Encl_Unit);
       end loop;
 
+      pragma Assert (Nkind (Encl_Unit) = N_Compilation_Unit);
       return Encl_Unit;
    end Enclosing_Lib_Unit_Node;
 

gcc/ada/sem_warn.adb

@@ -3367,7 +3367,7 @@ package body Sem_Warn is
          P := Parent (C);
          loop
             --  If tree is not attached, do not issue warning (this is very
-            --  peculiar, and probably arises from some other error condition)
+            --  peculiar, and probably arises from some other error condition).
 
             if No (P) then
                return;