mirror of
https://forge.sourceware.org/marek/gcc.git
synced 2026-02-22 03:47:02 -05:00
176 lines
6.5 KiB
Ada
176 lines
6.5 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- E R R I D --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 1992-2026, 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 Errid.Diagnostic_Repository; use Errid.Diagnostic_Repository;
|
|
with Errid.Switch_Repository; use Errid.Switch_Repository;
|
|
with Erroutc.SARIF_Emitter; use Erroutc.SARIF_Emitter;
|
|
|
|
package body Errid is
|
|
|
|
Doc_Directory : constant String := "./error_codes";
|
|
Doc_Extension : constant String := ".md";
|
|
|
|
Diagnostic_Inconsistency : exception;
|
|
|
|
procedure Add_All_Diagnostic_Rules (Printer : in out SARIF_Printer);
|
|
-- Add all active Diagnostic_Id-s to the SARIF_Printer
|
|
|
|
procedure Add_All_Switch_Rules (Printer : in out SARIF_Printer);
|
|
-- Add all active Switch_Id-s to the SARIF_Printer
|
|
|
|
procedure Check_Diagnostic_To_Switch_Consistency (D_Id : Diagnostic_Id);
|
|
-- Check that if a diagnostic has a switch then that diagnostic is also
|
|
-- included in the list of diagnostics for that switch.
|
|
|
|
procedure Check_Switch_To_Diagnostic_Consistency (S_Id : Switch_Id);
|
|
-- Check that if a Switch has diagnostics then that diagnostic has the same
|
|
-- switch marked as its switch.
|
|
|
|
--------------------------------------------
|
|
-- Check_Diagnostic_To_Switch_Consistency --
|
|
--------------------------------------------
|
|
|
|
procedure Check_Diagnostic_To_Switch_Consistency (D_Id : Diagnostic_Id) is
|
|
D : constant Diagnostic_Entry_Type := Diagnostic_Entries (D_Id);
|
|
Err_Msg : constant String :=
|
|
Switch_Id'Image (D.Switch)
|
|
& " should contain "
|
|
& Diagnostic_Id'Image (D_Id)
|
|
& " in its diagnostics";
|
|
begin
|
|
if D.Switch = No_Switch_Id then
|
|
return;
|
|
end if;
|
|
|
|
if Switches (D.Switch).Diagnostics = null then
|
|
raise Diagnostic_Inconsistency with Err_Msg;
|
|
end if;
|
|
|
|
for DD of Switches (D.Switch).Diagnostics.all loop
|
|
if D_Id = DD then
|
|
return;
|
|
end if;
|
|
end loop;
|
|
|
|
raise Diagnostic_Inconsistency with Err_Msg;
|
|
end Check_Diagnostic_To_Switch_Consistency;
|
|
|
|
--------------------------------------------
|
|
-- Check_Switch_To_Diagnostic_Consistency --
|
|
--------------------------------------------
|
|
|
|
procedure Check_Switch_To_Diagnostic_Consistency (S_Id : Switch_Id) is
|
|
S : constant Switch_Type := Switches (S_Id);
|
|
D : Diagnostic_Entry_Type;
|
|
begin
|
|
if S.Diagnostics = null then
|
|
return;
|
|
end if;
|
|
|
|
for D_Id of S.Diagnostics.all loop
|
|
D := Diagnostic_Entries (D_Id);
|
|
if D.Switch /= S_Id then
|
|
raise Diagnostic_Inconsistency
|
|
with
|
|
Switch_Id'Image (S_Id)
|
|
& " should be the switch for "
|
|
& Diagnostic_Id'Image (D_Id);
|
|
end if;
|
|
end loop;
|
|
end Check_Switch_To_Diagnostic_Consistency;
|
|
|
|
----------------------------
|
|
-- Get_Documentation_File --
|
|
----------------------------
|
|
|
|
function Get_Documentation_File (Id : Diagnostic_Id) return String is
|
|
begin
|
|
if Id = No_Diagnostic_Id then
|
|
return "";
|
|
else
|
|
return Doc_Directory & "/" & To_String (Id) & Doc_Extension;
|
|
end if;
|
|
end Get_Documentation_File;
|
|
|
|
---------------
|
|
-- To_String --
|
|
---------------
|
|
|
|
function To_String (Id : Diagnostic_Id) return String is
|
|
begin
|
|
if Id = No_Diagnostic_Id then
|
|
return "GNAT0000";
|
|
else
|
|
return Id'Img;
|
|
end if;
|
|
end To_String;
|
|
|
|
------------------------------
|
|
-- Add_All_Diagnostic_Rules --
|
|
------------------------------
|
|
|
|
procedure Add_All_Diagnostic_Rules (Printer : in out SARIF_Printer) is
|
|
begin
|
|
Printer.Diagnostics := Diagnostic_Id_Lists.Create;
|
|
for Id in Diagnostic_Id loop
|
|
if Id /= No_Diagnostic_Id then
|
|
Diagnostic_Id_Lists.Append (Printer.Diagnostics, Id);
|
|
Check_Diagnostic_To_Switch_Consistency (Id);
|
|
end if;
|
|
end loop;
|
|
end Add_All_Diagnostic_Rules;
|
|
|
|
--------------------------
|
|
-- Add_All_Switch_Rules --
|
|
--------------------------
|
|
|
|
procedure Add_All_Switch_Rules (Printer : in out SARIF_Printer) is
|
|
begin
|
|
Printer.Switches := Switch_Id_Lists.Create;
|
|
for S in Switch_Id loop
|
|
if S /= No_Switch_Id then
|
|
Switch_Id_Lists.Append (Printer.Switches, S);
|
|
Check_Switch_To_Diagnostic_Consistency (S);
|
|
end if;
|
|
end loop;
|
|
end Add_All_Switch_Rules;
|
|
|
|
---------------------------------
|
|
-- Print_Diagnostic_Repository --
|
|
---------------------------------
|
|
|
|
procedure Print_Diagnostic_Repository is
|
|
Printer : SARIF_Printer;
|
|
begin
|
|
Add_All_Diagnostic_Rules (Printer);
|
|
Add_All_Switch_Rules (Printer);
|
|
Printer.Report_Type := Repository_Report;
|
|
|
|
Print_SARIF_Report (Printer);
|
|
Free (Printer);
|
|
end Print_Diagnostic_Repository;
|
|
|
|
end Errid;
|