Skip to content

Commit c26fdb7

Browse files
HugoGGuerrierHugoGGuerrier
committed
Add an optional location to error messages
Also add location information at various places.
1 parent 46e2848 commit c26fdb7

File tree

14 files changed

+73
-60
lines changed

14 files changed

+73
-60
lines changed

‎lkql_checker/src/gnatcheck-output.adb‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -103,11 +103,13 @@ package body Gnatcheck.Output is
103103
(Message : String;
104104
Tag : Message_Tags := None;
105105
Tool_Name : Boolean := False;
106+
Location : String := "";
106107
New_Line : Boolean := False;
107108
Log_Message : Boolean := False)
108109
is
109110
Final_Message : constant String :=
110111
(if Tool_Name then Executable & ": " else "")
112+
& (if Location /= "" then Location & ": " else "")
111113
& (case Tag is
112114
when Info => "info: ",
113115
when Warning => "warning: ",
@@ -134,12 +136,13 @@ package body Gnatcheck.Output is
134136
-- Error --
135137
-----------
136138

137-
procedure Error (Message : String) is
139+
procedure Error (Message : String; Location : String := "") is
138140
begin
139141
Emit_Message
140142
(Message,
141143
Tag => Error,
142-
Tool_Name => True,
144+
Tool_Name => Location = "",
145+
Location => Location,
143146
New_Line => True,
144147
Log_Message => True);
145148
end Error;

‎lkql_checker/src/gnatcheck-output.ads‎

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -41,8 +41,10 @@ package Gnatcheck.Output is
4141
procedure Report_Missing_File (From_File, Missing_File : String);
4242
-- Reports that a required file could not be found
4343

44-
procedure Error (Message : String);
45-
-- Sends ``Message`` into stderr, prefixed by "tool_name: error: ".
44+
procedure Error (Message : String; Location : String := "");
45+
-- Sends ``Message`` into stderr, prefixed by "tool_name: error: " if
46+
-- ``Location`` is an empty string, otherwise the message is prefixed
47+
-- by "<location>: error: ".
4648

4749
procedure Warning (Message : String);
4850
-- Sends ``Message`` into stderr, prefixed by "tool_name: warning: ".
@@ -73,6 +75,7 @@ package Gnatcheck.Output is
7375
(Message : String;
7476
Tag : Message_Tags := None;
7577
Tool_Name : Boolean := False;
78+
Location : String := "";
7679
New_Line : Boolean := False;
7780
Log_Message : Boolean := False);
7881
-- Common procedure to emit a message to the user in ``Standard_Error``,
@@ -81,6 +84,8 @@ package Gnatcheck.Output is
8184
-- ``Tag``: Tag to add to the message when emitting it
8285
-- ``Tool_Name``: Whether to include the tool name at the start of the
8386
-- message (ex: "gnatcheck: ...")
87+
-- ``Location`` : Location string to append to the message just before the
88+
-- tag.
8489
-- ``New_Line``: Whether to add a end-of-line character at the end of the
8590
-- message
8691
-- ``Log_Message``: Whether to log this message in the current ``Log_File``

‎lkql_checker/src/gnatcheck-rules-rule_table.adb‎

Lines changed: 45 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -175,6 +175,7 @@ package body Gnatcheck.Rules.Rule_Table is
175175

176176
procedure Check_For_Looping (RF_Name : String; Success : in out Boolean) is
177177
Full_Name : constant String := Normalize_Pathname (RF_Name);
178+
Cycle_Msg : Unbounded_String := Null_Unbounded_String;
178179
begin
179180
for J in 1 .. Rule_File_Stack.Last loop
180181
if Full_Name = Rule_File_Stack.Table (J).Full_Name.all then
@@ -184,21 +185,19 @@ package body Gnatcheck.Rules.Rule_Table is
184185
end loop;
185186

186187
if not Success then
187-
Error ("cycling in rule files:");
188188

189189
for J in 1 .. Rule_File_Stack.Last loop
190-
Print (Rule_File_Stack.Table (J).Arg_Name.all & " needs ", False);
191-
190+
Append
191+
(Cycle_Msg, Rule_File_Stack.Table (J).Arg_Name.all & " needs ");
192192
if J < Rule_File_Stack.Last then
193-
Print (Rule_File_Stack.Table (J + 1).Arg_Name.all);
193+
Append (Cycle_Msg, Rule_File_Stack.Table (J + 1).Arg_Name.all);
194194
end if;
195195
end loop;
196196

197-
Print (RF_Name);
198-
Print ("");
199-
197+
Error
198+
("cycling in rule files (" & To_String (Cycle_Msg) & ")",
199+
Location => RF_Name & ":1:1");
200200
raise Fatal_Error;
201-
202201
else
203202
-- Add new file to the rule file stack
204203
Rule_File_Stack.Append
@@ -397,10 +396,8 @@ package body Gnatcheck.Rules.Rule_Table is
397396
begin
398397
if not Present (Rule) then
399398
Error
400-
("unknown rule: "
401-
& Rule_Name
402-
& ", ignored"
403-
& Instantiation_Location);
399+
("unknown rule: " & Rule_Name & ", ignored",
400+
Location => Instantiation_Location);
404401
Bad_Rule_Detected := True;
405402
return False;
406403
end if;
@@ -423,8 +420,8 @@ package body Gnatcheck.Rules.Rule_Table is
423420
& """ previously instantiated at "
424421
& (if Instance.Defined_At /= ""
425422
then To_String (Instance.Defined_At)
426-
else "command line")
427-
& Instantiation_Location);
423+
else "command line"),
424+
Location => Instantiation_Location);
428425
Bad_Rule_Detected := True;
429426
return False;
430427
end if;
@@ -596,6 +593,10 @@ package body Gnatcheck.Rules.Rule_Table is
596593

597594
procedure Scan_Line_Buf (Success : in out Boolean) is
598595
Idx : Positive := 1;
596+
597+
function Current_Location return String
598+
is (Rule_File_Base & ":" & Image (Current_Line) & ":" & Image (Idx));
599+
-- Get the current location in the rule file.
599600
begin
600601
while Idx <= Line_Len loop
601602

@@ -658,7 +659,8 @@ package body Gnatcheck.Rules.Rule_Table is
658659
& Image (Rule_Start_Line)
659660
& ":"
660661
& Image (Current_Line)
661-
& " ignored");
662+
& " ignored",
663+
Location => Current_Location);
662664
Rule_Option_Problem_Detected := True;
663665

664666
Success := True;
@@ -672,7 +674,8 @@ package body Gnatcheck.Rules.Rule_Table is
672674
else
673675
Error
674676
("can not locate rule file "
675-
& Rule_Buf (1 .. Rule_Len));
677+
& Rule_Buf (1 .. Rule_Len),
678+
Location => Current_Location);
676679
Missing_Rule_File_Detected := True;
677680
end if;
678681
end if;
@@ -685,7 +688,8 @@ package body Gnatcheck.Rules.Rule_Table is
685688
& Image (Rule_Start_Line)
686689
& ":"
687690
& Image (Current_Line - 1)
688-
& " do not have format of rule option");
691+
& " do not have format of rule option",
692+
Location => Current_Location);
689693
Rule_Option_Problem_Detected := True;
690694
end case;
691695
end if;
@@ -704,11 +708,11 @@ package body Gnatcheck.Rules.Rule_Table is
704708
Rule_Buf (Rule_Len) := Line_Buf (Idx);
705709
Idx := Idx + 1;
706710
else
707-
Error ("can not read rule options from " & RF_Name);
708711
Error
709712
("too long rule option, the content of the file ignored"
710713
& " starting from line "
711-
& Image (Current_Line));
714+
& Image (Current_Line),
715+
Location => Current_Location);
712716
Rule_Option_Problem_Detected := True;
713717
Success := False;
714718
return;
@@ -848,7 +852,9 @@ package body Gnatcheck.Rules.Rule_Table is
848852
& Image (Rule_Start_Line)
849853
& ":"
850854
& Image (Current_Line)
851-
& " ignored");
855+
& " ignored",
856+
Location =>
857+
Rule_File_Base & ":" & Image (Current_Line) & ":1");
852858

853859
Rule_Option_Problem_Detected := True;
854860
Success := True;
@@ -862,8 +868,9 @@ package body Gnatcheck.Rules.Rule_Table is
862868
Process_Legacy_Rule_File (Include_RF_Name.all);
863869
else
864870
Error
865-
("can not locate rule file "
866-
& Rule_Buf (1 .. Rule_Len));
871+
("can not locate rule file " & Rule_Buf (1 .. Rule_Len),
872+
Location =>
873+
Rule_File_Base & ":" & Image (Current_Line) & ":1");
867874
Missing_Rule_File_Detected := True;
868875
end if;
869876

@@ -881,7 +888,9 @@ package body Gnatcheck.Rules.Rule_Table is
881888
(if New_State = Indefinite
882889
then Current_Line
883890
else Current_Line - 1)
884-
& " do not have format of rule option");
891+
& " do not have format of rule option",
892+
Location =>
893+
Rule_File_Base & ":" & Image (Current_Line) & ":1");
885894
Rule_Option_Problem_Detected := True;
886895
end case;
887896

@@ -1048,9 +1057,6 @@ package body Gnatcheck.Rules.Rule_Table is
10481057
Instance_Name : Unbounded_String;
10491058
Instance : Rule_Instance_Access;
10501059

1051-
Diag_Defined_At : constant String :=
1052-
(if Defined_At = "" then "" else " (" & Defined_At & ")");
1053-
10541060
-------------------
10551061
-- Set_Parameter --
10561062
-------------------
@@ -1104,16 +1110,13 @@ package body Gnatcheck.Rules.Rule_Table is
11041110
begin
11051111
if Word_Start = 0 and then Enable then
11061112
Error
1107-
(R_Name
1108-
& " rule option must have a parameter"
1109-
& Diag_Defined_At);
1113+
(R_Name & " rule option must have a parameter",
1114+
Location => Defined_At);
11101115
return False;
11111116
elsif Word_Start /= 0 and then not Enable then
11121117
Error
1113-
("("
1114-
& Instance_Name
1115-
& ") no parameter allowed for -R"
1116-
& Diag_Defined_At);
1118+
("(" & Instance_Name & ") no parameter allowed for -R",
1119+
Location => Defined_At);
11171120
return False;
11181121
end if;
11191122

@@ -1144,7 +1147,8 @@ package body Gnatcheck.Rules.Rule_Table is
11441147

11451148
if Word_End = 0 then
11461149
Error
1147-
("bad structure of rule option " & Option & Diag_Defined_At);
1150+
("bad structure of rule option " & Option,
1151+
Location => Defined_At);
11481152
Rule_Option_Problem_Detected := True;
11491153
return;
11501154
end if;
@@ -1169,7 +1173,7 @@ package body Gnatcheck.Rules.Rule_Table is
11691173
declare
11701174
R_Name : constant String := Option (Word_Start .. Word_End);
11711175
begin
1172-
if Check_Rule_Exists (R_Name, Diag_Defined_At) then
1176+
if Check_Rule_Exists (R_Name, Defined_At) then
11731177
Rule := Get_Rule (Option (Word_Start .. Word_End));
11741178
else
11751179
return;
@@ -1190,7 +1194,7 @@ package body Gnatcheck.Rules.Rule_Table is
11901194
-- instance, check that this instance exists.
11911195
if Enable
11921196
and then not Check_Instance_Is_Unique
1193-
(To_String (Instance_Name), Diag_Defined_At)
1197+
(To_String (Instance_Name), Defined_At)
11941198
then
11951199
if not Instance_Help_Emitted then
11961200
Info
@@ -1205,8 +1209,8 @@ package body Gnatcheck.Rules.Rule_Table is
12051209
(""""
12061210
& To_String (Instance_Name)
12071211
& """ is not enabled, "
1208-
& "therefore, cannot be disabled"
1209-
& Diag_Defined_At);
1212+
& "therefore, cannot be disabled",
1213+
Location => Defined_At);
12101214
Bad_Rule_Detected := True;
12111215
return;
12121216
end if;
@@ -1274,7 +1278,8 @@ package body Gnatcheck.Rules.Rule_Table is
12741278
end if;
12751279
else
12761280
Error
1277-
("unknown rule option: " & Option & ", ignored" & Diag_Defined_At);
1281+
("unknown rule option: " & Option & ", ignored",
1282+
Location => Defined_At);
12781283
Rule_Option_Problem_Detected := True;
12791284
end if;
12801285
end Process_Legacy_Rule_Option;
@@ -1328,7 +1333,7 @@ package body Gnatcheck.Rules.Rule_Table is
13281333

13291334
procedure Error_In_Rule_File (Msg : String) is
13301335
begin
1331-
Error (Msg & " (" & Output_Rule_File & ")");
1336+
Error (Msg, Location => Output_Rule_File & ":1:1");
13321337
Bad_Rule_Detected := True;
13331338
end Error_In_Rule_File;
13341339

‎testsuite/tests/gnatcheck/lkql_rules_config/actual_parameters/test.out‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ main.adb:17:08: rule violation: actual parameter mismatch
99
Invalid type
1010
============
1111

12-
gnatcheck: error: invalid parameter for rule "actual_parameters": 'forbidden' should be a list of string tuples (invalid_type.lkql)
12+
invalid_type.lkql:1:1: error: invalid parameter for rule "actual_parameters": 'forbidden' should be a list of string tuples
1313
gnatcheck: error: no rule to check specified
1414
try "gnatcheck --help" for more information.
1515
>>>program returned status code 2

‎testsuite/tests/gnatcheck/lkql_rules_config/array_param/test.out‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ main.adb:9:15: rule violation: direct (in)equality
77
Invalid type
88
============
99

10-
gnatcheck: error: invalid parameter for rule "direct_equalities": 'actuals' value should be a list (invalid_type.lkql)
10+
invalid_type.lkql:1:1: error: invalid parameter for rule "direct_equalities": 'actuals' value should be a list
1111
gnatcheck: error: no rule to check specified
1212
try "gnatcheck --help" for more information.
1313
>>>program returned status code 2

‎testsuite/tests/gnatcheck/lkql_rules_config/bool_param/test.out‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ main.adb:3:24: rule violation: use of predefined OR for boolean type
1212
Invalid type
1313
============
1414

15-
gnatcheck: error: invalid parameter for rule "goto_statements": 'only_unconditional' value should be a boolean (invalid_type.lkql)
15+
invalid_type.lkql:1:1: error: invalid parameter for rule "goto_statements": 'only_unconditional' value should be a boolean
1616
gnatcheck: error: no rule to check specified
1717
try "gnatcheck --help" for more information.
1818
>>>program returned status code 2

‎testsuite/tests/gnatcheck/lkql_rules_config/exception_propagation_from_callbacks/test.out‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ main.adb:11:45: rule violation: callback may propagate exceptions
77
Invalid type
88
============
99

10-
gnatcheck: error: invalid parameter for rule "exception_propagation_from_callbacks": 'callbacks' should be a list of string tuples (invalid_type.lkql)
10+
invalid_type.lkql:1:1: error: invalid parameter for rule "exception_propagation_from_callbacks": 'callbacks' should be a list of string tuples
1111
gnatcheck: error: no rule to check specified
1212
try "gnatcheck --help" for more information.
1313
>>>program returned status code 2

‎testsuite/tests/gnatcheck/lkql_rules_config/headers/test.out‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@ no_header.adb:1:01: rule violation: compilation unit does not start with header
66
Missing parameter
77
=================
88

9-
gnatcheck: error: missing 'header' parameter for rule "headers" (missing_param.lkql)
9+
missing_param.lkql:1:1: error: missing 'header' parameter for rule "headers"
1010
gnatcheck: error: no rule to check specified
1111
try "gnatcheck --help" for more information.
1212
>>>program returned status code 2

‎testsuite/tests/gnatcheck/lkql_rules_config/int_and_bool_params/test.out‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@ main.adb:17:10: rule violation: membership test
1616
Invalid type
1717
============
1818

19-
gnatcheck: error: invalid parameter for rule "membership_tests": 'float_types_only' value should be a boolean (invalid_type.lkql)
19+
invalid_type.lkql:1:1: error: invalid parameter for rule "membership_tests": 'float_types_only' value should be a boolean
2020
gnatcheck: error: no rule to check specified
2121
try "gnatcheck --help" for more information.
2222
>>>program returned status code 2

‎testsuite/tests/gnatcheck/lkql_rules_config/int_param/test.out‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,15 +6,15 @@ main.ads:5:14: rule violation: too many formal OUT parameters (3)
66
Missing parameter
77
=================
88

9-
gnatcheck: error: missing 'n' parameter for rule "maximum_out_parameters" (missing_param.lkql)
9+
missing_param.lkql:1:1: error: missing 'n' parameter for rule "maximum_out_parameters"
1010
gnatcheck: error: no rule to check specified
1111
try "gnatcheck --help" for more information.
1212
>>>program returned status code 2
1313

1414
Invalid type
1515
============
1616

17-
gnatcheck: error: invalid parameter for rule "maximum_out_parameters": 'n' value should be an integer (invalid_type.lkql)
17+
invalid_type.lkql:1:1: error: invalid parameter for rule "maximum_out_parameters": 'n' value should be an integer
1818
gnatcheck: error: no rule to check specified
1919
try "gnatcheck --help" for more information.
2020
>>>program returned status code 2

0 commit comments

Comments
 (0)