[Ada] Add "option" field to GNAT's -fdiagnostics-format=json output

This enables better integration with tools that handle GNAT's output.

gcc/ada/

	* erroutc.ads (Get_Warning_Option): New function returning the
	option responsible for a warning if it exists.
	* erroutc.adb (Get_Warning_Option): Likewise.
	(Get_Warning_Tag): Rely on Get_Warning_Option when possible.
	* errout.adb (Output_JSON_Message): Emit option field.

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 101aed4..8658c38 100644 (file)
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -2170,6 +2170,9 @@ package body Errout is
       --  Do not print continuations messages as children of the current
       --  message if the current message is a continuation message.
 
+      Option : constant String := Get_Warning_Option (E);
+      --  The option that triggered this message.
+
    --  Start of processing for Output_JSON_Message
 
    begin
@@ -2197,9 +2200,16 @@ package body Errout is
          Write_Str ("}");
       end if;
 
+      Write_Str ("]");
+
+      --  Print message option, if there is one
+      if Option /= "" then
+         Write_Str (",""option"":""" & Option & """");
+      end if;
+
       --  Print message content
 
-      Write_Str ("],""message"":""");
+      Write_Str (",""message"":""");
       Write_JSON_Escaped_String (Errors.Table (E).Text);
       Write_Str ("""");
 

diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 866294e..b4f5064 100644 (file)
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -359,6 +359,26 @@ package body Erroutc is
       return Cur_Msg;
    end Get_Msg_Id;
 
+   ------------------------
+   -- Get_Warning_Option --
+   ------------------------
+
+   function Get_Warning_Option (Id : Error_Msg_Id) return String is
+      Warn     : constant Boolean         := Errors.Table (Id).Warn;
+      Warn_Chr : constant String (1 .. 2) := Errors.Table (Id).Warn_Chr;
+   begin
+      if Warn and then Warn_Chr /= "  " then
+         if Warn_Chr = "$ " then
+            return "-gnatel";
+         elsif Warn_Chr (2) = ' ' then
+            return "-gnatw" & Warn_Chr (1);
+         else
+            return "-gnatw" & Warn_Chr;
+         end if;
+      end if;
+      return "";
+   end Get_Warning_Option;
+
    ---------------------
    -- Get_Warning_Tag --
    ---------------------
@@ -366,22 +386,19 @@ package body Erroutc is
    function Get_Warning_Tag (Id : Error_Msg_Id) return String is
       Warn     : constant Boolean         := Errors.Table (Id).Warn;
       Warn_Chr : constant String (1 .. 2) := Errors.Table (Id).Warn_Chr;
+      Option   : constant String          := Get_Warning_Option (Id);
    begin
-      if Warn and then Warn_Chr /= "  " then
+      if Warn then
          if Warn_Chr = "? " then
             return "[enabled by default]";
          elsif Warn_Chr = "* " then
             return "[restriction warning]";
-         elsif Warn_Chr = "$ " then
-            return "[-gnatel]";
-         elsif Warn_Chr (2) = ' ' then
-            return "[-gnatw" & Warn_Chr (1) & ']';
-         else
-            return "[-gnatw" & Warn_Chr & ']';
+         elsif Option /= "" then
+            return "[" & Option & "]";
          end if;
-      else
-         return "";
       end if;
+
+      return "";
    end Get_Warning_Tag;
 
    -------------

diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index be8755b..7957228 100644 (file)
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -493,6 +493,10 @@ package Erroutc is
    --  Returns the number of warnings in the Errors table that were triggered
    --  by a Compile_Time_Warning pragma.
 
+   function Get_Warning_Option (Id : Error_Msg_Id) return String;
+   --  Returns the warning switch causing this warning message or an empty
+   --  string is there is none..
+
    function Get_Warning_Tag (Id : Error_Msg_Id) return String;
    --  Given an error message ID, return tag showing warning message class, or
    --  the null string if this option is not enabled or this is not a warning.