From 6d0d18dcb1b2e39d7aaaa7ac2c6a19dd77d8a53d Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 27 Apr 2016 15:09:13 +0200 Subject: [multiple changes] 2016-04-27 Bob Duff * a-chtgop.adb (Adjust): Zero the tampering counts on assignment, as is done for the other containers. 2016-04-27 Hristian Kirtchev * 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 * 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 | 26 ++++++++++++++++++++++++++ gcc/ada/a-chtgop.adb | 8 +++++++- gcc/ada/errout.adb | 24 ++++++++++++++---------- gcc/ada/errout.ads | 9 +++++---- gcc/ada/erroutc.adb | 6 +++--- gcc/ada/errutil.adb | 19 ++++++++++++------- gcc/ada/ghost.adb | 49 ++++++++++++++++++++++++++++++++++++++++--------- 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 + + * a-chtgop.adb (Adjust): Zero the tampering counts on assignment, + as is done for the other containers. + +2016-04-27 Hristian Kirtchev + + * 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 + + * 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 * 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; -- cgit v1.1