------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- D I A G N O S T I C S . C O N V E R T E R -- -- -- -- B o d y -- -- -- -- Copyright (C) 1992-2025, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING3. If not, go to -- -- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with Erroutc; use Erroutc; with Debug; use Debug; with Diagnostics.Repository; use Diagnostics.Repository; with Diagnostics.SARIF_Emitter; use Diagnostics.SARIF_Emitter; with Diagnostics.Switch_Repository; use Diagnostics.Switch_Repository; with Opt; use Opt; with Osint; use Osint; with Output; use Output; use Diagnostics.Diagnostics_Lists; with System.OS_Lib; use System.OS_Lib; package body Diagnostics.Converter is function Convert (E_Id : Error_Msg_Id) return Diagnostic_Type; function Convert_Sub_Diagnostic (E_Id : Error_Msg_Id) return Sub_Diagnostic_Type; function Get_Warning_Kind (E_Msg : Error_Msg_Object) return Diagnostic_Kind is (if E_Msg.Warn_Chr = "* " then Restriction_Warning elsif E_Msg.Warn_Chr = "? " then Default_Warning elsif E_Msg.Warn_Chr = " " then Tagless_Warning else Warning); -- NOTE: Some messages have both info and warning set to true. The old -- printer added the warning switch label but treated the message as -- an info message. function Get_Diagnostics_Kind (E_Msg : Error_Msg_Object) return Diagnostic_Kind is (if E_Msg.Kind = Erroutc.Warning then Get_Warning_Kind (E_Msg) elsif E_Msg.Kind = Erroutc.Style then Style elsif E_Msg.Kind = Erroutc.Info then Info elsif E_Msg.Kind = Erroutc.Non_Serious_Error then Non_Serious_Error else Error); ----------------------------------- -- Convert_Errors_To_Diagnostics -- ----------------------------------- procedure Convert_Errors_To_Diagnostics is E : Error_Msg_Id; begin E := First_Error_Msg; while E /= No_Error_Msg loop if not Errors.Table (E).Deleted and then not Errors.Table (E).Msg_Cont then -- We do not need to update the count of converted error messages -- since they are accounted for in their creation. Record_Diagnostic (Convert (E), Update_Count => False); end if; E := Errors.Table (E).Next; end loop; end Convert_Errors_To_Diagnostics; ---------------------------- -- Convert_Sub_Diagnostic -- ---------------------------- function Convert_Sub_Diagnostic (E_Id : Error_Msg_Id) return Sub_Diagnostic_Type is E_Msg : constant Error_Msg_Object := Errors.Table (E_Id); D : Sub_Diagnostic_Type; begin D.Message := E_Msg.Text; -- All converted sub-diagnostics are continuations. When emitted they -- shall be printed with the same kind token as the main diagnostic. D.Kind := Continuation; Add_Location (D, Primary_Labeled_Span (if E_Msg.Insertion_Sloc /= No_Location then To_Span (E_Msg.Insertion_Sloc) else E_Msg.Sptr)); if E_Msg.Optr.Ptr /= E_Msg.Sptr.Ptr then Add_Location (D, Secondary_Labeled_Span (E_Msg.Optr)); end if; return D; end Convert_Sub_Diagnostic; ------------- -- Convert -- ------------- function Convert (E_Id : Error_Msg_Id) return Diagnostic_Type is E_Next_Id : Error_Msg_Id; E_Msg : constant Error_Msg_Object := Errors.Table (E_Id); D : Diagnostic_Type; begin D.Message := E_Msg.Text; D.Kind := Get_Diagnostics_Kind (E_Msg); if E_Msg.Kind in Erroutc.Warning | Erroutc.Style | Erroutc.Info then D.Switch := Get_Switch_Id (E_Msg); end if; D.Warn_Err := E_Msg.Warn_Err; -- Convert the primary location Add_Location (D, Primary_Labeled_Span (E_Msg.Sptr)); -- Convert the secondary location if it is different from the primary if E_Msg.Optr.Ptr /= E_Msg.Sptr.Ptr then Add_Location (D, Secondary_Labeled_Span (E_Msg.Optr)); end if; E_Next_Id := Errors.Table (E_Id).Next; while E_Next_Id /= No_Error_Msg and then Errors.Table (E_Next_Id).Msg_Cont loop Add_Sub_Diagnostic (D, Convert_Sub_Diagnostic (E_Next_Id)); E_Next_Id := Errors.Table (E_Next_Id).Next; end loop; return D; end Convert; ---------------------- -- Emit_Diagnostics -- ---------------------- procedure Emit_Diagnostics is D : Diagnostic_Type; It : Iterator := Iterate (All_Diagnostics); Sarif_File_Name : constant String := Get_First_Main_File_Name & ".gnat.sarif"; Switches_File_Name : constant String := "gnat_switches.json"; Diagnostics_File_Name : constant String := "gnat_diagnostics.json"; Dummy : Boolean; begin if Opt.SARIF_Output then Set_Standard_Error; Print_SARIF_Report (All_Diagnostics); Set_Standard_Output; elsif Opt.SARIF_File then Delete_File (Sarif_File_Name, Dummy); declare Output_FD : constant File_Descriptor := Create_New_File (Sarif_File_Name, Fmode => Text); begin Set_Output (Output_FD); Print_SARIF_Report (All_Diagnostics); Set_Standard_Output; Close (Output_FD); end; else Set_Standard_Error; while Has_Next (It) loop Next (It, D); Print_Diagnostic (D); end loop; Set_Standard_Output; end if; if Debug_Flag_Underscore_EE then -- Print the switch repository to a file Delete_File (Switches_File_Name, Dummy); declare Output_FD : constant File_Descriptor := Create_New_File (Switches_File_Name, Fmode => Text); begin Set_Output (Output_FD); Print_Switch_Repository; Set_Standard_Output; Close (Output_FD); end; -- Print the diagnostics repository to a file Delete_File (Diagnostics_File_Name, Dummy); declare Output_FD : constant File_Descriptor := Create_New_File (Diagnostics_File_Name, Fmode => Text); begin Set_Output (Output_FD); Print_Diagnostic_Repository; Set_Standard_Output; Close (Output_FD); end; end if; Destroy (All_Diagnostics); end Emit_Diagnostics; end Diagnostics.Converter;