OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Add colors to GNATprove messages output to a terminal

Browse Source 
gcc/ada/

	* errout.adb (Output_Messages): Insert SGR strings where needed.
	* erroutc.adb (Output_Message_Txt): Insert SGR strings where
	needed in the text of the message itself.
	(Output_Msg_Text): Allow for style message not to start
	with (style).
	* erroutc.ads: Add new constants and functions to control colors
	in messages output to the terminal. Add variable Use_SGR_Control
	that should be set to True for using SGR color control strings.
This commit is contained in:
Yannick Moy 2020-12-17 09:56:16 +01:00 committed by Pierre-Marie de Rodat
parent b626569a56
commit 210cae9d51
3 changed files with 146 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
gcc/ada/errout.adb
View File

@ -2071,7 +2071,9 @@ package body Errout is
procedure Write_Max_Errors;
-- Write message if max errors reached
procedure Write_Source_Code_Lines (Span : Source_Span);
procedure Write_Source_Code_Lines
(Span : Source_Span;
SGR_Span : String);
-- Write the source code line corresponding to Span, as follows when
-- Span in on one line:
--
@ -2095,6 +2097,9 @@ package body Errout is
-- | ^ here
--
-- where the caret on the line points to location Span.Ptr
--
-- SGR_Span is the SGR string to start the section of code in the span,
-- that should be closed with SGR_Reset.
-------------------------
-- Write_Error_Summary --
@ -2290,8 +2295,10 @@ package body Errout is
-- Write_Source_Code_Lines --
-----------------------------
procedure Write_Source_Code_Lines (Span : Source_Span) is
procedure Write_Source_Code_Lines
(Span : Source_Span;
SGR_Span : String)
is
function Get_Line_End
(Buf : Source_Buffer_Ptr;
Loc : Source_Ptr) return Source_Ptr;
@ -2490,6 +2497,15 @@ package body Errout is
-- the gap with first/last lines, otherwise use ... to denote
-- intermediate lines.
-- If the span is on one line and not a simple source location,
-- color it appropriately.
if Line_Fst = Line_Lst
and then Col_Fst /= Col_Lst
then
Write_Str (SGR_Span);
end if;
declare
function Do_Write_Line (Cur_Line : Pos) return Boolean is
(Cur_Line in Line_Fst | Line | Line_Lst
@ -2499,7 +2515,7 @@ package body Errout is
(Cur_Line = Line + 1 and then Cur_Line = Line_Lst - 1));
begin
while Cur_Loc <= Buf'Last
and then Cur_Loc < Lst
and then Cur_Loc <= Lst
loop
if Do_Write_Line (Cur_Line) then
Write_Buffer_Char (Buf, Cur_Loc);
@ -2535,6 +2551,12 @@ package body Errout is
end loop;
end;
if Line_Fst = Line_Lst
and then Col_Fst /= Col_Lst
then
Write_Str (SGR_Reset);
end if;
-- Output the rest of the last line of the span
Write_Buffer (Buf, Cur_Loc, Get_Line_End (Buf, Cur_Loc));
@ -2546,6 +2568,9 @@ package body Errout is
Write_Str (String'(1 .. Width => ' '));
Write_Str (" |");
Write_Str (String'(1 .. Col_Fst - 1 => ' '));
Write_Str (SGR_Span);
Write_Str (String'(Col_Fst .. Col - 1 => '~'));
Write_Str ("^");
Write_Str (String'(Col + 1 .. Col_Lst => '~'));
@ -2557,6 +2582,8 @@ package body Errout is
Write_Str (" here");
end if;
Write_Str (SGR_Reset);
Write_Eol;
end if;
end if;
@ -2615,6 +2642,8 @@ package body Errout is
end if;
if Use_Prefix then
Write_Str (SGR_Locus);
if Full_Path_Name_For_Brief_Errors then
Write_Name (Full_Ref_Name (Errors.Table (E).Sfile));
else
@ -2633,6 +2662,8 @@ package body Errout is
Write_Int (Int (Errors.Table (E).Col));
Write_Str (": ");
Write_Str (SGR_Reset);
end if;
Output_Msg_Text (E);
@ -2652,12 +2683,23 @@ package body Errout is
Errors.Table (E).Insertion_Sloc;
begin
if Loc /= No_Location then
Write_Source_Code_Lines (To_Span (Loc));
Write_Source_Code_Lines
(To_Span (Loc), SGR_Span => SGR_Note);
end if;
end;
else
Write_Source_Code_Lines (Errors.Table (E).Sptr);
declare
SGR_Span : constant String :=
(if Errors.Table (E).Info then SGR_Note
elsif Errors.Table (E).Warn
and then not Errors.Table (E).Warn_Err
then SGR_Warning
else SGR_Error);
begin
Write_Source_Code_Lines
(Errors.Table (E).Sptr, SGR_Span);
end;
end if;
end if;
end if;

45
gcc/ada/erroutc.adb
View File

@ -699,7 +699,7 @@ package body Erroutc is
-- For info messages, prefix message with "info: "
elsif E_Msg.Info then
Txt := new String'("info: " & Txt.all);
Txt := new String'(SGR_Note & "info: " & SGR_Reset & Txt.all);
-- Warning treated as error
@ -709,27 +709,58 @@ package body Erroutc is
-- [warning-as-error] at the end.
Warnings_Treated_As_Errors := Warnings_Treated_As_Errors + 1;
Txt := new String'("error: " & Txt.all & " [warning-as-error]");
Txt := new String'(SGR_Error & "error: " & SGR_Reset
& Txt.all & " [warning-as-error]");
-- Normal warning, prefix with "warning: "
elsif E_Msg.Warn then
Txt := new String'("warning: " & Txt.all);
Txt := new String'(SGR_Warning & "warning: " & SGR_Reset & Txt.all);
-- No prefix needed for style message, "(style)" is there already
-- No prefix needed for style message, "(style)" is there already,
-- although not necessarily in first position if -gnatdJ is used.
elsif E_Msg.Style then
null;
if Txt (Txt'First .. Txt'First + 6) = "(style)" then
Txt := new String'(SGR_Warning & "(style)" & SGR_Reset
& Txt (Txt'First + 7 .. Txt'Last));
end if;
-- No prefix needed for check message, severity is there already
elsif E_Msg.Check then
null;
-- The message format is "severity: ..."
--
-- Enclose the severity with an SGR control string if requested
if Use_SGR_Control then
declare
Msg : String renames Text.all;
Colon : Natural := 0;
begin
-- Find first colon
for J in Msg'Range loop
if Msg (J) = ':' then
Colon := J;
exit;
end if;
end loop;
pragma Assert (Colon > 0);
Txt := new String'(SGR_Error
& Msg (Msg'First .. Colon)
& SGR_Reset
& Msg (Colon + 1 .. Msg'Last));
end;
end if;
-- All other cases, add "error: " if unique error tag set
elsif Opt.Unique_Error_Tag then
Txt := new String'("error: " & Txt.all);
Txt := new String'(SGR_Error & "error: " & SGR_Reset & Txt.all);
end if;
-- Set error message line length and length of message

60
gcc/ada/erroutc.ads
View File

@ -390,6 +390,66 @@ package Erroutc is
-- find such an On entry, we cancel the indication of it being the
-- configuration case. This seems to handle all cases we run into ok.
-------------------
-- Color Control --
-------------------
Use_SGR_Control : Boolean := False;
-- Set to True for enabling colored output. This should only be done when
-- outputting messages to a terminal that supports it.
-- Colors in messages output to a terminal are controlled using SGR
-- (Select Graphic Rendition).
Color_Separator : constant String := ";";
Color_None : constant String := "00";
Color_Bold : constant String := "01";
Color_Underscore : constant String := "04";
Color_Blink : constant String := "05";
Color_Reverse : constant String := "07";
Color_Fg_Black : constant String := "30";
Color_Fg_Red : constant String := "31";
Color_Fg_Green : constant String := "32";
Color_Fg_Yellow : constant String := "33";
Color_Fg_Blue : constant String := "34";
Color_Fg_Magenta : constant String := "35";
Color_Fg_Cyan : constant String := "36";
Color_Fg_White : constant String := "37";
Color_Bg_Black : constant String := "40";
Color_Bg_Red : constant String := "41";
Color_Bg_Green : constant String := "42";
Color_Bg_Yellow : constant String := "43";
Color_Bg_Blue : constant String := "44";
Color_Bg_Magenta : constant String := "45";
Color_Bg_Cyan : constant String := "46";
Color_Bg_White : constant String := "47";
SGR_Start : constant String := ASCII.ESC & "[";
SGR_End : constant String := "m" & ASCII.ESC & "[K";
function SGR_Seq (Str : String) return String is
(if Use_SGR_Control then SGR_Start & Str & SGR_End else "");
-- Return the SGR control string for the commands in Str. It returns the
-- empty string if Use_SGR_Control is False, so that we can insert this
-- string unconditionally.
function SGR_Reset return String is (SGR_Seq (""));
-- This ends the current section of colored output
-- We're using the same colors as gcc/g++ for errors/warnings/notes/locus.
-- More colors are defined in gcc/g++ for other features of diagnostic
-- messages (e.g. inline types, fixit) and could be used in GNAT in the
-- future. The following functions start a section of colored output.
function SGR_Error return String is
(SGR_Seq (Color_Bold & Color_Separator & Color_Fg_Red));
function SGR_Warning return String is
(SGR_Seq (Color_Bold & Color_Separator & Color_Fg_Magenta));
function SGR_Note return String is
(SGR_Seq (Color_Bold & Color_Separator & Color_Fg_Cyan));
function SGR_Locus return String is
(SGR_Seq (Color_Bold));
-----------------
-- Subprograms --
-----------------