[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1fb9feb5219d8a4dbcd2cf943d2ea3872ddd0b23..8fbb4176f699eec7c3517e00c301c9619a70873c 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+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

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index a402c684101e909f976bdf879442e72ff42c3821..2b9664daac32f58aa6d76928fc5dca5e4aa11240 100644 (file)
--- 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 e9c4eb47f7f5bf401f44ee1aa3df60a75d08e8e7..d3de0ad9ff39cd133b547ac5cc1f40d9d63b5298 100644 (file)
--- 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 929de9a8f219cece6a2498c91ddfb388fd0dd303..8cc2e7299fd37ba20122b3c77c4a5b85307f7e72 100644 (file)
--- 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 83bb25118a406eafd883f912da013a6d23b51d15..ddcedcae1304c281a1a7b10bf1374654d9b6f341 100644 (file)
--- 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 dd4bdb4b329325445d3e920e2c772dc3f0e43ce9..7ea2d0675d8e8fe2c8c994453709c8200545fff8 100644 (file)
--- 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 9e4ac07426f98f8f7f9373be68da4bac36e82b23..b5d6d2036a35ed6a05403afd0ab64d03e3adf9e4 100644 (file)
--- 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 bbcbff92c13e28658242e9c3ebcd6206f4d1d9fa..c9f81d07fd332f0d4498c4bc7a423a1ad1d735e3 100644 (file)
--- 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 ec9a916be0b99ad9282f72ee056d53d00aae3bf2..01b4670458b7c10c567ce0ce08334fae6a85e1f0 100644 (file)
--- 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 6c7dc0cadbce6c4c2b6b52ddea224af7255babad..48b8b584747ba46f8572638dc303806d4b794845 100644 (file)
--- 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 c5604fd5477143f68cb0fbf336a23726700b3ded..79a21b9faf6691a6823ab4b3d6993b5dfe7b3ef9 100644 (file)
--- 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 a0d61aa37b432aaffd60fe4ecfd1edfec6a2d3bb..df043d0669bf948f0ce0cce0a2bc9920340a5659 100644 (file)
--- 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