Skip to content

R
riscv-gcc-1
Commit 2cf8eabd by Pierre-Marie de Rodat
Options

[multiple changes] 

2017-11-08  Piotr Trojanek  <trojanek@adacore.com>

	* spark_xrefs.ads (SPARK_Xref_Record): Replace file and scope indices
	with Entity_Id of the reference.
	* spark_xrefs.adb (dspark): Adapt pretty-printing routine.
	* lib-xref-spark_specific.adb (Add_SPARK_Xrefs): Store Entity_Id of the
	reference, not the file and scope indices.

2017-11-08  Arnaud Charlet  <charlet@adacore.com>

	* errout.ads (Current_Node): New.
	* errout.adb (Error_Msg): Use Current_Node.
	* par-ch6.adb, par-ch7.adb, par-ch9.adb, par-util.adb: Set Current_Node
	when relevant.
	* style.adb: Call Error_Msg_N when possible.

From-SVN: r254543
parent 45a6947d
Showing with 49 additions and 21 deletions
gcc/ada/ChangeLog
2017-11-08 Piotr Trojanek <trojanek@adacore.com>
* spark_xrefs.ads (SPARK_Xref_Record): Replace file and scope indices
with Entity_Id of the reference.
* spark_xrefs.adb (dspark): Adapt pretty-printing routine.
* lib-xref-spark_specific.adb (Add_SPARK_Xrefs): Store Entity_Id of the
reference, not the file and scope indices.
2017-11-08 Arnaud Charlet <charlet@adacore.com>
* errout.ads (Current_Node): New.
* errout.adb (Error_Msg): Use Current_Node.
* par-ch6.adb, par-ch7.adb, par-ch9.adb, par-util.adb: Set Current_Node
when relevant.
* style.adb: Call Error_Msg_N when possible.
2017-11-08 Piotr Trojanek <trojanek@adacore.com>
* spark_xrefs.ads (SPARK_Scope_Record): Rename Scope_Id component to
Entity.
* lib-xref-spark_specific.adb, spark_xrefs.adb: Propagate renaming of
......
gcc/ada/errout.adb
......@@ -307,7 +307,7 @@ package body Errout is
procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
begin
Error_Msg (Msg, Flag_Location, Empty);
Error_Msg (Msg, Flag_Location, Current_Node);
end Error_Msg;
procedure Error_Msg
......
gcc/ada/errout.ads
......@@ -68,6 +68,10 @@ package Errout is
-- error message tag. The -gnatw.d switch sets this flag True, -gnatw.D
-- sets this flag False.
Current_Node : Node_Id := Empty;
-- Used by Error_Msg as a default Node_Id.
-- Relevant only when Opt.Include_Subprogram_In_Messages is set.
-----------------------------------
-- Suppression of Error Messages --
-----------------------------------
......
gcc/ada/lib-xref-spark_specific.adb
......@@ -773,8 +773,7 @@ package body SPARK_Specific is
SPARK_Xref_Table.Append (
(Entity => Unique_Entity (Ref.Ent),
File_Num => Dependency_Num (Ref.Lun),
Scope_Num => Get_Scope_Num (Ref.Ref_Scope),
Ref_Scope => Ref.Ref_Scope,
Rtype => Typ));
end;
end loop;
......
gcc/ada/par-ch6.adb
......@@ -336,6 +336,7 @@ package body Ch6 is
end if;
Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
Ignore (Tok_Colon);
-- Deal with generic instantiation, the one case in which we do not
......
gcc/ada/par-ch7.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2017, 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- --
......@@ -146,6 +146,7 @@ package body Ch7 is
Scope.Table (Scope.Last).Sloc := Token_Ptr;
Name_Node := P_Defining_Program_Unit_Name;
Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
if Aspect_Specifications_Present then
Aspect_Sloc := Token_Ptr;
......@@ -211,6 +212,7 @@ package body Ch7 is
Scope.Table (Scope.Last).Sloc := Token_Ptr;
Name_Node := P_Defining_Program_Unit_Name;
Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
-- Case of renaming declaration
......
gcc/ada/par-ch9.adb
......@@ -101,6 +101,7 @@ package body Ch9 is
Scan; -- past BODY
Name_Node := P_Defining_Identifier (C_Is);
Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
if Token = Tok_Left_Paren then
Error_Msg_SC ("discriminant part not allowed in task body");
......@@ -168,6 +169,7 @@ package body Ch9 is
Name_Node := P_Defining_Identifier;
Set_Defining_Identifier (Task_Node, Name_Node);
Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
Set_Discriminant_Specifications
(Task_Node, P_Known_Discriminant_Part_Opt);
......@@ -176,6 +178,7 @@ package body Ch9 is
Name_Node := P_Defining_Identifier (C_Is);
Set_Defining_Identifier (Task_Node, Name_Node);
Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
if Token = Tok_Left_Paren then
Error_Msg_SC ("discriminant part not allowed for single task");
......@@ -447,6 +450,7 @@ package body Ch9 is
Scan; -- past BODY
Name_Node := P_Defining_Identifier (C_Is);
Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
if Token = Tok_Left_Paren then
Error_Msg_SC ("discriminant part not allowed in protected body");
......@@ -501,6 +505,7 @@ package body Ch9 is
Name_Node := P_Defining_Identifier (C_Is);
Set_Defining_Identifier (Protected_Node, Name_Node);
Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
Set_Discriminant_Specifications
(Protected_Node, P_Known_Discriminant_Part_Opt);
......@@ -517,6 +522,7 @@ package body Ch9 is
end if;
Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
end if;
P_Aspect_Specifications (Protected_Node, Semicolon => False);
......@@ -1049,6 +1055,7 @@ package body Ch9 is
Accept_Node := New_Node (N_Accept_Statement, Token_Ptr);
Scan; -- past ACCEPT
Scope.Table (Scope.Last).Labl := Token_Node;
Current_Node := Token_Node;
Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do));
......@@ -1197,6 +1204,7 @@ package body Ch9 is
Name_Node := P_Defining_Identifier;
Set_Defining_Identifier (Entry_Node, Name_Node);
Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
Formal_Part_Node := P_Entry_Body_Formal_Part;
Set_Entry_Body_Formal_Part (Entry_Node, Formal_Part_Node);
......
gcc/ada/par-endh.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2017, 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- --
......
gcc/ada/par-util.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2017, 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- --
......@@ -667,6 +667,12 @@ package body Util is
pragma Assert (Scope.Last > 0);
Scope.Decrement_Last;
if Include_Subprogram_In_Messages
and then Scope.Table (Scope.Last).Labl /= Error
then
Current_Node := Scope.Table (Scope.Last).Labl;
end if;
if Debug_Flag_P then
Error_Msg_Uint_1 := UI_From_Int (Scope.Last);
Error_Msg_SC ("decrement scope stack ptr, new value = ^!");
......
gcc/ada/spark_xrefs.adb
......@@ -104,10 +104,9 @@ package body SPARK_Xrefs is
Write_Str (Unique_Name (AXR.Entity));
Write_Char ('"');
Write_Str (" File_Num = ");
Write_Int (Int (AXR.File_Num));
Write_Str (" Scope_Num = ");
Write_Int (Int (AXR.Scope_Num));
Write_Str (" Reference_Scope = ");
Write_Str (Unique_Name (AXR.Ref_Scope));
Write_Char ('"');
Write_Str (" Type = ");
Write_Char (AXR.Rtype);
Write_Eol;
......
gcc/ada/spark_xrefs.ads
......@@ -67,17 +67,10 @@ package SPARK_Xrefs is
type SPARK_Xref_Record is record
Entity : Entity_Id;
-- Pointer to entity name in ALI file
-- Referenced entity
File_Num : Nat;
-- File dependency number for the cross-reference. Note that if no file
-- entry is present explicitly, this is just a copy of the reference for
-- the current cross-reference section.
Scope_Num : Nat;
-- Scope number for the cross-reference. Note that if no scope entry is
-- present explicitly, this is just a copy of the reference for the
-- current cross-reference section.
Ref_Scope : Entity_Id;
-- Scope where the reference occurs
Rtype : Character;
-- Indicates type of the reference, using code used in ALI file:
......
gcc/ada/style.adb
......@@ -166,7 +166,7 @@ package body Style is
Error_Msg_Node_1 := Def;
Error_Msg_Sloc := Sloc (Def);
Error_Msg -- CODEFIX
("(style) bad casing of & declared#", Sref);
("(style) bad casing of & declared#", Sref, Ref);
return;
-- Else end of identifiers, and they match
......
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