From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from rock.gnat.com (rock.gnat.com [IPv6:2620:20:4000:0:a9e:1ff:fe9b:1d1]) by sourceware.org (Postfix) with ESMTPS id 2D81939B440C for ; Fri, 18 Jun 2021 08:38:27 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 2D81939B440C Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id EDFCC117886; Fri, 18 Jun 2021 04:38:26 -0400 (EDT) X-Virus-Scanned: Debian amavisd-new at gnat.com Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id JAr9VxgjCFid; Fri, 18 Jun 2021 04:38:26 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id D53DA117514; Fri, 18 Jun 2021 04:38:26 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id D434A180; Fri, 18 Jun 2021 04:38:26 -0400 (EDT) Date: Fri, 18 Jun 2021 04:38:26 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Ghjuvan Lacambre Subject: [Ada] Implement basic support for -fdiagnostics-format=json Message-ID: <20210618083826.GA128551@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="bp/iNruPH9dso1Pn" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-12.3 required=5.0 tests=BAYES_00, GIT_PATCH_0, KAM_ASCII_DIVIDERS, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP, WEIRD_QUOTING autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Fri, 18 Jun 2021 08:38:29 -0000 --bp/iNruPH9dso1Pn Content-Type: text/plain; charset=us-ascii Content-Disposition: inline This commit implements basic support for the -fdiagnostics-format=json option that GCC has. When GNAT finds this argument in the command line, error messages such as: tmp.adb:4:12: "My_Var" is undefined Will be printed as: [ { "kind": "error", "locations": [ { "caret": { "file": "tmp.adb", "line": 4, "column": 12 }, "finish": { "file": "tmp.adb", "line": 4, "column": 17 } } ], "message": "\"My_Var\" is undefined" } ] This will make the task of interfacing with GNAT easier. Support for GCC's other message attributes, such as "fixits", "option" and "option_url" will be implemented in a later commit. Design decision: while -fdiagnostics-format=json inhibits regular printing of messages, it doesn't do so if -gnatv or -gnatl are present. This is for two reasons: - Combining -fdiagnostics-format=json with -gnatv makes comparing the output of both options easier. - While combining these options is likely to be a mistake from the user, printing both kinds of output will make the issue more obvious than silently silencing one of the two. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * back_end.adb (Scan_Back_End_Switches): Set Opt.JSON_Output to True if -fdiagnostics-format=json option is found. * back_end.ads (Scan_Compiler_Arguments): Mention Opt.JSON_Output. * errout.adb (Output_JSON_Message): New procedure. (Output_Messages): If Opt.JSON_Output is True, print messages with new Output_JSON_Message procedure. * opt.ads: Declare JSON_Output variable. * doc/gnat_ugn/building_executable_programs_with_gnat.rst: Mention new -fdiagnostics-format option. * gnat_ugn.texi: Regenerate. --bp/iNruPH9dso1Pn Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb --- a/gcc/ada/back_end.adb +++ b/gcc/ada/back_end.adb @@ -281,6 +281,14 @@ package body Back_End is elsif Switch_Chars (First .. Last) = "fpreserve-control-flow" then Opt.Suppress_Control_Flow_Optimizations := True; + -- Back end switch -fdiagnostics-format=json tells the frontend to + -- output its error and warning messages in the same format GCC + -- uses when passed -fdiagnostics-format=json. + + elsif Switch_Chars (First .. Last) = "fdiagnostics-format=json" + then + Opt.JSON_Output := True; + -- Back end switch -fdump-scos, which exists primarily for C, is -- also accepted for Ada as a synonym of -gnateS. diff --git a/gcc/ada/back_end.ads b/gcc/ada/back_end.ads --- a/gcc/ada/back_end.ads +++ b/gcc/ada/back_end.ads @@ -70,6 +70,7 @@ package Back_End is -- Opt.Suppress_Control_Float_Optimizations -- Opt.Generate_SCO -- Opt.Generate_SCO_Instance_Table + -- Opt.JSON_Output -- Opt.Stack_Checking_Enabled -- Opt.No_Stdinc -- Opt.No_Stdlib diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst --- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst @@ -1233,6 +1233,13 @@ Alphabetical List of All Switches marker is specified, the callgraph is decorated with information about dynamically allocated objects. +.. index:: -fdiagnostics-format (gcc) + +:switch:`-fdiagnostics-format=json` + Makes GNAT emit warning and error messages as JSON. Inhibits printing of + text warning and errors messages except if :switch:`-gnatv` or + :switch:`-gnatl` are present. + .. index:: -fdump-scos (gcc) diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -130,6 +130,11 @@ package body Errout is -- or if it refers to an Etype that has an error posted on it, or if -- it references an Entity that has an error posted on it. + procedure Output_JSON_Message (Error_Id : Error_Msg_Id); + -- Output error message Error_Id and any subsequent continuation message + -- using a JSON format similar to the one GCC uses when passed + -- -fdiagnostics-format=json. + procedure Output_Source_Line (L : Physical_Line_Number; Sfile : Source_File_Index; @@ -2055,6 +2060,133 @@ package body Errout is end if; end OK_Node; + ------------------------- + -- Output_JSON_Message -- + ------------------------- + + procedure Output_JSON_Message (Error_Id : Error_Msg_Id) is + + procedure Write_JSON_Escaped_String (Str : String_Ptr); + -- Write each character of Str, taking care of preceding each quote and + -- backslash with a backslash. Note that this escaping differs from what + -- GCC does. + -- + -- Indeed, the JSON specification mandates encoding wide characters + -- either as their direct UTF-8 representation or as their escaped + -- UTF-16 surrogate pairs representation. GCC seems to prefer escaping - + -- we choose to use the UTF-8 representation instead. + + procedure Write_JSON_Location (Sptr : Source_Ptr); + -- Write Sptr as a JSON location, an object containing a file attribute, + -- a line number and a column number. + + procedure Write_JSON_Span (Span : Source_Span); + -- Write Span as a JSON span, an object containing a "caret" attribute + -- whose value is the JSON location of Span.Ptr. If Span.First and + -- Span.Last are different from Span.Ptr, they will be printed as JSON + -- locations under the names "start" and "finish". + + ------------------------------- + -- Write_JSON_Escaped_String -- + ------------------------------- + + procedure Write_JSON_Escaped_String (Str : String_Ptr) is + begin + for C of Str.all loop + if C = '"' or else C = '\' then + Write_Char ('\'); + end if; + + Write_Char (C); + end loop; + end Write_JSON_Escaped_String; + + ------------------------- + -- Write_JSON_Location -- + ------------------------- + + procedure Write_JSON_Location (Sptr : Source_Ptr) is + begin + Write_Str ("{""file"":"""); + Write_Name (Full_Ref_Name (Get_Source_File_Index (Sptr))); + Write_Str (""",""line"":"); + Write_Int (Pos (Get_Physical_Line_Number (Sptr))); + Write_Str (", ""column"":"); + Write_Int (Nat (Get_Column_Number (Sptr))); + Write_Str ("}"); + end Write_JSON_Location; + + --------------------- + -- Write_JSON_Span -- + --------------------- + + procedure Write_JSON_Span (Span : Source_Span) is + begin + Write_Str ("{""caret"":"); + Write_JSON_Location (Span.Ptr); + + if Span.Ptr /= Span.First then + Write_Str (",""start"":"); + Write_JSON_Location (Span.First); + end if; + + if Span.Ptr /= Span.Last then + Write_Str (",""finish"":"); + Write_JSON_Location (Span.Last); + end if; + + Write_Str ("}"); + end Write_JSON_Span; + + -- Local Variables + + E : Error_Msg_Id := Error_Id; + + -- Start of processing for Output_JSON_Message + + begin + + -- Print message kind + + Write_Str ("{""kind"":"); + + if Errors.Table (E).Warn and then not Errors.Table (E).Warn_Err then + Write_Str ("""warning"""); + elsif Errors.Table (E).Info or else Errors.Table (E).Check then + Write_Str ("""note"""); + else + Write_Str ("""error"""); + end if; + + -- Print message location + + Write_Str (",""locations"":["); + Write_JSON_Span (Errors.Table (E).Sptr); + + if Errors.Table (E).Optr /= Errors.Table (E).Sptr.Ptr then + Write_Str (",{""caret"":"); + Write_JSON_Location (Errors.Table (E).Optr); + Write_Str ("}"); + end if; + + -- Print message content + + Write_Str ("],""message"":"""); + Write_JSON_Escaped_String (Errors.Table (E).Text); + + -- Print message continuations if present + + E := E + 1; + + while E <= Last_Error_Msg and then Errors.Table (E).Msg_Cont loop + Write_Str (", "); + Write_JSON_Escaped_String (Errors.Table (E).Text); + E := E + 1; + end loop; + + Write_Str ("""}"); + end Output_JSON_Message; + --------------------- -- Output_Messages -- --------------------- @@ -2615,9 +2747,46 @@ package body Errout is Current_Error_Source_File := No_Source_File; end if; + if Opt.JSON_Output then + Set_Standard_Error; + + E := First_Error_Msg; + + -- Find first printable message + + while E /= No_Error_Msg and then Errors.Table (E).Deleted loop + E := Errors.Table (E).Next; + end loop; + + Write_Char ('['); + + if E /= No_Error_Msg then + + Output_JSON_Message (E); + + E := Errors.Table (E).Next; + + -- Skip deleted messages. + -- Also skip continuation messages, as they have already been + -- printed along the message they're attached to. + + while E /= No_Error_Msg + and then not Errors.Table (E).Deleted + and then not Errors.Table (E).Msg_Cont + loop + Write_Char (','); + Output_JSON_Message (E); + E := Errors.Table (E).Next; + end loop; + end if; + + Write_Char (']'); + + Set_Standard_Output; + -- Brief Error mode - if Brief_Output or (not Full_List and not Verbose_Mode) then + elsif Brief_Output or (not Full_List and not Verbose_Mode) then Set_Standard_Error; E := First_Error_Msg; @@ -2899,7 +3068,9 @@ package body Errout is Write_Error_Summary; end if; - Write_Max_Errors; + if not Opt.JSON_Output then + Write_Max_Errors; + end if; -- Even though Warning_Info_Messages are a subclass of warnings, they -- must not be treated as errors when -gnatwe is in effect. diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -8581,6 +8581,18 @@ marker is specified, the callgraph is decorated with information about dynamically allocated objects. @end table +@geindex -fdiagnostics-format (gcc) + + +@table @asis + +@item @code{-fdiagnostics-format=json} + +Makes GNAT emit warning and error messages as JSON. Inhibits printing of +text warning and errors messages except if @code{-gnatv} or +@code{-gnatl} are present. +@end table + @geindex -fdump-scos (gcc) diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -915,6 +915,11 @@ package Opt is -- directory if these files already exist or in the source directory -- if not. + JSON_Output : Boolean := False; + -- GNAT + -- Output error and warning messages in JSON format. Set to true when the + -- backend option "-fdiagnostics-format=json" is found on the command line. + Keep_Going : Boolean := False; -- GNATMAKE, GPRBUILD -- When True signals to ignore compilation errors and keep processing --bp/iNruPH9dso1Pn--