Skip to content

Commit 1c7f468

Browse files
HugoGGuerrierHugoGGuerrier
committed
Add tags to GNATcheck messages
Create an API for message emission and use it in all places it is possible. Also cleanup and harmonize message format.
1 parent 5c5feb6 commit 1c7f468

File tree

51 files changed

+525
-451
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

51 files changed

+525
-451
lines changed

‎lkql_checker/src/gnatcheck-compiler.adb‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -451,12 +451,12 @@ package body Gnatcheck.Compiler is
451451
-- them.
452452

453453
if Is_Regular_File (Out_File) and then Size (Out_File) /= 0 then
454-
Error ("error when calling gprbuild:");
454+
Error ("error when calling gprbuild, raw output:");
455455

456456
declare
457457
Str : String_Access := Read_File (Out_File);
458458
begin
459-
Error_No_Tool_Name (Str (Str'First .. Str'Last - 1));
459+
Print (Str (Str'First .. Str'Last - 1));
460460
Free (Str);
461461
end;
462462

@@ -474,7 +474,7 @@ package body Gnatcheck.Compiler is
474474
and then Line (1 .. 29) = "gnat1: invalid switch: -gnatw")
475475
then
476476
Error ("wrong parameter specified for compiler-related rule:");
477-
Error_No_Tool_Name (Line (1 .. Line_Len));
477+
Print (Line (1 .. Line_Len));
478478
Errors := True;
479479

480480
elsif Index (Line (1 .. Line_Len), "BUG DETECTED") /= 0 then

‎lkql_checker/src/gnatcheck-diagnoses.adb‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -761,7 +761,7 @@ package body Gnatcheck.Diagnoses is
761761
Error ("cannot copy information from " & User_Info_File.all &
762762
" into report file");
763763

764-
Error_No_Tool_Name (Ada.Exceptions.Exception_Information (E));
764+
Print (Ada.Exceptions.Exception_Information (E));
765765
end Copy_User_Info;
766766

767767
----------------
@@ -1717,17 +1717,17 @@ package body Gnatcheck.Diagnoses is
17171717
Diagnoses_Reported >= Max_Diagnoses
17181718
then
17191719
Limit_Exceeded := True;
1720-
Info ("Maximum diagnoses reached, " &
1721-
"see the report file for full details");
1720+
Info
1721+
("maximum diagnoses reached, see the report file for " &
1722+
"full details");
17221723
else
17231724
if Error_Messages_Storage.Element (Position).Justification
17241725
= Null_Unbounded_String
17251726
then
17261727
Diagnoses_Reported := @ + 1;
1727-
Info
1728+
Print
17281729
(Preprocess_Diag
1729-
(Image
1730-
(Error_Messages_Storage.Element (Position))));
1730+
(Image (Error_Messages_Storage.Element (Position))));
17311731
end if;
17321732
end if;
17331733
end if;

‎lkql_checker/src/gnatcheck-output.adb‎

Lines changed: 82 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -95,34 +95,55 @@ package body Gnatcheck.Output is
9595
end if;
9696
end Close_Report_Files;
9797

98+
------------------
99+
-- Emit_Message --
100+
------------------
101+
102+
procedure Emit_Message
103+
(Message : String;
104+
Tag : Message_Tags := None;
105+
Tool_Name : Boolean := False;
106+
New_Line : Boolean := False;
107+
Log_Message : Boolean := False)
108+
is
109+
Final_Message : constant String :=
110+
(if Tool_Name then Executable & ": " else "")
111+
& (case Tag is
112+
when Info => "info: ",
113+
when Warning => "warning: ",
114+
when Error => "error: ",
115+
when None => "")
116+
& Message;
117+
begin
118+
-- Display the message in the standard error
119+
Put (Standard_Error, Final_Message);
120+
if New_Line then
121+
Ada.Text_IO.New_Line (Standard_Error);
122+
end if;
123+
124+
-- If required, log the message
125+
if Log_Message and then Log_Mode and then Is_Open (Log_File) then
126+
Put (Log_File, Final_Message);
127+
if New_Line then
128+
Ada.Text_IO.New_Line (Log_File);
129+
end if;
130+
end if;
131+
end Emit_Message;
132+
98133
-----------
99134
-- Error --
100135
-----------
101136

102137
procedure Error (Message : String) is
103138
begin
104-
Put (Standard_Error, Executable & ": ");
105-
106-
if Log_Mode and then Is_Open (Log_File) then
107-
Put (Log_File, Executable & ": ");
108-
end if;
109-
110-
Error_No_Tool_Name (Message);
139+
Emit_Message
140+
(Message,
141+
Tag => Error,
142+
Tool_Name => True,
143+
New_Line => True,
144+
Log_Message => True);
111145
end Error;
112146

113-
------------------------
114-
-- Error_No_Tool_Name --
115-
------------------------
116-
117-
procedure Error_No_Tool_Name (Message : String) is
118-
begin
119-
Put_Line (Standard_Error, Message);
120-
121-
if Log_Mode and then Is_Open (Log_File) then
122-
Put_Line (Log_File, Message);
123-
end if;
124-
end Error_No_Tool_Name;
125-
126147
-----------------------
127148
-- Get_Indent_String --
128149
-----------------------
@@ -204,38 +225,46 @@ package body Gnatcheck.Output is
204225

