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/ghost.adb | 49 ++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 40 insertions(+), 9 deletions(-) (limited to 'gcc/ada/ghost.adb') 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