[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Wed, 27 Apr 2016 13:09:13 +0000 (15:09 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 27 Apr 2016 13:09:13 +0000 (15:09 +0200)
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

gcc/ada/ChangeLog
gcc/ada/a-chtgop.adb
gcc/ada/errout.adb
gcc/ada/errout.ads
gcc/ada/erroutc.adb
gcc/ada/errutil.adb
gcc/ada/ghost.adb

index 0aee0a8f08be9a077e01099ba620fdf88f595e00..1e3b0450d7e96f2761d898acd5b9b4dd64163294 100644 (file)
@@ -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
index 0d7f88fa3fb5c9c1fb525443af6fb2cd387c0569..bdf1c5b60ce4263c67482029a63f3dab04352183 100644 (file)
@@ -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;
 
index db558ebacf9e6dcacbbfa9345d79bf959c4f35da..a0032810dab7700149b0de8242fe6f43cb98aaee 100644 (file)
@@ -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);
index fb41f79022d19eca2bfd5faacc50ccb477f5eb5d..e2e7de4a67ed37368436f83e1a001256036ea8c5 100644 (file)
@@ -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
index 5376aecfa141e1391f973a09382eafa5538d9bd0..ada93157af0060be2966bbcdff1d8899d53718b6 100644 (file)
@@ -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;
index 9fd67e16a741f9128b6bbedf514f0dd387af538a..d4e951079210dd603fa3750c662abe2cb913a0b0 100644 (file)
@@ -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;
 
index 8bd10310704c1aa97ae2713274fbb67148adbfe6..2eca5eda4748ac80b135de71dfc38b56112443b8 100644 (file)
@@ -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;