1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
|
------------------------------------------------------------------------------
-- --
-- GNATCHECK COMPONENTS --
-- --
-- G N A T S Y N C . W R A P P E R --
-- --
-- B o d y --
-- --
-- Copyright (C) 2007, AdaCore --
-- --
-- GNATSYNC is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 2, or ( at your option) any later --
-- version. GNATCHECK is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
-- Public License for more details. You should have received a copy of the --
-- GNU General Public License distributed with GNAT; see file COPYING. If --
-- not, write to the Free Software Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA. --
-- --
-- GNATSYNC is maintained by AdaCore (http://www.adacore.com). --
-- --
------------------------------------------------------------------------------
-- This wrapper procedure assumes that the GNAT instalation has the following
-- directory structure:
-- root --
-- |
-- + -- bin -- gnatsync.exe (the executable for this wrapper)
-- |
-- + -- shared --
-- |
-- gnatsync -- gnatcheck.exe (the gnatsync executable
-- renamed as 'gnatcheck')
--
-- The wrapper has only two switches on its own:
-- - '-Pproject' - to specify the project file
-- - '-U' - to specify if a full project closure should be processed
-- all the other content of the command line is considered as gnatsync
-- switches and is passed without any change to gnatsync
--
-- The wrapper places root/shared/gnatsync/ as the first directory on the
-- path, and then, if '-Pproject' is set, calls
--
-- 'gnat check -Pproject <rest_of_switches>
--
-- otherwise it just calls 'gnatcheck <switches>
with Ada.Directories; use Ada.Directories;
with GNAT.Command_Line; use GNAT.Command_Line;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with ASIS_UL.Common;
with ASIS_UL.Output; use ASIS_UL.Output;
with Gnatsync.Output; use Gnatsync.Output;
procedure Gnatsync.Wrapper is
Project_Par : String_Access;
Main_Unit : String_Access;
Tmp : String_Access;
Num_Of_GNnatsync_Args : Natural := 0;
Quiet_Mode_Set : Boolean := False;
Verbose_Mode_Set : Boolean := False;
Timing_Set : Boolean := False;
Output_Mode_Set : Boolean := False;
Warnings_Mode_Set : Boolean := False;
Out_File_Set : Boolean := False;
Ada_2005_Mode_Set : Boolean := False;
Args : Argument_List (1 .. 9);
-- Arguments to be passed to gnatsync from the call to the GNAT driver
Gnatsync_Dir : constant String :=
Normalize_Pathname
(Containing_Directory (Locate_Exec_On_Path ("gnatsync").all)) &
Directory_Separator & ".." & Directory_Separator &
"share" & Directory_Separator & "gnatsync";
Result : Integer;
begin
Initialize_Option_Scan
(Stop_At_First_Non_Switch => True);
loop
case GNAT.Command_Line.Getopt
("P! " & -- project file
"v q " & -- verbose or quiet mode
"t " & -- output execution time
"os om of " & -- output level control
"wq " & -- Warning message control
"gnat05 " & -- Ada 2005 mode
"out_file=") -- output file control
is
when ASCII.NUL =>
exit;
when 'g' =>
if Full_Switch = "gnat05" then
Ada_2005_Mode_Set := True;
end if;
when 'o' =>
if Full_Switch = "out_file" then
if Out_File_Set then
Error ("out file can be set only once, " &
"all but first settings ignored");
else
Out_File_Set := True;
Num_Of_GNnatsync_Args := Num_Of_GNnatsync_Args + 1;
Args (Num_Of_GNnatsync_Args) :=
new String'("-out_file=" & Parameter);
end if;
else
if Output_Mode_Set then
Error ("output detalization level can be set only once, " &
"all but first settings ignored");
else
Output_Mode_Set := True;
Num_Of_GNnatsync_Args := Num_Of_GNnatsync_Args + 1;
Args (Num_Of_GNnatsync_Args) :=
new String'('-' & Full_Switch);
end if;
end if;
when 'P' =>
if Project_Par /= null then
Error ("exactly one project file must be specified");
Brief_Wrapper_Help;
return;
else
Project_Par := new String'("-P" & Parameter);
end if;
when 'q' =>
if not Quiet_Mode_Set then
Quiet_Mode_Set := True;
Num_Of_GNnatsync_Args := Num_Of_GNnatsync_Args + 1;
Args (Num_Of_GNnatsync_Args) := new String'("-q");
end if;
when 'v' =>
if not Timing_Set then
Timing_Set := True;
Num_Of_GNnatsync_Args := Num_Of_GNnatsync_Args + 1;
Args (Num_Of_GNnatsync_Args) := new String'("-t");
end if;
when 't' =>
if not Verbose_Mode_Set then
Verbose_Mode_Set := True;
Num_Of_GNnatsync_Args := Num_Of_GNnatsync_Args + 1;
Args (Num_Of_GNnatsync_Args) := new String'("-v");
end if;
when 'w' =>
if not Warnings_Mode_Set then
Warnings_Mode_Set := True;
Num_Of_GNnatsync_Args := Num_Of_GNnatsync_Args + 1;
Args (Num_Of_GNnatsync_Args) := new String'("-wq");
end if;
when others =>
raise ASIS_UL.Common.Parameter_Error;
end case;
end loop;
loop
if Main_Unit = null then
Main_Unit := new String'(Get_Argument (Do_Expansion => True));
if Main_Unit.all = "" then
exit;
end if;
else
Tmp := new String'(Get_Argument (Do_Expansion => True));
if Tmp.all = "" then
exit;
else
Error ("at most one main unit can be specified");
Brief_Wrapper_Help;
return;
end if;
end if;
end loop;
if Project_Par = null then
Error ("no project file specified");
Brief_Wrapper_Help;
return;
end if;
if Main_Unit.all /= "" then
if Is_Regular_File (Main_Unit.all) then
Num_Of_GNnatsync_Args := Num_Of_GNnatsync_Args + 1;
Args (Num_Of_GNnatsync_Args) := new String'("-main=" & Main_Unit.all);
else
Error ("file " & Main_Unit.all & " specified as main unit not found");
end if;
end if;
if Ada_2005_Mode_Set then
Num_Of_GNnatsync_Args := Num_Of_GNnatsync_Args + 1;
Args (Num_Of_GNnatsync_Args) := new String'("-cargs");
Num_Of_GNnatsync_Args := Num_Of_GNnatsync_Args + 1;
Args (Num_Of_GNnatsync_Args) := new String'("-gnat05");
end if;
Normalize_Arguments (Args (1 .. Num_Of_GNnatsync_Args));
Setenv
("PATH",
Gnatsync_Dir & Path_Separator & Getenv ("PATH").all);
Result :=
Spawn
(Program_Name => "gnat",
Args => new String'("check") &
new String'("-U") &
new String'(Project_Par.all) &
Args (1 .. Num_Of_GNnatsync_Args));
OS_Exit (Result);
exception
when GNAT.Command_Line.Invalid_Switch =>
Error ("invalid switch : " & Full_Switch);
Brief_Wrapper_Help;
when GNAT.Command_Line.Invalid_Parameter =>
Error ("missing parameter for: " & Full_Switch);
Brief_Wrapper_Help;
end Gnatsync.Wrapper;
|
