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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@237687 138bc75d-0d04-0410-961f-82ee72b054a4

10 files changed, 128 insertions, 284 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index dd2f6796335..0302b488863 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,42 @@
+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
diff --git a/gcc/ada/a-cuprqu.adb b/gcc/ada/a-cuprqu.adb
index 5fb74cc098f..5d1bbacfc63 100644
--- a/gcc/ada/a-cuprqu.adb
+++ b/gcc/ada/a-cuprqu.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---            Copyright (C) 2011-2015, Free Software Foundation, Inc.       --
+--            Copyright (C) 2011-2016, Free Software Foundation, Inc.       --
 --                                                                          --
 -- GNAT 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- --
@@ -27,225 +27,8 @@
 -- This unit was originally developed by Matthew J Heaney.                  --
 ------------------------------------------------------------------------------
 
-with Ada.Unchecked_Deallocation;
-
 package body Ada.Containers.Unbounded_Priority_Queues is
 
-   package body Implementation is
-
-      -----------------------
-      -- Local Subprograms --
-      -----------------------
-
-      function Before_Or_Equal (X, Y : Queue_Priority) return Boolean;
-      --  True if X is before or equal to Y. Equal means both Before(X,Y) and
-      --  Before(Y,X) are False.
-
-      procedure Free is
-        new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
-
-      ---------------------
-      -- Before_Or_Equal --
-      ---------------------
-
-      function Before_Or_Equal (X, Y : Queue_Priority) return Boolean is
-      begin
-         return (if Before (X, Y) then True else not Before (Y, X));
-      end Before_Or_Equal;
-
-      -------------
-      -- Dequeue --
-      -------------
-
-      procedure Dequeue
-        (List    : in out List_Type;
-         Element : out Queue_Interfaces.Element_Type)
-      is
-         H : constant Node_Access := List.Header'Unchecked_Access;
-         pragma Assert (List.Length /= 0);
-         pragma Assert (List.Header.Next /= H);
-         --  List can't be empty; see the barrier
-
-         pragma Assert
-           (List.Header.Next.Next = H or else
-            Before_Or_Equal (Get_Priority (List.Header.Next.Element),
-                             Get_Priority (List.Header.Next.Next.Element)));
-         --  The first item is before-or-equal to the second
-
-         pragma Assert
-           (List.Header.Next.Next_Unequal = H or else
-            Before (Get_Priority (List.Header.Next.Element),
-                    Get_Priority (List.Header.Next.Next_Unequal.Element)));
-         --  The first item is before its Next_Unequal item
-
-         --  The highest-priority item is always first; just remove it and
-         --  return that element.
-
-         X : Node_Access := List.Header.Next;
-
-      --  Start of processing for Dequeue
-
-      begin
-         Element := X.Element;
-         X.Next.Prev := H;
-         List.Header.Next := X.Next;
-         List.Header.Next_Unequal := X.Next;
-         List.Length := List.Length - 1;
-         Free (X);
-      end Dequeue;
-
-      procedure Dequeue
-        (List     : in out List_Type;
-         At_Least : Queue_Priority;
-         Element  : in out Queue_Interfaces.Element_Type;
-         Success  : out Boolean)
-      is
-      begin
-         --  This operation dequeues a high priority item if it exists in the
-         --  queue. By "high priority" we mean an item whose priority is equal
-         --  or greater than the value At_Least. The generic formal operation
-         --  Before has the meaning "has higher priority than". To dequeue an
-         --  item (meaning that we return True as our Success value), we need
-         --  as our predicate the equivalent of "has equal or higher priority
-         --  than", but we cannot say that directly, so we require some logical
-         --  gymnastics to make it so.
-
-         --  If E is the element at the head of the queue, and symbol ">"
-         --  refers to the "is higher priority than" function Before, then we
-         --  derive our predicate as follows:
-         --    original: P(E) >= At_Least
-         --    same as:  not (P(E) < At_Least)
-         --    same as:  not (At_Least > P(E))
-         --    same as:  not Before (At_Least, P(E))
-
-         --  But that predicate needs to be true in order to successfully
-         --  dequeue an item. If it's false, it means no item is dequeued, and
-         --  we return False as the Success value.
-
-         Success := List.Length > 0
-           and then
-             not Before (At_Least, Get_Priority (List.Header.Next.Element));
-
-         if Success then
-            List.Dequeue (Element);
-         end if;
-      end Dequeue;
-
-      -------------
-      -- Enqueue --
-      -------------
-
-      procedure Enqueue
-        (List     : in out List_Type;
-         New_Item : Queue_Interfaces.Element_Type)
-      is
-         P : constant Queue_Priority := Get_Priority (New_Item);
-         H : constant Node_Access := List.Header'Unchecked_Access;
-
-         function Next return Node_Access;
-         --  The node before which we wish to insert the new node
-
-         ----------
-         -- Next --
-         ----------
-
-         function Next return Node_Access is
-         begin
-            return Result : Node_Access := H.Next_Unequal do
-               while Result /= H
-                 and then not Before (P, Get_Priority (Result.Element))
-               loop
-                  Result := Result.Next_Unequal;
-               end loop;
-            end return;
-         end Next;
-
-         --  Local varaibles
-
-         Prev : constant Node_Access := Next.Prev;
-         --  The node after which we wish to insert the new node. So Prev must
-         --  be the header, or be higher or equal priority to the new item.
-         --  Prev.Next must be the header, or be lower priority than the
-         --  new item.
-
-         pragma Assert
-           (Prev = H or else Before_Or_Equal (Get_Priority (Prev.Element), P));
-         pragma Assert
-           (Prev.Next = H
-              or else Before (P, Get_Priority (Prev.Next.Element)));
-         pragma Assert (Prev.Next = Prev.Next_Unequal);
-
-         Node : constant Node_Access :=
-                  new Node_Type'(New_Item,
-                                 Prev         => Prev,
-                                 Next         => Prev.Next,
-                                 Next_Unequal => Prev.Next);
-
-      --  Start of processing for Enqueue
-
-      begin
-         Prev.Next.Prev := Node;
-         Prev.Next := Node;
-
-         if Prev = H then
-
-            --  Make sure Next_Unequal of the Header always points to the first
-            --  "real" node. Here, we've inserted a new first "real" node, so
-            --  must update.
-
-            List.Header.Next_Unequal := Node;
-
-         elsif Before (Get_Priority (Prev.Element), P) then
-
-            --  If the new item inserted has a unique priority in queue (not
-            --  same priority as precedent), set Next_Unequal of precedent
-            --  element to the new element instead of old next element, since
-            --  Before (P, Get_Priority (Next.Element) or Next = H).
-
-            Prev.Next_Unequal := Node;
-         end if;
-
-         pragma Assert (List.Header.Next_Unequal = List.Header.Next);
-
-         List.Length := List.Length + 1;
-
-         if List.Length > List.Max_Length then
-            List.Max_Length := List.Length;
-         end if;
-      end Enqueue;
-
-      --------------
-      -- Finalize --
-      --------------
-
-      procedure Finalize (List : in out List_Type) is
-         Ignore : Queue_Interfaces.Element_Type;
-      begin
-         while List.Length > 0 loop
-            List.Dequeue (Ignore);
-         end loop;
-      end Finalize;
-
-      ------------
-      -- Length --
-      ------------
-
-      function Length (List : List_Type) return Count_Type is
-      begin
-         return List.Length;
-      end Length;
-
-      ----------------
-      -- Max_Length --
-      ----------------
-
-      function Max_Length (List : List_Type) return Count_Type is
-      begin
-         return List.Max_Length;
-      end Max_Length;
-
-   end Implementation;
-
    protected body Queue is
 
       -----------------
