diff options
Diffstat (limited to 'gcc/ada/diagnostics.ads')
| -rw-r--r-- | gcc/ada/diagnostics.ads | 481 |
1 files changed, 481 insertions, 0 deletions
diff --git a/gcc/ada/diagnostics.ads b/gcc/ada/diagnostics.ads new file mode 100644 index 0000000..18afb1c --- /dev/null +++ b/gcc/ada/diagnostics.ads @@ -0,0 +1,481 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- D I A G N O S T I C S -- +-- -- +-- S p e c -- +-- -- +-- 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 Types; use Types; +with GNAT.Lists; use GNAT.Lists; + +package Diagnostics is + + type Diagnostic_Id is + (No_Diagnostic_Id, + GNAT0001, + GNAT0002, + GNAT0003, + GNAT0004, + GNAT0005, + GNAT0006, + GNAT0007, + GNAT0008, + GNAT0009, + GNAT0010); + + -- Labeled_Span_Type represents a span of source code that is associated + -- with a textual label. Primary spans indicate the primary location of the + -- diagnostic. Non-primary spans are used to indicate secondary locations. + -- + -- Spans can contain labels that are used to annotate the highlighted span. + -- Usually, the label is a short and concise message that provide + -- additional allthough non-critical information about the span. This is + -- an important since labels are not printed in the brief output and are + -- only present in the pretty and structural outputs. That is an important + -- distintion when choosing between a label and a sub-diagnostic. + type Labeled_Span_Type is record + Label : String_Ptr := null; + -- Text associated with the span + + Span : Source_Span := (others => No_Location); + -- Textual region in the source code + + Is_Primary : Boolean := True; + -- Primary spans are used to indicate the primary location of the + -- diagnostic. Typically there should just be one primary span per + -- diagnostic. + -- Non-primary spans are used to indicate secondary locations and + -- typically are formatted in a different way or omitted in some + -- contexts. + + Is_Region : Boolean := False; + -- Regional spans are multiline spans that have a unique way of being + -- displayed in the pretty output. + end record; + + No_Labeled_Span : constant Labeled_Span_Type := (others => <>); + + procedure Destroy (Elem : in out Labeled_Span_Type); + pragma Inline (Destroy); + + package Labeled_Span_Lists is new Doubly_Linked_Lists + (Element_Type => Labeled_Span_Type, + "=" => "=", + Destroy_Element => Destroy, + Check_Tampering => False); + subtype Labeled_Span_List is Labeled_Span_Lists.Doubly_Linked_List; + + type Sub_Diagnostic_Kind is + (Continuation, + Help, + Note, + Suggestion); + + -- Sub_Diagnostic_Type represents a sub-diagnostic message that is meant + -- to provide additional information about the primary diagnostic message. + -- + -- Sub-diagnostics are usually constructed with a full sentence as the + -- message and provide important context to the main diagnostic message or + -- some concrete action to the user. + -- + -- This is different from the labels of labeled spans which are meant to be + -- short and concise and are mostly there to annotate the higlighted span. + + type Sub_Diagnostic_Type is record + Kind : Sub_Diagnostic_Kind; + + Message : String_Ptr; + + Locations : Labeled_Span_List; + end record; + + procedure Add_Location + (Diagnostic : in out Sub_Diagnostic_Type; Location : Labeled_Span_Type); + + function Primary_Location + (Diagnostic : Sub_Diagnostic_Type) return Labeled_Span_Type; + + procedure Destroy (Elem : in out Sub_Diagnostic_Type); + pragma Inline (Destroy); + + package Sub_Diagnostic_Lists is new Doubly_Linked_Lists + (Element_Type => Sub_Diagnostic_Type, + "=" => "=", + Destroy_Element => Destroy, + Check_Tampering => False); + + subtype Sub_Diagnostic_List is Sub_Diagnostic_Lists.Doubly_Linked_List; + + -- An Edit_Type represents a textual edit that is associated with a Fix. + type Edit_Type is record + Span : Source_Span; + -- Region of the file to be removed + + Text : String_Ptr; + -- Text to be inserted at the start location of the span + end record; + + procedure Destroy (Elem : in out Edit_Type); + pragma Inline (Destroy); + + package Edit_Lists is new Doubly_Linked_Lists + (Element_Type => Edit_Type, + "=" => "=", + Destroy_Element => Destroy, + Check_Tampering => False); + + subtype Edit_List is Edit_Lists.Doubly_Linked_List; + + -- Type Applicability_Type will indicate the state of the resulting code + -- after applying a fix. + -- * Option Has_Placeholders indicates that the fix contains placeholders + -- that the user would need to fill. + -- * Option Legal indicates that applying the fix will result in legal Ada + -- code. + -- * Option Possibly_Illegal indicates that applying the fix will result in + -- possibly legal, but also possibly illegal Ada code. + type Applicability_Type is + (Has_Placeholders, + Legal, + Possibly_Illegal, + Unspecified); + + type Fix_Type is record + Description : String_Ptr := null; + -- Message describing the fix that will be displayed to the user. + + Applicability : Applicability_Type := Unspecified; + + Edits : Edit_List; + -- File changes for the fix. + end record; + + procedure Destroy (Elem : in out Fix_Type); + pragma Inline (Destroy); + + package Fix_Lists is new Doubly_Linked_Lists + (Element_Type => Fix_Type, + "=" => "=", + Destroy_Element => Destroy, + Check_Tampering => False); + + subtype Fix_List is Fix_Lists.Doubly_Linked_List; + + procedure Add_Edit (Fix : in out Fix_Type; Edit : Edit_Type); + + type Status_Type is + (Active, + Deprecated); + + type Switch_Id is ( + No_Switch_Id, + gnatwb, + gnatwc, + gnatwd, + gnatwf, + gnatwg, + gnatwh, + gnatwi, + gnatwj, + gnatwk, + gnatwl, + gnatwm, + gnatwo, + gnatwp, + gnatwq, + gnatwr, + gnatwt, + gnatwu, + gnatwv, + gnatww, + gnatwx, + gnatwy, + gnatwz, + gnatw_dot_a, + gnatw_dot_b, + gnatw_dot_c, + gnatw_dot_f, + gnatw_dot_h, + gnatw_dot_i, + gnatw_dot_j, + gnatw_dot_k, + gnatw_dot_l, + gnatw_dot_m, + gnatw_dot_n, + gnatw_dot_o, + gnatw_dot_p, + gnatw_dot_q, + gnatw_dot_r, + gnatw_dot_s, + gnatw_dot_t, + gnatw_dot_u, + gnatw_dot_v, + gnatw_dot_w, + gnatw_dot_x, + gnatw_dot_y, + gnatw_dot_z, + gnatw_underscore_a, + gnatw_underscore_c, + gnatw_underscore_j, + gnatw_underscore_l, + gnatw_underscore_p, + gnatw_underscore_q, + gnatw_underscore_r, + gnatw_underscore_s, + gnaty, + gnatya, + gnatyb, + gnatyc, + gnatyd, + gnatye, + gnatyf, + gnatyh, + gnatyi, + gnatyk, + gnatyl, + gnatym, + gnatyn, + gnatyo, + gnatyp, + gnatyr, + gnatys, + gnatyu, + gnatyx, + gnatyz, + gnatyaa, + gnatybb, + gnatycc, + gnatydd, + gnatyii, + gnatyll, + gnatymm, + gnatyoo, + gnatyss, + gnatytt, + gnatel + ); + + subtype Active_Switch_Id is Switch_Id range gnatwb .. gnatel; + -- The range of switch ids that represent switches that trigger a specific + -- diagnostic check. + + type Switch_Type is record + + Status : Status_Type := Active; + -- The status will indicate whether the switch is currently active, + -- or has been deprecated. A deprecated switch will not control + -- diagnostics, and will not be emitted by the GNAT usage. + + Human_Id : String_Ptr := null; + -- The Human_Id will be a unique and stable string-based ID which + -- identifies the content of the switch within the switch registry. + -- This ID will appear in SARIF readers. + + Short_Name : String_Ptr := null; + -- The Short_Name will denote the -gnatXX name of the switch. + + Description : String_Ptr := null; + -- The description will contain the description of the switch, as it is + -- currently emitted by the GNAT usage. + + Documentation_Url : String_Ptr := null; + -- The documentation_url will point to the AdaCore documentation site + -- for the switch. + + end record; + + type Diagnostic_Kind is + (Error, + Warning, + Default_Warning, + -- Warning representing the old warnings created with the '??' insertion + -- character. These warning have the [enabled by default] tag. + Restriction_Warning, + -- Warning representing the old warnings created with the '?*?' + -- insertion character. These warning have the [restriction warning] + -- tag. + Style, + Tagless_Warning, + -- Warning representing the old warnings created with the '?' insertion + -- character. + Info, + Info_Warning + -- Info warnings are old messages where both warning and info were set + -- to true. These info messages behave like warnings and are usually + -- accompanied by a warning tag. + ); + + type Diagnostic_Entry_Type is record + Status : Status_Type := Active; + + Human_Id : String_Ptr := null; + -- A human readable code for the diagnostic. If the diagnostic has a + -- switch with a human id then the human_id of the switch shall be used + -- in SARIF reports. + + Documentation : String_Ptr := null; + + Switch : Switch_Id := No_Switch_Id; + -- The switch that controls the diagnostic message. + end record; + + type Diagnostic_Type is record + + Id : Diagnostic_Id := No_Diagnostic_Id; + + Kind : Diagnostic_Kind := Error; + + Switch : Switch_Id := No_Switch_Id; + + Message : String_Ptr := null; + + Warn_Err : Boolean := False; + -- Signal whether the diagnostic was converted from a warning to an + -- error. This needs to be set during the message emission as this + -- behavior depends on the context of the code. + + Serious : Boolean := True; + -- Typically all errors are considered serious and the compiler should + -- stop its processing since the tree is essentially invalid. However, + -- some errors are not serious and the compiler can continue its + -- processing to discover more critical errors. + + Locations : Labeled_Span_List := Labeled_Span_Lists.Nil; + + Sub_Diagnostics : Sub_Diagnostic_List := Sub_Diagnostic_Lists.Nil; + + Fixes : Fix_List := Fix_Lists.Nil; + end record; + + procedure Destroy (Elem : in out Diagnostic_Type); + pragma Inline (Destroy); + + package Diagnostics_Lists is new Doubly_Linked_Lists + (Element_Type => Diagnostic_Type, + "=" => "=", + Destroy_Element => Destroy, + Check_Tampering => False); + + subtype Diagnostic_List is Diagnostics_Lists.Doubly_Linked_List; + + All_Diagnostics : Diagnostic_List := Diagnostics_Lists.Create; + + procedure Add_Location + (Diagnostic : in out Diagnostic_Type; Location : Labeled_Span_Type); + + procedure Add_Sub_Diagnostic + (Diagnostic : in out Diagnostic_Type; + Sub_Diagnostic : Sub_Diagnostic_Type); + + procedure Add_Fix (Diagnostic : in out Diagnostic_Type; Fix : Fix_Type); + + procedure Record_Diagnostic (Diagnostic : Diagnostic_Type; + Update_Count : Boolean := True); + + procedure Print_Diagnostic (Diagnostic : Diagnostic_Type); + + function Primary_Location + (Diagnostic : Diagnostic_Type) return Labeled_Span_Type; + + type Labeled_Span_Array is + array (Positive range <>) of Labeled_Span_Type; + type Sub_Diagnostic_Array is + array (Positive range <>) of Sub_Diagnostic_Type; + type Fix_Array is + array (Positive range <>) of Fix_Type; + type Edit_Array is + array (Positive range <>) of Edit_Type; + + No_Locations : constant Labeled_Span_Array (1 .. 0) := (others => <>); + No_Sub_Diags : constant Sub_Diagnostic_Array (1 .. 0) := (others => <>); + No_Fixes : constant Fix_Array (1 .. 0) := (others => <>); + No_Edits : constant Edit_Array (1 .. 0) := (others => <>); + + function Make_Diagnostic + (Msg : String; + Location : Labeled_Span_Type; + Id : Diagnostic_Id := No_Diagnostic_Id; + Kind : Diagnostic_Kind := Diagnostics.Error; + Switch : Switch_Id := No_Switch_Id; + Spans : Labeled_Span_Array := No_Locations; + Sub_Diags : Sub_Diagnostic_Array := No_Sub_Diags; + Fixes : Fix_Array := No_Fixes) + return Diagnostic_Type; + + procedure Record_Diagnostic + (Msg : String; + Location : Labeled_Span_Type; + Id : Diagnostic_Id := No_Diagnostic_Id; + Kind : Diagnostic_Kind := Diagnostics.Error; + Switch : Switch_Id := No_Switch_Id; + Spans : Labeled_Span_Array := No_Locations; + Sub_Diags : Sub_Diagnostic_Array := No_Sub_Diags; + Fixes : Fix_Array := No_Fixes); + + function Labeled_Span (Span : Source_Span; + Label : String := ""; + Is_Primary : Boolean := True; + Is_Region : Boolean := False) + return Labeled_Span_Type; + + function Primary_Labeled_Span (Span : Source_Span; + Label : String := "") + return Labeled_Span_Type; + + function Primary_Labeled_Span (N : Node_Or_Entity_Id; + Label : String := "") + return Labeled_Span_Type; + + function Secondary_Labeled_Span (Span : Source_Span; + Label : String := "") + return Labeled_Span_Type; + + function Secondary_Labeled_Span (N : Node_Or_Entity_Id; + Label : String := "") + return Labeled_Span_Type; + + function Sub_Diag (Msg : String; + Kind : Sub_Diagnostic_Kind := + Diagnostics.Continuation; + Locations : Labeled_Span_Array := No_Locations) + return Sub_Diagnostic_Type; + + function Continuation (Msg : String; + Locations : Labeled_Span_Array := No_Locations) + return Sub_Diagnostic_Type; + + function Help (Msg : String; + Locations : Labeled_Span_Array := No_Locations) + return Sub_Diagnostic_Type; + + function Suggestion (Msg : String; + Locations : Labeled_Span_Array := No_Locations) + return Sub_Diagnostic_Type; + + function Fix (Description : String; + Edits : Edit_Array; + Applicability : Applicability_Type := Unspecified) + return Fix_Type; + + function Edit (Text : String; + Span : Source_Span) + return Edit_Type; +end Diagnostics; |