[multiple changes]

2016-04-27  Bob Duff  <duff@adacore.com>

	* a-chtgop.adb (Adjust): Zero the tampering counts on assignment,
	as is done for the other containers.

2016-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* ghost.adb (In_Subprogram_Body_Profile): New routine.
	(Is_OK_Declaration): Treat an unanalyzed expression
	function as an OK context.  Treat a reference to a Ghost entity
	as OK when it appears within the profile of a subprogram body.

2016-04-27  Bob Duff  <duff@adacore.com>

	* errout.ads: Document the fact that informational messages
	don't have to be warnings.
	* errout.adb (Error_Msg_Internal): In statistics counts, deal
	correctly with informational messages that are not warnings.
	(Error_Msg_NEL): Remove useless 'if' aroung Set_Posted, because
	Set_Posted already checks for errors and ignores others.
	* erroutc.adb (Prescan_Message): Set Is_Serious_Error to False
	if Is_Info_Msg; the previous code was assuming that Is_Info_Msg
	implies Is_Warning_Msg.
	* errutil.adb (Error_Msg): In statistics counts, deal correctly
	with informational messages that are not warnings.

From-SVN: r235500

7 files changed, 107 insertions, 34 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0aee0a8..1e3b045 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,29 @@
+2016-04-27  Bob Duff  <duff@adacore.com>
+
+	* a-chtgop.adb (Adjust): Zero the tampering counts on assignment,
+	as is done for the other containers.
+
+2016-04-27  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* ghost.adb (In_Subprogram_Body_Profile): New routine.
+	(Is_OK_Declaration): Treat an unanalyzed expression
+	function as an OK context.  Treat a reference to a Ghost entity
+	as OK when it appears within the profile of a subprogram body.
+
+2016-04-27  Bob Duff  <duff@adacore.com>
+
+	* errout.ads: Document the fact that informational messages
+	don't have to be warnings.
+	* errout.adb (Error_Msg_Internal): In statistics counts, deal
+	correctly with informational messages that are not warnings.
+	(Error_Msg_NEL): Remove useless 'if' aroung Set_Posted, because
+	Set_Posted already checks for errors and ignores others.
+	* erroutc.adb (Prescan_Message): Set Is_Serious_Error to False
+	if Is_Info_Msg; the previous code was assuming that Is_Info_Msg
+	implies Is_Warning_Msg.
+	* errutil.adb (Error_Msg): In statistics counts, deal correctly
+	with informational messages that are not warnings.
+
 2016-04-27  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_util.ads, sem_util.adb (Is_Null_Record_Type): New predicate
diff --git a/gcc/ada/a-chtgop.adb b/gcc/ada/a-chtgop.adb
index 0d7f88f..bdf1c5b 100644
--- a/gcc/ada/a-chtgop.adb
+++ b/gcc/ada/a-chtgop.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-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- --
@@ -53,6 +53,12 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
       Dst_Prev    : Node_Access;
 
    begin
+      --  If the counts are nonzero, execution is technically erroneous, but
+      --  it seems friendly to allow things like concurrent "=" on shared
+      --  constants.
+
+      Zero_Counts (HT.TC);
+
       HT.Buckets := null;
       HT.Length := 0;
 
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index db558eb..a003281 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.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.         --
 --                                                                          --
 -- 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- --
@@ -1153,15 +1153,22 @@ package body Errout is
          end if;
       end if;
 
-      --  Bump appropriate statistics count
+      --  Bump appropriate statistics counts
 
-      if Errors.Table (Cur_Msg).Warn or else Errors.Table (Cur_Msg).Style then
-         Warnings_Detected := Warnings_Detected + 1;
+      if Errors.Table (Cur_Msg).Info then
+         Info_Messages := Info_Messages + 1;
+
+         --  Could be (usually is) both "info" and "warning"
 
-         if Errors.Table (Cur_Msg).Info then
-            Info_Messages := Info_Messages + 1;
+         if Errors.Table (Cur_Msg).Warn then
+            Warnings_Detected := Warnings_Detected + 1;
          end if;
 
+      elsif Errors.Table (Cur_Msg).Warn
+        or else Errors.Table (Cur_Msg).Style
+      then
+         Warnings_Detected := Warnings_Detected + 1;
+
       elsif Errors.Table (Cur_Msg).Check then
          Check_Messages := Check_Messages + 1;
 
@@ -1298,9 +1305,7 @@ package body Errout is
          Last_Killed := True;
       end if;
 
-      if not (Is_Warning_Msg or Is_Style_Msg) then
-         Set_Posted (N);
-      end if;
+      Set_Posted (N);
    end Error_Msg_NEL;
 
    ------------------
@@ -3077,7 +3082,6 @@ package body Errout is
 
    begin
       if Is_Serious_Error then
-
          --  We always set Error_Posted on the node itself
 
          Set_Error_Posted (N);
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index fb41f79..e2e7de4 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-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- --
@@ -324,7 +324,7 @@ package Errout is
    --      "[restriction warning]" at the end of the warning message. For
    --      continuations, use this on each continuation message.
 
-   --    Insertion character ?$? (elaboration information messages)
+   --    Insertion character ?$? (elaboration informational messages)
    --      Like ?, but if the flag Warn_Doc_Switch is True, adds the string
    --      "[-gnatel]" at the end of the info message. This is used for the
    --      messages generated by the switch -gnatel. For continuations, use
