public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-1614] [Ada] Implement basic support for -fdiagnostics-format=json Date: Fri, 18 Jun 2021 08:37:54 +0000 (GMT) [thread overview] Message-ID: <20210618083754.6FC6B388CC14@sourceware.org> (raw) https://gcc.gnu.org/g:26373979deab7481b0503d86e80390ab65c65381 commit r12-1614-g26373979deab7481b0503d86e80390ab65c65381 Author: Ghjuvan Lacambre <lacambre@adacore.com> Date: Wed Jan 27 09:53:26 2021 +0100 [Ada] Implement basic support for -fdiagnostics-format=json 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. Diff: --- gcc/ada/back_end.adb | 8 + gcc/ada/back_end.ads | 1 + .../building_executable_programs_with_gnat.rst | 7 + gcc/ada/errout.adb | 175 ++++++++++++++++++++- gcc/ada/gnat_ugn.texi | 12 ++ gcc/ada/opt.ads | 5 + 6 files changed, 206 insertions(+), 2 deletions(-) diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb index a170ed5fbaf..42d837d1df9 100644 --- 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 index 8f8682558e3..32a0ea34b23 100644 --- 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 index 446e7cf1a2f..0b5e71fb0b2 100644 --- 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 index 42a1099c8f4..16f7aa3a85c 100644 --- 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 index f7773c37b05..369427ccf7b 100644 --- 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 index 5384bd9da3f..827bbeff9c9 100644 --- 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
reply other threads:[~2021-06-18 8:37 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20210618083754.6FC6B388CC14@sourceware.org \ --to=pmderodat@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).