Skip to content

R
riscv-gcc-1
Commit 6d0d18dc by Arnaud Charlet
Options

[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
parent 680d5f61
Showing with 107 additions and 34 deletions
gcc/ada/ChangeLog
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
......
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;
......
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);
......
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
......
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;
......
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;
......
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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment