path: root/gcc/ada/diagnostics-pretty_emitter.adb

------------------------------------------------------------------------------
--                                                                          --
--                         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 (LF) 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 Get_Last_Line_Char
     (Buf : Source_Buffer_Ptr; Loc : Source_Ptr) return Source_Ptr;
   --  Get last non line end [LF, CR] 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:
   --
   --  '['<Diag.Id>']' <Diag.Kind>: <Diag.Message> ['['<Diag.Switch>']']

   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;

   ------------------------
   -- Get_Last_Line_Char --
   ------------------------

   function Get_Last_Line_Char
     (Buf : Source_Buffer_Ptr; Loc : Source_Ptr) return Source_Ptr
   is
      Cur_Loc : Source_Ptr := Get_Line_End (Buf, Loc);
   begin

      while Cur_Loc > Buf'First
        and then Buf (Cur_Loc) in ASCII.LF | ASCII.CR
      loop
         Cur_Loc := Cur_Loc - 1;
      end loop;

      return Cur_Loc;
   end Get_Last_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 (Get_Last_Line_Char (Buf, 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 := Primary_Location (Sub_Diag);
      Diag_Loc : constant Labeled_Span_Type := Primary_Location (Diag);

      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 := Primary_Location (Sub_Diag);
      Diag_Loc : constant Labeled_Span_Type := Primary_Location (Diag);
   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;