ada: Remove -gnatdJ switch

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

9 files changed, 22 insertions, 220 deletions

diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 540db2a..602a8fa 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 92c4f6a..76c461a 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 cef04d5d..f404018c 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 1c43bce..5d48d5b 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 bac9d4b..4f5aa21 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 081d943..754dab8 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 5f402cf..d24b9b9 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 8ed5947..f254026 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 3d12f55..1705b58 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;