@@ -419,12 +419,13 @@ package Errout is
    --      message. Style messages are also considered to be warnings, but
    --      they do not get a tag.
 
-   --    Insertion sequence "info: " (information message)
+   --    Insertion sequence "info: " (informational message)
    --      This appears only at the start of the message (and not any of its
    --      continuations, if any), and indicates that the message is an info
    --      message. The message will be output with this prefix, and if there
    --      are continuations that are not printed using the -gnatj switch they
-   --      will also have this prefix.
+   --      will also have this prefix. Informational messages are usually also
+   --      warnings, but they don't have to be.
 
    --    Insertion sequence "low: " or "medium: " or "high: " (check message)
    --      This appears only at the start of the message (and not any of its
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 5376aec..ada9315 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.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.         --
 --                                                                          --
 -- 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- --
@@ -633,7 +633,7 @@ package body Erroutc is
 
          --  Deal with warning case
 
-         if Errors.Table (E).Warn then
+         if Errors.Table (E).Warn or else Errors.Table (E).Info then
 
             --  For info messages, prefix message with "info: "
 
@@ -855,7 +855,7 @@ package body Erroutc is
          end if;
       end loop;
 
-      if Is_Warning_Msg or Is_Style_Msg or Is_Check_Msg then
+      if Is_Info_Msg or Is_Warning_Msg or Is_Style_Msg or Is_Check_Msg then
          Is_Serious_Error := False;
       end if;
    end Prescan_Message;
diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb
index 9fd67e1..d4e9510 100644
--- a/gcc/ada/errutil.adb
+++ b/gcc/ada/errutil.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1991-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1991-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- --
@@ -302,18 +302,23 @@ package body Errutil is
 
       Errors.Table (Cur_Msg).Next := Next_Msg;
 
-      --  Bump appropriate statistics count
+      --  Bump appropriate statistics counts
 
-      if Errors.Table (Cur_Msg).Warn
+      if Errors.Table (Cur_Msg).Info then
+         Info_Messages := Info_Messages + 1;
+
+         --  Could be (usually is) both "info" and "warning"
+
+         if Errors.Table (Cur_Msg).Warn then
+            Warnings_Detected := Warnings_Detected + 1;
+         end if;
+
+      elsif Errors.Table (Cur_Msg).Warn
            or else
          Errors.Table (Cur_Msg).Style
       then
          Warnings_Detected := Warnings_Detected + 1;
 
-         if Errors.Table (Cur_Msg).Info then
-            Info_Messages := Info_Messages + 1;
-         end if;
-
       elsif Errors.Table (Cur_Msg).Check then
          Check_Messages := Check_Messages + 1;
 
diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb
index 8bd1031..2eca5ed 100644
--- a/gcc/ada/ghost.adb
+++ b/gcc/ada/ghost.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2014-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2014-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- --
@@ -188,10 +188,34 @@ package body Ghost is
          -----------------------
 
          function Is_OK_Declaration (Decl : Node_Id) return Boolean is
+            function In_Subprogram_Body_Profile (N : Node_Id) return Boolean;
+            --  Determine whether node N appears in the profile of a subprogram
+            --  body.
+
             function Is_Ghost_Renaming (Ren_Decl : Node_Id) return Boolean;
             --  Determine whether node Ren_Decl denotes a renaming declaration
             --  with a Ghost name.
 
+            --------------------------------
+            -- In_Subprogram_Body_Profile --
+            --------------------------------
+
+            function In_Subprogram_Body_Profile (N : Node_Id) return Boolean is
+               Spec : constant Node_Id := Parent (N);
+
+            begin
+               --  The node appears in a parameter specification in which case
+               --  it is either the parameter type or the default expression or
+               --  the node appears as the result definition of a function.
+
+               return
+                 (Nkind (N) = N_Parameter_Specification
+                   or else
+                     (Nkind (Spec) = N_Function_Specification
+                       and then N = Result_Definition (Spec)))
+                   and then Nkind (Parent (Spec)) = N_Subprogram_Body;
+            end In_Subprogram_Body_Profile;
+
             -----------------------
             -- Is_Ghost_Renaming --
             -----------------------
@@ -234,15 +258,22 @@ package body Ghost is
 
             --  Special cases
 
-            --  A reference to a Ghost entity may appear as the default
-            --  expression of a formal parameter of a subprogram body. This
-            --  context must be treated as suitable because the relation
-            --  between the spec and the body has not been established and
-            --  the body is not marked as Ghost yet. The real check was
-            --  performed on the spec.
+            --  A reference to a Ghost entity may appear within the profile of
+            --  a subprogram body. This context is treated as suitable because
+            --  it duplicates the context of the corresponding spec. The real
+            --  check was already performed during the analysis of the spec.
+
+            elsif In_Subprogram_Body_Profile (Decl) then
+               return True;
+
+            --  A reference to a Ghost entity may appear within an expression
+            --  function which is still being analyzed. This context is treated
+            --  as suitable because it is not yet known whether the expression
+            --  function is an initial declaration or a completion. The real
+            --  check is performed when the expression function is expanded.
 
-            elsif Nkind (Decl) = N_Parameter_Specification
-              and then Nkind (Parent (Parent (Decl))) = N_Subprogram_Body
+            elsif Nkind (Decl) = N_Expression_Function
+              and then not Analyzed (Decl)
             then
                return True;