Skip to content

Commit 5fbb161

Browse files
committed
Add 'Error' primitives to 'Rule_Instance' and 'Arg_Project_Type'
This primitives are used to emit error messages about rule instances and project files.
1 parent c26fdb7 commit 5fbb161

File tree

7 files changed

+84
-47
lines changed

7 files changed

+84
-47
lines changed

lkql_checker/src/gnatcheck-compiler.adb

Lines changed: 13 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1066,7 +1066,7 @@ package body Gnatcheck.Compiler is
10661066
if R_Id = Not_A_Restriction_Id
10671067
and then Special_R_Id = Not_A_Special_Restriction_Id
10681068
then
1069-
Error
1069+
Instance.Error
10701070
("wrong restriction identifier : " & Rest_Name & ", ignored");
10711071
Bad_Rule_Detected := True;
10721072
return;
@@ -1078,7 +1078,7 @@ package body Gnatcheck.Compiler is
10781078
(Lower_Rest_Name, I_Name, Cursor, Success);
10791079
if not Success and then Restriction_To_Instance (Cursor) /= I_Name
10801080
then
1081-
Error
1081+
Instance.Error
10821082
("cannot enable the same restriction in different rule "
10831083
& "instances: "
10841084
& Rest_Name);
@@ -1097,7 +1097,7 @@ package body Gnatcheck.Compiler is
10971097
exit;
10981098

10991099
else
1100-
Error
1100+
Instance.Error
11011101
("wrong structure of restriction rule parameter "
11021102
& Param
11031103
& ", ignored");
@@ -1111,7 +1111,7 @@ package body Gnatcheck.Compiler is
11111111
if R_Id in All_Boolean_Restrictions then
11121112

11131113
if Arg_Present then
1114-
Error
1114+
Instance.Error
11151115
("RESTRICTIONS rule parameter: "
11161116
& Param
11171117
& " can not contain expression, ignored");
@@ -1123,7 +1123,7 @@ package body Gnatcheck.Compiler is
11231123
elsif R_Id /= Not_A_Restriction_Id then
11241124

11251125
if not Arg_Present then
1126-
Error
1126+
Instance.Error
11271127
("RESTRICTIONS rule parameter: "
11281128
& Param
11291129
& " should contain an expression, ignored");
@@ -1150,7 +1150,7 @@ package body Gnatcheck.Compiler is
11501150
end if;
11511151
end loop;
11521152

