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> 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 * spark_xrefs.ads (SPARK_Scope_Record): Rename Scope_Id component to
Entity. Entity.
* lib-xref-spark_specific.adb, spark_xrefs.adb: Propagate renaming of * lib-xref-spark_specific.adb, spark_xrefs.adb: Propagate renaming of
......
gcc/ada/errout.adb
...@@ -307,7 +307,7 @@ package body Errout is ...@@ -307,7 +307,7 @@ package body Errout is
procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
begin begin
Error_Msg (Msg, Flag_Location, Empty); Error_Msg (Msg, Flag_Location, Current_Node);
end Error_Msg; end Error_Msg;
procedure Error_Msg procedure Error_Msg
......
gcc/ada/errout.ads
...@@ -68,6 +68,10 @@ package Errout is ...@@ -68,6 +68,10 @@ package Errout is
-- error message tag. The -gnatw.d switch sets this flag True, -gnatw.D -- error message tag. The -gnatw.d switch sets this flag True, -gnatw.D
-- sets this flag False. -- 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 -- -- Suppression of Error Messages --
----------------------------------- -----------------------------------
......
gcc/ada/lib-xref-spark_specific.adb
...@@ -773,8 +773,7 @@ package body SPARK_Specific is ...@@ -773,8 +773,7 @@ package body SPARK_Specific is
SPARK_Xref_Table.Append ( SPARK_Xref_Table.Append (
(Entity => Unique_Entity (Ref.Ent), (Entity => Unique_Entity (Ref.Ent),
File_Num => Dependency_Num (Ref.Lun), Ref_Scope => Ref.Ref_Scope,
Scope_Num => Get_Scope_Num (Ref.Ref_Scope),
Rtype => Typ)); Rtype => Typ));
end; end;
end loop; end loop;
......
gcc/ada/par-ch6.adb
...@@ -336,6 +336,7 @@ package body Ch6 is ...@@ -336,6 +336,7 @@ package body Ch6 is
end if; end if;
Scope.Table (Scope.Last).Labl := Name_Node; Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
Ignore (Tok_Colon); Ignore (Tok_Colon);
-- Deal with generic instantiation, the one case in which we do not -- Deal with generic instantiation, the one case in which we do not
......
gcc/ada/par-ch7.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -146,6 +146,7 @@ package body Ch7 is ...@@ -146,6 +146,7 @@ package body Ch7 is
Scope.Table (Scope.Last).Sloc := Token_Ptr; Scope.Table (Scope.Last).Sloc := Token_Ptr;
Name_Node := P_Defining_Program_Unit_Name; Name_Node := P_Defining_Program_Unit_Name;
Scope.Table (Scope.Last).Labl := Name_Node; Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
if Aspect_Specifications_Present then if Aspect_Specifications_Present then
Aspect_Sloc := Token_Ptr; Aspect_Sloc := Token_Ptr;
...@@ -211,6 +212,7 @@ package body Ch7 is ...@@ -211,6 +212,7 @@ package body Ch7 is
Scope.Table (Scope.Last).Sloc := Token_Ptr; Scope.Table (Scope.Last).Sloc := Token_Ptr;
Name_Node := P_Defining_Program_Unit_Name; Name_Node := P_Defining_Program_Unit_Name;
Scope.Table (Scope.Last).Labl := Name_Node; Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
-- Case of renaming declaration -- Case of renaming declaration
......
gcc/ada/par-ch9.adb
...@@ -101,6 +101,7 @@ package body Ch9 is ...@@ -101,6 +101,7 @@ package body Ch9 is
Scan; -- past BODY Scan; -- past BODY
Name_Node := P_Defining_Identifier (C_Is); Name_Node := P_Defining_Identifier (C_Is);
Scope.Table (Scope.Last).Labl := Name_Node; Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
if Token = Tok_Left_Paren then if Token = Tok_Left_Paren then
Error_Msg_SC ("discriminant part not allowed in task body"); Error_Msg_SC ("discriminant part not allowed in task body");
...@@ -168,6 +169,7 @@ package body Ch9 is ...@@ -168,6 +169,7 @@ package body Ch9 is
Name_Node := P_Defining_Identifier; Name_Node := P_Defining_Identifier;
Set_Defining_Identifier (Task_Node, Name_Node); Set_Defining_Identifier (Task_Node, Name_Node);
Scope.Table (Scope.Last).Labl := Name_Node; Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
Set_Discriminant_Specifications Set_Discriminant_Specifications
(Task_Node, P_Known_Discriminant_Part_Opt); (Task_Node, P_Known_Discriminant_Part_Opt);
...@@ -176,6 +178,7 @@ package body Ch9 is ...@@ -176,6 +178,7 @@ package body Ch9 is
Name_Node := P_Defining_Identifier (C_Is); Name_Node := P_Defining_Identifier (C_Is);
Set_Defining_Identifier (Task_Node, Name_Node); Set_Defining_Identifier (Task_Node, Name_Node);
Scope.Table (Scope.Last).Labl := Name_Node; Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
if Token = Tok_Left_Paren then if Token = Tok_Left_Paren then
Error_Msg_SC ("discriminant part not allowed for single task"); Error_Msg_SC ("discriminant part not allowed for single task");
...@@ -447,6 +450,7 @@ package body Ch9 is ...@@ -447,6 +450,7 @@ package body Ch9 is
Scan; -- past BODY Scan; -- past BODY
Name_Node := P_Defining_Identifier (C_Is); Name_Node := P_Defining_Identifier (C_Is);
Scope.Table (Scope.Last).Labl := Name_Node; Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
if Token = Tok_Left_Paren then if Token = Tok_Left_Paren then
Error_Msg_SC ("discriminant part not allowed in protected body"); Error_Msg_SC ("discriminant part not allowed in protected body");
...@@ -501,6 +505,7 @@ package body Ch9 is ...@@ -501,6 +505,7 @@ package body Ch9 is
Name_Node := P_Defining_Identifier (C_Is); Name_Node := P_Defining_Identifier (C_Is);
Set_Defining_Identifier (Protected_Node, Name_Node); Set_Defining_Identifier (Protected_Node, Name_Node);
Scope.Table (Scope.Last).Labl := Name_Node; Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
Set_Discriminant_Specifications Set_Discriminant_Specifications
(Protected_Node, P_Known_Discriminant_Part_Opt); (Protected_Node, P_Known_Discriminant_Part_Opt);
...@@ -517,6 +522,7 @@ package body Ch9 is ...@@ -517,6 +522,7 @@ package body Ch9 is
end if; end if;
Scope.Table (Scope.Last).Labl := Name_Node; Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
end if; end if;
P_Aspect_Specifications (Protected_Node, Semicolon => False); P_Aspect_Specifications (Protected_Node, Semicolon => False);
...@@ -1049,6 +1055,7 @@ package body Ch9 is ...@@ -1049,6 +1055,7 @@ package body Ch9 is
Accept_Node := New_Node (N_Accept_Statement, Token_Ptr); Accept_Node := New_Node (N_Accept_Statement, Token_Ptr);
Scan; -- past ACCEPT Scan; -- past ACCEPT
Scope.Table (Scope.Last).Labl := Token_Node; Scope.Table (Scope.Last).Labl := Token_Node;
Current_Node := Token_Node;
Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do)); Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do));
...@@ -1197,6 +1204,7 @@ package body Ch9 is ...@@ -1197,6 +1204,7 @@ package body Ch9 is
Name_Node := P_Defining_Identifier; Name_Node := P_Defining_Identifier;
Set_Defining_Identifier (Entry_Node, Name_Node); Set_Defining_Identifier (Entry_Node, Name_Node);
Scope.Table (Scope.Last).Labl := Name_Node; Scope.Table (Scope.Last).Labl := Name_Node;
Current_Node := Name_Node;
Formal_Part_Node := P_Entry_Body_Formal_Part; Formal_Part_Node := P_Entry_Body_Formal_Part;
Set_Entry_Body_Formal_Part (Entry_Node, Formal_Part_Node); Set_Entry_Body_Formal_Part (Entry_Node, Formal_Part_Node);
......
gcc/ada/par-endh.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
......
gcc/ada/par-util.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -667,6 +667,12 @@ package body Util is ...@@ -667,6 +667,12 @@ package body Util is
pragma Assert (Scope.Last > 0); pragma Assert (Scope.Last > 0);
Scope.Decrement_Last; 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 if Debug_Flag_P then
Error_Msg_Uint_1 := UI_From_Int (Scope.Last); Error_Msg_Uint_1 := UI_From_Int (Scope.Last);
Error_Msg_SC ("decrement scope stack ptr, new value = ^!"); Error_Msg_SC ("decrement scope stack ptr, new value = ^!");
......
gcc/ada/spark_xrefs.adb
...@@ -104,10 +104,9 @@ package body SPARK_Xrefs is ...@@ -104,10 +104,9 @@ package body SPARK_Xrefs is
Write_Str (Unique_Name (AXR.Entity)); Write_Str (Unique_Name (AXR.Entity));
Write_Char ('"'); Write_Char ('"');
Write_Str (" File_Num = "); Write_Str (" Reference_Scope = ");
Write_Int (Int (AXR.File_Num)); Write_Str (Unique_Name (AXR.Ref_Scope));
Write_Str (" Scope_Num = "); Write_Char ('"');
Write_Int (Int (AXR.Scope_Num));
Write_Str (" Type = "); Write_Str (" Type = ");
Write_Char (AXR.Rtype); Write_Char (AXR.Rtype);
Write_Eol; Write_Eol;
......
gcc/ada/spark_xrefs.ads
...@@ -67,17 +67,10 @@ package SPARK_Xrefs is ...@@ -67,17 +67,10 @@ package SPARK_Xrefs is
type SPARK_Xref_Record is record type SPARK_Xref_Record is record
Entity : Entity_Id; Entity : Entity_Id;
-- Pointer to entity name in ALI file -- Referenced entity
File_Num : Nat; Ref_Scope : Entity_Id;
-- File dependency number for the cross-reference. Note that if no file -- Scope where the reference occurs
-- 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.
Rtype : Character; Rtype : Character;
-- Indicates type of the reference, using code used in ALI file: -- Indicates type of the reference, using code used in ALI file:
......
gcc/ada/style.adb
...@@ -166,7 +166,7 @@ package body Style is ...@@ -166,7 +166,7 @@ package body Style is
Error_Msg_Node_1 := Def; Error_Msg_Node_1 := Def;
Error_Msg_Sloc := Sloc (Def); Error_Msg_Sloc := Sloc (Def);
Error_Msg -- CODEFIX Error_Msg -- CODEFIX
("(style) bad casing of & declared#", Sref); ("(style) bad casing of & declared#", Sref, Ref);
return; return;
-- Else end of identifiers, and they match -- 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