From a4db870e1b042ac6ab7ddaef6e2d3e32408578dd Mon Sep 17 00:00:00 2001
From: Ghjuvan Lacambre <lacambre@adacore.com>
Date: Wed, 27 Apr 2022 15:01:28 +0200
Subject: [PATCH] [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.
---
gcc/ada/errout.adb | 12 +++++++++++-
gcc/ada/erroutc.adb | 35 ++++++++++++++++++++++++++---------
gcc/ada/erroutc.ads | 4 ++++
3 files changed, 41 insertions(+), 10 deletions(-)
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 101aed435e6a..8658c38d559d 100644
--- 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 866294ee64b4..b4f506496020 100644
--- 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 be8755b316e0..7957228a91b8 100644
--- 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.
--
GitLab