aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/ada/ChangeLog16
-rw-r--r--gcc/ada/errout.adb2
-rw-r--r--gcc/ada/errout.ads4
-rw-r--r--gcc/ada/lib-xref-spark_specific.adb3
-rw-r--r--gcc/ada/par-ch6.adb1
-rw-r--r--gcc/ada/par-ch7.adb4
-rw-r--r--gcc/ada/par-ch9.adb8
-rw-r--r--gcc/ada/par-endh.adb2
-rw-r--r--gcc/ada/par-util.adb8
-rw-r--r--gcc/ada/spark_xrefs.adb7
-rw-r--r--gcc/ada/spark_xrefs.ads13
-rw-r--r--gcc/ada/style.adb2
12 files changed, 49 insertions, 21 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1fb9feb..8fbb417 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,21 @@
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
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index a402c68..2b9664d 100644
--- a/gcc/ada/errout.adb
+++ b/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
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index e9c4eb4..d3de0ad 100644
--- a/gcc/ada/errout.ads
+++ b/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 --
-----------------------------------
diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb
index 929de9a..8cc2e72 100644
--- a/gcc/ada/lib-xref-spark_specific.adb
+++ b/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;
diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index 83bb251..ddcedca 100644
--- a/gcc/ada/par-ch6.adb
+++ b/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
diff --git a/gcc/ada/par-ch7.adb b/gcc/ada/par-ch7.adb
index dd4bdb4..7ea2d06 100644
--- a/gcc/ada/par-ch7.adb
+++ b/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
diff --git a/gcc/ada/par-ch9.adb b/gcc/ada/par-ch9.adb
index 9e4ac07..b5d6d20 100644
--- a/gcc/ada/par-ch9.adb
+++ b/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);
diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb
index bbcbff9..c9f81d0 100644
--- a/gcc/ada/par-endh.adb
+++ b/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- --
diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb
index ec9a916..01b4670 100644
--- a/gcc/ada/par-util.adb
+++ b/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 = ^!");
diff --git a/gcc/ada/spark_xrefs.adb b/gcc/ada/spark_xrefs.adb
index 6c7dc0c..48b8b58 100644
--- a/gcc/ada/spark_xrefs.adb
+++ b/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;
diff --git a/gcc/ada/spark_xrefs.ads b/gcc/ada/spark_xrefs.ads
index c5604fd..79a21b9 100644
--- a/gcc/ada/spark_xrefs.ads
+++ b/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:
diff --git a/gcc/ada/style.adb b/gcc/ada/style.adb
index a0d61aa..df043d0 100644
--- a/gcc/ada/style.adb
+++ b/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
generated by cgit v1.1 at 2024-10-01 02:51:13 +0000