diff options
Diffstat (limited to 'gcc/ada/diagnostics-converter.adb')
| -rw-r--r-- | gcc/ada/diagnostics-converter.adb | 281 |
1 files changed, 281 insertions, 0 deletions
diff --git a/gcc/ada/diagnostics-converter.adb b/gcc/ada/diagnostics-converter.adb new file mode 100644 index 0000000..45bb19c --- /dev/null +++ b/gcc/ada/diagnostics-converter.adb @@ -0,0 +1,281 @@ +------------------------------------------------------------------------------ +-- -- +-- 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-2024, 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.Info then Info_Warning + elsif 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. + + ----------------------------------- + -- 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; + + declare + L : Labeled_Span_Type; + begin + if E_Msg.Insertion_Sloc /= No_Location then + L.Span := To_Span (E_Msg.Insertion_Sloc); + else + L.Span := E_Msg.Sptr; + end if; + + L.Is_Primary := True; + Add_Location (D, L); + end; + + if E_Msg.Optr.Ptr /= E_Msg.Sptr.Ptr then + declare + L : Labeled_Span_Type; + begin + L.Span := E_Msg.Optr; + L.Is_Primary := False; + Add_Location (D, L); + end; + 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; + + if E_Msg.Warn then + D.Kind := Get_Warning_Kind (E_Msg); + D.Switch := Get_Switch_Id (E_Msg); + elsif E_Msg.Style then + D.Kind := Style; + D.Switch := Get_Switch_Id (E_Msg); + elsif E_Msg.Info then + D.Kind := Info; + D.Switch := Get_Switch_Id (E_Msg); + else + D.Kind := Error; + end if; + + D.Warn_Err := E_Msg.Warn_Err; + + D.Serious := E_Msg.Serious; + + -- Convert the primary location + + declare + L : Labeled_Span_Type; + begin + L.Span := E_Msg.Sptr; + L.Is_Primary := True; + Add_Location (D, L); + end; + + -- Convert the secondary location if it is different from the primary + + if E_Msg.Optr.Ptr /= E_Msg.Sptr.Ptr then + declare + L : Labeled_Span_Type; + begin + L.Span := E_Msg.Optr; + L.Is_Primary := False; + Add_Location (D, L); + end; + 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; |