------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- D I A G N O S T I C S . P R E T T Y _ E M I T 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 Diagnostics.Utils; use Diagnostics.Utils; with Output; use Output; with Sinput; use Sinput; with Erroutc; use Erroutc; package body Diagnostics.Pretty_Emitter is REGION_OFFSET : constant := 1; -- Number of characters between the line bar and the region span REGION_ARM_SIZE : constant := 2; -- Number of characters on the region span arms -- e.g. two for this case: -- +-- -- | -- +-- -- ^^ REGION_SIZE : constant := REGION_OFFSET + 1 + REGION_ARM_SIZE; -- The total number of characters taken up by the region span characters MAX_BAR_POS : constant := 7; -- The maximum position of the line bar from the start of the line type Printable_Line is record First : Source_Ptr; -- The first character of the line Last : Source_Ptr; -- The last character of the line Line_Nr : Pos; -- The line number Spans : Labeled_Span_List; -- The spans applied on the line end record; procedure Destroy (Elem : in out Printable_Line); pragma Inline (Destroy); function Equals (L, R : Printable_Line) return Boolean is (L.Line_Nr = R.Line_Nr); package Lines_Lists is new Doubly_Linked_Lists (Element_Type => Printable_Line, "=" => Equals, Destroy_Element => Destroy, Check_Tampering => False); subtype Lines_List is Lines_Lists.Doubly_Linked_List; type File_Sections is record File : String_Ptr; -- Name of the file Lines : Lines_List; -- Lines to be printed for the file end record; procedure Destroy (Elem : in out File_Sections); pragma Inline (Destroy); function Equals (L, R : File_Sections) return Boolean is (L.File /= null and then R.File /= null and then L.File.all = R.File.all); package File_Section_Lists is new Doubly_Linked_Lists (Element_Type => File_Sections, "=" => Equals, Destroy_Element => Destroy, Check_Tampering => False); subtype File_Section_List is File_Section_Lists.Doubly_Linked_List; function Create_File_Sections (Spans : Labeled_Span_List) return File_Section_List; -- Create a list of file sections from the labeled spans that are to be -- printed. -- -- Each file section contains a list of lines that are to be printed for -- the file and the spans that are applied to each of those lines. procedure Create_File_Section (Sections : in out File_Section_List; Loc : Labeled_Span_Type); -- Create a new file section for the given labeled span. procedure Add_Printable_Line (Lines : Lines_List; Loc : Labeled_Span_Type; S_Ptr : Source_Ptr); procedure Create_Printable_Line (Lines : Lines_List; Loc : Labeled_Span_Type; S_Ptr : Source_Ptr); -- Create a new printable line for the given labeled span and add it in the -- correct position to the Lines list based on the line number. function Has_Region_Span_Start (L : Printable_Line) return Boolean; function Has_Region_Span_End (L : Printable_Line) return Boolean; function Has_Multiple_Labeled_Spans (L : Printable_Line) return Boolean; procedure Write_Region_Delimiter; -- Write the arms signifying the start and end of a region span -- e.g. +-- procedure Write_Region_Bar; -- Write the bar signifying the continuation of a region span -- e.g. | procedure Write_Region_Continuation; -- Write the continuation signifying the continuation of a region span -- e.g. : procedure Write_Region_Offset; -- Write a number of whitespaces equal to the size of the region span function Trimmed_Image (I : Natural) return String; procedure Write_Span_Labels (Loc : Labeled_Span_Type; L : Printable_Line; Line_Size : Integer; Idx : String; Within_Region_Span : Boolean); procedure Write_File_Section (Sec : File_Sections; Write_File_Name : Boolean; File_Name_Offset : Integer); procedure Write_Labeled_Spans (Spans : Labeled_Span_List; Write_File_Name : Boolean; File_Name_Offset : Integer); procedure Write_Intersecting_Labels (Intersecting_Labels : Labeled_Span_List); function Get_Line_End (Buf : Source_Buffer_Ptr; Loc : Source_Ptr) return Source_Ptr; -- Get the source location for the end of the line in Buf for Loc. If -- Loc is past the end of Buf already, return Buf'Last. function Get_Line_Start (Buf : Source_Buffer_Ptr; Loc : Source_Ptr) return Source_Ptr; -- Get the source location for the start of the line in Buf for Loc function Get_First_Line_Char (Buf : Source_Buffer_Ptr; Loc : Source_Ptr) return Source_Ptr; -- Get first non-space character in the line containing Loc function Image (X : Positive; Width : Positive) return String; -- Output number X over Width characters, with whitespace padding. -- Only output the low-order Width digits of X, if X is larger than -- Width digits. procedure Write_Buffer (Buf : Source_Buffer_Ptr; First : Source_Ptr; Last : Source_Ptr); -- Output the characters from First to Last position in Buf, using -- Write_Buffer_Char. procedure Write_Buffer_Char (Buf : Source_Buffer_Ptr; Loc : Source_Ptr); -- Output the characters at position Loc in Buf, translating ASCII.HT -- in a suitable number of spaces so that the output is not modified -- by starting in a different column that 1. procedure Write_Line_Marker (Num : Pos; Width : Positive); procedure Write_Empty_Bar_Line (Width : Integer); procedure Write_Empty_Skip_Line (Width : Integer); procedure Write_Error_Msg_Line (Diag : Diagnostic_Type); -- Write the error message line for the given diagnostic: -- -- '['']' : ['['']'] function Should_Write_File_Name (Sub_Diag : Sub_Diagnostic_Type; Diag : Diagnostic_Type) return Boolean; -- If the sub-diagnostic and the main diagnostic only point to the same -- file then there is no reason to add the file name to the sub-diagnostic. function Should_Write_Spans (Sub_Diag : Sub_Diagnostic_Type; Diag : Diagnostic_Type) return Boolean; -- Old sub-diagnostics used to have the same location as the main -- diagnostic in order to group them correctly. However in most cases -- it was not meant to point to a location but rather add an additional -- message to the original diagnostic. -- -- If the sub-diagnostic and the main diagnostic have the same location -- then we should avoid printing the spans. procedure Print_Edit (Edit : Edit_Type; Offset : Integer); procedure Print_Fix (Fix : Fix_Type; Offset : Integer); procedure Print_Sub_Diagnostic (Sub_Diag : Sub_Diagnostic_Type; Diag : Diagnostic_Type; Offset : Integer); ------------- -- Destroy -- ------------- procedure Destroy (Elem : in out Printable_Line) is begin -- Diagnostic elements will be freed when all the diagnostics have been -- emitted. null; end Destroy; ------------- -- Destroy -- ------------- procedure Destroy (Elem : in out File_Sections) is begin Free (Elem.File); end Destroy; ------------------ -- Get_Line_End -- ------------------ function Get_Line_End (Buf : Source_Buffer_Ptr; Loc : Source_Ptr) return Source_Ptr is Cur_Loc : Source_Ptr := Source_Ptr'Min (Loc, Buf'Last); begin while Cur_Loc < Buf'Last and then Buf (Cur_Loc) /= ASCII.LF loop Cur_Loc := Cur_Loc + 1; end loop; return Cur_Loc; end Get_Line_End; -------------------- -- Get_Line_Start -- -------------------- function Get_Line_Start (Buf : Source_Buffer_Ptr; Loc : Source_Ptr) return Source_Ptr is Cur_Loc : Source_Ptr := Loc; begin while Cur_Loc > Buf'First and then Buf (Cur_Loc - 1) /= ASCII.LF loop Cur_Loc := Cur_Loc - 1; end loop; return Cur_Loc; end Get_Line_Start; ------------------------- -- Get_First_Line_Char -- ------------------------- function Get_First_Line_Char (Buf : Source_Buffer_Ptr; Loc : Source_Ptr) return Source_Ptr is Cur_Loc : Source_Ptr := Get_Line_Start (Buf, Loc); begin while Cur_Loc < Buf'Last and then Buf (Cur_Loc) = ' ' loop Cur_Loc := Cur_Loc + 1; end loop; return Cur_Loc; end Get_First_Line_Char; ----------- -- Image -- ----------- function Image (X : Positive; Width : Positive) return String is Str : String (1 .. Width); Curr : Natural := X; begin for J in reverse 1 .. Width loop if Curr > 0 then Str (J) := Character'Val (Character'Pos ('0') + Curr mod 10); Curr := Curr / 10; else Str (J) := ' '; end if; end loop; return Str; end Image; -------------------------------- -- Has_Multiple_Labeled_Spans -- -------------------------------- function Has_Multiple_Labeled_Spans (L : Printable_Line) return Boolean is Count : Natural := 0; Loc : Labeled_Span_Type; Loc_It : Labeled_Span_Lists.Iterator := Labeled_Span_Lists.Iterate (L.Spans); begin while Labeled_Span_Lists.Has_Next (Loc_It) loop Labeled_Span_Lists.Next (Loc_It, Loc); if Loc.Label /= null then Count := Count + 1; end if; end loop; return Count > 1; end Has_Multiple_Labeled_Spans; --------------------------- -- Has_Region_Span_Start -- --------------------------- function Has_Region_Span_Start (L : Printable_Line) return Boolean is Loc : Labeled_Span_Type; Loc_It : Labeled_Span_Lists.Iterator := Labeled_Span_Lists.Iterate (L.Spans); Has_Region_Start : Boolean := False; begin while Labeled_Span_Lists.Has_Next (Loc_It) loop Labeled_Span_Lists.Next (Loc_It, Loc); if not Has_Region_Start and then Loc.Is_Region and then L.Line_Nr = Pos (Get_Physical_Line_Number (Loc.Span.First)) then Has_Region_Start := True; end if; end loop; return Has_Region_Start; end Has_Region_Span_Start; ------------------------- -- Has_Region_Span_End -- ------------------------- function Has_Region_Span_End (L : Printable_Line) return Boolean is Loc : Labeled_Span_Type; Loc_It : Labeled_Span_Lists.Iterator := Labeled_Span_Lists.Iterate (L.Spans); Has_Region_End : Boolean := False; begin while Labeled_Span_Lists.Has_Next (Loc_It) loop Labeled_Span_Lists.Next (Loc_It, Loc); if not Has_Region_End and then Loc.Is_Region and then L.Line_Nr = Pos (Get_Physical_Line_Number (Loc.Span.Last)) then Has_Region_End := True; end if; end loop; return Has_Region_End; end Has_Region_Span_End; ------------------ -- Write_Buffer -- ------------------ procedure Write_Buffer (Buf : Source_Buffer_Ptr; First : Source_Ptr; Last : Source_Ptr) is begin for Loc in First .. Last loop Write_Buffer_Char (Buf, Loc); end loop; end Write_Buffer; ----------------------- -- Write_Buffer_Char -- ----------------------- procedure Write_Buffer_Char (Buf : Source_Buffer_Ptr; Loc : Source_Ptr) is begin -- If the character ASCII.HT is not the last one in the file, -- output as many spaces as the character represents in the -- original source file. if Buf (Loc) = ASCII.HT and then Loc < Buf'Last then for X in Get_Column_Number (Loc) .. Get_Column_Number (Loc + 1) - 1 loop Write_Char (' '); end loop; -- Otherwise output the character itself else Write_Char (Buf (Loc)); end if; end Write_Buffer_Char; ----------------------- -- Write_Line_Marker -- ----------------------- procedure Write_Line_Marker (Num : Pos; Width : Positive) is begin Write_Str (Image (Positive (Num), Width => Width - 2)); Write_Str (" |"); end Write_Line_Marker; -------------------------- -- Write_Empty_Bar_Line -- -------------------------- procedure Write_Empty_Bar_Line (Width : Integer) is begin Write_Str (String'(1 .. Width - 1 => ' ')); Write_Str ("|"); end Write_Empty_Bar_Line; --------------------------- -- Write_Empty_Skip_Line -- --------------------------- procedure Write_Empty_Skip_Line (Width : Integer) is begin Write_Str (String'(1 .. Width - 1 => ' ')); Write_Str (":"); end Write_Empty_Skip_Line; ---------------------------- -- Write_Region_Delimiter -- ---------------------------- procedure Write_Region_Delimiter is begin Write_Str (String'(1 .. REGION_OFFSET => ' ')); Write_Str ("+"); Write_Str (String'(1 .. REGION_ARM_SIZE => '-')); end Write_Region_Delimiter; ---------------------- -- Write_Region_Bar -- ---------------------- procedure Write_Region_Bar is begin Write_Str (String'(1 .. REGION_OFFSET => ' ')); Write_Str ("|"); Write_Str (String'(1 .. REGION_ARM_SIZE => ' ')); end Write_Region_Bar; ------------------------------- -- Write_Region_Continuation -- ------------------------------- procedure Write_Region_Continuation is begin Write_Str (String'(1 .. REGION_OFFSET => ' ')); Write_Str (":"); Write_Str (String'(1 .. REGION_ARM_SIZE => ' ')); end Write_Region_Continuation; ------------------------- -- Write_Region_Offset -- ------------------------- procedure Write_Region_Offset is begin Write_Str (String'(1 .. REGION_SIZE => ' ')); end Write_Region_Offset; ------------------------ -- Add_Printable_Line -- ------------------------ procedure Add_Printable_Line (Lines : Lines_List; Loc : Labeled_Span_Type; S_Ptr : Source_Ptr) is L : Printable_Line; L_It : Lines_Lists.Iterator; Line_Ptr : constant Pos := Pos (Get_Physical_Line_Number (S_Ptr)); Line_Found : Boolean := False; begin L_It := Lines_Lists.Iterate (Lines); while Lines_Lists.Has_Next (L_It) loop Lines_Lists.Next (L_It, L); if not Line_Found and then L.Line_Nr = Line_Ptr then if not Labeled_Span_Lists.Contains (L.Spans, Loc) then Labeled_Span_Lists.Append (L.Spans, Loc); end if; Line_Found := True; end if; end loop; if not Line_Found then Create_Printable_Line (Lines, Loc, S_Ptr); end if; end Add_Printable_Line; --------------------------- -- Create_Printable_Line -- --------------------------- procedure Create_Printable_Line (Lines : Lines_List; Loc : Labeled_Span_Type; S_Ptr : Source_Ptr) is Spans : constant Labeled_Span_List := Labeled_Span_Lists.Create; Buf : constant Source_Buffer_Ptr := Source_Text (Get_Source_File_Index (S_Ptr)); Line_Nr : constant Pos := Pos (Get_Physical_Line_Number (S_Ptr)); New_Line : constant Printable_Line := (First => Get_Line_Start (Buf, S_Ptr), Last => Get_Line_End (Buf, S_Ptr), Line_Nr => Line_Nr, Spans => Spans); L : Printable_Line; L_It : Lines_Lists.Iterator := Lines_Lists.Iterate (Lines); Found_Greater_Line : Boolean := False; Insert_Before_Line : Printable_Line; begin Labeled_Span_Lists.Append (Spans, Loc); -- Insert the new line based on the line number while Lines_Lists.Has_Next (L_It) loop Lines_Lists.Next (L_It, L); if not Found_Greater_Line and then L.Line_Nr > New_Line.Line_Nr then Found_Greater_Line := True; Insert_Before_Line := L; Lines_Lists.Insert_Before (Lines, Insert_Before_Line, New_Line); end if; end loop; if Found_Greater_Line then -- Insert after all the lines have been iterated over to avoid the -- mutation lock in GNAT.Lists null; else Lines_Lists.Append (Lines, New_Line); end if; end Create_Printable_Line; ------------------------- -- Create_File_Section -- ------------------------- procedure Create_File_Section (Sections : in out File_Section_List; Loc : Labeled_Span_Type) is Lines : constant Lines_List := Lines_Lists.Create; -- Carret positions Ptr : constant Source_Ptr := Loc.Span.Ptr; Line_Ptr : constant Pos := Pos (Get_Physical_Line_Number (Ptr)); -- Span start positions Fst : constant Source_Ptr := Loc.Span.First; Line_Fst : constant Pos := Pos (Get_Physical_Line_Number (Fst)); -- Span end positions Lst : constant Source_Ptr := Loc.Span.Last; Line_Lst : constant Pos := Pos (Get_Physical_Line_Number (Lst)); begin Create_Printable_Line (Lines, Loc, Fst); if Line_Fst /= Line_Ptr then Create_Printable_Line (Lines, Loc, Ptr); end if; if Line_Ptr /= Line_Lst then Create_Printable_Line (Lines, Loc, Lst); end if; File_Section_Lists.Append (Sections, (File => new String'(To_File_Name (Loc.Span.Ptr)), Lines => Lines)); end Create_File_Section; -------------------------- -- Create_File_Sections -- -------------------------- function Create_File_Sections (Spans : Labeled_Span_List) return File_Section_List is Loc : Labeled_Span_Type; Loc_It : Labeled_Span_Lists.Iterator := Labeled_Span_Lists.Iterate (Spans); Sections : File_Section_List := File_Section_Lists.Create; Sec : File_Sections; F_It : File_Section_Lists.Iterator; File_Found : Boolean; begin while Labeled_Span_Lists.Has_Next (Loc_It) loop Labeled_Span_Lists.Next (Loc_It, Loc); File_Found := False; F_It := File_Section_Lists.Iterate (Sections); while File_Section_Lists.Has_Next (F_It) loop File_Section_Lists.Next (F_It, Sec); if Sec.File /= null and then Sec.File.all = To_File_Name (Loc.Span.Ptr) then File_Found := True; Add_Printable_Line (Sec.Lines, Loc, Loc.Span.First); Add_Printable_Line (Sec.Lines, Loc, Loc.Span.Ptr); Add_Printable_Line (Sec.Lines, Loc, Loc.Span.Last); end if; end loop; if not File_Found then Create_File_Section (Sections, Loc); end if; end loop; return Sections; end Create_File_Sections; ----------------------- -- Write_Span_Labels -- ----------------------- procedure Write_Span_Labels (Loc : Labeled_Span_Type; L : Printable_Line; Line_Size : Integer; Idx : String; Within_Region_Span : Boolean) is Span_Char : constant Character := (if Loc.Is_Primary then '~' else '-'); Buf : constant Source_Buffer_Ptr := Source_Text (Get_Source_File_Index (L.First)); Col_L_Fst : constant Natural := Natural (Get_Column_Number (Get_First_Line_Char (Buf, L.First))); Col_L_Lst : constant Natural := Natural (Get_Column_Number (L.Last)); -- Carret positions Ptr : constant Source_Ptr := Loc.Span.Ptr; Line_Ptr : constant Pos := Pos (Get_Physical_Line_Number (Ptr)); Col_Ptr : constant Natural := Natural (Get_Column_Number (Ptr)); -- Span start positions Fst : constant Source_Ptr := Loc.Span.First; Line_Fst : constant Pos := Pos (Get_Physical_Line_Number (Fst)); Col_Fst : constant Natural := Natural (Get_Column_Number (Fst)); -- Span end positions Lst : constant Source_Ptr := Loc.Span.Last; Line_Lst : constant Pos := Pos (Get_Physical_Line_Number (Lst)); Col_Lst : constant Natural := Natural (Get_Column_Number (Lst)); -- Attributes for the span on the current line Span_Sym : constant String := (if Idx = "" then "^" else Idx); Span_Fst : constant Natural := (if Line_Fst = L.Line_Nr then Col_Fst else Col_L_Fst); Span_Lst : constant Natural := (if Line_Lst = L.Line_Nr then Col_Lst else Col_L_Lst); Span_Ptr_Fst : constant Natural := (if Line_Ptr = L.Line_Nr then Col_Ptr else Col_L_Fst); Span_Ptr_Lst : constant Natural := (if Line_Ptr = L.Line_Nr then Span_Ptr_Fst + Span_Sym'Length else Span_Fst); begin if not Loc.Is_Region then Write_Empty_Bar_Line (Line_Size); if Within_Region_Span then Write_Region_Bar; else Write_Region_Offset; end if; Write_Str (String'(1 .. Span_Fst - 1 => ' ')); if Line_Ptr = L.Line_Nr then Write_Str (String'(Span_Fst .. Col_Ptr - 1 => Span_Char)); Write_Str (Span_Sym); end if; Write_Str (String'(Span_Ptr_Lst .. Span_Lst => Span_Char)); Write_Eol; -- Write the label under the line unless it is an intersecting span. -- In this case omit the label which will be printed later along with -- the index. if Loc.Label /= null and then Idx = "" then Write_Empty_Bar_Line (Line_Size); if Within_Region_Span then Write_Region_Bar; else Write_Region_Offset; end if; Write_Str (String'(1 .. Span_Fst - 1 => ' ')); Write_Str (Loc.Label.all); Write_Eol; end if; else if Line_Lst = L.Line_Nr then Write_Empty_Bar_Line (Line_Size); Write_Str (String'(1 .. REGION_OFFSET => ' ')); Write_Str (Loc.Label.all); Write_Eol; end if; end if; end Write_Span_Labels; ------------------- -- Trimmed_Image -- ------------------- function Trimmed_Image (I : Natural) return String is Img_Raw : constant String := Natural'Image (I); begin return Img_Raw (Img_Raw'First + 1 .. Img_Raw'Last); end Trimmed_Image; ------------------------------- -- Write_Intersecting_Labels -- ------------------------------- procedure Write_Intersecting_Labels (Intersecting_Labels : Labeled_Span_List) is Ls : Labeled_Span_Type; Ls_It : Labeled_Span_Lists.Iterator := Labeled_Span_Lists.Iterate (Intersecting_Labels); Idx : Integer := 0; begin while Labeled_Span_Lists.Has_Next (Ls_It) loop Labeled_Span_Lists.Next (Ls_It, Ls); Idx := Idx + 1; Write_Empty_Bar_Line (MAX_BAR_POS); Write_Str (" "); Write_Int (Int (Idx)); Write_Str (": "); Write_Str (Ls.Label.all); Write_Eol; end loop; end Write_Intersecting_Labels; ------------------------ -- Write_File_Section -- ------------------------ procedure Write_File_Section (Sec : File_Sections; Write_File_Name : Boolean; File_Name_Offset : Integer) is use Lines_Lists; L : Printable_Line; L_It : Iterator := Iterate (Sec.Lines); -- The error should be included in the first (primary) span of the file. Loc : constant Labeled_Span_Type := Labeled_Span_Lists.First (Lines_Lists.First (Sec.Lines).Spans); Multiple_Labeled_Spans : Boolean := False; Idx : Integer := 0; Intersecting_Labels : constant Labeled_Span_List := Labeled_Span_Lists.Create; Prev_Line_Nr : Natural := 0; Within_Region_Span : Boolean := False; begin if Write_File_Name then -- offset the file start location for sub-diagnostics Write_Str (String'(1 .. File_Name_Offset => ' ')); Write_Str ("--> " & To_String (Loc.Span.Ptr)); Write_Eol; end if; while Has_Next (L_It) loop Next (L_It, L); declare Line_Nr : constant Pos := L.Line_Nr; Line_Str : constant String := Trimmed_Image (Natural (Line_Nr)); Line_Size : constant Integer := Integer'Max (Line_Str'Length, MAX_BAR_POS); Loc : Labeled_Span_Type; Loc_It : Labeled_Span_Lists.Iterator := Labeled_Span_Lists.Iterate (L.Spans); Buf : constant Source_Buffer_Ptr := Source_Text (Get_Source_File_Index (L.First)); Contains_Region_Span_Start : constant Boolean := Has_Region_Span_Start (L); Contains_Region_Span_End : constant Boolean := Has_Region_Span_End (L); begin if not Multiple_Labeled_Spans then Multiple_Labeled_Spans := Has_Multiple_Labeled_Spans (L); end if; -- Write an empty line with the continuation symbol if the line -- numbers are not contiguous if Prev_Line_Nr /= 0 and then Pos (Prev_Line_Nr + 1) /= Line_Nr then Write_Empty_Skip_Line (Line_Size); if Within_Region_Span then Write_Region_Continuation; end if; Write_Eol; end if; if Contains_Region_Span_Start then Within_Region_Span := True; end if; Write_Line_Marker (Line_Nr, Line_Size); -- Write either the region span symbol or the same number of -- whitespaces. if Contains_Region_Span_Start or Contains_Region_Span_End then Write_Region_Delimiter; elsif Within_Region_Span then Write_Region_Bar; else Write_Region_Offset; end if; -- Write the line itself Write_Buffer (Buf => Buf, First => L.First, Last => L.Last); -- Write all the spans for the line while Labeled_Span_Lists.Has_Next (Loc_It) loop Labeled_Span_Lists.Next (Loc_It, Loc); if Multiple_Labeled_Spans and then Loc.Label /= null then -- Collect all the spans with labels to print them at the -- end. Labeled_Span_Lists.Append (Intersecting_Labels, Loc); Idx := Idx + 1; Write_Span_Labels (Loc, L, Line_Size, Trimmed_Image (Idx), Within_Region_Span); else Write_Span_Labels (Loc, L, Line_Size, "", Within_Region_Span); end if; end loop; if Contains_Region_Span_End then Within_Region_Span := False; end if; Prev_Line_Nr := Natural (Line_Nr); end; end loop; Write_Intersecting_Labels (Intersecting_Labels); end Write_File_Section; ------------------------- -- Write_Labeled_Spans -- ------------------------- procedure Write_Labeled_Spans (Spans : Labeled_Span_List; Write_File_Name : Boolean; File_Name_Offset : Integer) is Sections : File_Section_List := Create_File_Sections (Spans); Sec : File_Sections; F_It : File_Section_Lists.Iterator := File_Section_Lists.Iterate (Sections); begin while File_Section_Lists.Has_Next (F_It) loop File_Section_Lists.Next (F_It, Sec); Write_File_Section (Sec, Write_File_Name, File_Name_Offset); end loop; File_Section_Lists.Destroy (Sections); end Write_Labeled_Spans; -------------------------- -- Write_Error_Msg_Line -- -------------------------- procedure Write_Error_Msg_Line (Diag : Diagnostic_Type) is Switch_Str : constant String := Get_Doc_Switch (Diag); Kind_Str : constant String := Kind_To_String (Diag); SGR_Code : constant String := (if Kind_Str = "error" then SGR_Error elsif Kind_Str = "warning" then SGR_Warning elsif Kind_Str = "info" then SGR_Note else SGR_Reset); begin Write_Str (SGR_Code); Write_Str ("[" & To_String (Diag.Id) & "]"); Write_Str (" " & Kind_To_String (Diag) & ": "); Write_Str (SGR_Reset); Write_Str (Diag.Message.all); if Switch_Str /= "" then Write_Str (" " & Switch_Str); end if; if Diag.Warn_Err then Write_Str (" [warning-as-error]"); end if; Write_Eol; end Write_Error_Msg_Line; ---------------------------- -- Should_Write_File_Name -- ---------------------------- function Should_Write_File_Name (Sub_Diag : Sub_Diagnostic_Type; Diag : Diagnostic_Type) return Boolean is Sub_Loc : constant Labeled_Span_Type := Get_Primary_Labeled_Span (Sub_Diag.Locations); Diag_Loc : constant Labeled_Span_Type := Get_Primary_Labeled_Span (Diag.Locations); function Has_Multiple_Files (Spans : Labeled_Span_List) return Boolean; ------------------------ -- Has_Multiple_Files -- ------------------------ function Has_Multiple_Files (Spans : Labeled_Span_List) return Boolean is First : constant Labeled_Span_Type := Labeled_Span_Lists.First (Spans); File : constant String := To_File_Name (First.Span.Ptr); Loc : Labeled_Span_Type; It : Labeled_Span_Lists.Iterator := Labeled_Span_Lists.Iterate (Spans); begin while Labeled_Span_Lists.Has_Next (It) loop Labeled_Span_Lists.Next (It, Loc); if To_File_Name (Loc.Span.Ptr) /= File then return True; end if; end loop; return False; end Has_Multiple_Files; begin return Has_Multiple_Files (Diag.Locations) or else To_File_Name (Sub_Loc.Span.Ptr) /= To_File_Name (Diag_Loc.Span.Ptr); end Should_Write_File_Name; ------------------------ -- Should_Write_Spans -- ------------------------ function Should_Write_Spans (Sub_Diag : Sub_Diagnostic_Type; Diag : Diagnostic_Type) return Boolean is Sub_Loc : constant Labeled_Span_Type := Get_Primary_Labeled_Span (Sub_Diag.Locations); Diag_Loc : constant Labeled_Span_Type := Get_Primary_Labeled_Span (Diag.Locations); begin return Sub_Loc /= No_Labeled_Span and then Diag_Loc /= No_Labeled_Span and then Sub_Loc.Span.Ptr /= Diag_Loc.Span.Ptr; end Should_Write_Spans; ---------------- -- Print_Edit -- ---------------- procedure Print_Edit (Edit : Edit_Type; Offset : Integer) is Buf : constant Source_Buffer_Ptr := Source_Text (Get_Source_File_Index (Edit.Span.Ptr)); Line_Nr : constant Pos := Pos (Get_Physical_Line_Number (Edit.Span.Ptr)); Line_Fst : constant Source_Ptr := Get_Line_Start (Buf, Edit.Span.First); Line_Lst : constant Source_Ptr := Get_Line_End (Buf, Edit.Span.First); begin Write_Str (String'(1 .. Offset => ' ')); Write_Str ("--> " & To_File_Name (Edit.Span.Ptr)); Write_Eol; -- write the original line Write_Char ('-'); Write_Line_Marker (Line_Nr, MAX_BAR_POS - 1); Write_Buffer (Buf => Buf, First => Line_Fst, Last => Line_Lst); -- write the edited line Write_Char ('+'); Write_Line_Marker (Line_Nr, MAX_BAR_POS - 1); Write_Buffer (Buf => Buf, First => Line_Fst, Last => Edit.Span.First - 1); if Edit.Text /= null then Write_Str (Edit.Text.all); end if; Write_Buffer (Buf => Buf, First => Edit.Span.Last + 1, Last => Line_Lst); end Print_Edit; --------------- -- Print_Fix -- --------------- procedure Print_Fix (Fix : Fix_Type; Offset : Integer) is use Edit_Lists; begin Write_Str (String'(1 .. Offset => ' ')); Write_Str ("+ Fix: "); if Fix.Description /= null then Write_Str (Fix.Description.all); end if; Write_Eol; if Present (Fix.Edits) then declare Edit : Edit_Type; It : Iterator := Iterate (Fix.Edits); begin while Has_Next (It) loop Next (It, Edit); Print_Edit (Edit, MAX_BAR_POS - 1); end loop; end; end if; end Print_Fix; -------------------------- -- Print_Sub_Diagnostic -- -------------------------- procedure Print_Sub_Diagnostic (Sub_Diag : Sub_Diagnostic_Type; Diag : Diagnostic_Type; Offset : Integer) is begin Write_Str (String'(1 .. Offset => ' ')); if Sub_Diag.Kind = Suggestion then Write_Str ("+ Suggestion: "); else Write_Str ("+ "); end if; Write_Str (Sub_Diag.Message.all); Write_Eol; if Should_Write_Spans (Sub_Diag, Diag) then Write_Labeled_Spans (Sub_Diag.Locations, Should_Write_File_Name (Sub_Diag, Diag), Offset); end if; end Print_Sub_Diagnostic; ---------------------- -- Print_Diagnostic -- ---------------------- procedure Print_Diagnostic (Diag : Diagnostic_Type) is begin -- Print the main diagnostic Write_Error_Msg_Line (Diag); -- Print diagnostic locations along with spans Write_Labeled_Spans (Diag.Locations, True, 0); -- Print subdiagnostics if Sub_Diagnostic_Lists.Present (Diag.Sub_Diagnostics) then declare use Sub_Diagnostic_Lists; Sub_Diag : Sub_Diagnostic_Type; It : Iterator := Iterate (Diag.Sub_Diagnostics); begin while Has_Next (It) loop Next (It, Sub_Diag); -- Print the subdiagnostic and offset the location of the file -- name Print_Sub_Diagnostic (Sub_Diag, Diag, MAX_BAR_POS - 1); end loop; end; end if; -- Print fixes if Fix_Lists.Present (Diag.Fixes) then declare use Fix_Lists; Fix : Fix_Type; It : Iterator := Iterate (Diag.Fixes); begin while Has_Next (It) loop Next (It, Fix); Print_Fix (Fix, MAX_BAR_POS - 1); end loop; end; end if; -- Separate main diagnostics with a blank line Write_Eol; end Print_Diagnostic; end Diagnostics.Pretty_Emitter;