From: Viljar Indus <in...@adacore.com>
Using -gnatdJ with various other switches was error prone.
Remove this switch since the primary users of this mode
GNATCheck and Codepeer no longer need it.
gcc/ada/
* debug.adb: Remove mentions of -gnatdJ.
* errout.adb: Remove printing subprogram names to JSON.
* erroutc.adb: Remove printing subprogram names in messages.
* erroutc.ads: Remove Node and Subprogram_Name_Ptr used for -gnatdJ.
* errutil.adb: Remove Node used for -gnatdJ
* gnat1drv.adb: Remove references of -gnatdJ and
Include_Subprgram_In_Messages.
* opt.ads: Remove Include_Subprgram_In_Messages
* par-util.adb: Remove behavior related to
Include_Subprgram_In_Messages.
* sem_util.adb: Remove Subprogram_Name used for -gnatdJ
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/debug.adb | 6 ---
gcc/ada/errout.adb | 62 +++++++----------------
gcc/ada/erroutc.adb | 20 +-------
gcc/ada/erroutc.ads | 18 -------
gcc/ada/errutil.adb | 3 +-
gcc/ada/gnat1drv.adb | 7 ---
gcc/ada/opt.ads | 4 --
gcc/ada/par-util.adb | 6 ---
gcc/ada/sem_util.adb | 116 -------------------------------------------
9 files changed, 22 insertions(+), 220 deletions(-)
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 540db2a9942..602a8fa0b63 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -67,7 +67,6 @@ package body Debug is
-- dG Generate all warnings including those normally suppressed
-- dH Hold (kill) call to gigi
-- dI Inhibit internal name numbering in gnatG listing
- -- dJ Prepend subprogram name in messages
-- dK Kill all error messages
-- dL Ignore external calls from instances for elaboration
-- dM Assume all variables are modified (no current values)
@@ -615,11 +614,6 @@ package body Debug is
-- is used in the fixed bugs run to minimize system and version
-- dependency in filed -gnatD or -gnatG output.
- -- dJ Prepend the name of the enclosing subprogram in compiler messages
- -- (errors, warnings, style checks). This is useful in particular to
- -- integrate compiler warnings in static analysis tools such as
- -- CodePeer.
-
-- dK Kill all error messages. This debug flag suppresses the output
-- of all error messages. It is used in regression tests where the
-- error messages are target dependent and irrelevant.
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 92c4f6a4635..76c461a2fd7 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -100,8 +100,7 @@ package body Errout is
(Msg : String;
Span : Source_Span;
Opan : Source_Span;
- Msg_Cont : Boolean;
- Node : Node_Id);
+ Msg_Cont : Boolean);
-- This is the low-level routine used to post messages after dealing with
-- the issue of messages placed on instantiations (which get broken up
-- into separate calls in Error_Msg). Span is the location on which the
@@ -112,9 +111,7 @@ package body Errout is
-- copy. So typically we can see Opan pointing to the template location
-- in an instantiation copy when Span points to the source location of
-- the actual instantiation (i.e the line with the new). Msg_Cont is
- -- set true if this is a continuation message. Node is the relevant
- -- Node_Id for this message, to be used to compute the enclosing entity if
- -- Opt.Include_Subprogram_In_Messages is set.
+ -- set true if this is a continuation message.
function No_Warnings (N : Node_Or_Entity_Id) return Boolean;
-- Determines if warnings should be suppressed for the given node
@@ -475,7 +472,7 @@ package body Errout is
-- Error_Msg_Internal to place the message in the requested location.
if Instantiation (Sindex) = No_Location then
- Error_Msg_Internal (Msg, Flag_Span, Flag_Span, False, N);
+ Error_Msg_Internal (Msg, Flag_Span, Flag_Span, False);
return;
end if;
@@ -573,32 +570,28 @@ package body Errout is
(Msg => "info: in inlined body #",
Span => To_Span (Actual_Error_Loc),
Opan => Flag_Span,
- Msg_Cont => Msg_Cont_Status,
- Node => N);
+ Msg_Cont => Msg_Cont_Status);
elsif Is_Warning_Msg then
Error_Msg_Internal
(Msg => Warn_Insertion & "in inlined body #",
Span => To_Span (Actual_Error_Loc),
Opan => Flag_Span,
- Msg_Cont => Msg_Cont_Status,
- Node => N);
+ Msg_Cont => Msg_Cont_Status);
elsif Is_Style_Msg then
Error_Msg_Internal
(Msg => "style: in inlined body #",
Span => To_Span (Actual_Error_Loc),
Opan => Flag_Span,
- Msg_Cont => Msg_Cont_Status,
- Node => N);
+ Msg_Cont => Msg_Cont_Status);
else
Error_Msg_Internal
(Msg => "error in inlined body #",
Span => To_Span (Actual_Error_Loc),
Opan => Flag_Span,
- Msg_Cont => Msg_Cont_Status,
- Node => N);
+ Msg_Cont => Msg_Cont_Status);
end if;
-- Case of generic instantiation
@@ -609,32 +602,28 @@ package body Errout is
(Msg => "info: in instantiation #",
Span => To_Span (Actual_Error_Loc),
Opan => Flag_Span,
- Msg_Cont => Msg_Cont_Status,
- Node => N);
+ Msg_Cont => Msg_Cont_Status);
elsif Is_Warning_Msg then
Error_Msg_Internal
(Msg => Warn_Insertion & "in instantiation #",
Span => To_Span (Actual_Error_Loc),
Opan => Flag_Span,
- Msg_Cont => Msg_Cont_Status,
- Node => N);
+ Msg_Cont => Msg_Cont_Status);
elsif Is_Style_Msg then
Error_Msg_Internal
(Msg => "style: in instantiation #",
Span => To_Span (Actual_Error_Loc),
Opan => Flag_Span,
- Msg_Cont => Msg_Cont_Status,
- Node => N);
+ Msg_Cont => Msg_Cont_Status);
else
Error_Msg_Internal
(Msg => "instantiation error #",
Span => To_Span (Actual_Error_Loc),
Opan => Flag_Span,
- Msg_Cont => Msg_Cont_Status,
- Node => N);
+ Msg_Cont => Msg_Cont_Status);
end if;
end if;
end if;
@@ -653,8 +642,7 @@ package body Errout is
(Msg => Msg,
Span => To_Span (Actual_Error_Loc),
Opan => Flag_Span,
- Msg_Cont => Msg_Cont_Status,
- Node => N);
+ Msg_Cont => Msg_Cont_Status);
end;
end Error_Msg;
@@ -944,8 +932,7 @@ package body Errout is
(Msg : String;
Span : Source_Span;
Opan : Source_Span;
- Msg_Cont : Boolean;
- Node : Node_Id)
+ Msg_Cont : Boolean)
is
Sptr : constant Source_Ptr := Span.Ptr;
Optr : constant Source_Ptr := Opan.Ptr;
@@ -1247,8 +1234,7 @@ package body Errout is
Serious => Is_Serious_Error,
Uncond => Is_Unconditional_Msg,
Msg_Cont => Continuation,
- Deleted => False,
- Node => Node));
+ Deleted => False));
Cur_Msg := Errors.Last;
-- Test if warning to be treated as error
@@ -1471,8 +1457,7 @@ package body Errout is
(Msg => Msg,
Span => Span,
Opan => Opan,
- Msg_Cont => True,
- Node => Node);
+ Msg_Cont => True);
end;
end if;
end Error_Msg_Internal;
@@ -2026,9 +2011,9 @@ package body Errout is
-- Warn for unmatched Warnings (Off, ...)
if SWE.Open then
- Error_Msg_N
+ Error_Msg
("?.w?pragma Warnings Off with no matching Warnings On",
- SWE.Node);
+ SWE.Start);
-- Warn for ineffective Warnings (Off, ..)
@@ -2041,9 +2026,9 @@ package body Errout is
and then not
(SWE.Msg'Length > 3 and then SWE.Msg (2 .. 3) = "-W")
then
- Error_Msg_N
+ Error_Msg
("?.w?no warning suppressed by this pragma",
- SWE.Node);
+ SWE.Start);
end if;
end if;
end;
@@ -2394,9 +2379,6 @@ package body Errout is
-- whose value is the JSON location of Error.Sptr.Ptr. If Sptr.First and
-- Sptr.Last are different from Sptr.Ptr, they will be printed as JSON
-- locations under the names "start" and "finish".
- -- When Include_Subprogram_In_Messages is true (-gnatdJ) an additional,
- -- non-standard, attribute named "subprogram" will be added, allowing
- -- precisely identifying the subprogram surrounding the span.
-----------------------
-- Is_Continuation --
@@ -2473,12 +2455,6 @@ package body Errout is
Write_JSON_Location (Span.Last);
end if;
- if Include_Subprogram_In_Messages then
- Write_Str (",""subprogram"":""");
- Write_JSON_Escaped_String (Subprogram_Name_Ptr (Error.Node));
- Write_Str ("""");
- end if;
-
Write_Str ("}");
end Write_JSON_Span;
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index cef04d5daf2..f404018c44d 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -339,7 +339,6 @@ package body Erroutc is
w (" Uncond = ", E.Uncond);
w (" Msg_Cont = ", E.Msg_Cont);
w (" Deleted = ", E.Deleted);
- w (" Node = ", Int (E.Node));
Write_Eol;
end dmsg;
@@ -698,20 +697,7 @@ package body Erroutc is
-- Postfix warning tag to message if needed
if Tag /= "" and then Warning_Doc_Switch then
- if Include_Subprogram_In_Messages then
- Txt :=
- new String'
- (Subprogram_Name_Ptr (E_Msg.Node) &
- ": " & Text.all & ' ' & Tag);
- else
- Txt := new String'(Text.all & ' ' & Tag);
- end if;
-
- elsif Include_Subprogram_In_Messages
- and then (E_Msg.Warn or else E_Msg.Style)
- then
- Txt :=
- new String'(Subprogram_Name_Ptr (E_Msg.Node) & ": " & Text.all);
+ Txt := new String'(Text.all & ' ' & Tag);
else
Txt := Text;
end if;
@@ -744,8 +730,7 @@ package body Erroutc is
elsif E_Msg.Warn then
Txt := new String'(SGR_Warning & "warning: " & SGR_Reset & Txt.all);
- -- No prefix needed for style message, "(style)" is there already,
- -- although not necessarily in first position if -gnatdJ is used.
+ -- No prefix needed for style message, "(style)" is there already
elsif E_Msg.Style then
if Txt (Txt'First .. Txt'First + 6) = "(style)" then
@@ -1674,7 +1659,6 @@ package body Erroutc is
((Start => Loc,
Msg => new String'(Msg),
Stop => Source_Last (Get_Source_File_Index (Loc)),
- Node => Node,
Reason => Reason,
Open => True,
Used => Used,
diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index 1c43bce2b21..5d48d5b899f 100644
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -149,11 +149,6 @@ package Erroutc is
-- output. This is used for internal processing for the case of an
-- illegal instantiation. See Error_Msg routine for further details.
- type Subprogram_Name_Type is access function (N : Node_Id) return String;
- Subprogram_Name_Ptr : Subprogram_Name_Type;
- -- Indirect call to Sem_Util.Subprogram_Name to break circular
- -- dependency with the static elaboration model.
-
----------------------------
-- Message ID Definitions --
----------------------------
@@ -276,11 +271,6 @@ package Erroutc is
Deleted : Boolean;
-- If this flag is set, the message is not printed. This is used
-- in the circuit for deleting duplicate/redundant error messages.
-
- Node : Node_Id;
- -- If set, points to the node relevant for this message which will be
- -- used to compute the enclosing subprogram name if
- -- Opt.Include_Subprogram_In_Messages is set.
end record;
package Errors is new Table.Table (
@@ -352,14 +342,6 @@ package Erroutc is
-- Starting and ending source pointers for the range. These are always
-- from the same source file.
- Node : Node_Id;
- -- Node for the pragma Warnings occurrence. We store it to compute the
- -- enclosing subprogram if -gnatdJ is enabled and a message about this
- -- clause needs to be emitted. Note that we cannot remove the Start
- -- component above and use Sloc (Node) on message display instead
- -- because -gnatD output can already have messed with slocs at the point
- -- when warnings about ineffective clauses are emitted.
-
Reason : String_Id;
-- Reason string from pragma Warnings, or null string if none
diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb
index bac9d4b15f1..4f5aa216461 100644
--- a/gcc/ada/errutil.adb
+++ b/gcc/ada/errutil.adb
@@ -223,8 +223,7 @@ package body Errutil is
Serious => Is_Serious_Error,
Uncond => Is_Unconditional_Msg,
Msg_Cont => Continuation,
- Deleted => False,
- Node => Empty));
+ Deleted => False));
Cur_Msg := Errors.Last;
Prev_Msg := No_Error_Msg;
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 081d9435f4a..754dab82862 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -207,13 +207,6 @@ procedure Gnat1drv is
Error_To_Warning := True;
end if;
- -- -gnatdJ sets Include_Subprogram_In_Messages, adding the related
- -- subprogram as part of the error and warning messages.
-
- if Debug_Flag_JJ then
- Include_Subprogram_In_Messages := True;
- end if;
-
-- Disable CodePeer_Mode in Check_Syntax, since we need front-end
-- expansion.
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 5f402cf5d6e..d24b9b941ff 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -816,10 +816,6 @@ package Opt is
-- cause implicit packing instead of generating an error message. Set by
-- use of pragma Implicit_Packing.
- Include_Subprogram_In_Messages : Boolean := False;
- -- GNAT
- -- Set True to include the enclosing subprogram in compiler messages.
-
Init_Or_Norm_Scalars : Boolean := False;
-- GNAT, GNATBIND
-- Set True if a pragma Initialize_Scalars applies to the current unit.
diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb
index 8ed5947f4a0..f254026431f 100644
--- a/gcc/ada/par-util.adb
+++ b/gcc/ada/par-util.adb
@@ -689,12 +689,6 @@ package body Util is
pragma Assert (Scope.Last > 0);
Scope.Decrement_Last;
- if Include_Subprogram_In_Messages
- and then Scopes (Scope.Last).Labl /= Error
- then
- Current_Node := Scopes (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/sem_util.adb b/gcc/ada/sem_util.adb
index 3d12f552f41..1705b5817b9 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -30,7 +30,6 @@ with Debug; use Debug;
with Einfo.Utils; use Einfo.Utils;
with Elists; use Elists;
with Errout; use Errout;
-with Erroutc; use Erroutc;
with Exp_Ch6; use Exp_Ch6;
with Exp_Ch11; use Exp_Ch11;
with Exp_Util; use Exp_Util;
@@ -171,12 +170,6 @@ package body Sem_Util is
-- routine does not take simple flow diagnostics into account, it relies on
-- static facts such as the presence of null exclusions.
- function Subprogram_Name (N : Node_Id) return String;
- -- Return the fully qualified name of the enclosing subprogram for the
- -- given node N, with file:line:col information appended, e.g.
- -- "subp:file:line:col", corresponding to the source location of the
- -- body of the subprogram.
-
-----------------------------
-- Abstract_Interface_List --
-----------------------------
@@ -28074,113 +28067,6 @@ package body Sem_Util is
and then Has_Loop_Entry_Attributes (Entity (Identifier (Stmt)));
end Subject_To_Loop_Entry_Attributes;
- ---------------------
- -- Subprogram_Name --
- ---------------------
-
- function Subprogram_Name (N : Node_Id) return String is
- Buf : Bounded_String;
- Ent : Node_Id := N;
- Nod : Node_Id;
-
- begin
- while Present (Ent) loop
- case Nkind (Ent) is
- when N_Subprogram_Body =>
- Ent := Defining_Unit_Name (Specification (Ent));
- exit;
-
- when N_Subprogram_Declaration =>
- Nod := Corresponding_Body (Ent);
-
- if Present (Nod) then
- Ent := Nod;
- else
- Ent := Defining_Unit_Name (Specification (Ent));
- end if;
-
- exit;
-
- when N_Subprogram_Instantiation
- | N_Package_Body
- | N_Package_Specification
- =>
- Ent := Defining_Unit_Name (Ent);
- exit;
-
- when N_Protected_Type_Declaration =>
- Ent := Corresponding_Body (Ent);
- exit;
-
- when N_Protected_Body
- | N_Task_Body
- =>
- Ent := Defining_Identifier (Ent);
- exit;
-
- when N_Entity =>
- exit;
-
- when others =>
- null;
- end case;
-
- Ent := Parent (Ent);
- end loop;
-
- if No (Ent) then
- return "unknown subprogram:unknown file:0:0";
- end if;
-
- -- If the subprogram is a child unit, use its simple name to start the
- -- construction of the fully qualified name.
-
- if Nkind (Ent) = N_Defining_Program_Unit_Name then
- Ent := Defining_Identifier (Ent);
- end if;
-
- Append_Entity_Name (Buf, Ent);
-
- -- Append homonym number if needed
-
- if Nkind (N) in N_Entity and then Has_Homonym (N) then
- declare
- H : Entity_Id := Homonym (N);
- Nr : Nat := 1;
-
- begin
- while Present (H) loop
- if Scope (H) = Scope (N) then
- Nr := Nr + 1;
- end if;
-
- H := Homonym (H);
- end loop;
-
- if Nr > 1 then
- Append (Buf, '#');
- Append (Buf, Nr);
- end if;
- end;
- end if;
-
- -- Append source location of Ent to Buf so that the string will
- -- look like "subp:file:line:col".
-
- declare
- Loc : constant Source_Ptr := Sloc (Ent);
- begin
- Append (Buf, ':');
- Append (Buf, Reference_Name (Get_Source_File_Index (Loc)));
- Append (Buf, ':');
- Append (Buf, Nat (Get_Logical_Line_Number (Loc)));
- Append (Buf, ':');
- Append (Buf, Nat (Get_Column_Number (Loc)));
- end;
-
- return +Buf;
- end Subprogram_Name;
-
-------------------------------
-- Support_Atomic_Primitives --
-------------------------------
@@ -31395,6 +31281,4 @@ package body Sem_Util is
end Storage_Model_Support;
-begin
- Erroutc.Subprogram_Name_Ptr := Subprogram_Name'Access;
end Sem_Util;
--
2.45.1