1153-
Error
1153+
Instance.Error
11541154
("expression for RESTRICTIONS rule parameter: "
11551155
& Param (First_Idx .. Last_Idx)
11561156
& " is specified more than once");
@@ -1160,7 +1160,7 @@ package body Gnatcheck.Compiler is
11601160
Restriction_Setting (R_Id).Param.Append (R_Val'Img);
11611161
exception
11621162
when Constraint_Error =>
1163-
Error
1163+
Instance.Error
11641164
("wrong restriction parameter expression in "
11651165
& Param
11661166
& ", ignored");
@@ -1186,7 +1186,7 @@ package body Gnatcheck.Compiler is
11861186
case Special_R_Id is
11871187
when No_Dependence =>
11881188
if not Arg_Present then
1189-
Error
1189+
Instance.Error
11901190
("Restrictions rule parameter: "
11911191
& Param
11921192
& " should contain a unit name, ignored");
@@ -1201,7 +1201,7 @@ package body Gnatcheck.Compiler is
12011201

12021202
when No_Use_Of_Entity =>
12031203
if not Arg_Present then
1204-
Error
1204+
Instance.Error
12051205
("Restrictions rule parameter: "
12061206
& Param
12071207
& " should contain an entity name, ignored");
@@ -1216,7 +1216,7 @@ package body Gnatcheck.Compiler is
12161216

12171217
when No_Specification_Of_Aspect =>
12181218
if not Arg_Present then
1219-
Error
1219+
Instance.Error
12201220
("Restrictions rule parameter: "
12211221
& Param
12221222
& " should contain an aspect name, ignored");
@@ -1357,7 +1357,7 @@ package body Gnatcheck.Compiler is
13571357

13581358
Style_To_Instance.Insert ([C], Name, Cursor, Success);
13591359
if not Success and then Style_To_Instance (Cursor) /= Name then
1360-
Error
1360+
Instance.Error
13611361
("cannot enable the same style check in different rule "
13621362
& "instances: "
13631363
& C);
@@ -1433,7 +1433,7 @@ package body Gnatcheck.Compiler is
14331433
if Param (J) in 'e' | 's'
14341434
and then (J = Param'First or else Param (J - 1) not in '.' | '_')
14351435
then
1436-
Error
1436+
Instance.Error
14371437
("Warnings rule cannot have "
14381438
& Param (J)
14391439
& " parameter, parameter string "
@@ -1458,7 +1458,7 @@ package body Gnatcheck.Compiler is
14581458

14591459
Warning_To_Instance.Insert (Param (I .. J), Name, Cursor, Success);
14601460
if not Success and then Warning_To_Instance (Cursor) /= Name then
1461-
Error
1461+
Instance.Error
14621462
("cannot enable the same warning in different rule instances: "
14631463
& Param (I .. J));
14641464
Bad_Rule_Detected := True;

lkql_checker/src/gnatcheck-projects.adb

Lines changed: 23 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -144,6 +144,20 @@ package body Gnatcheck.Projects is
144144
return GPR2.Reporter.Regular;
145145
end Verbosity;
146146

147+
-----------
148+
-- Error --
149+
-----------
150+
151+
procedure Error (My_Project : Arg_Project_Type; Message : String) is
152+
begin
153+
if My_Project.Is_Specified then
154+
Gnatcheck.Output.Error
155+
(Message, Location => Source_Prj (My_Project) & ":1:1");
156+
else
157+
Gnatcheck.Output.Error (Message);
158+
end if;
159+
end Error;
160+
147161
-----------------------
148162
-- Local subprograms --
149163
-----------------------
@@ -392,7 +406,8 @@ package body Gnatcheck.Projects is
392406

393407
exception
394408
when E : GPR2.Options.Usage_Error =>
395-
Error (Ada.Exceptions.Exception_Message (E));
409+
My_Project.Error
410+
("libgpr2 usage error: " & Ada.Exceptions.Exception_Message (E));
396411
end Get_Sources_From_Project;
397412

398413
----------------------------
@@ -478,7 +493,7 @@ package body Gnatcheck.Projects is
478493
Config => Conf_Obj)
479494
then
480495
if not My_Project.Tree.Has_Runtime_Project then
481-
Error ("no runtime information found");
496+
My_Project.Error ("no runtime information found");
482497
end if;
483498

484499
Error ("""" & Get_Aggregated_Project & """ processing failed");
@@ -492,7 +507,8 @@ package body Gnatcheck.Projects is
492507

493508
exception
494509
when E : GPR2.Options.Usage_Error =>
495-
Error ("usage error: " & Ada.Exceptions.Exception_Message (E));
510+
My_Project.Error
511+
("libgpr2 usage error: " & Ada.Exceptions.Exception_Message (E));
496512
raise Parameter_Error;
497513
end Load_Aggregated_Project;
498514

@@ -551,23 +567,15 @@ package body Gnatcheck.Projects is
551567
end if;
552568

553569
if not My_Project.Tree.Languages.Contains (GPR2.Ada_Language) then
554-
Error
555-
(""""
556-
& String (My_Project.Tree.Root_Project.Path_Name.Simple_Name)
557-
& """ has no Ada sources, processing failed");
558-
570+
My_Project.Error ("project has no Ada sources, processing failed");
559571
raise Parameter_Error;
560572

561573
elsif not My_Project.Tree.Has_Runtime_Project then
562574
-- Issue with the configuration of Ada
563575
for Msg of My_Project.Tree.Configuration.Log_Messages loop
564576
Print (Msg.Format);
565577
end loop;
566-
Error
567-
(""""
568-
& String (My_Project.Tree.Root_Project.Path_Name.Simple_Name)
569-
& """ processing failed");
570-
578+
My_Project.Error ("processing failed");
571579
raise Parameter_Error;
572580
end if;
573581

@@ -604,7 +612,8 @@ package body Gnatcheck.Projects is
604612

605613
exception
606614
when E : GPR2.Options.Usage_Error =>
607-
Error ("usage error: " & Ada.Exceptions.Exception_Message (E));
615+
My_Project.Error
616+
("libgpr2 usage error: " & Ada.Exceptions.Exception_Message (E));
608617
raise Parameter_Error;
609618
end Load_Tool_Project;
610619

lkql_checker/src/gnatcheck-projects.ads

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -173,6 +173,9 @@ package Gnatcheck.Projects is
173173
(My_Project : Arg_Project_Type) return GPR2.Project.View.Object;
174174
-- Returns access to project view object
175175

176+
procedure Error (My_Project : Arg_Project_Type; Message : String);
177+
-- Emit an error message about this ``My_Project`` project
178+
176179
procedure Store_Project_Source
177180
(My_Project : in out Arg_Project_Type; Project_File_Name : String);
178181
-- If Project_File_Name ends with ".gpr", it is taken to be the name of

lkql_checker/src/gnatcheck-rules.adb

Lines changed: 40 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,8 @@ package body Gnatcheck.Rules is
2828
-- Local helpers --
2929
-------------------
3030

31-
function Expand_Env_Variables (Name : String) return String;
31+
function Expand_Env_Variables
32+
(Name : String; Instance : Rule_Instance'Class) return String;
3233
-- Assuming that Name is a name of a dictionary file (used as rule
3334
-- parameter) and that it may contain environment variables, tries
3435
-- to locate environment variables and to replace them with their values.
@@ -401,7 +402,9 @@ package body Gnatcheck.Rules is
401402
-- Expand_Env_Variables --
402403
--------------------------
403404

404-
function Expand_Env_Variables (Name : String) return String is
405+
function Expand_Env_Variables
406+
(Name : String; Instance : Rule_Instance'Class) return String
407+
is
405408
Text_Start : Natural := Name'First;
406409
EV_Start : Natural := Index (Name, "$");
407410
EV_End : Positive;
@@ -423,7 +426,7 @@ package body Gnatcheck.Rules is
423426
Val : GNAT.OS_Lib.String_Access := Getenv (EV_Name);
424427
begin
425428
if Val = null or else Val.all = "" then
426-
Error ("environment variable " & EV_Name & " undefined");
429+
Instance.Error ("environment variable " & EV_Name & " undefined");
427430
Free (Val);
428431
return EV_Name;
429432
else
@@ -1224,7 +1227,8 @@ package body Gnatcheck.Rules is
12241227
procedure Emit_Wrong_Parameter
12251228
(Instance : Rule_Instance_Access; Param : String) is
12261229
begin
1227-
Error ("(" & Instance_Name (Instance) & ") wrong parameter: " & Param);
1230+
Instance.Error
1231+
("(" & Instance_Name (Instance) & ") wrong parameter: " & Param);
12281232
Bad_Rule_Detected := True;
12291233
end Emit_Wrong_Parameter;
12301234

@@ -1234,7 +1238,7 @@ package body Gnatcheck.Rules is
12341238

12351239
procedure Emit_Required_Parameter (Instance : Rule_Instance_Access) is
12361240
begin
1237-
Error
1241+
Instance.Error
12381242
("(" & Instance_Name (Instance) & ") parameter is required for +R");
12391243
Bad_Rule_Detected := True;
12401244
end Emit_Required_Parameter;
@@ -1245,7 +1249,8 @@ package body Gnatcheck.Rules is
12451249

12461250
procedure Emit_No_Parameter_Allowed (Instance : Rule_Instance_Access) is
12471251
begin
1248-
Error ("(" & Instance_Name (Instance) & ") no parameter allowed for -R");
1252+
Instance.Error
1253+
("(" & Instance_Name (Instance) & ") no parameter allowed for -R");
12491254
Bad_Rule_Detected := True;
12501255
end Emit_No_Parameter_Allowed;
12511256

@@ -1256,7 +1261,7 @@ package body Gnatcheck.Rules is
12561261
procedure Emit_Redefining (Instance : Rule_Instance_Access; Param : String)
12571262
is
12581263
begin
1259-
Error
1264+
Instance.Error
12601265
("redefining at "
12611266
& Defined_Str (To_String (Instance.Defined_At))
12621267
& " parameter"
@@ -1273,8 +1278,8 @@ package body Gnatcheck.Rules is
12731278
procedure Emit_File_Load_Error
12741279
(Instance : Rule_Instance_Access; File_Name : String) is
12751280
begin
1276-
Error
1277-
("(" & Instance_Name (Instance) & "): cannot load file " & File_Name);
1281+
Instance.Error
1282+
("(" & Instance_Name (Instance) & ") cannot load file " & File_Name);
12781283
Bad_Rule_Detected := True;
12791284
end Emit_File_Load_Error;
12801285

@@ -1287,7 +1292,7 @@ package body Gnatcheck.Rules is
12871292
begin
12881293
-- If there is a provided param display an error
12891294
if Param /= "" then
1290-
Error
1295+
Instance.Error
12911296
("no parameter can be set for rule "
12921297
& Gnatcheck.Rules.Instance_Name (Instance)
12931298
& ", "
@@ -1475,7 +1480,7 @@ package body Gnatcheck.Rules is
14751480
if Rule_Name (Instance) = "name_clashes" then
14761481
if Load_Dictionary
14771482
(Instance,
1478-
Expand_Env_Variables (Param),
1483+
Expand_Env_Variables (Param, Instance.all),
14791484
Tagged_Instance.Param)
14801485
then
14811486
Ada.Strings.Unbounded.Set_Unbounded_String
@@ -1921,7 +1926,8 @@ package body Gnatcheck.Rules is
19211926
if Load_Dictionary
19221927
(Instance,
19231928
Expand_Env_Variables
1924-
(Norm_Param (Norm_Param'First + 8 .. Norm_Param'Last)),
1929+
(Norm_Param (Norm_Param'First + 8 .. Norm_Param'Last),
1930+
Instance.all),
19251931
Tagged_Instance.Exclude)
19261932
then
19271933
Set_Unbounded_Wide_Wide_String
@@ -2216,7 +2222,7 @@ package body Gnatcheck.Rules is
22162222
-- error in the parameter syntax.
22172223
First_Equal := Index (Param, "=");
22182224
if First_Equal = 0 then
2219-
Error
2225+
Instance.Error
22202226
("("
22212227
& Gnatcheck.Rules.Instance_Name (Instance)
22222228
& ") missing = in parameter argument: "
@@ -2253,7 +2259,7 @@ package body Gnatcheck.Rules is
22532259
(To_Text (Param (First_Equal + 1 .. Param'Last)))));
22542260
else
22552261
-- Else, display an error and disable the instance
2256-
Error
2262+
Instance.Error
22572263
("("
22582264
& Gnatcheck.Rules.Instance_Name (Instance)
22592265
& ") unknown parameter: "
@@ -2386,7 +2392,7 @@ package body Gnatcheck.Rules is
23862392

23872393
procedure Error is
23882394
begin
2389-
Gnatcheck.Output.Error
2395+
Instance.Error
23902396
("("
23912397
& Instance_Name (Instance)
23922398
& ") wrong parameter: "
@@ -2429,7 +2435,7 @@ package body Gnatcheck.Rules is
24292435
and then Last /= 0
24302436
and then Slice_Count (Create (To_String (Instance.Param), ",")) /= 5
24312437
then
2432-
Error
2438+
Instance.Error
24332439
("("
24342440
& Instance_Name (Instance)
24352441
& ") requires 5 parameters, got: "
@@ -2970,6 +2976,20 @@ package body Gnatcheck.Rules is
29702976
end if;
29712977
end Annotate_Diag;
29722978

2979+
-----------
2980+
-- Error --
2981+
-----------
2982+
2983+
procedure Error (Self : Rule_Instance'Class; Message : String) is
2984+
begin
2985+
if Self.Defined_At /= Null_Unbounded_String then
2986+
Gnatcheck.Output.Error
2987+
(Message, Location => To_String (Self.Defined_At));
2988+
else
2989+
Gnatcheck.Output.Error (Message);
2990+
end if;
2991+
end Error;
2992+
29732993
-- == Overriding operations on rule instances
29742994

29752995
------------------------------------
@@ -3044,7 +3064,8 @@ package body Gnatcheck.Rules is
30443064
Param_Value : constant String :=
30453065
Expect_Literal (Params_Object, "dictionary_file");
30463066
File_Content : constant Unbounded_String :=
3047-
Load_Dictionary_File (Expand_Env_Variables (Param_Value));
3067+
Load_Dictionary_File
3068+
(Expand_Env_Variables (Param_Value, Instance));
30483069
begin
30493070
Params_Object.Unset_Field ("dictionary_file");
30503071
if File_Content /= Null_Unbounded_String then
@@ -3282,7 +3303,8 @@ package body Gnatcheck.Rules is
32823303
Exclude_File : constant String :=
32833304
Expect_Literal (Params_Object, "exclude");
32843305
File_Content : constant Unbounded_String :=
3285-
Load_Dictionary_File (Expand_Env_Variables (Exclude_File));
3306+
Load_Dictionary_File
3307+
(Expand_Env_Variables (Exclude_File, Instance));
32863308
begin
32873309
Params_Object.Unset_Field ("exclude");
32883310
if File_Content /= Null_Unbounded_String then

0 commit comments

Comments
 (0)