@@ -254,7 +37,7 @@ package body Ada.Containers.Unbounded_Priority_Queues is
 
       function Current_Use return Count_Type is
       begin
-         return List.Length;
+         return Q_Elems.Length;
       end Current_Use;
 
       -------------
@@ -262,10 +45,14 @@ package body Ada.Containers.Unbounded_Priority_Queues is
       -------------
 
       entry Dequeue (Element : out Queue_Interfaces.Element_Type)
-        when List.Length > 0
+        when Q_Elems.Length > 0
       is
+         --  Grab the first item of the set, and remove it from the set
+
+         C : constant Cursor := First (Q_Elems);
       begin
-         List.Dequeue (Element);
+         Element := Sets.Element (C).Item;
+         Delete_First (Q_Elems);
       end Dequeue;
 
       --------------------------------
@@ -277,8 +64,19 @@ package body Ada.Containers.Unbounded_Priority_Queues is
          Element  : in out Queue_Interfaces.Element_Type;
          Success  : out Boolean)
       is
+         --  Grab the first item. If it exists and has appropriate priority,
+         --  set Success to True, and remove that item. Otherwise, set Success
+         --  to False.
+
+         C : constant Cursor := First (Q_Elems);
       begin
-         List.Dequeue (At_Least, Element, Success);
+         Success := Has_Element (C) and then
+            not Before (At_Least, Get_Priority (Sets.Element (C).Item));
+
+         if Success then
+            Element := Sets.Element (C).Item;
+            Delete_First (Q_Elems);
+         end if;
       end Dequeue_Only_High_Priority;
 
       -------------
@@ -287,7 +85,15 @@ package body Ada.Containers.Unbounded_Priority_Queues is
 
       entry Enqueue (New_Item : Queue_Interfaces.Element_Type) when True is
       begin
-         List.Enqueue (New_Item);
+         Insert (Q_Elems, (Next_Sequence_Number, New_Item));
+         Next_Sequence_Number := Next_Sequence_Number + 1;
+
+         --  If we reached a new high-water mark, increase Max_Length
+
+         if Q_Elems.Length > Max_Length then
+            pragma Assert (Max_Length + 1 = Q_Elems.Length);
+            Max_Length := Q_Elems.Length;
+         end if;
       end Enqueue;
 
       --------------
@@ -296,7 +102,7 @@ package body Ada.Containers.Unbounded_Priority_Queues is
 
       function Peak_Use return Count_Type is
       begin
-         return List.Max_Length;
+         return Max_Length;
       end Peak_Use;
 
    end Queue;
diff --git a/gcc/ada/a-cuprqu.ads b/gcc/ada/a-cuprqu.ads
index 1a239837b1e..44735e0bed0 100644
--- a/gcc/ada/a-cuprqu.ads
+++ b/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;
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index a4e83a9fad7..e3c53dda462 100644
--- a/gcc/ada/debug.adb
+++ b/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.
 
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index a0ec3256649..b52fcccbdb4 100644
--- a/gcc/ada/exp_util.adb
+++ b/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;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 06367aff002..599ce451c1e 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/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;
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 9fe05eb9511..d34db0210d2 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/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);
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index fd5a70360cf..1b3015aaf42 100644
--- a/gcc/ada/sem_elab.adb
+++ b/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;
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index d66205167b8..de0f987d4a3 100644
--- a/gcc/ada/sem_util.adb
+++ b/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;
 
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index c8bf23a6ec6..cb0a09293aa 100644
--- a/gcc/ada/sem_warn.adb
+++ b/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;