@@ -40,7 +40,7 @@ pragma Warnings (On);
40
40
with GPR2.Context ;
41
41
with GPR2.KB ;
42
42
with GPR2.Log ;
43
- with GPR2.Message.Reporter ;
43
+ with GPR2.Message ;
44
44
with GPR2.Options ;
45
45
with GPR2.Path_Name ;
46
46
with GPR2.Project.Attribute ;
@@ -51,6 +51,7 @@ with GPR2.Project.Registry.Attribute.Description;
51
51
with GPR2.Project.Registry.Pack ;
52
52
with GPR2.Project.Registry.Pack.Description ;
53
53
with GPR2.Project.View ;
54
+ with GPR2.Reporter.Console ;
54
55
55
56
with GNATCOLL.Opt_Parse ; use GNATCOLL.Opt_Parse;
56
57
with GNATCOLL.Strings ; use GNATCOLL.Strings;
@@ -78,48 +79,65 @@ package body Gnatcheck.Projects is
78
79
79
80
X_Vars : GPR2.Containers.Value_Set;
80
81
81
- type Gnatcheck_Reporter is new GPR2.Message.Reporter.Object with
82
+ -- --------------------------
83
+ -- GPR2 messages reporter --
84
+ -- --------------------------
85
+
86
+ type Gnatcheck_Reporter is new GPR2.Reporter.Object with
82
87
null record ;
83
88
84
- overriding procedure Report
85
- (Self : Gnatcheck_Reporter;
89
+ overriding procedure Internal_Report
90
+ (Self : in out Gnatcheck_Reporter;
86
91
Message : GPR2.Message.Object);
87
92
88
- overriding procedure Report
89
- (Self : Gnatcheck_Reporter;
90
- Message : String);
93
+ overriding function Verbosity
94
+ (Self : Gnatcheck_Reporter) return GPR2.Reporter.Verbosity_Level;
91
95
92
96
Gpr2_Reporter : Gnatcheck_Reporter;
93
97
-- Make libgpt2 report messages using the proper gnatcheck.Output API
94
98
99
+ function Report_Missing_File (Log : String) return Boolean is
100
+ (Index (Log, " source file" ) /= 0
101
+ and then
102
+ Index (Log, " not found" ) /= 0 );
103
+ -- Checks if Log reports about a missing source file.
104
+
95
105
-- ----------
96
106
-- Report --
97
107
-- ----------
98
108
99
- overriding procedure Report
100
- (Self : Gnatcheck_Reporter;
109
+ overriding procedure Internal_Report
110
+ (Self : in out Gnatcheck_Reporter;
101
111
Message : GPR2.Message.Object)
102
112
is
103
113
begin
104
114
case Message.Level is
105
115
when GPR2.Message.Error =>
106
116
Error (Message.Format);
107
117
when GPR2.Message.Warning =>
108
- Warning (Message.Format);
118
+ if Verbose_Mode then
119
+ Warning (Message.Format);
120
+ end if ;
121
+
122
+ if not Missing_File_Detected
123
+ and then Report_Missing_File (Message.Message)
124
+ then
125
+ Missing_File_Detected := True;
126
+ end if ;
109
127
when others =>
110
128
null ;
111
129
end case ;
112
- end Report ;
130
+ end Internal_Report ;
113
131
114
- overriding procedure Report
115
- (Self : Gnatcheck_Reporter;
116
- Message : String)
117
- is
118
- pragma Unreferenced (Self, Message);
132
+ -- -------------
133
+ -- Verbosity --
134
+ -- -------------
135
+
136
+ overriding function Verbosity
137
+ (Self : Gnatcheck_Reporter) return GPR2.Reporter.Verbosity_Level is
119
138
begin
120
- -- Info (Message);
121
- null ;
122
- end Report ;
139
+ return GPR2.Reporter.Regular;
140
+ end Verbosity ;
123
141
124
142
-- ---------------------
125
143
-- Local subprograms --
@@ -141,12 +159,6 @@ package body Gnatcheck.Projects is
141
159
-- parameter of '-A option' (which is supposed to be a (non-aggregate)
142
160
-- project aggregated by My_Project
143
161
144
- function Report_Missing_File (Log : String) return Boolean is
145
- (Index (Log, " source file" ) /= 0
146
- and then
147
- Index (Log, " not found" ) /= 0 );
148
- -- Checks if Log reports about a missing source file.
149
-
150
162
-- ------------
151
163
-- Clean_Up --
152
164
-- ------------
@@ -440,19 +452,7 @@ package body Gnatcheck.Projects is
440
452
use GPR2;
441
453
use GPR2.Containers;
442
454
use Ada.Strings.Unbounded;
443
-
444
- Log : GPR2.Log.Object;
445
- Has_Error : Boolean;
446
455
begin
447
- -- Set reporting verbosity when loading the project tree and the sources
448
- if Verbose_Mode then
449
- GPR2.Project.Tree.Verbosity := GPR2.Project.Tree.Warnings_And_Errors;
450
- else
451
- GPR2.Project.Tree.Verbosity := GPR2.Project.Tree.Errors;
452
- end if ;
453
-
454
- GPR2.Message.Reporter.Register_Reporter (Gpr2_Reporter);
455
-
456
456
-- In case of autoconf, restrict to the Ada language
457
457
458
458
My_Project.Tree.Restrict_Autoconf_To_Languages
@@ -486,12 +486,27 @@ package body Gnatcheck.Projects is
486
486
Project_Options.Add_Switch (GPR2.Options.Resolve_Links);
487
487
end if ;
488
488
489
- if not My_Project.Tree.Load (Project_Options, With_Runtime => True) then
489
+ if not My_Project.Tree.Load (Project_Options,
490
+ Reporter => Gpr2_Reporter,
491
+ Absent_Dir_Error => GPR2.No_Error,
492
+ With_Runtime => True)
493
+ then
490
494
raise Parameter_Error;
491
495
end if ;
492
496
493
- if not My_Project.Tree.Has_Runtime_Project then
494
- My_Project.Tree.Log_Messages.Output_Messages (Information => False);
497
+ if not My_Project.Tree.Languages.Contains (GPR2.Ada_Language) then
498
+ Error
499
+ (" "" "
500
+ & String (My_Project.Tree.Root_Project.Path_Name.Simple_Name)
501
+ & " "" has no Ada sources, processing failed" );
502
+
503
+ raise Parameter_Error;
504
+
505
+ elsif not My_Project.Tree.Has_Runtime_Project then
506
+ -- Issue with the configuration of Ada
507
+ for Msg of My_Project.Tree.Configuration.Log_Messages loop
508
+ Warning (Msg.Format);
509
+ end loop ;
495
510
Error
496
511
(" "" "
497
512
& String (My_Project.Tree.Root_Project.Path_Name.Simple_Name)
@@ -521,25 +536,7 @@ package body Gnatcheck.Projects is
521
536
Target := To_Unbounded_String (String (My_Project.Tree.Target));
522
537
end if ;
523
538
524
- My_Project.Tree.Update_Sources (Messages => Log);
525
-
526
- for Msg_Cur in Log.Iterate
527
- (Information => False,
528
- Warning => False)
529
- loop
530
- Missing_File_Detected :=
531
- Report_Missing_File (GPR2.Log.Element (Msg_Cur).Format);
532
-
533
- exit when Missing_File_Detected;
534
- end loop ;
535
-
536
- Has_Error := Log.Has_Element
537
- (Error => True,
538
- Warning => False,
539
- Information => False,
540
- Read => True);
541
-
542
- if Has_Error then
539
+ if not My_Project.Tree.Update_Sources then
543
540
raise Parameter_Error;
544
541
end if ;
545
542
end if ;
0 commit comments