205226
procedure Info (Message : String) is
206227
begin
207-
Info_No_EOL (Message);
208-
New_Line (Standard_Error);
209-
210-
if Log_Mode and then Is_Open (Log_File) then
211-
New_Line (Log_File);
212-
end if;
228+
Emit_Message
229+
(Message,
230+
Tag => Info,
231+
Tool_Name => True,
232+
New_Line => True,
233+
Log_Message => True);
213234
end Info;
214235

215236
-----------------
216237
-- Info_No_EOL --
217238
-----------------
218239

219-
procedure Info_No_EOL (Message : String) is
220-
begin
221-
Put (Standard_Error, Message);
222-
223-
if Log_Mode and then Is_Open (Log_File) then
224-
Put (Log_File, Message);
225-
end if;
226-
end Info_No_EOL;
227-
228240
-----------------
229241
-- Info_In_Tty --
230242
-----------------
231243

232244
procedure Info_In_Tty (Message : String) is
233245
begin
234246
if isatty (fileno (stderr)) /= 0 then
235-
Put_Line (Standard_Error, Message);
247+
Emit_Message
248+
(Message,
249+
Tag => Info,
250+
Tool_Name => True,
251+
New_Line => True,
252+
Log_Message => False);
236253
end if;
237254
end Info_In_Tty;
238255

256+
-----------
257+
-- Print --
258+
-----------
259+
260+
procedure Print
261+
(Message : String;
262+
New_Line, Log_Message : Boolean := True)
263+
is
264+
begin
265+
Emit_Message (Message, New_Line => New_Line, Log_Message => Log_Message);
266+
end Print;
267+
239268
------------------------
240269
-- Print_Tool_Version --
241270
------------------------
@@ -262,12 +291,14 @@ package body Gnatcheck.Output is
262291

263292
procedure Print_Version_Info (Released_At : Positive) is
264293
begin
265-
Info (Executable & " " & Version_String);
266-
Info_No_EOL ("Copyright ");
267-
Info_No_EOL (Image (Released_At));
268-
Info_No_EOL ("-");
269-
Info_No_EOL (Current_Year);
270-
Info (", AdaCore.");
294+
Print (Executable & " " & Version_String, Log_Message => False);
295+
Print
296+
("Copyright "
297+
& Image (Released_At)
298+
& '-'
299+
& Current_Year
300+
& ", AdaCore.",
301+
Log_Message => False);
271302
end Print_Version_Info;
272303

273304
------------
@@ -350,9 +381,7 @@ package body Gnatcheck.Output is
350381
begin
351382
Error (Exception_Message (Ex));
352383
if Arg.Debug_Mode.Get then
353-
Put_Line
354-
(Standard_Error,
355-
GNAT.Traceback.Symbolic.Symbolic_Traceback_No_Hex (Ex));
384+
Print (GNAT.Traceback.Symbolic.Symbolic_Traceback_No_Hex (Ex));
356385
end if;
357386
end Report_Unhandled_Exception;
358387

@@ -543,11 +572,16 @@ package body Gnatcheck.Output is
543572

544573
procedure Warning (Message : String) is
545574
begin
546-
Error (Message);
547-
548-
-- Force a non-zero return code when "warnings as errors" is enabled
549575
if Arg.Warnings_As_Errors.Get then
576+
Error (Message);
550577
Error_From_Warning := True;
578+
else
579+
Emit_Message
580+
(Message,
581+
Tag => Warning,
582+
Tool_Name => True,
583+
New_Line => True,
584+
Log_Message => True);
551585
end if;
552586
end Warning;
553587

‎lkql_checker/src/gnatcheck-output.ads‎

Lines changed: 31 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -44,26 +44,50 @@ package Gnatcheck.Output is
4444
procedure Error (Message : String);
4545
-- Sends into Stderr the error message in the form 'Tool_Name: Message'
4646

47-
procedure Error_No_Tool_Name (Message : String);
48-
-- Sends into Stderr the error message with no tool name prefix
49-
5047
procedure Warning (Message : String);
5148
-- Same as ``Error``
5249

5350
procedure Info (Message : String);
5451
-- Sends Message into Stderr (with no tool name prefix).
5552

56-
procedure Info_No_EOL (Message : String);
57-
-- The same as ``Info``, but does not output a (platform-specific) EOL
58-
-- character(s) after ``Message``.
59-
6053
procedure Info_In_Tty (Message : String);
6154
-- Same as ``Info`` but send the message only if Stderr is a TTY. Also,
6255
-- ``Message`` is not added to the current ``Log_File``.
6356

57+
procedure Print
58+
(Message : String;
59+
New_Line, Log_Message : Boolean := True);
60+
-- Send the given message to ``Standard_Error``, eventually adding a
61+
-- newline following the ``New_Line`` parameter.
62+
-- If ``Log_Message`` is ``True``, add the message to the ``Log_File``.
63+
6464
Indent_String : constant String := " ";
6565
-- Used as indentation element in various output
6666

