From 2cf8eabd48500b8d2480301020bd2aa82cf6556d Mon Sep 17 00:00:00 2001 From: Pierre-Marie de Rodat Date: Wed, 8 Nov 2017 16:31:39 +0000 Subject: [PATCH] [multiple changes] 2017-11-08 Piotr Trojanek * 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 * 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 --- gcc/ada/ChangeLog | 16 ++++++++++++++++ gcc/ada/errout.adb | 2 +- gcc/ada/errout.ads | 4 ++++ gcc/ada/lib-xref-spark_specific.adb | 3 +-- gcc/ada/par-ch6.adb | 1 + gcc/ada/par-ch7.adb | 4 +++- gcc/ada/par-ch9.adb | 8 ++++++++ gcc/ada/par-endh.adb | 2 +- gcc/ada/par-util.adb | 8 +++++++- gcc/ada/spark_xrefs.adb | 7 +++---- gcc/ada/spark_xrefs.ads | 13 +++---------- gcc/ada/style.adb | 2 +- 12 files changed, 49 insertions(+), 21 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1fb9feb5219..8fbb4176f69 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2017-11-08 Piotr Trojanek + + * 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 + + * 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 * spark_xrefs.ads (SPARK_Scope_Record): Rename Scope_Id component to diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index a402c684101..2b9664daac3 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 e9c4eb47f7f..d3de0ad9ff3 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 929de9a8f21..8cc2e7299fd 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 83bb25118a4..ddcedcae130 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 dd4bdb4b329..7ea2d0675d8 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 9e4ac07426f..b5d6d2036a3 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 bbcbff92c13..c9f81d07fd3 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 ec9a916be0b..01b4670458b 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 6c7dc0cadbc..48b8b584747 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 c5604fd5477..79a21b9faf6 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 a0d61aa37b4..df043d0669b 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 -- 2.30.2