67+
---------------------------
68+
-- Tool message emission --
69+
---------------------------
70+
71+
type Message_Tags is (Info, Warning, Error, None);
72+
-- Possible tags when displaying a message to the user
73+
74+
procedure Emit_Message
75+
(Message : String;
76+
Tag : Message_Tags := None;
77+
Tool_Name : Boolean := False;
78+
New_Line : Boolean := False;
79+
Log_Message : Boolean := False);
80+
-- Common procedure to emit a message to the user in ``Standard_Error``,
81+
-- controlling the format of the message.
82+
--
83+
-- ``Tag``: Tag to add to the message when emitting it
84+
-- ``Tool_Name``: Whether to include the tool name at the start of the
85+
-- message (ex: "gnatcheck: ...")
86+
-- ``New_Line``: Whether to add a end-of-line character at the end of the
87+
-- message
88+
-- ``Log_Message``: Whether to log this message in the current ``Log_File``
89+
-- if ``Log_Mode`` is ``True``
90+
6791
----------------------
6892
-- Tool report file --
6993
----------------------

‎lkql_checker/src/gnatcheck-projects.adb‎

Lines changed: 15 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -117,10 +117,10 @@ package body Gnatcheck.Projects is
117117
begin
118118
case Message.Level is
119119
when GPR2.Message.Error =>
120-
Error (Message.Format);
120+
Print (Message.Format);
121121
when GPR2.Message.Warning =>
122122
if Verbose_Mode then
123-
Warning (Message.Format);
123+
Print (Message.Format);
124124
end if;
125125

126126
if not Missing_File_Detected
@@ -581,12 +581,12 @@ package body Gnatcheck.Projects is
581581
elsif not My_Project.Tree.Has_Runtime_Project then
582582
-- Issue with the configuration of Ada
583583
for Msg of My_Project.Tree.Configuration.Log_Messages loop
584-
Warning (Msg.Format);
584+
Print (Msg.Format);
585585
end loop;
586586
Error
587-
(""""
588-
& String (My_Project.Tree.Root_Project.Path_Name.Simple_Name)
589-
& """ processing failed");
587+
("""" &
588+
String (My_Project.Tree.Root_Project.Path_Name.Simple_Name) &
589+
""" processing failed");
590590

591591
raise Parameter_Error;
592592
end if;
@@ -640,9 +640,9 @@ package body Gnatcheck.Projects is
640640

641641
if Aggregate.Num_Of_Aggregated_Projects > 1 then
642642
if not Main_Unit.Is_Empty then
643-
Error ("'-U main' cannot be used if aggregate project");
644-
Error_No_Tool_Name
645-
("aggregates more than one non-aggregate project");
643+
Error
644+
("'-U main' cannot be used if aggregate project " &
645+
"aggregates more than one non-aggregate project");
646646

647647
raise Parameter_Error;
648648
end if;
@@ -1562,7 +1562,7 @@ package body Gnatcheck.Projects is
15621562
Nothing_To_Do := Last_Source < First_SF_Id;
15631563

15641564
if Nothing_To_Do then
1565-
Error ("No existing file to process");
1565+
Error ("no existing file to process");
15661566
return;
15671567
end if;
15681568

@@ -1611,15 +1611,13 @@ package body Gnatcheck.Projects is
16111611
then
16121612
if not Arg.Quiet_Mode then
16131613
Info
1614-
("info: " &
1615-
Ada.Strings.Unbounded.To_String (Rule.Name) &
1614+
(Ada.Strings.Unbounded.To_String (Rule.Name) &
16161615
" disabled, target does not match");
16171616
end if;
16181617
else
16191618
if not Arg.Quiet_Mode then
16201619
Info
1621-
("info: " &
1622-
Ada.Strings.Unbounded.To_String (Rule.Name) &
1620+
(Ada.Strings.Unbounded.To_String (Rule.Name) &
16231621
" enabled");
16241622
end if;
16251623

@@ -1637,11 +1635,11 @@ package body Gnatcheck.Projects is
16371635

16381636
if not (Active_Rule_Present or else Analyze_Compiler_Output) then
16391637
if Gnatkp_Mode and then KP_Version /= null then
1640-
Error ("No rule for the given kp-version");
1638+
Error ("no rule for the given kp-version");
16411639
No_Detectors_For_KP_Version := True;
16421640
return;
16431641
else
1644-
Error ("No rule to check specified");
1642+
Error ("no rule to check specified");
16451643
raise Parameter_Error;
16461644
end if;
16471645
end if;
@@ -1653,7 +1651,7 @@ package body Gnatcheck.Projects is
16531651
Total_Sources := Total_Sources_To_Process;
16541652

16551653
if Total_Sources = 0 then
1656-
Error ("No existing file to process");
1654+
Error ("no existing file to process");
16571655
Nothing_To_Do := True;
16581656
return;
16591657
end if;

0 commit comments

Comments
 (0)