|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- G N A T . C O M M A N D _ L I N E --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 1999-2018, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
11 -- GNAT is free software; you can redistribute it and/or modify it under --
|
|
|
12 -- terms of the GNU General Public License as published by the Free Soft- --
|
|
|
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
|
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
|
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
|
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
|
|
|
17 -- --
|
|
|
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
19 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
20 -- version 3.1, as published by the Free Software Foundation. --
|
|
|
21 -- --
|
|
|
22 -- You should have received a copy of the GNU General Public License and --
|
|
|
23 -- a copy of the GCC Runtime Library Exception along with this program; --
|
|
|
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
|
25 -- <http://www.gnu.org/licenses/>. --
|
|
|
26 -- --
|
|
|
27 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
|
32 with Ada.Characters.Handling; use Ada.Characters.Handling;
|
|
|
33 with Ada.Strings.Unbounded;
|
|
|
34 with Ada.Text_IO; use Ada.Text_IO;
|
|
|
35 with Ada.Unchecked_Deallocation;
|
|
|
36
|
|
|
37 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
|
|
38 with GNAT.OS_Lib; use GNAT.OS_Lib;
|
|
|
39
|
|
|
40 package body GNAT.Command_Line is
|
|
|
41
|
|
|
42 -- General note: this entire body could use much more commenting. There
|
|
|
43 -- are large sections of uncommented code throughout, and many formal
|
|
|
44 -- parameters of local subprograms are not documented at all ???
|
|
|
45
|
|
|
46 package CL renames Ada.Command_Line;
|
|
|
47
|
|
|
48 type Switch_Parameter_Type is
|
|
|
49 (Parameter_None,
|
|
|
50 Parameter_With_Optional_Space, -- ':' in getopt
|
|
|
51 Parameter_With_Space_Or_Equal, -- '=' in getopt
|
|
|
52 Parameter_No_Space, -- '!' in getopt
|
|
|
53 Parameter_Optional); -- '?' in getopt
|
|
|
54
|
|
|
55 procedure Set_Parameter
|
|
|
56 (Variable : out Parameter_Type;
|
|
|
57 Arg_Num : Positive;
|
|
|
58 First : Positive;
|
|
|
59 Last : Natural;
|
|
|
60 Extra : Character := ASCII.NUL);
|
|
|
61 pragma Inline (Set_Parameter);
|
|
|
62 -- Set the parameter that will be returned by Parameter below
|
|
|
63 --
|
|
|
64 -- Extra is a character that needs to be added when reporting Full_Switch.
|
|
|
65 -- (it will in general be the switch character, for instance '-').
|
|
|
66 -- Otherwise, Full_Switch will report 'f' instead of '-f'. In particular,
|
|
|
67 -- it needs to be set when reporting an invalid switch or handling '*'.
|
|
|
68 --
|
|
|
69 -- Parameters need to be defined ???
|
|
|
70
|
|
|
71 function Goto_Next_Argument_In_Section (Parser : Opt_Parser) return Boolean;
|
|
|
72 -- Go to the next argument on the command line. If we are at the end of
|
|
|
73 -- the current section, we want to make sure there is no other identical
|
|
|
74 -- section on the command line (there might be multiple instances of
|
|
|
75 -- -largs). Returns True iff there is another argument.
|
|
|
76
|
|
|
77 function Get_File_Names_Case_Sensitive return Integer;
|
|
|
78 pragma Import (C, Get_File_Names_Case_Sensitive,
|
|
|
79 "__gnat_get_file_names_case_sensitive");
|
|
|
80
|
|
|
81 File_Names_Case_Sensitive : constant Boolean :=
|
|
|
82 Get_File_Names_Case_Sensitive /= 0;
|
|
|
83
|
|
|
84 procedure Canonical_Case_File_Name (S : in out String);
|
|
|
85 -- Given a file name, converts it to canonical case form. For systems where
|
|
|
86 -- file names are case sensitive, this procedure has no effect. If file
|
|
|
87 -- names are not case sensitive (i.e. for example if you have the file
|
|
|
88 -- "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then this call
|
|
|
89 -- converts the given string to canonical all lower case form, so that two
|
|
|
90 -- file names compare equal if they refer to the same file.
|
|
|
91
|
|
|
92 procedure Internal_Initialize_Option_Scan
|
|
|
93 (Parser : Opt_Parser;
|
|
|
94 Switch_Char : Character;
|
|
|
95 Stop_At_First_Non_Switch : Boolean;
|
|
|
96 Section_Delimiters : String);
|
|
|
97 -- Initialize Parser, which must have been allocated already
|
|
|
98
|
|
|
99 function Argument (Parser : Opt_Parser; Index : Integer) return String;
|
|
|
100 -- Return the index-th command line argument
|
|
|
101
|
|
|
102 procedure Find_Longest_Matching_Switch
|
|
|
103 (Switches : String;
|
|
|
104 Arg : String;
|
|
|
105 Index_In_Switches : out Integer;
|
|
|
106 Switch_Length : out Integer;
|
|
|
107 Param : out Switch_Parameter_Type);
|
|
|
108 -- Return the Longest switch from Switches that at least partially matches
|
|
|
109 -- Arg. Index_In_Switches is set to 0 if none matches. What are other
|
|
|
110 -- parameters??? in particular Param is not always set???
|
|
|
111
|
|
|
112 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
|
|
|
113 (Argument_List, Argument_List_Access);
|
|
|
114
|
|
|
115 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
|
|
|
116 (Command_Line_Configuration_Record, Command_Line_Configuration);
|
|
|
117
|
|
|
118 procedure Remove (Line : in out Argument_List_Access; Index : Integer);
|
|
|
119 -- Remove a specific element from Line
|
|
|
120
|
|
|
121 procedure Add
|
|
|
122 (Line : in out Argument_List_Access;
|
|
|
123 Str : String_Access;
|
|
|
124 Before : Boolean := False);
|
|
|
125 -- Add a new element to Line. If Before is True, the item is inserted at
|
|
|
126 -- the beginning, else it is appended.
|
|
|
127
|
|
|
128 procedure Add
|
|
|
129 (Config : in out Command_Line_Configuration;
|
|
|
130 Switch : Switch_Definition);
|
|
|
131 procedure Add
|
|
|
132 (Def : in out Alias_Definitions_List;
|
|
|
133 Alias : Alias_Definition);
|
|
|
134 -- Add a new element to Def
|
|
|
135
|
|
|
136 procedure Initialize_Switch_Def
|
|
|
137 (Def : out Switch_Definition;
|
|
|
138 Switch : String := "";
|
|
|
139 Long_Switch : String := "";
|
|
|
140 Help : String := "";
|
|
|
141 Section : String := "";
|
|
|
142 Argument : String := "ARG");
|
|
|
143 -- Initialize [Def] with the contents of the other parameters.
|
|
|
144 -- This also checks consistency of the switch parameters, and will raise
|
|
|
145 -- Invalid_Switch if they do not match.
|
|
|
146
|
|
|
147 procedure Decompose_Switch
|
|
|
148 (Switch : String;
|
|
|
149 Parameter_Type : out Switch_Parameter_Type;
|
|
|
150 Switch_Last : out Integer);
|
|
|
151 -- Given a switch definition ("name:" for instance), extracts the type of
|
|
|
152 -- parameter that is expected, and the name of the switch
|
|
|
153
|
|
|
154 function Can_Have_Parameter (S : String) return Boolean;
|
|
|
155 -- True if S can have a parameter
|
|
|
156
|
|
|
157 function Require_Parameter (S : String) return Boolean;
|
|
|
158 -- True if S requires a parameter
|
|
|
159
|
|
|
160 function Actual_Switch (S : String) return String;
|
|
|
161 -- Remove any possible trailing '!', ':', '?' and '='
|
|
|
162
|
|
|
163 generic
|
|
|
164 with procedure Callback
|
|
|
165 (Simple_Switch : String;
|
|
|
166 Separator : String;
|
|
|
167 Parameter : String;
|
|
|
168 Index : Integer); -- Index in Config.Switches, or -1
|
|
|
169 procedure For_Each_Simple_Switch
|
|
|
170 (Config : Command_Line_Configuration;
|
|
|
171 Section : String;
|
|
|
172 Switch : String;
|
|
|
173 Parameter : String := "";
|
|
|
174 Unalias : Boolean := True);
|
|
|
175 -- Breaks Switch into as simple switches as possible (expanding aliases and
|
|
|
176 -- ungrouping common prefixes when possible), and call Callback for each of
|
|
|
177 -- these.
|
|
|
178
|
|
|
179 procedure Sort_Sections
|
|
|
180 (Line : not null GNAT.OS_Lib.Argument_List_Access;
|
|
|
181 Sections : GNAT.OS_Lib.Argument_List_Access;
|
|
|
182 Params : GNAT.OS_Lib.Argument_List_Access);
|
|
|
183 -- Reorder the command line switches so that the switches belonging to a
|
|
|
184 -- section are grouped together.
|
|
|
185
|
|
|
186 procedure Group_Switches
|
|
|
187 (Cmd : Command_Line;
|
|
|
188 Result : Argument_List_Access;
|
|
|
189 Sections : Argument_List_Access;
|
|
|
190 Params : Argument_List_Access);
|
|
|
191 -- Group switches with common prefixes whenever possible. Once they have
|
|
|
192 -- been grouped, we also check items for possible aliasing.
|
|
|
193
|
|
|
194 procedure Alias_Switches
|
|
|
195 (Cmd : Command_Line;
|
|
|
196 Result : Argument_List_Access;
|
|
|
197 Params : Argument_List_Access);
|
|
|
198 -- When possible, replace one or more switches by an alias, i.e. a shorter
|
|
|
199 -- version.
|
|
|
200
|
|
|
201 function Looking_At
|
|
|
202 (Type_Str : String;
|
|
|
203 Index : Natural;
|
|
|
204 Substring : String) return Boolean;
|
|
|
205 -- Return True if the characters starting at Index in Type_Str are
|
|
|
206 -- equivalent to Substring.
|
|
|
207
|
|
|
208 generic
|
|
|
209 with function Callback (S : String; Index : Integer) return Boolean;
|
|
|
210 procedure Foreach_Switch
|
|
|
211 (Config : Command_Line_Configuration;
|
|
|
212 Section : String);
|
|
|
213 -- Iterate over all switches defined in Config, for a specific section.
|
|
|
214 -- Index is set to the index in Config.Switches. Stop iterating when
|
|
|
215 -- Callback returns False.
|
|
|
216
|
|
|
217 --------------
|
|
|
218 -- Argument --
|
|
|
219 --------------
|
|
|
220
|
|
|
221 function Argument (Parser : Opt_Parser; Index : Integer) return String is
|
|
|
222 begin
|
|
|
223 if Parser.Arguments /= null then
|
|
|
224 return Parser.Arguments (Index + Parser.Arguments'First - 1).all;
|
|
|
225 else
|
|
|
226 return CL.Argument (Index);
|
|
|
227 end if;
|
|
|
228 end Argument;
|
|
|
229
|
|
|
230 ------------------------------
|
|
|
231 -- Canonical_Case_File_Name --
|
|
|
232 ------------------------------
|
|
|
233
|
|
|
234 procedure Canonical_Case_File_Name (S : in out String) is
|
|
|
235 begin
|
|
|
236 if not File_Names_Case_Sensitive then
|
|
|
237 for J in S'Range loop
|
|
|
238 if S (J) in 'A' .. 'Z' then
|
|
|
239 S (J) := Character'Val
|
|
|
240 (Character'Pos (S (J)) +
|
|
|
241 (Character'Pos ('a') - Character'Pos ('A')));
|
|
|
242 end if;
|
|
|
243 end loop;
|
|
|
244 end if;
|
|
|
245 end Canonical_Case_File_Name;
|
|
|
246
|
|
|
247 ---------------
|
|
|
248 -- Expansion --
|
|
|
249 ---------------
|
|
|
250
|
|
|
251 function Expansion (Iterator : Expansion_Iterator) return String is
|
|
|
252 type Pointer is access all Expansion_Iterator;
|
|
|
253
|
|
|
254 It : constant Pointer := Iterator'Unrestricted_Access;
|
|
|
255 S : String (1 .. 1024);
|
|
|
256 Last : Natural;
|
|
|
257
|
|
|
258 Current : Depth := It.Current_Depth;
|
|
|
259 NL : Positive;
|
|
|
260
|
|
|
261 begin
|
|
|
262 -- It is assumed that a directory is opened at the current level.
|
|
|
263 -- Otherwise GNAT.Directory_Operations.Directory_Error will be raised
|
|
|
264 -- at the first call to Read.
|
|
|
265
|
|
|
266 loop
|
|
|
267 Read (It.Levels (Current).Dir, S, Last);
|
|
|
268
|
|
|
269 -- If we have exhausted the directory, close it and go back one level
|
|
|
270
|
|
|
271 if Last = 0 then
|
|
|
272 Close (It.Levels (Current).Dir);
|
|
|
273
|
|
|
274 -- If we are at level 1, we are finished; return an empty string
|
|
|
275
|
|
|
276 if Current = 1 then
|
|
|
277 return String'(1 .. 0 => ' ');
|
|
|
278
|
|
|
279 -- Otherwise continue with the directory at the previous level
|
|
|
280
|
|
|
281 else
|
|
|
282 Current := Current - 1;
|
|
|
283 It.Current_Depth := Current;
|
|
|
284 end if;
|
|
|
285
|
|
|
286 -- If this is a directory, that is neither "." or "..", attempt to
|
|
|
287 -- go to the next level.
|
|
|
288
|
|
|
289 elsif Is_Directory
|
|
|
290 (It.Dir_Name (1 .. It.Levels (Current).Name_Last) &
|
|
|
291 S (1 .. Last))
|
|
|
292 and then S (1 .. Last) /= "."
|
|
|
293 and then S (1 .. Last) /= ".."
|
|
|
294 then
|
|
|
295 -- We can go to the next level only if we have not reached the
|
|
|
296 -- maximum depth,
|
|
|
297
|
|
|
298 if Current < It.Maximum_Depth then
|
|
|
299 NL := It.Levels (Current).Name_Last;
|
|
|
300
|
|
|
301 -- And if relative path of this new directory is not too long
|
|
|
302
|
|
|
303 if NL + Last + 1 < Max_Path_Length then
|
|
|
304 Current := Current + 1;
|
|
|
305 It.Current_Depth := Current;
|
|
|
306 It.Dir_Name (NL + 1 .. NL + Last) := S (1 .. Last);
|
|
|
307 NL := NL + Last + 1;
|
|
|
308 It.Dir_Name (NL) := Directory_Separator;
|
|
|
309 It.Levels (Current).Name_Last := NL;
|
|
|
310 Canonical_Case_File_Name (It.Dir_Name (1 .. NL));
|
|
|
311
|
|
|
312 -- Open the new directory, and read from it
|
|
|
313
|
|
|
314 GNAT.Directory_Operations.Open
|
|
|
315 (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
|
|
|
316 end if;
|
|
|
317 end if;
|
|
|
318 end if;
|
|
|
319
|
|
|
320 -- Check the relative path against the pattern
|
|
|
321
|
|
|
322 -- Note that we try to match also against directory names, since
|
|
|
323 -- clients of this function may expect to retrieve directories.
|
|
|
324
|
|
|
325 declare
|
|
|
326 Name : String :=
|
|
|
327 It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
|
|
|
328 & S (1 .. Last);
|
|
|
329
|
|
|
330 begin
|
|
|
331 Canonical_Case_File_Name (Name);
|
|
|
332
|
|
|
333 -- If it matches return the relative path
|
|
|
334
|
|
|
335 if GNAT.Regexp.Match (Name, Iterator.Regexp) then
|
|
|
336 return Name;
|
|
|
337 end if;
|
|
|
338 end;
|
|
|
339 end loop;
|
|
|
340 end Expansion;
|
|
|
341
|
|
|
342 ---------------------
|
|
|
343 -- Current_Section --
|
|
|
344 ---------------------
|
|
|
345
|
|
|
346 function Current_Section
|
|
|
347 (Parser : Opt_Parser := Command_Line_Parser) return String
|
|
|
348 is
|
|
|
349 begin
|
|
|
350 if Parser.Current_Section = 1 then
|
|
|
351 return "";
|
|
|
352 end if;
|
|
|
353
|
|
|
354 for Index in reverse 1 .. Integer'Min (Parser.Current_Argument - 1,
|
|
|
355 Parser.Section'Last)
|
|
|
356 loop
|
|
|
357 if Parser.Section (Index) = 0 then
|
|
|
358 return Argument (Parser, Index);
|
|
|
359 end if;
|
|
|
360 end loop;
|
|
|
361
|
|
|
362 return "";
|
|
|
363 end Current_Section;
|
|
|
364
|
|
|
365 -----------------
|
|
|
366 -- Full_Switch --
|
|
|
367 -----------------
|
|
|
368
|
|
|
369 function Full_Switch
|
|
|
370 (Parser : Opt_Parser := Command_Line_Parser) return String
|
|
|
371 is
|
|
|
372 begin
|
|
|
373 if Parser.The_Switch.Extra = ASCII.NUL then
|
|
|
374 return Argument (Parser, Parser.The_Switch.Arg_Num)
|
|
|
375 (Parser.The_Switch.First .. Parser.The_Switch.Last);
|
|
|
376 else
|
|
|
377 return Parser.The_Switch.Extra
|
|
|
378 & Argument (Parser, Parser.The_Switch.Arg_Num)
|
|
|
379 (Parser.The_Switch.First .. Parser.The_Switch.Last);
|
|
|
380 end if;
|
|
|
381 end Full_Switch;
|
|
|
382
|
|
|
383 ------------------
|
|
|
384 -- Get_Argument --
|
|
|
385 ------------------
|
|
|
386
|
|
|
387 function Get_Argument
|
|
|
388 (Do_Expansion : Boolean := False;
|
|
|
389 Parser : Opt_Parser := Command_Line_Parser) return String
|
|
|
390 is
|
|
|
391 begin
|
|
|
392 if Parser.In_Expansion then
|
|
|
393 declare
|
|
|
394 S : constant String := Expansion (Parser.Expansion_It);
|
|
|
395 begin
|
|
|
396 if S'Length /= 0 then
|
|
|
397 return S;
|
|
|
398 else
|
|
|
399 Parser.In_Expansion := False;
|
|
|
400 end if;
|
|
|
401 end;
|
|
|
402 end if;
|
|
|
403
|
|
|
404 if Parser.Current_Argument > Parser.Arg_Count then
|
|
|
405
|
|
|
406 -- If this is the first time this function is called
|
|
|
407
|
|
|
408 if Parser.Current_Index = 1 then
|
|
|
409 Parser.Current_Argument := 1;
|
|
|
410 while Parser.Current_Argument <= Parser.Arg_Count
|
|
|
411 and then Parser.Section (Parser.Current_Argument) /=
|
|
|
412 Parser.Current_Section
|
|
|
413 loop
|
|
|
414 Parser.Current_Argument := Parser.Current_Argument + 1;
|
|
|
415 end loop;
|
|
|
416
|
|
|
417 else
|
|
|
418 return String'(1 .. 0 => ' ');
|
|
|
419 end if;
|
|
|
420
|
|
|
421 elsif Parser.Section (Parser.Current_Argument) = 0 then
|
|
|
422 while Parser.Current_Argument <= Parser.Arg_Count
|
|
|
423 and then Parser.Section (Parser.Current_Argument) /=
|
|
|
424 Parser.Current_Section
|
|
|
425 loop
|
|
|
426 Parser.Current_Argument := Parser.Current_Argument + 1;
|
|
|
427 end loop;
|
|
|
428 end if;
|
|
|
429
|
|
|
430 Parser.Current_Index := Integer'Last;
|
|
|
431
|
|
|
432 while Parser.Current_Argument <= Parser.Arg_Count
|
|
|
433 and then Parser.Is_Switch (Parser.Current_Argument)
|
|
|
434 loop
|
|
|
435 Parser.Current_Argument := Parser.Current_Argument + 1;
|
|
|
436 end loop;
|
|
|
437
|
|
|
438 if Parser.Current_Argument > Parser.Arg_Count then
|
|
|
439 return String'(1 .. 0 => ' ');
|
|
|
440 elsif Parser.Section (Parser.Current_Argument) = 0 then
|
|
|
441 return Get_Argument (Do_Expansion);
|
|
|
442 end if;
|
|
|
443
|
|
|
444 Parser.Current_Argument := Parser.Current_Argument + 1;
|
|
|
445
|
|
|
446 -- Could it be a file name with wild cards to expand?
|
|
|
447
|
|
|
448 if Do_Expansion then
|
|
|
449 declare
|
|
|
450 Arg : constant String :=
|
|
|
451 Argument (Parser, Parser.Current_Argument - 1);
|
|
|
452 begin
|
|
|
453 for Index in Arg'Range loop
|
|
|
454 if Arg (Index) = '*'
|
|
|
455 or else Arg (Index) = '?'
|
|
|
456 or else Arg (Index) = '['
|
|
|
457 then
|
|
|
458 Parser.In_Expansion := True;
|
|
|
459 Start_Expansion (Parser.Expansion_It, Arg);
|
|
|
460 return Get_Argument (Do_Expansion, Parser);
|
|
|
461 end if;
|
|
|
462 end loop;
|
|
|
463 end;
|
|
|
464 end if;
|
|
|
465
|
|
|
466 return Argument (Parser, Parser.Current_Argument - 1);
|
|
|
467 end Get_Argument;
|
|
|
468
|
|
|
469 ----------------------
|
|
|
470 -- Decompose_Switch --
|
|
|
471 ----------------------
|
|
|
472
|
|
|
473 procedure Decompose_Switch
|
|
|
474 (Switch : String;
|
|
|
475 Parameter_Type : out Switch_Parameter_Type;
|
|
|
476 Switch_Last : out Integer)
|
|
|
477 is
|
|
|
478 begin
|
|
|
479 if Switch = "" then
|
|
|
480 Parameter_Type := Parameter_None;
|
|
|
481 Switch_Last := Switch'Last;
|
|
|
482 return;
|
|
|
483 end if;
|
|
|
484
|
|
|
485 case Switch (Switch'Last) is
|
|
|
486 when ':' =>
|
|
|
487 Parameter_Type := Parameter_With_Optional_Space;
|
|
|
488 Switch_Last := Switch'Last - 1;
|
|
|
489
|
|
|
490 when '=' =>
|
|
|
491 Parameter_Type := Parameter_With_Space_Or_Equal;
|
|
|
492 Switch_Last := Switch'Last - 1;
|
|
|
493
|
|
|
494 when '!' =>
|
|
|
495 Parameter_Type := Parameter_No_Space;
|
|
|
496 Switch_Last := Switch'Last - 1;
|
|
|
497
|
|
|
498 when '?' =>
|
|
|
499 Parameter_Type := Parameter_Optional;
|
|
|
500 Switch_Last := Switch'Last - 1;
|
|
|
501
|
|
|
502 when others =>
|
|
|
503 Parameter_Type := Parameter_None;
|
|
|
504 Switch_Last := Switch'Last;
|
|
|
505 end case;
|
|
|
506 end Decompose_Switch;
|
|
|
507
|
|
|
508 ----------------------------------
|
|
|
509 -- Find_Longest_Matching_Switch --
|
|
|
510 ----------------------------------
|
|
|
511
|
|
|
512 procedure Find_Longest_Matching_Switch
|
|
|
513 (Switches : String;
|
|
|
514 Arg : String;
|
|
|
515 Index_In_Switches : out Integer;
|
|
|
516 Switch_Length : out Integer;
|
|
|
517 Param : out Switch_Parameter_Type)
|
|
|
518 is
|
|
|
519 Index : Natural;
|
|
|
520 Length : Natural := 1;
|
|
|
521 Last : Natural;
|
|
|
522 P : Switch_Parameter_Type;
|
|
|
523
|
|
|
524 begin
|
|
|
525 Index_In_Switches := 0;
|
|
|
526 Switch_Length := 0;
|
|
|
527
|
|
|
528 -- Remove all leading spaces first to make sure that Index points
|
|
|
529 -- at the start of the first switch.
|
|
|
530
|
|
|
531 Index := Switches'First;
|
|
|
532 while Index <= Switches'Last and then Switches (Index) = ' ' loop
|
|
|
533 Index := Index + 1;
|
|
|
534 end loop;
|
|
|
535
|
|
|
536 while Index <= Switches'Last loop
|
|
|
537
|
|
|
538 -- Search the length of the parameter at this position in Switches
|
|
|
539
|
|
|
540 Length := Index;
|
|
|
541 while Length <= Switches'Last
|
|
|
542 and then Switches (Length) /= ' '
|
|
|
543 loop
|
|
|
544 Length := Length + 1;
|
|
|
545 end loop;
|
|
|
546
|
|
|
547 -- Length now marks the separator after the current switch. Last will
|
|
|
548 -- mark the last character of the name of the switch.
|
|
|
549
|
|
|
550 if Length = Index + 1 then
|
|
|
551 P := Parameter_None;
|
|
|
552 Last := Index;
|
|
|
553 else
|
|
|
554 Decompose_Switch (Switches (Index .. Length - 1), P, Last);
|
|
|
555 end if;
|
|
|
556
|
|
|
557 -- If it is the one we searched, it may be a candidate
|
|
|
558
|
|
|
559 if Arg'First + Last - Index <= Arg'Last
|
|
|
560 and then Switches (Index .. Last) =
|
|
|
561 Arg (Arg'First .. Arg'First + Last - Index)
|
|
|
562 and then Last - Index + 1 > Switch_Length
|
|
|
563 and then
|
|
|
564 (P /= Parameter_With_Space_Or_Equal
|
|
|
565 or else Arg'Last = Arg'First + Last - Index
|
|
|
566 or else Arg (Arg'First + Last - Index + 1) = '=')
|
|
|
567 then
|
|
|
568 Param := P;
|
|
|
569 Index_In_Switches := Index;
|
|
|
570 Switch_Length := Last - Index + 1;
|
|
|
571 end if;
|
|
|
572
|
|
|
573 -- Look for the next switch in Switches
|
|
|
574
|
|
|
575 while Index <= Switches'Last
|
|
|
576 and then Switches (Index) /= ' '
|
|
|
577 loop
|
|
|
578 Index := Index + 1;
|
|
|
579 end loop;
|
|
|
580
|
|
|
581 Index := Index + 1;
|
|
|
582 end loop;
|
|
|
583 end Find_Longest_Matching_Switch;
|
|
|
584
|
|
|
585 ------------
|
|
|
586 -- Getopt --
|
|
|
587 ------------
|
|
|
588
|
|
|
589 function Getopt
|
|
|
590 (Switches : String;
|
|
|
591 Concatenate : Boolean := True;
|
|
|
592 Parser : Opt_Parser := Command_Line_Parser) return Character
|
|
|
593 is
|
|
|
594 Dummy : Boolean;
|
|
|
595
|
|
|
596 begin
|
|
|
597 <<Restart>>
|
|
|
598
|
|
|
599 -- If we have finished parsing the current command line item (there
|
|
|
600 -- might be multiple switches in a single item), then go to the next
|
|
|
601 -- element.
|
|
|
602
|
|
|
603 if Parser.Current_Argument > Parser.Arg_Count
|
|
|
604 or else (Parser.Current_Index >
|
|
|
605 Argument (Parser, Parser.Current_Argument)'Last
|
|
|
606 and then not Goto_Next_Argument_In_Section (Parser))
|
|
|
607 then
|
|
|
608 return ASCII.NUL;
|
|
|
609 end if;
|
|
|
610
|
|
|
611 -- By default, the switch will not have a parameter
|
|
|
612
|
|
|
613 Parser.The_Parameter :=
|
|
|
614 (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL);
|
|
|
615 Parser.The_Separator := ASCII.NUL;
|
|
|
616
|
|
|
617 declare
|
|
|
618 Arg : constant String :=
|
|
|
619 Argument (Parser, Parser.Current_Argument);
|
|
|
620 Index_Switches : Natural := 0;
|
|
|
621 Max_Length : Natural := 0;
|
|
|
622 End_Index : Natural;
|
|
|
623 Param : Switch_Parameter_Type;
|
|
|
624 begin
|
|
|
625 -- If we are on a new item, test if this might be a switch
|
|
|
626
|
|
|
627 if Parser.Current_Index = Arg'First then
|
|
|
628 if Arg = "" or else Arg (Arg'First) /= Parser.Switch_Character then
|
|
|
629
|
|
|
630 -- If it isn't a switch, return it immediately. We also know it
|
|
|
631 -- isn't the parameter to a previous switch, since that has
|
|
|
632 -- already been handled.
|
|
|
633
|
|
|
634 if Switches (Switches'First) = '*' then
|
|
|
635 Set_Parameter
|
|
|
636 (Parser.The_Switch,
|
|
|
637 Arg_Num => Parser.Current_Argument,
|
|
|
638 First => Arg'First,
|
|
|
639 Last => Arg'Last);
|
|
|
640 Parser.Is_Switch (Parser.Current_Argument) := True;
|
|
|
641 Dummy := Goto_Next_Argument_In_Section (Parser);
|
|
|
642 return '*';
|
|
|
643 end if;
|
|
|
644
|
|
|
645 if Parser.Stop_At_First then
|
|
|
646 Parser.Current_Argument := Positive'Last;
|
|
|
647 return ASCII.NUL;
|
|
|
648
|
|
|
649 elsif not Goto_Next_Argument_In_Section (Parser) then
|
|
|
650 return ASCII.NUL;
|
|
|
651
|
|
|
652 else
|
|
|
653 -- Recurse to get the next switch on the command line
|
|
|
654
|
|
|
655 goto Restart;
|
|
|
656 end if;
|
|
|
657 end if;
|
|
|
658
|
|
|
659 -- We are on the first character of a new command line argument,
|
|
|
660 -- which starts with Switch_Character. Further analysis is needed.
|
|
|
661
|
|
|
662 Parser.Current_Index := Parser.Current_Index + 1;
|
|
|
663 Parser.Is_Switch (Parser.Current_Argument) := True;
|
|
|
664 end if;
|
|
|
665
|
|
|
666 Find_Longest_Matching_Switch
|
|
|
667 (Switches => Switches,
|
|
|
668 Arg => Arg (Parser.Current_Index .. Arg'Last),
|
|
|
669 Index_In_Switches => Index_Switches,
|
|
|
670 Switch_Length => Max_Length,
|
|
|
671 Param => Param);
|
|
|
672
|
|
|
673 -- If switch is not accepted, it is either invalid or is returned
|
|
|
674 -- in the context of '*'.
|
|
|
675
|
|
|
676 if Index_Switches = 0 then
|
|
|
677
|
|
|
678 -- Find the current switch that we did not recognize. This is in
|
|
|
679 -- fact difficult because Getopt does not know explicitly about
|
|
|
680 -- short and long switches. Ideally, we would want the following
|
|
|
681 -- behavior:
|
|
|
682
|
|
|
683 -- * for short switches, with Concatenate:
|
|
|
684 -- if -a is not recognized, and the command line has -daf
|
|
|
685 -- we should report the invalid switch as "-a".
|
|
|
686
|
|
|
687 -- * for short switches, wihtout Concatenate:
|
|
|
688 -- we should report the invalid switch as "-daf".
|
|
|
689
|
|
|
690 -- * for long switches:
|
|
|
691 -- if the commadn line is "--long" we should report --long
|
|
|
692 -- as unrecongized.
|
|
|
693
|
|
|
694 -- Unfortunately, the fact that long switches start with a
|
|
|
695 -- duplicate switch character is just a convention (so we could
|
|
|
696 -- have a long switch "-long" for instance). We'll still rely on
|
|
|
697 -- this convention here to try and get as helpful an error message
|
|
|
698 -- as possible.
|
|
|
699
|
|
|
700 -- Long switch case (starting with double switch character)
|
|
|
701
|
|
|
702 if Arg (Arg'First + 1) = Parser.Switch_Character then
|
|
|
703 End_Index := Arg'Last;
|
|
|
704
|
|
|
705 -- Short switch case
|
|
|
706
|
|
|
707 else
|
|
|
708 End_Index :=
|
|
|
709 (if Concatenate then Parser.Current_Index else Arg'Last);
|
|
|
710 end if;
|
|
|
711
|
|
|
712 if Switches /= "" and then Switches (Switches'First) = '*' then
|
|
|
713
|
|
|
714 -- Always prepend the switch character, so that users know
|
|
|
715 -- that this comes from a switch on the command line. This
|
|
|
716 -- is especially important when Concatenate is False, since
|
|
|
717 -- otherwise the current argument first character is lost.
|
|
|
718
|
|
|
719 if Parser.Section (Parser.Current_Argument) = 0 then
|
|
|
720
|
|
|
721 -- A section transition should not be returned to the user
|
|
|
722
|
|
|
723 Dummy := Goto_Next_Argument_In_Section (Parser);
|
|
|
724 goto Restart;
|
|
|
725
|
|
|
726 else
|
|
|
727 Set_Parameter
|
|
|
728 (Parser.The_Switch,
|
|
|
729 Arg_Num => Parser.Current_Argument,
|
|
|
730 First => Parser.Current_Index,
|
|
|
731 Last => Arg'Last,
|
|
|
732 Extra => Parser.Switch_Character);
|
|
|
733 Parser.Is_Switch (Parser.Current_Argument) := True;
|
|
|
734 Dummy := Goto_Next_Argument_In_Section (Parser);
|
|
|
735 return '*';
|
|
|
736 end if;
|
|
|
737 end if;
|
|
|
738
|
|
|
739 if Parser.Current_Index = Arg'First then
|
|
|
740 Set_Parameter
|
|
|
741 (Parser.The_Switch,
|
|
|
742 Arg_Num => Parser.Current_Argument,
|
|
|
743 First => Parser.Current_Index,
|
|
|
744 Last => End_Index);
|
|
|
745 else
|
|
|
746 Set_Parameter
|
|
|
747 (Parser.The_Switch,
|
|
|
748 Arg_Num => Parser.Current_Argument,
|
|
|
749 First => Parser.Current_Index,
|
|
|
750 Last => End_Index,
|
|
|
751 Extra => Parser.Switch_Character);
|
|
|
752 end if;
|
|
|
753
|
|
|
754 Parser.Current_Index := End_Index + 1;
|
|
|
755
|
|
|
756 raise Invalid_Switch;
|
|
|
757 end if;
|
|
|
758
|
|
|
759 End_Index := Parser.Current_Index + Max_Length - 1;
|
|
|
760 Set_Parameter
|
|
|
761 (Parser.The_Switch,
|
|
|
762 Arg_Num => Parser.Current_Argument,
|
|
|
763 First => Parser.Current_Index,
|
|
|
764 Last => End_Index);
|
|
|
765
|
|
|
766 case Param is
|
|
|
767 when Parameter_With_Optional_Space =>
|
|
|
768 if End_Index < Arg'Last then
|
|
|
769 Set_Parameter
|
|
|
770 (Parser.The_Parameter,
|
|
|
771 Arg_Num => Parser.Current_Argument,
|
|
|
772 First => End_Index + 1,
|
|
|
773 Last => Arg'Last);
|
|
|
774 Dummy := Goto_Next_Argument_In_Section (Parser);
|
|
|
775
|
|
|
776 elsif Parser.Current_Argument < Parser.Arg_Count
|
|
|
777 and then Parser.Section (Parser.Current_Argument + 1) /= 0
|
|
|
778 then
|
|
|
779 Parser.Current_Argument := Parser.Current_Argument + 1;
|
|
|
780 Parser.The_Separator := ' ';
|
|
|
781 Set_Parameter
|
|
|
782 (Parser.The_Parameter,
|
|
|
783 Arg_Num => Parser.Current_Argument,
|
|
|
784 First => Argument (Parser, Parser.Current_Argument)'First,
|
|
|
785 Last => Argument (Parser, Parser.Current_Argument)'Last);
|
|
|
786 Parser.Is_Switch (Parser.Current_Argument) := True;
|
|
|
787 Dummy := Goto_Next_Argument_In_Section (Parser);
|
|
|
788
|
|
|
789 else
|
|
|
790 Parser.Current_Index := End_Index + 1;
|
|
|
791 raise Invalid_Parameter;
|
|
|
792 end if;
|
|
|
793
|
|
|
794 when Parameter_With_Space_Or_Equal =>
|
|
|
795
|
|
|
796 -- If the switch is of the form <switch>=xxx
|
|
|
797
|
|
|
798 if End_Index < Arg'Last then
|
|
|
799 if Arg (End_Index + 1) = '='
|
|
|
800 and then End_Index + 1 < Arg'Last
|
|
|
801 then
|
|
|
802 Parser.The_Separator := '=';
|
|
|
803 Set_Parameter
|
|
|
804 (Parser.The_Parameter,
|
|
|
805 Arg_Num => Parser.Current_Argument,
|
|
|
806 First => End_Index + 2,
|
|
|
807 Last => Arg'Last);
|
|
|
808 Dummy := Goto_Next_Argument_In_Section (Parser);
|
|
|
809
|
|
|
810 else
|
|
|
811 Parser.Current_Index := End_Index + 1;
|
|
|
812 raise Invalid_Parameter;
|
|
|
813 end if;
|
|
|
814
|
|
|
815 -- Case of switch of the form <switch> xxx
|
|
|
816
|
|
|
817 elsif Parser.Current_Argument < Parser.Arg_Count
|
|
|
818 and then Parser.Section (Parser.Current_Argument + 1) /= 0
|
|
|
819 then
|
|
|
820 Parser.Current_Argument := Parser.Current_Argument + 1;
|
|
|
821 Parser.The_Separator := ' ';
|
|
|
822 Set_Parameter
|
|
|
823 (Parser.The_Parameter,
|
|
|
824 Arg_Num => Parser.Current_Argument,
|
|
|
825 First => Argument (Parser, Parser.Current_Argument)'First,
|
|
|
826 Last => Argument (Parser, Parser.Current_Argument)'Last);
|
|
|
827 Parser.Is_Switch (Parser.Current_Argument) := True;
|
|
|
828 Dummy := Goto_Next_Argument_In_Section (Parser);
|
|
|
829
|
|
|
830 else
|
|
|
831 Parser.Current_Index := End_Index + 1;
|
|
|
832 raise Invalid_Parameter;
|
|
|
833 end if;
|
|
|
834
|
|
|
835 when Parameter_No_Space =>
|
|
|
836 if End_Index < Arg'Last then
|
|
|
837 Set_Parameter
|
|
|
838 (Parser.The_Parameter,
|
|
|
839 Arg_Num => Parser.Current_Argument,
|
|
|
840 First => End_Index + 1,
|
|
|
841 Last => Arg'Last);
|
|
|
842 Dummy := Goto_Next_Argument_In_Section (Parser);
|
|
|
843
|
|
|
844 else
|
|
|
845 Parser.Current_Index := End_Index + 1;
|
|
|
846 raise Invalid_Parameter;
|
|
|
847 end if;
|
|
|
848
|
|
|
849 when Parameter_Optional =>
|
|
|
850 if End_Index < Arg'Last then
|
|
|
851 Set_Parameter
|
|
|
852 (Parser.The_Parameter,
|
|
|
853 Arg_Num => Parser.Current_Argument,
|
|
|
854 First => End_Index + 1,
|
|
|
855 Last => Arg'Last);
|
|
|
856 end if;
|
|
|
857
|
|
|
858 Dummy := Goto_Next_Argument_In_Section (Parser);
|
|
|
859
|
|
|
860 when Parameter_None =>
|
|
|
861 if Concatenate or else End_Index = Arg'Last then
|
|
|
862 Parser.Current_Index := End_Index + 1;
|
|
|
863
|
|
|
864 else
|
|
|
865 -- If Concatenate is False and the full argument is not
|
|
|
866 -- recognized as a switch, this is an invalid switch.
|
|
|
867
|
|
|
868 if Switches (Switches'First) = '*' then
|
|
|
869 Set_Parameter
|
|
|
870 (Parser.The_Switch,
|
|
|
871 Arg_Num => Parser.Current_Argument,
|
|
|
872 First => Arg'First,
|
|
|
873 Last => Arg'Last);
|
|
|
874 Parser.Is_Switch (Parser.Current_Argument) := True;
|
|
|
875 Dummy := Goto_Next_Argument_In_Section (Parser);
|
|
|
876 return '*';
|
|
|
877 end if;
|
|
|
878
|
|
|
879 Set_Parameter
|
|
|
880 (Parser.The_Switch,
|
|
|
881 Arg_Num => Parser.Current_Argument,
|
|
|
882 First => Parser.Current_Index,
|
|
|
883 Last => Arg'Last,
|
|
|
884 Extra => Parser.Switch_Character);
|
|
|
885 Parser.Current_Index := Arg'Last + 1;
|
|
|
886 raise Invalid_Switch;
|
|
|
887 end if;
|
|
|
888 end case;
|
|
|
889
|
|
|
890 return Switches (Index_Switches);
|
|
|
891 end;
|
|
|
892 end Getopt;
|
|
|
893
|
|
|
894 -----------------------------------
|
|
|
895 -- Goto_Next_Argument_In_Section --
|
|
|
896 -----------------------------------
|
|
|
897
|
|
|
898 function Goto_Next_Argument_In_Section
|
|
|
899 (Parser : Opt_Parser) return Boolean
|
|
|
900 is
|
|
|
901 begin
|
|
|
902 Parser.Current_Argument := Parser.Current_Argument + 1;
|
|
|
903
|
|
|
904 if Parser.Current_Argument > Parser.Arg_Count
|
|
|
905 or else Parser.Section (Parser.Current_Argument) = 0
|
|
|
906 then
|
|
|
907 loop
|
|
|
908 Parser.Current_Argument := Parser.Current_Argument + 1;
|
|
|
909
|
|
|
910 if Parser.Current_Argument > Parser.Arg_Count then
|
|
|
911 Parser.Current_Index := 1;
|
|
|
912 return False;
|
|
|
913 end if;
|
|
|
914
|
|
|
915 exit when Parser.Section (Parser.Current_Argument) =
|
|
|
916 Parser.Current_Section;
|
|
|
917 end loop;
|
|
|
918 end if;
|
|
|
919
|
|
|
920 Parser.Current_Index :=
|
|
|
921 Argument (Parser, Parser.Current_Argument)'First;
|
|
|
922
|
|
|
923 return True;
|
|
|
924 end Goto_Next_Argument_In_Section;
|
|
|
925
|
|
|
926 ------------------
|
|
|
927 -- Goto_Section --
|
|
|
928 ------------------
|
|
|
929
|
|
|
930 procedure Goto_Section
|
|
|
931 (Name : String := "";
|
|
|
932 Parser : Opt_Parser := Command_Line_Parser)
|
|
|
933 is
|
|
|
934 Index : Integer;
|
|
|
935
|
|
|
936 begin
|
|
|
937 Parser.In_Expansion := False;
|
|
|
938
|
|
|
939 if Name = "" then
|
|
|
940 Parser.Current_Argument := 1;
|
|
|
941 Parser.Current_Index := 1;
|
|
|
942 Parser.Current_Section := 1;
|
|
|
943 return;
|
|
|
944 end if;
|
|
|
945
|
|
|
946 Index := 1;
|
|
|
947 while Index <= Parser.Arg_Count loop
|
|
|
948 if Parser.Section (Index) = 0
|
|
|
949 and then Argument (Parser, Index) = Parser.Switch_Character & Name
|
|
|
950 then
|
|
|
951 Parser.Current_Argument := Index + 1;
|
|
|
952 Parser.Current_Index := 1;
|
|
|
953
|
|
|
954 if Parser.Current_Argument <= Parser.Arg_Count then
|
|
|
955 Parser.Current_Section :=
|
|
|
956 Parser.Section (Parser.Current_Argument);
|
|
|
957 end if;
|
|
|
958
|
|
|
959 -- Exit from loop if we have the start of another section
|
|
|
960
|
|
|
961 if Index = Parser.Section'Last
|
|
|
962 or else Parser.Section (Index + 1) /= 0
|
|
|
963 then
|
|
|
964 return;
|
|
|
965 end if;
|
|
|
966 end if;
|
|
|
967
|
|
|
968 Index := Index + 1;
|
|
|
969 end loop;
|
|
|
970
|
|
|
971 Parser.Current_Argument := Positive'Last;
|
|
|
972 Parser.Current_Index := 2; -- so that Get_Argument returns nothing
|
|
|
973 end Goto_Section;
|
|
|
974
|
|
|
975 ----------------------------
|
|
|
976 -- Initialize_Option_Scan --
|
|
|
977 ----------------------------
|
|
|
978
|
|
|
979 procedure Initialize_Option_Scan
|
|
|
980 (Switch_Char : Character := '-';
|
|
|
981 Stop_At_First_Non_Switch : Boolean := False;
|
|
|
982 Section_Delimiters : String := "")
|
|
|
983 is
|
|
|
984 begin
|
|
|
985 Internal_Initialize_Option_Scan
|
|
|
986 (Parser => Command_Line_Parser,
|
|
|
987 Switch_Char => Switch_Char,
|
|
|
988 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
|
|
|
989 Section_Delimiters => Section_Delimiters);
|
|
|
990 end Initialize_Option_Scan;
|
|
|
991
|
|
|
992 ----------------------------
|
|
|
993 -- Initialize_Option_Scan --
|
|
|
994 ----------------------------
|
|
|
995
|
|
|
996 procedure Initialize_Option_Scan
|
|
|
997 (Parser : out Opt_Parser;
|
|
|
998 Command_Line : GNAT.OS_Lib.Argument_List_Access;
|
|
|
999 Switch_Char : Character := '-';
|
|
|
1000 Stop_At_First_Non_Switch : Boolean := False;
|
|
|
1001 Section_Delimiters : String := "")
|
|
|
1002 is
|
|
|
1003 begin
|
|
|
1004 Free (Parser);
|
|
|
1005
|
|
|
1006 if Command_Line = null then
|
|
|
1007 Parser := new Opt_Parser_Data (CL.Argument_Count);
|
|
|
1008 Internal_Initialize_Option_Scan
|
|
|
1009 (Parser => Parser,
|
|
|
1010 Switch_Char => Switch_Char,
|
|
|
1011 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
|
|
|
1012 Section_Delimiters => Section_Delimiters);
|
|
|
1013 else
|
|
|
1014 Parser := new Opt_Parser_Data (Command_Line'Length);
|
|
|
1015 Parser.Arguments := Command_Line;
|
|
|
1016 Internal_Initialize_Option_Scan
|
|
|
1017 (Parser => Parser,
|
|
|
1018 Switch_Char => Switch_Char,
|
|
|
1019 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
|
|
|
1020 Section_Delimiters => Section_Delimiters);
|
|
|
1021 end if;
|
|
|
1022 end Initialize_Option_Scan;
|
|
|
1023
|
|
|
1024 -------------------------------------
|
|
|
1025 -- Internal_Initialize_Option_Scan --
|
|
|
1026 -------------------------------------
|
|
|
1027
|
|
|
1028 procedure Internal_Initialize_Option_Scan
|
|
|
1029 (Parser : Opt_Parser;
|
|
|
1030 Switch_Char : Character;
|
|
|
1031 Stop_At_First_Non_Switch : Boolean;
|
|
|
1032 Section_Delimiters : String)
|
|
|
1033 is
|
|
|
1034 Section_Num : Section_Number;
|
|
|
1035 Section_Index : Integer;
|
|
|
1036 Last : Integer;
|
|
|
1037 Delimiter_Found : Boolean;
|
|
|
1038
|
|
|
1039 Discard : Boolean;
|
|
|
1040 pragma Warnings (Off, Discard);
|
|
|
1041
|
|
|
1042 begin
|
|
|
1043 Parser.Current_Argument := 0;
|
|
|
1044 Parser.Current_Index := 0;
|
|
|
1045 Parser.In_Expansion := False;
|
|
|
1046 Parser.Switch_Character := Switch_Char;
|
|
|
1047 Parser.Stop_At_First := Stop_At_First_Non_Switch;
|
|
|
1048 Parser.Section := (others => 1);
|
|
|
1049
|
|
|
1050 -- If we are using sections, we have to preprocess the command line to
|
|
|
1051 -- delimit them. A section can be repeated, so we just give each item
|
|
|
1052 -- on the command line a section number
|
|
|
1053
|
|
|
1054 Section_Num := 1;
|
|
|
1055 Section_Index := Section_Delimiters'First;
|
|
|
1056 while Section_Index <= Section_Delimiters'Last loop
|
|
|
1057 Last := Section_Index;
|
|
|
1058 while Last <= Section_Delimiters'Last
|
|
|
1059 and then Section_Delimiters (Last) /= ' '
|
|
|
1060 loop
|
|
|
1061 Last := Last + 1;
|
|
|
1062 end loop;
|
|
|
1063
|
|
|
1064 Delimiter_Found := False;
|
|
|
1065 Section_Num := Section_Num + 1;
|
|
|
1066
|
|
|
1067 for Index in 1 .. Parser.Arg_Count loop
|
|
|
1068 pragma Assert (Argument (Parser, Index)'First = 1);
|
|
|
1069 if Argument (Parser, Index) /= ""
|
|
|
1070 and then Argument (Parser, Index)(1) = Parser.Switch_Character
|
|
|
1071 and then
|
|
|
1072 Argument (Parser, Index) = Parser.Switch_Character &
|
|
|
1073 Section_Delimiters
|
|
|
1074 (Section_Index .. Last - 1)
|
|
|
1075 then
|
|
|
1076 Parser.Section (Index) := 0;
|
|
|
1077 Delimiter_Found := True;
|
|
|
1078
|
|
|
1079 elsif Parser.Section (Index) = 0 then
|
|
|
1080
|
|
|
1081 -- A previous section delimiter
|
|
|
1082
|
|
|
1083 Delimiter_Found := False;
|
|
|
1084
|
|
|
1085 elsif Delimiter_Found then
|
|
|
1086 Parser.Section (Index) := Section_Num;
|
|
|
1087 end if;
|
|
|
1088 end loop;
|
|
|
1089
|
|
|
1090 Section_Index := Last + 1;
|
|
|
1091 while Section_Index <= Section_Delimiters'Last
|
|
|
1092 and then Section_Delimiters (Section_Index) = ' '
|
|
|
1093 loop
|
|
|
1094 Section_Index := Section_Index + 1;
|
|
|
1095 end loop;
|
|
|
1096 end loop;
|
|
|
1097
|
|
|
1098 Discard := Goto_Next_Argument_In_Section (Parser);
|
|
|
1099 end Internal_Initialize_Option_Scan;
|
|
|
1100
|
|
|
1101 ---------------
|
|
|
1102 -- Parameter --
|
|
|
1103 ---------------
|
|
|
1104
|
|
|
1105 function Parameter
|
|
|
1106 (Parser : Opt_Parser := Command_Line_Parser) return String
|
|
|
1107 is
|
|
|
1108 begin
|
|
|
1109 if Parser.The_Parameter.First > Parser.The_Parameter.Last then
|
|
|
1110 return String'(1 .. 0 => ' ');
|
|
|
1111 else
|
|
|
1112 return Argument (Parser, Parser.The_Parameter.Arg_Num)
|
|
|
1113 (Parser.The_Parameter.First .. Parser.The_Parameter.Last);
|
|
|
1114 end if;
|
|
|
1115 end Parameter;
|
|
|
1116
|
|
|
1117 ---------------
|
|
|
1118 -- Separator --
|
|
|
1119 ---------------
|
|
|
1120
|
|
|
1121 function Separator
|
|
|
1122 (Parser : Opt_Parser := Command_Line_Parser) return Character
|
|
|
1123 is
|
|
|
1124 begin
|
|
|
1125 return Parser.The_Separator;
|
|
|
1126 end Separator;
|
|
|
1127
|
|
|
1128 -------------------
|
|
|
1129 -- Set_Parameter --
|
|
|
1130 -------------------
|
|
|
1131
|
|
|
1132 procedure Set_Parameter
|
|
|
1133 (Variable : out Parameter_Type;
|
|
|
1134 Arg_Num : Positive;
|
|
|
1135 First : Positive;
|
|
|
1136 Last : Natural;
|
|
|
1137 Extra : Character := ASCII.NUL)
|
|
|
1138 is
|
|
|
1139 begin
|
|
|
1140 Variable.Arg_Num := Arg_Num;
|
|
|
1141 Variable.First := First;
|
|
|
1142 Variable.Last := Last;
|
|
|
1143 Variable.Extra := Extra;
|
|
|
1144 end Set_Parameter;
|
|
|
1145
|
|
|
1146 ---------------------
|
|
|
1147 -- Start_Expansion --
|
|
|
1148 ---------------------
|
|
|
1149
|
|
|
1150 procedure Start_Expansion
|
|
|
1151 (Iterator : out Expansion_Iterator;
|
|
|
1152 Pattern : String;
|
|
|
1153 Directory : String := "";
|
|
|
1154 Basic_Regexp : Boolean := True)
|
|
|
1155 is
|
|
|
1156 Directory_Separator : Character;
|
|
|
1157 pragma Import (C, Directory_Separator, "__gnat_dir_separator");
|
|
|
1158
|
|
|
1159 First : Positive := Pattern'First;
|
|
|
1160 Pat : String := Pattern;
|
|
|
1161
|
|
|
1162 begin
|
|
|
1163 Canonical_Case_File_Name (Pat);
|
|
|
1164 Iterator.Current_Depth := 1;
|
|
|
1165
|
|
|
1166 -- If Directory is unspecified, use the current directory ("./" or ".\")
|
|
|
1167
|
|
|
1168 if Directory = "" then
|
|
|
1169 Iterator.Dir_Name (1 .. 2) := "." & Directory_Separator;
|
|
|
1170 Iterator.Start := 3;
|
|
|
1171
|
|
|
1172 else
|
|
|
1173 Iterator.Dir_Name (1 .. Directory'Length) := Directory;
|
|
|
1174 Iterator.Start := Directory'Length + 1;
|
|
|
1175 Canonical_Case_File_Name (Iterator.Dir_Name (1 .. Directory'Length));
|
|
|
1176
|
|
|
1177 -- Make sure that the last character is a directory separator
|
|
|
1178
|
|
|
1179 if Directory (Directory'Last) /= Directory_Separator then
|
|
|
1180 Iterator.Dir_Name (Iterator.Start) := Directory_Separator;
|
|
|
1181 Iterator.Start := Iterator.Start + 1;
|
|
|
1182 end if;
|
|
|
1183 end if;
|
|
|
1184
|
|
|
1185 Iterator.Levels (1).Name_Last := Iterator.Start - 1;
|
|
|
1186
|
|
|
1187 -- Open the initial Directory, at depth 1
|
|
|
1188
|
|
|
1189 GNAT.Directory_Operations.Open
|
|
|
1190 (Iterator.Levels (1).Dir, Iterator.Dir_Name (1 .. Iterator.Start - 1));
|
|
|
1191
|
|
|
1192 -- If in the current directory and the pattern starts with "./" or ".\",
|
|
|
1193 -- drop the "./" or ".\" from the pattern.
|
|
|
1194
|
|
|
1195 if Directory = "" and then Pat'Length > 2
|
|
|
1196 and then Pat (Pat'First) = '.'
|
|
|
1197 and then Pat (Pat'First + 1) = Directory_Separator
|
|
|
1198 then
|
|
|
1199 First := Pat'First + 2;
|
|
|
1200 end if;
|
|
|
1201
|
|
|
1202 Iterator.Regexp :=
|
|
|
1203 GNAT.Regexp.Compile (Pat (First .. Pat'Last), Basic_Regexp, True);
|
|
|
1204
|
|
|
1205 Iterator.Maximum_Depth := 1;
|
|
|
1206
|
|
|
1207 -- Maximum_Depth is equal to 1 plus the number of directory separators
|
|
|
1208 -- in the pattern.
|
|
|
1209
|
|
|
1210 for Index in First .. Pat'Last loop
|
|
|
1211 if Pat (Index) = Directory_Separator then
|
|
|
1212 Iterator.Maximum_Depth := Iterator.Maximum_Depth + 1;
|
|
|
1213 exit when Iterator.Maximum_Depth = Max_Depth;
|
|
|
1214 end if;
|
|
|
1215 end loop;
|
|
|
1216 end Start_Expansion;
|
|
|
1217
|
|
|
1218 ----------
|
|
|
1219 -- Free --
|
|
|
1220 ----------
|
|
|
1221
|
|
|
1222 procedure Free (Parser : in out Opt_Parser) is
|
|
|
1223 procedure Unchecked_Free is new
|
|
|
1224 Ada.Unchecked_Deallocation (Opt_Parser_Data, Opt_Parser);
|
|
|
1225 begin
|
|
|
1226 if Parser /= null and then Parser /= Command_Line_Parser then
|
|
|
1227 Free (Parser.Arguments);
|
|
|
1228 Unchecked_Free (Parser);
|
|
|
1229 end if;
|
|
|
1230 end Free;
|
|
|
1231
|
|
|
1232 ------------------
|
|
|
1233 -- Define_Alias --
|
|
|
1234 ------------------
|
|
|
1235
|
|
|
1236 procedure Define_Alias
|
|
|
1237 (Config : in out Command_Line_Configuration;
|
|
|
1238 Switch : String;
|
|
|
1239 Expanded : String;
|
|
|
1240 Section : String := "")
|
|
|
1241 is
|
|
|
1242 Def : Alias_Definition;
|
|
|
1243
|
|
|
1244 begin
|
|
|
1245 if Config = null then
|
|
|
1246 Config := new Command_Line_Configuration_Record;
|
|
|
1247 end if;
|
|
|
1248
|
|
|
1249 Def.Alias := new String'(Switch);
|
|
|
1250 Def.Expansion := new String'(Expanded);
|
|
|
1251 Def.Section := new String'(Section);
|
|
|
1252 Add (Config.Aliases, Def);
|
|
|
1253 end Define_Alias;
|
|
|
1254
|
|
|
1255 -------------------
|
|
|
1256 -- Define_Prefix --
|
|
|
1257 -------------------
|
|
|
1258
|
|
|
1259 procedure Define_Prefix
|
|
|
1260 (Config : in out Command_Line_Configuration;
|
|
|
1261 Prefix : String)
|
|
|
1262 is
|
|
|
1263 begin
|
|
|
1264 if Config = null then
|
|
|
1265 Config := new Command_Line_Configuration_Record;
|
|
|
1266 end if;
|
|
|
1267
|
|
|
1268 Add (Config.Prefixes, new String'(Prefix));
|
|
|
1269 end Define_Prefix;
|
|
|
1270
|
|
|
1271 ---------
|
|
|
1272 -- Add --
|
|
|
1273 ---------
|
|
|
1274
|
|
|
1275 procedure Add
|
|
|
1276 (Config : in out Command_Line_Configuration;
|
|
|
1277 Switch : Switch_Definition)
|
|
|
1278 is
|
|
|
1279 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
|
|
|
1280 (Switch_Definitions, Switch_Definitions_List);
|
|
|
1281
|
|
|
1282 Tmp : Switch_Definitions_List;
|
|
|
1283
|
|
|
1284 begin
|
|
|
1285 if Config = null then
|
|
|
1286 Config := new Command_Line_Configuration_Record;
|
|
|
1287 end if;
|
|
|
1288
|
|
|
1289 Tmp := Config.Switches;
|
|
|
1290
|
|
|
1291 if Tmp = null then
|
|
|
1292 Config.Switches := new Switch_Definitions (1 .. 1);
|
|
|
1293 else
|
|
|
1294 Config.Switches := new Switch_Definitions (1 .. Tmp'Length + 1);
|
|
|
1295 Config.Switches (1 .. Tmp'Length) := Tmp.all;
|
|
|
1296 Unchecked_Free (Tmp);
|
|
|
1297 end if;
|
|
|
1298
|
|
|
1299 if Switch.Switch /= null and then Switch.Switch.all = "*" then
|
|
|
1300 Config.Star_Switch := True;
|
|
|
1301 end if;
|
|
|
1302
|
|
|
1303 Config.Switches (Config.Switches'Last) := Switch;
|
|
|
1304 end Add;
|
|
|
1305
|
|
|
1306 ---------
|
|
|
1307 -- Add --
|
|
|
1308 ---------
|
|
|
1309
|
|
|
1310 procedure Add
|
|
|
1311 (Def : in out Alias_Definitions_List;
|
|
|
1312 Alias : Alias_Definition)
|
|
|
1313 is
|
|
|
1314 procedure Unchecked_Free is new
|
|
|
1315 Ada.Unchecked_Deallocation
|
|
|
1316 (Alias_Definitions, Alias_Definitions_List);
|
|
|
1317
|
|
|
1318 Tmp : Alias_Definitions_List := Def;
|
|
|
1319
|
|
|
1320 begin
|
|
|
1321 if Tmp = null then
|
|
|
1322 Def := new Alias_Definitions (1 .. 1);
|
|
|
1323 else
|
|
|
1324 Def := new Alias_Definitions (1 .. Tmp'Length + 1);
|
|
|
1325 Def (1 .. Tmp'Length) := Tmp.all;
|
|
|
1326 Unchecked_Free (Tmp);
|
|
|
1327 end if;
|
|
|
1328
|
|
|
1329 Def (Def'Last) := Alias;
|
|
|
1330 end Add;
|
|
|
1331
|
|
|
1332 ---------------------------
|
|
|
1333 -- Initialize_Switch_Def --
|
|
|
1334 ---------------------------
|
|
|
1335
|
|
|
1336 procedure Initialize_Switch_Def
|
|
|
1337 (Def : out Switch_Definition;
|
|
|
1338 Switch : String := "";
|
|
|
1339 Long_Switch : String := "";
|
|
|
1340 Help : String := "";
|
|
|
1341 Section : String := "";
|
|
|
1342 Argument : String := "ARG")
|
|
|
1343 is
|
|
|
1344 P1, P2 : Switch_Parameter_Type := Parameter_None;
|
|
|
1345 Last1, Last2 : Integer;
|
|
|
1346
|
|
|
1347 begin
|
|
|
1348 if Switch /= "" then
|
|
|
1349 Def.Switch := new String'(Switch);
|
|
|
1350 Decompose_Switch (Switch, P1, Last1);
|
|
|
1351 end if;
|
|
|
1352
|
|
|
1353 if Long_Switch /= "" then
|
|
|
1354 Def.Long_Switch := new String'(Long_Switch);
|
|
|
1355 Decompose_Switch (Long_Switch, P2, Last2);
|
|
|
1356 end if;
|
|
|
1357
|
|
|
1358 if Switch /= "" and then Long_Switch /= "" then
|
|
|
1359 if (P1 = Parameter_None and then P2 /= P1)
|
|
|
1360 or else (P2 = Parameter_None and then P1 /= P2)
|
|
|
1361 or else (P1 = Parameter_Optional and then P2 /= P1)
|
|
|
1362 or else (P2 = Parameter_Optional and then P2 /= P1)
|
|
|
1363 then
|
|
|
1364 raise Invalid_Switch
|
|
|
1365 with "Inconsistent parameter types for "
|
|
|
1366 & Switch & " and " & Long_Switch;
|
|
|
1367 end if;
|
|
|
1368 end if;
|
|
|
1369
|
|
|
1370 if Section /= "" then
|
|
|
1371 Def.Section := new String'(Section);
|
|
|
1372 end if;
|
|
|
1373
|
|
|
1374 if Argument /= "ARG" then
|
|
|
1375 Def.Argument := new String'(Argument);
|
|
|
1376 end if;
|
|
|
1377
|
|
|
1378 if Help /= "" then
|
|
|
1379 Def.Help := new String'(Help);
|
|
|
1380 end if;
|
|
|
1381 end Initialize_Switch_Def;
|
|
|
1382
|
|
|
1383 -------------------
|
|
|
1384 -- Define_Switch --
|
|
|
1385 -------------------
|
|
|
1386
|
|
|
1387 procedure Define_Switch
|
|
|
1388 (Config : in out Command_Line_Configuration;
|
|
|
1389 Switch : String := "";
|
|
|
1390 Long_Switch : String := "";
|
|
|
1391 Help : String := "";
|
|
|
1392 Section : String := "";
|
|
|
1393 Argument : String := "ARG")
|
|
|
1394 is
|
|
|
1395 Def : Switch_Definition;
|
|
|
1396 begin
|
|
|
1397 if Switch /= "" or else Long_Switch /= "" then
|
|
|
1398 Initialize_Switch_Def
|
|
|
1399 (Def, Switch, Long_Switch, Help, Section, Argument);
|
|
|
1400 Add (Config, Def);
|
|
|
1401 end if;
|
|
|
1402 end Define_Switch;
|
|
|
1403
|
|
|
1404 -------------------
|
|
|
1405 -- Define_Switch --
|
|
|
1406 -------------------
|
|
|
1407
|
|
|
1408 procedure Define_Switch
|
|
|
1409 (Config : in out Command_Line_Configuration;
|
|
|
1410 Output : access Boolean;
|
|
|
1411 Switch : String := "";
|
|
|
1412 Long_Switch : String := "";
|
|
|
1413 Help : String := "";
|
|
|
1414 Section : String := "";
|
|
|
1415 Value : Boolean := True)
|
|
|
1416 is
|
|
|
1417 Def : Switch_Definition (Switch_Boolean);
|
|
|
1418 begin
|
|
|
1419 if Switch /= "" or else Long_Switch /= "" then
|
|
|
1420 Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
|
|
|
1421 Def.Boolean_Output := Output.all'Unchecked_Access;
|
|
|
1422 Def.Boolean_Value := Value;
|
|
|
1423 Add (Config, Def);
|
|
|
1424 end if;
|
|
|
1425 end Define_Switch;
|
|
|
1426
|
|
|
1427 -------------------
|
|
|
1428 -- Define_Switch --
|
|
|
1429 -------------------
|
|
|
1430
|
|
|
1431 procedure Define_Switch
|
|
|
1432 (Config : in out Command_Line_Configuration;
|
|
|
1433 Output : access Integer;
|
|
|
1434 Switch : String := "";
|
|
|
1435 Long_Switch : String := "";
|
|
|
1436 Help : String := "";
|
|
|
1437 Section : String := "";
|
|
|
1438 Initial : Integer := 0;
|
|
|
1439 Default : Integer := 1;
|
|
|
1440 Argument : String := "ARG")
|
|
|
1441 is
|
|
|
1442 Def : Switch_Definition (Switch_Integer);
|
|
|
1443 begin
|
|
|
1444 if Switch /= "" or else Long_Switch /= "" then
|
|
|
1445 Initialize_Switch_Def
|
|
|
1446 (Def, Switch, Long_Switch, Help, Section, Argument);
|
|
|
1447 Def.Integer_Output := Output.all'Unchecked_Access;
|
|
|
1448 Def.Integer_Default := Default;
|
|
|
1449 Def.Integer_Initial := Initial;
|
|
|
1450 Add (Config, Def);
|
|
|
1451 end if;
|
|
|
1452 end Define_Switch;
|
|
|
1453
|
|
|
1454 -------------------
|
|
|
1455 -- Define_Switch --
|
|
|
1456 -------------------
|
|
|
1457
|
|
|
1458 procedure Define_Switch
|
|
|
1459 (Config : in out Command_Line_Configuration;
|
|
|
1460 Output : access GNAT.Strings.String_Access;
|
|
|
1461 Switch : String := "";
|
|
|
1462 Long_Switch : String := "";
|
|
|
1463 Help : String := "";
|
|
|
1464 Section : String := "";
|
|
|
1465 Argument : String := "ARG")
|
|
|
1466 is
|
|
|
1467 Def : Switch_Definition (Switch_String);
|
|
|
1468 begin
|
|
|
1469 if Switch /= "" or else Long_Switch /= "" then
|
|
|
1470 Initialize_Switch_Def
|
|
|
1471 (Def, Switch, Long_Switch, Help, Section, Argument);
|
|
|
1472 Def.String_Output := Output.all'Unchecked_Access;
|
|
|
1473 Add (Config, Def);
|
|
|
1474 end if;
|
|
|
1475 end Define_Switch;
|
|
|
1476
|
|
131
|
1477 -------------------
|
|
|
1478 -- Define_Switch --
|
|
|
1479 -------------------
|
|
|
1480
|
|
|
1481 procedure Define_Switch
|
|
|
1482 (Config : in out Command_Line_Configuration;
|
|
|
1483 Callback : not null Value_Callback;
|
|
|
1484 Switch : String := "";
|
|
|
1485 Long_Switch : String := "";
|
|
|
1486 Help : String := "";
|
|
|
1487 Section : String := "";
|
|
|
1488 Argument : String := "ARG")
|
|
|
1489 is
|
|
|
1490 Def : Switch_Definition (Switch_Callback);
|
|
|
1491 begin
|
|
|
1492 if Switch /= "" or else Long_Switch /= "" then
|
|
|
1493 Initialize_Switch_Def
|
|
|
1494 (Def, Switch, Long_Switch, Help, Section, Argument);
|
|
|
1495 Def.Callback := Callback;
|
|
|
1496 Add (Config, Def);
|
|
|
1497 end if;
|
|
|
1498 end Define_Switch;
|
|
|
1499
|
|
111
|
1500 --------------------
|
|
|
1501 -- Define_Section --
|
|
|
1502 --------------------
|
|
|
1503
|
|
|
1504 procedure Define_Section
|
|
|
1505 (Config : in out Command_Line_Configuration;
|
|
|
1506 Section : String)
|
|
|
1507 is
|
|
|
1508 begin
|
|
|
1509 if Config = null then
|
|
|
1510 Config := new Command_Line_Configuration_Record;
|
|
|
1511 end if;
|
|
|
1512
|
|
|
1513 Add (Config.Sections, new String'(Section));
|
|
|
1514 end Define_Section;
|
|
|
1515
|
|
|
1516 --------------------
|
|
|
1517 -- Foreach_Switch --
|
|
|
1518 --------------------
|
|
|
1519
|
|
|
1520 procedure Foreach_Switch
|
|
|
1521 (Config : Command_Line_Configuration;
|
|
|
1522 Section : String)
|
|
|
1523 is
|
|
|
1524 begin
|
|
|
1525 if Config /= null and then Config.Switches /= null then
|
|
|
1526 for J in Config.Switches'Range loop
|
|
|
1527 if (Section = "" and then Config.Switches (J).Section = null)
|
|
|
1528 or else
|
|
|
1529 (Config.Switches (J).Section /= null
|
|
|
1530 and then Config.Switches (J).Section.all = Section)
|
|
|
1531 then
|
|
|
1532 exit when Config.Switches (J).Switch /= null
|
|
|
1533 and then not Callback (Config.Switches (J).Switch.all, J);
|
|
|
1534
|
|
|
1535 exit when Config.Switches (J).Long_Switch /= null
|
|
|
1536 and then
|
|
|
1537 not Callback (Config.Switches (J).Long_Switch.all, J);
|
|
|
1538 end if;
|
|
|
1539 end loop;
|
|
|
1540 end if;
|
|
|
1541 end Foreach_Switch;
|
|
|
1542
|
|
|
1543 ------------------
|
|
|
1544 -- Get_Switches --
|
|
|
1545 ------------------
|
|
|
1546
|
|
|
1547 function Get_Switches
|
|
|
1548 (Config : Command_Line_Configuration;
|
|
|
1549 Switch_Char : Character := '-';
|
|
|
1550 Section : String := "") return String
|
|
|
1551 is
|
|
|
1552 Ret : Ada.Strings.Unbounded.Unbounded_String;
|
|
|
1553 use Ada.Strings.Unbounded;
|
|
|
1554
|
|
|
1555 function Add_Switch (S : String; Index : Integer) return Boolean;
|
|
|
1556 -- Add a switch to Ret
|
|
|
1557
|
|
|
1558 ----------------
|
|
|
1559 -- Add_Switch --
|
|
|
1560 ----------------
|
|
|
1561
|
|
|
1562 function Add_Switch (S : String; Index : Integer) return Boolean is
|
|
|
1563 pragma Unreferenced (Index);
|
|
|
1564 begin
|
|
|
1565 if S = "*" then
|
|
|
1566 Ret := "*" & Ret; -- Always first
|
|
|
1567 elsif S (S'First) = Switch_Char then
|
|
|
1568 Append (Ret, " " & S (S'First + 1 .. S'Last));
|
|
|
1569 else
|
|
|
1570 Append (Ret, " " & S);
|
|
|
1571 end if;
|
|
|
1572
|
|
|
1573 return True;
|
|
|
1574 end Add_Switch;
|
|
|
1575
|
|
|
1576 Tmp : Boolean;
|
|
|
1577 pragma Unreferenced (Tmp);
|
|
|
1578
|
|
|
1579 procedure Foreach is new Foreach_Switch (Add_Switch);
|
|
|
1580
|
|
|
1581 -- Start of processing for Get_Switches
|
|
|
1582
|
|
|
1583 begin
|
|
|
1584 if Config = null then
|
|
|
1585 return "";
|
|
|
1586 end if;
|
|
|
1587
|
|
|
1588 Foreach (Config, Section => Section);
|
|
|
1589
|
|
|
1590 -- Add relevant aliases
|
|
|
1591
|
|
|
1592 if Config.Aliases /= null then
|
|
|
1593 for A in Config.Aliases'Range loop
|
|
|
1594 if Config.Aliases (A).Section.all = Section then
|
|
|
1595 Tmp := Add_Switch (Config.Aliases (A).Alias.all, -1);
|
|
|
1596 end if;
|
|
|
1597 end loop;
|
|
|
1598 end if;
|
|
|
1599
|
|
|
1600 return To_String (Ret);
|
|
|
1601 end Get_Switches;
|
|
|
1602
|
|
|
1603 ------------------------
|
|
|
1604 -- Section_Delimiters --
|
|
|
1605 ------------------------
|
|
|
1606
|
|
|
1607 function Section_Delimiters
|
|
|
1608 (Config : Command_Line_Configuration) return String
|
|
|
1609 is
|
|
|
1610 use Ada.Strings.Unbounded;
|
|
|
1611 Result : Unbounded_String;
|
|
|
1612
|
|
|
1613 begin
|
|
|
1614 if Config /= null and then Config.Sections /= null then
|
|
|
1615 for S in Config.Sections'Range loop
|
|
|
1616 Append (Result, " " & Config.Sections (S).all);
|
|
|
1617 end loop;
|
|
|
1618 end if;
|
|
|
1619
|
|
|
1620 return To_String (Result);
|
|
|
1621 end Section_Delimiters;
|
|
|
1622
|
|
|
1623 -----------------------
|
|
|
1624 -- Set_Configuration --
|
|
|
1625 -----------------------
|
|
|
1626
|
|
|
1627 procedure Set_Configuration
|
|
|
1628 (Cmd : in out Command_Line;
|
|
|
1629 Config : Command_Line_Configuration)
|
|
|
1630 is
|
|
|
1631 begin
|
|
|
1632 Cmd.Config := Config;
|
|
|
1633 end Set_Configuration;
|
|
|
1634
|
|
|
1635 -----------------------
|
|
|
1636 -- Get_Configuration --
|
|
|
1637 -----------------------
|
|
|
1638
|
|
|
1639 function Get_Configuration
|
|
|
1640 (Cmd : Command_Line) return Command_Line_Configuration
|
|
|
1641 is
|
|
|
1642 begin
|
|
|
1643 return Cmd.Config;
|
|
|
1644 end Get_Configuration;
|
|
|
1645
|
|
|
1646 ----------------------
|
|
|
1647 -- Set_Command_Line --
|
|
|
1648 ----------------------
|
|
|
1649
|
|
|
1650 procedure Set_Command_Line
|
|
|
1651 (Cmd : in out Command_Line;
|
|
|
1652 Switches : String;
|
|
|
1653 Getopt_Description : String := "";
|
|
|
1654 Switch_Char : Character := '-')
|
|
|
1655 is
|
|
|
1656 Tmp : Argument_List_Access;
|
|
|
1657 Parser : Opt_Parser;
|
|
|
1658 S : Character;
|
|
|
1659 Section : String_Access := null;
|
|
|
1660
|
|
|
1661 function Real_Full_Switch
|
|
|
1662 (S : Character;
|
|
|
1663 Parser : Opt_Parser) return String;
|
|
|
1664 -- Ensure that the returned switch value contains the Switch_Char prefix
|
|
|
1665 -- if needed.
|
|
|
1666
|
|
|
1667 ----------------------
|
|
|
1668 -- Real_Full_Switch --
|
|
|
1669 ----------------------
|
|
|
1670
|
|
|
1671 function Real_Full_Switch
|
|
|
1672 (S : Character;
|
|
|
1673 Parser : Opt_Parser) return String
|
|
|
1674 is
|
|
|
1675 begin
|
|
|
1676 if S = '*' then
|
|
|
1677 return Full_Switch (Parser);
|
|
|
1678 else
|
|
|
1679 return Switch_Char & Full_Switch (Parser);
|
|
|
1680 end if;
|
|
|
1681 end Real_Full_Switch;
|
|
|
1682
|
|
|
1683 -- Start of processing for Set_Command_Line
|
|
|
1684
|
|
|
1685 begin
|
|
|
1686 Free (Cmd.Expanded);
|
|
|
1687 Free (Cmd.Params);
|
|
|
1688
|
|
|
1689 if Switches /= "" then
|
|
|
1690 Tmp := Argument_String_To_List (Switches);
|
|
|
1691 Initialize_Option_Scan (Parser, Tmp, Switch_Char);
|
|
|
1692
|
|
|
1693 loop
|
|
|
1694 begin
|
|
|
1695 if Cmd.Config /= null then
|
|
|
1696
|
|
|
1697 -- Do not use Getopt_Description in this case. Otherwise,
|
|
|
1698 -- if we have defined a prefix -gnaty, and two switches
|
|
|
1699 -- -gnatya and -gnatyL!, we would have a different behavior
|
|
|
1700 -- depending on the order of switches:
|
|
|
1701
|
|
|
1702 -- -gnatyL1a => -gnatyL with argument "1a"
|
|
|
1703 -- -gnatyaL1 => -gnatya and -gnatyL with argument "1"
|
|
|
1704
|
|
|
1705 -- This is because the call to Getopt below knows nothing
|
|
|
1706 -- about prefixes, and in the first case finds a valid
|
|
|
1707 -- switch with arguments, so returns it without analyzing
|
|
|
1708 -- the argument. In the second case, the switch matches "*",
|
|
|
1709 -- and is then decomposed below.
|
|
|
1710
|
|
|
1711 -- Note: When a Command_Line object is associated with a
|
|
|
1712 -- Command_Line_Config (which is mostly the case for tools
|
|
|
1713 -- that let users choose the command line before spawning
|
|
|
1714 -- other tools, for instance IDEs), the configuration of
|
|
|
1715 -- the switches must be taken from the Command_Line_Config.
|
|
|
1716
|
|
|
1717 S := Getopt (Switches => "* " & Get_Switches (Cmd.Config),
|
|
|
1718 Concatenate => False,
|
|
|
1719 Parser => Parser);
|
|
|
1720
|
|
|
1721 else
|
|
|
1722 S := Getopt (Switches => "* " & Getopt_Description,
|
|
|
1723 Concatenate => False,
|
|
|
1724 Parser => Parser);
|
|
|
1725 end if;
|
|
|
1726
|
|
|
1727 exit when S = ASCII.NUL;
|
|
|
1728
|
|
|
1729 declare
|
|
|
1730 Sw : constant String := Real_Full_Switch (S, Parser);
|
|
|
1731 Is_Section : Boolean := False;
|
|
|
1732
|
|
|
1733 begin
|
|
|
1734 if Cmd.Config /= null
|
|
|
1735 and then Cmd.Config.Sections /= null
|
|
|
1736 then
|
|
|
1737 Section_Search :
|
|
|
1738 for S in Cmd.Config.Sections'Range loop
|
|
|
1739 if Sw = Cmd.Config.Sections (S).all then
|
|
|
1740 Section := Cmd.Config.Sections (S);
|
|
|
1741 Is_Section := True;
|
|
|
1742
|
|
|
1743 exit Section_Search;
|
|
|
1744 end if;
|
|
|
1745 end loop Section_Search;
|
|
|
1746 end if;
|
|
|
1747
|
|
|
1748 if not Is_Section then
|
|
|
1749 if Section = null then
|
|
|
1750 Add_Switch (Cmd, Sw, Parameter (Parser));
|
|
|
1751 else
|
|
|
1752 Add_Switch
|
|
|
1753 (Cmd, Sw, Parameter (Parser),
|
|
|
1754 Section => Section.all);
|
|
|
1755 end if;
|
|
|
1756 end if;
|
|
|
1757 end;
|
|
|
1758
|
|
|
1759 exception
|
|
|
1760 when Invalid_Parameter =>
|
|
|
1761
|
|
|
1762 -- Add it with no parameter, if that's the way the user
|
|
|
1763 -- wants it.
|
|
|
1764
|
|
|
1765 -- Specify the separator in all cases, as the switch might
|
|
|
1766 -- need to be unaliased, and the alias might contain
|
|
|
1767 -- switches with parameters.
|
|
|
1768
|
|
|
1769 if Section = null then
|
|
|
1770 Add_Switch
|
|
|
1771 (Cmd, Switch_Char & Full_Switch (Parser));
|
|
|
1772 else
|
|
|
1773 Add_Switch
|
|
|
1774 (Cmd, Switch_Char & Full_Switch (Parser),
|
|
|
1775 Section => Section.all);
|
|
|
1776 end if;
|
|
|
1777 end;
|
|
|
1778 end loop;
|
|
|
1779
|
|
|
1780 Free (Parser);
|
|
|
1781 end if;
|
|
|
1782 end Set_Command_Line;
|
|
|
1783
|
|
|
1784 ----------------
|
|
|
1785 -- Looking_At --
|
|
|
1786 ----------------
|
|
|
1787
|
|
|
1788 function Looking_At
|
|
|
1789 (Type_Str : String;
|
|
|
1790 Index : Natural;
|
|
|
1791 Substring : String) return Boolean
|
|
|
1792 is
|
|
|
1793 begin
|
|
|
1794 return Index + Substring'Length - 1 <= Type_Str'Last
|
|
|
1795 and then Type_Str (Index .. Index + Substring'Length - 1) = Substring;
|
|
|
1796 end Looking_At;
|
|
|
1797
|
|
|
1798 ------------------------
|
|
|
1799 -- Can_Have_Parameter --
|
|
|
1800 ------------------------
|
|
|
1801
|
|
|
1802 function Can_Have_Parameter (S : String) return Boolean is
|
|
|
1803 begin
|
|
|
1804 if S'Length <= 1 then
|
|
|
1805 return False;
|
|
|
1806 end if;
|
|
|
1807
|
|
|
1808 case S (S'Last) is
|
|
|
1809 when '!' | ':' | '?' | '=' =>
|
|
|
1810 return True;
|
|
|
1811 when others =>
|
|
|
1812 return False;
|
|
|
1813 end case;
|
|
|
1814 end Can_Have_Parameter;
|
|
|
1815
|
|
|
1816 -----------------------
|
|
|
1817 -- Require_Parameter --
|
|
|
1818 -----------------------
|
|
|
1819
|
|
|
1820 function Require_Parameter (S : String) return Boolean is
|
|
|
1821 begin
|
|
|
1822 if S'Length <= 1 then
|
|
|
1823 return False;
|
|
|
1824 end if;
|
|
|
1825
|
|
|
1826 case S (S'Last) is
|
|
|
1827 when '!' | ':' | '=' =>
|
|
|
1828 return True;
|
|
|
1829 when others =>
|
|
|
1830 return False;
|
|
|
1831 end case;
|
|
|
1832 end Require_Parameter;
|
|
|
1833
|
|
|
1834 -------------------
|
|
|
1835 -- Actual_Switch --
|
|
|
1836 -------------------
|
|
|
1837
|
|
|
1838 function Actual_Switch (S : String) return String is
|
|
|
1839 begin
|
|
|
1840 if S'Length <= 1 then
|
|
|
1841 return S;
|
|
|
1842 end if;
|
|
|
1843
|
|
|
1844 case S (S'Last) is
|
|
|
1845 when '!' | ':' | '?' | '=' =>
|
|
|
1846 return S (S'First .. S'Last - 1);
|
|
|
1847 when others =>
|
|
|
1848 return S;
|
|
|
1849 end case;
|
|
|
1850 end Actual_Switch;
|
|
|
1851
|
|
|
1852 ----------------------------
|
|
|
1853 -- For_Each_Simple_Switch --
|
|
|
1854 ----------------------------
|
|
|
1855
|
|
|
1856 procedure For_Each_Simple_Switch
|
|
|
1857 (Config : Command_Line_Configuration;
|
|
|
1858 Section : String;
|
|
|
1859 Switch : String;
|
|
|
1860 Parameter : String := "";
|
|
|
1861 Unalias : Boolean := True)
|
|
|
1862 is
|
|
|
1863 function Group_Analysis
|
|
|
1864 (Prefix : String;
|
|
|
1865 Group : String) return Boolean;
|
|
|
1866 -- Perform the analysis of a group of switches
|
|
|
1867
|
|
|
1868 Found_In_Config : Boolean := False;
|
|
|
1869 function Is_In_Config
|
|
|
1870 (Config_Switch : String; Index : Integer) return Boolean;
|
|
|
1871 -- If Switch is the same as Config_Switch, run the callback and sets
|
|
|
1872 -- Found_In_Config to True.
|
|
|
1873
|
|
|
1874 function Starts_With
|
|
|
1875 (Config_Switch : String; Index : Integer) return Boolean;
|
|
|
1876 -- if Switch starts with Config_Switch, sets Found_In_Config to True.
|
|
|
1877 -- The return value is for the Foreach_Switch iterator.
|
|
|
1878
|
|
|
1879 --------------------
|
|
|
1880 -- Group_Analysis --
|
|
|
1881 --------------------
|
|
|
1882
|
|
|
1883 function Group_Analysis
|
|
|
1884 (Prefix : String;
|
|
|
1885 Group : String) return Boolean
|
|
|
1886 is
|
|
|
1887 Idx : Natural;
|
|
|
1888 Found : Boolean;
|
|
|
1889
|
|
|
1890 function Analyze_Simple_Switch
|
|
|
1891 (Switch : String; Index : Integer) return Boolean;
|
|
|
1892 -- "Switches" is one of the switch definitions passed to the
|
|
|
1893 -- configuration, not one of the switches found on the command line.
|
|
|
1894
|
|
|
1895 ---------------------------
|
|
|
1896 -- Analyze_Simple_Switch --
|
|
|
1897 ---------------------------
|
|
|
1898
|
|
|
1899 function Analyze_Simple_Switch
|
|
|
1900 (Switch : String; Index : Integer) return Boolean
|
|
|
1901 is
|
|
|
1902 pragma Unreferenced (Index);
|
|
|
1903
|
|
|
1904 Full : constant String := Prefix & Group (Idx .. Group'Last);
|
|
|
1905
|
|
|
1906 Sw : constant String := Actual_Switch (Switch);
|
|
|
1907 -- Switches definition minus argument definition
|
|
|
1908
|
|
|
1909 Last : Natural;
|
|
|
1910 Param : Natural;
|
|
|
1911
|
|
|
1912 begin
|
|
|
1913 -- Verify that sw starts with Prefix
|
|
|
1914
|
|
|
1915 if Looking_At (Sw, Sw'First, Prefix)
|
|
|
1916
|
|
|
1917 -- Verify that the group starts with sw
|
|
|
1918
|
|
|
1919 and then Looking_At (Full, Full'First, Sw)
|
|
|
1920 then
|
|
|
1921 Last := Idx + Sw'Length - Prefix'Length - 1;
|
|
|
1922 Param := Last + 1;
|
|
|
1923
|
|
|
1924 if Can_Have_Parameter (Switch) then
|
|
|
1925
|
|
|
1926 -- Include potential parameter to the recursive call. Only
|
|
|
1927 -- numbers are allowed.
|
|
|
1928
|
|
|
1929 while Last < Group'Last
|
|
|
1930 and then Group (Last + 1) in '0' .. '9'
|
|
|
1931 loop
|
|
|
1932 Last := Last + 1;
|
|
|
1933 end loop;
|
|
|
1934 end if;
|
|
|
1935
|
|
|
1936 if not Require_Parameter (Switch) or else Last >= Param then
|
|
|
1937 if Idx = Group'First
|
|
|
1938 and then Last = Group'Last
|
|
|
1939 and then Last < Param
|
|
|
1940 then
|
|
|
1941 -- The group only concerns a single switch. Do not
|
|
|
1942 -- perform recursive call.
|
|
|
1943
|
|
|
1944 -- Note that we still perform a recursive call if
|
|
|
1945 -- a parameter is detected in the switch, as this
|
|
|
1946 -- is a way to correctly identify such a parameter
|
|
|
1947 -- in aliases.
|
|
|
1948
|
|
|
1949 return False;
|
|
|
1950 end if;
|
|
|
1951
|
|
|
1952 Found := True;
|
|
|
1953
|
|
|
1954 -- Recursive call, using the detected parameter if any
|
|
|
1955
|
|
|
1956 if Last >= Param then
|
|
|
1957 For_Each_Simple_Switch
|
|
|
1958 (Config,
|
|
|
1959 Section,
|
|
|
1960 Prefix & Group (Idx .. Param - 1),
|
|
|
1961 Group (Param .. Last));
|
|
|
1962
|
|
|
1963 else
|
|
|
1964 For_Each_Simple_Switch
|
|
|
1965 (Config, Section, Prefix & Group (Idx .. Last), "");
|
|
|
1966 end if;
|
|
|
1967
|
|
|
1968 Idx := Last + 1;
|
|
|
1969 return False;
|
|
|
1970 end if;
|
|
|
1971 end if;
|
|
|
1972
|
|
|
1973 return True;
|
|
|
1974 end Analyze_Simple_Switch;
|
|
|
1975
|
|
|
1976 procedure Foreach is new Foreach_Switch (Analyze_Simple_Switch);
|
|
|
1977
|
|
|
1978 -- Start of processing for Group_Analysis
|
|
|
1979
|
|
|
1980 begin
|
|
|
1981 Idx := Group'First;
|
|
|
1982 while Idx <= Group'Last loop
|
|
|
1983 Found := False;
|
|
|
1984 Foreach (Config, Section);
|
|
|
1985
|
|
|
1986 if not Found then
|
|
|
1987 For_Each_Simple_Switch
|
|
|
1988 (Config, Section, Prefix & Group (Idx), "");
|
|
|
1989 Idx := Idx + 1;
|
|
|
1990 end if;
|
|
|
1991 end loop;
|
|
|
1992
|
|
|
1993 return True;
|
|
|
1994 end Group_Analysis;
|
|
|
1995
|
|
|
1996 ------------------
|
|
|
1997 -- Is_In_Config --
|
|
|
1998 ------------------
|
|
|
1999
|
|
|
2000 function Is_In_Config
|
|
|
2001 (Config_Switch : String; Index : Integer) return Boolean
|
|
|
2002 is
|
|
|
2003 Last : Natural;
|
|
|
2004 P : Switch_Parameter_Type;
|
|
|
2005
|
|
|
2006 begin
|
|
|
2007 Decompose_Switch (Config_Switch, P, Last);
|
|
|
2008
|
|
|
2009 if Config_Switch (Config_Switch'First .. Last) = Switch then
|
|
|
2010 case P is
|
|
|
2011 when Parameter_None =>
|
|
|
2012 if Parameter = "" then
|
|
|
2013 Callback (Switch, "", "", Index => Index);
|
|
|
2014 Found_In_Config := True;
|
|
|
2015 return False;
|
|
|
2016 end if;
|
|
|
2017
|
|
|
2018 when Parameter_With_Optional_Space =>
|
|
|
2019 Callback (Switch, " ", Parameter, Index => Index);
|
|
|
2020 Found_In_Config := True;
|
|
|
2021 return False;
|
|
|
2022
|
|
|
2023 when Parameter_With_Space_Or_Equal =>
|
|
|
2024 Callback (Switch, "=", Parameter, Index => Index);
|
|
|
2025 Found_In_Config := True;
|
|
|
2026 return False;
|
|
|
2027
|
|
|
2028 when Parameter_No_Space
|
|
|
2029 | Parameter_Optional
|
|
|
2030 =>
|
|
|
2031 Callback (Switch, "", Parameter, Index);
|
|
|
2032 Found_In_Config := True;
|
|
|
2033 return False;
|
|
|
2034 end case;
|
|
|
2035 end if;
|
|
|
2036
|
|
|
2037 return True;
|
|
|
2038 end Is_In_Config;
|
|
|
2039
|
|
|
2040 -----------------
|
|
|
2041 -- Starts_With --
|
|
|
2042 -----------------
|
|
|
2043
|
|
|
2044 function Starts_With
|
|
|
2045 (Config_Switch : String; Index : Integer) return Boolean
|
|
|
2046 is
|
|
|
2047 Last : Natural;
|
|
|
2048 Param : Natural;
|
|
|
2049 P : Switch_Parameter_Type;
|
|
|
2050
|
|
|
2051 begin
|
|
|
2052 -- This function is called when we believe the parameter was
|
|
|
2053 -- specified as part of the switch, instead of separately. Thus we
|
|
|
2054 -- look in the config to find all possible switches.
|
|
|
2055
|
|
|
2056 Decompose_Switch (Config_Switch, P, Last);
|
|
|
2057
|
|
|
2058 if Looking_At
|
|
|
2059 (Switch, Switch'First,
|
|
|
2060 Config_Switch (Config_Switch'First .. Last))
|
|
|
2061 then
|
|
|
2062 -- Set first char of Param, and last char of Switch
|
|
|
2063
|
|
|
2064 Param := Switch'First + Last;
|
|
|
2065 Last := Switch'First + Last - Config_Switch'First;
|
|
|
2066
|
|
|
2067 case P is
|
|
|
2068
|
|
|
2069 -- None is already handled in Is_In_Config
|
|
|
2070
|
|
|
2071 when Parameter_None =>
|
|
|
2072 null;
|
|
|
2073
|
|
|
2074 when Parameter_With_Space_Or_Equal =>
|
|
|
2075 if Param <= Switch'Last
|
|
|
2076 and then
|
|
|
2077 (Switch (Param) = ' ' or else Switch (Param) = '=')
|
|
|
2078 then
|
|
|
2079 Callback (Switch (Switch'First .. Last),
|
|
|
2080 "=", Switch (Param + 1 .. Switch'Last), Index);
|
|
|
2081 Found_In_Config := True;
|
|
|
2082 return False;
|
|
|
2083 end if;
|
|
|
2084
|
|
|
2085 when Parameter_With_Optional_Space =>
|
|
|
2086 if Param <= Switch'Last and then Switch (Param) = ' ' then
|
|
|
2087 Param := Param + 1;
|
|
|
2088 end if;
|
|
|
2089
|
|
|
2090 Callback (Switch (Switch'First .. Last),
|
|
|
2091 " ", Switch (Param .. Switch'Last), Index);
|
|
|
2092 Found_In_Config := True;
|
|
|
2093 return False;
|
|
|
2094
|
|
|
2095 when Parameter_No_Space
|
|
|
2096 | Parameter_Optional
|
|
|
2097 =>
|
|
|
2098 Callback (Switch (Switch'First .. Last),
|
|
|
2099 "", Switch (Param .. Switch'Last), Index);
|
|
|
2100 Found_In_Config := True;
|
|
|
2101 return False;
|
|
|
2102 end case;
|
|
|
2103 end if;
|
|
|
2104 return True;
|
|
|
2105 end Starts_With;
|
|
|
2106
|
|
|
2107 procedure Foreach_In_Config is new Foreach_Switch (Is_In_Config);
|
|
|
2108 procedure Foreach_Starts_With is new Foreach_Switch (Starts_With);
|
|
|
2109
|
|
|
2110 -- Start of processing for For_Each_Simple_Switch
|
|
|
2111
|
|
|
2112 begin
|
|
|
2113 -- First determine if the switch corresponds to one belonging to the
|
|
|
2114 -- configuration. If so, run callback and exit.
|
|
|
2115
|
|
|
2116 -- ??? Is this necessary. On simple tests, we seem to have the same
|
|
|
2117 -- results with or without this call.
|
|
|
2118
|
|
|
2119 Foreach_In_Config (Config, Section);
|
|
|
2120
|
|
|
2121 if Found_In_Config then
|
|
|
2122 return;
|
|
|
2123 end if;
|
|
|
2124
|
|
|
2125 -- If adding a switch that can in fact be expanded through aliases,
|
|
|
2126 -- add separately each of its expansions.
|
|
|
2127
|
|
|
2128 -- This takes care of expansions like "-T" -> "-gnatwrs", where the
|
|
|
2129 -- alias and its expansion do not have the same prefix. Given the order
|
|
|
2130 -- in which we do things here, the expansion of the alias will itself
|
|
|
2131 -- be checked for a common prefix and split into simple switches.
|
|
|
2132
|
|
|
2133 if Unalias
|
|
|
2134 and then Config /= null
|
|
|
2135 and then Config.Aliases /= null
|
|
|
2136 then
|
|
|
2137 for A in Config.Aliases'Range loop
|
|
|
2138 if Config.Aliases (A).Section.all = Section
|
|
|
2139 and then Config.Aliases (A).Alias.all = Switch
|
|
|
2140 and then Parameter = ""
|
|
|
2141 then
|
|
|
2142 For_Each_Simple_Switch
|
|
|
2143 (Config, Section, Config.Aliases (A).Expansion.all, "");
|
|
|
2144 return;
|
|
|
2145 end if;
|
|
|
2146 end loop;
|
|
|
2147 end if;
|
|
|
2148
|
|
|
2149 -- If adding a switch grouping several switches, add each of the simple
|
|
|
2150 -- switches instead.
|
|
|
2151
|
|
|
2152 if Config /= null and then Config.Prefixes /= null then
|
|
|
2153 for P in Config.Prefixes'Range loop
|
|
|
2154 if Switch'Length > Config.Prefixes (P)'Length + 1
|
|
|
2155 and then
|
|
|
2156 Looking_At (Switch, Switch'First, Config.Prefixes (P).all)
|
|
|
2157 then
|
|
|
2158 -- Alias expansion will be done recursively
|
|
|
2159
|
|
|
2160 if Config.Switches = null then
|
|
|
2161 for S in Switch'First + Config.Prefixes (P)'Length
|
|
|
2162 .. Switch'Last
|
|
|
2163 loop
|
|
|
2164 For_Each_Simple_Switch
|
|
|
2165 (Config, Section,
|
|
|
2166 Config.Prefixes (P).all & Switch (S), "");
|
|
|
2167 end loop;
|
|
|
2168
|
|
|
2169 return;
|
|
|
2170
|
|
|
2171 elsif Group_Analysis
|
|
|
2172 (Config.Prefixes (P).all,
|
|
|
2173 Switch
|
|
|
2174 (Switch'First + Config.Prefixes (P)'Length .. Switch'Last))
|
|
|
2175 then
|
|
|
2176 -- Recursive calls already done on each switch of the group:
|
|
|
2177 -- Return without executing Callback.
|
|
|
2178
|
|
|
2179 return;
|
|
|
2180 end if;
|
|
|
2181 end if;
|
|
|
2182 end loop;
|
|
|
2183 end if;
|
|
|
2184
|
|
|
2185 -- Test if added switch is a known switch with parameter attached
|
|
|
2186 -- instead of being specified separately
|
|
|
2187
|
|
|
2188 if Parameter = ""
|
|
|
2189 and then Config /= null
|
|
|
2190 and then Config.Switches /= null
|
|
|
2191 then
|
|
|
2192 Found_In_Config := False;
|
|
|
2193 Foreach_Starts_With (Config, Section);
|
|
|
2194
|
|
|
2195 if Found_In_Config then
|
|
|
2196 return;
|
|
|
2197 end if;
|
|
|
2198 end if;
|
|
|
2199
|
|
|
2200 -- The switch is invalid in the config, but we still want to report it.
|
|
|
2201 -- The config could, for instance, include "*" to specify it accepts
|
|
|
2202 -- all switches.
|
|
|
2203
|
|
|
2204 Callback (Switch, " ", Parameter, Index => -1);
|
|
|
2205 end For_Each_Simple_Switch;
|
|
|
2206
|
|
|
2207 ----------------
|
|
|
2208 -- Add_Switch --
|
|
|
2209 ----------------
|
|
|
2210
|
|
|
2211 procedure Add_Switch
|
|
|
2212 (Cmd : in out Command_Line;
|
|
|
2213 Switch : String;
|
|
|
2214 Parameter : String := "";
|
|
|
2215 Separator : Character := ASCII.NUL;
|
|
|
2216 Section : String := "";
|
|
|
2217 Add_Before : Boolean := False)
|
|
|
2218 is
|
|
|
2219 Success : Boolean;
|
|
|
2220 pragma Unreferenced (Success);
|
|
|
2221 begin
|
|
|
2222 Add_Switch (Cmd, Switch, Parameter, Separator,
|
|
|
2223 Section, Add_Before, Success);
|
|
|
2224 end Add_Switch;
|
|
|
2225
|
|
|
2226 ----------------
|
|
|
2227 -- Add_Switch --
|
|
|
2228 ----------------
|
|
|
2229
|
|
|
2230 procedure Add_Switch
|
|
|
2231 (Cmd : in out Command_Line;
|
|
|
2232 Switch : String;
|
|
|
2233 Parameter : String := "";
|
|
|
2234 Separator : Character := ASCII.NUL;
|
|
|
2235 Section : String := "";
|
|
|
2236 Add_Before : Boolean := False;
|
|
|
2237 Success : out Boolean)
|
|
|
2238 is
|
|
|
2239 procedure Add_Simple_Switch
|
|
|
2240 (Simple : String;
|
|
|
2241 Sepa : String;
|
|
|
2242 Param : String;
|
|
|
2243 Index : Integer);
|
|
|
2244 -- Add a new switch that has had all its aliases expanded, and switches
|
|
|
2245 -- ungrouped. We know there are no more aliases in Switches.
|
|
|
2246
|
|
|
2247 -----------------------
|
|
|
2248 -- Add_Simple_Switch --
|
|
|
2249 -----------------------
|
|
|
2250
|
|
|
2251 procedure Add_Simple_Switch
|
|
|
2252 (Simple : String;
|
|
|
2253 Sepa : String;
|
|
|
2254 Param : String;
|
|
|
2255 Index : Integer)
|
|
|
2256 is
|
|
|
2257 Sep : Character;
|
|
|
2258
|
|
|
2259 begin
|
|
|
2260 if Index = -1
|
|
|
2261 and then Cmd.Config /= null
|
|
|
2262 and then not Cmd.Config.Star_Switch
|
|
|
2263 then
|
|
|
2264 raise Invalid_Switch
|
|
|
2265 with "Invalid switch " & Simple;
|
|
|
2266 end if;
|
|
|
2267
|
|
|
2268 if Separator /= ASCII.NUL then
|
|
|
2269 Sep := Separator;
|
|
|
2270
|
|
|
2271 elsif Sepa = "" then
|
|
|
2272 Sep := ASCII.NUL;
|
|
|
2273 else
|
|
|
2274 Sep := Sepa (Sepa'First);
|
|
|
2275 end if;
|
|
|
2276
|
|
|
2277 if Cmd.Expanded = null then
|
|
|
2278 Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
|
|
|
2279
|
|
|
2280 if Param /= "" then
|
|
|
2281 Cmd.Params :=
|
|
|
2282 new Argument_List'(1 .. 1 => new String'(Sep & Param));
|
|
|
2283 else
|
|
|
2284 Cmd.Params := new Argument_List'(1 .. 1 => null);
|
|
|
2285 end if;
|
|
|
2286
|
|
|
2287 if Section = "" then
|
|
|
2288 Cmd.Sections := new Argument_List'(1 .. 1 => null);
|
|
|
2289 else
|
|
|
2290 Cmd.Sections :=
|
|
|
2291 new Argument_List'(1 .. 1 => new String'(Section));
|
|
|
2292 end if;
|
|
|
2293
|
|
|
2294 else
|
|
|
2295 -- Do we already have this switch?
|
|
|
2296
|
|
|
2297 for C in Cmd.Expanded'Range loop
|
|
|
2298 if Cmd.Expanded (C).all = Simple
|
|
|
2299 and then
|
|
|
2300 ((Cmd.Params (C) = null and then Param = "")
|
|
|
2301 or else
|
|
|
2302 (Cmd.Params (C) /= null
|
|
|
2303 and then Cmd.Params (C).all = Sep & Param))
|
|
|
2304 and then
|
|
|
2305 ((Cmd.Sections (C) = null and then Section = "")
|
|
|
2306 or else
|
|
|
2307 (Cmd.Sections (C) /= null
|
|
|
2308 and then Cmd.Sections (C).all = Section))
|
|
|
2309 then
|
|
|
2310 return;
|
|
|
2311 end if;
|
|
|
2312 end loop;
|
|
|
2313
|
|
|
2314 -- Inserting at least one switch
|
|
|
2315
|
|
|
2316 Success := True;
|
|
|
2317 Add (Cmd.Expanded, new String'(Simple), Add_Before);
|
|
|
2318
|
|
|
2319 if Param /= "" then
|
|
|
2320 Add
|
|
|
2321 (Cmd.Params,
|
|
|
2322 new String'(Sep & Param),
|
|
|
2323 Add_Before);
|
|
|
2324 else
|
|
|
2325 Add
|
|
|
2326 (Cmd.Params,
|
|
|
2327 null,
|
|
|
2328 Add_Before);
|
|
|
2329 end if;
|
|
|
2330
|
|
|
2331 if Section = "" then
|
|
|
2332 Add
|
|
|
2333 (Cmd.Sections,
|
|
|
2334 null,
|
|
|
2335 Add_Before);
|
|
|
2336 else
|
|
|
2337 Add
|
|
|
2338 (Cmd.Sections,
|
|
|
2339 new String'(Section),
|
|
|
2340 Add_Before);
|
|
|
2341 end if;
|
|
|
2342 end if;
|
|
|
2343 end Add_Simple_Switch;
|
|
|
2344
|
|
|
2345 procedure Add_Simple_Switches is
|
|
|
2346 new For_Each_Simple_Switch (Add_Simple_Switch);
|
|
|
2347
|
|
|
2348 -- Local Variables
|
|
|
2349
|
|
|
2350 Section_Valid : Boolean := False;
|
|
|
2351
|
|
|
2352 -- Start of processing for Add_Switch
|
|
|
2353
|
|
|
2354 begin
|
|
|
2355 if Section /= "" and then Cmd.Config /= null then
|
|
|
2356 for S in Cmd.Config.Sections'Range loop
|
|
|
2357 if Section = Cmd.Config.Sections (S).all then
|
|
|
2358 Section_Valid := True;
|
|
|
2359 exit;
|
|
|
2360 end if;
|
|
|
2361 end loop;
|
|
|
2362
|
|
|
2363 if not Section_Valid then
|
|
|
2364 raise Invalid_Section;
|
|
|
2365 end if;
|
|
|
2366 end if;
|
|
|
2367
|
|
|
2368 Success := False;
|
|
|
2369 Add_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
|
|
|
2370 Free (Cmd.Coalesce);
|
|
|
2371 end Add_Switch;
|
|
|
2372
|
|
|
2373 ------------
|
|
|
2374 -- Remove --
|
|
|
2375 ------------
|
|
|
2376
|
|
|
2377 procedure Remove (Line : in out Argument_List_Access; Index : Integer) is
|
|
|
2378 Tmp : Argument_List_Access := Line;
|
|
|
2379
|
|
|
2380 begin
|
|
|
2381 Line := new Argument_List (Tmp'First .. Tmp'Last - 1);
|
|
|
2382
|
|
|
2383 if Index /= Tmp'First then
|
|
|
2384 Line (Tmp'First .. Index - 1) := Tmp (Tmp'First .. Index - 1);
|
|
|
2385 end if;
|
|
|
2386
|
|
|
2387 Free (Tmp (Index));
|
|
|
2388
|
|
|
2389 if Index /= Tmp'Last then
|
|
|
2390 Line (Index .. Tmp'Last - 1) := Tmp (Index + 1 .. Tmp'Last);
|
|
|
2391 end if;
|
|
|
2392
|
|
|
2393 Unchecked_Free (Tmp);
|
|
|
2394 end Remove;
|
|
|
2395
|
|
|
2396 ---------
|
|
|
2397 -- Add --
|
|
|
2398 ---------
|
|
|
2399
|
|
|
2400 procedure Add
|
|
|
2401 (Line : in out Argument_List_Access;
|
|
|
2402 Str : String_Access;
|
|
|
2403 Before : Boolean := False)
|
|
|
2404 is
|
|
|
2405 Tmp : Argument_List_Access := Line;
|
|
|
2406
|
|
|
2407 begin
|
|
|
2408 if Tmp /= null then
|
|
|
2409 Line := new Argument_List (Tmp'First .. Tmp'Last + 1);
|
|
|
2410
|
|
|
2411 if Before then
|
|
|
2412 Line (Tmp'First) := Str;
|
|
|
2413 Line (Tmp'First + 1 .. Tmp'Last + 1) := Tmp.all;
|
|
|
2414 else
|
|
|
2415 Line (Tmp'Range) := Tmp.all;
|
|
|
2416 Line (Tmp'Last + 1) := Str;
|
|
|
2417 end if;
|
|
|
2418
|
|
|
2419 Unchecked_Free (Tmp);
|
|
|
2420
|
|
|
2421 else
|
|
|
2422 Line := new Argument_List'(1 .. 1 => Str);
|
|
|
2423 end if;
|
|
|
2424 end Add;
|
|
|
2425
|
|
|
2426 -------------------
|
|
|
2427 -- Remove_Switch --
|
|
|
2428 -------------------
|
|
|
2429
|
|
|
2430 procedure Remove_Switch
|
|
|
2431 (Cmd : in out Command_Line;
|
|
|
2432 Switch : String;
|
|
|
2433 Remove_All : Boolean := False;
|
|
|
2434 Has_Parameter : Boolean := False;
|
|
|
2435 Section : String := "")
|
|
|
2436 is
|
|
|
2437 Success : Boolean;
|
|
|
2438 pragma Unreferenced (Success);
|
|
|
2439 begin
|
|
|
2440 Remove_Switch (Cmd, Switch, Remove_All, Has_Parameter, Section, Success);
|
|
|
2441 end Remove_Switch;
|
|
|
2442
|
|
|
2443 -------------------
|
|
|
2444 -- Remove_Switch --
|
|
|
2445 -------------------
|
|
|
2446
|
|
|
2447 procedure Remove_Switch
|
|
|
2448 (Cmd : in out Command_Line;
|
|
|
2449 Switch : String;
|
|
|
2450 Remove_All : Boolean := False;
|
|
|
2451 Has_Parameter : Boolean := False;
|
|
|
2452 Section : String := "";
|
|
|
2453 Success : out Boolean)
|
|
|
2454 is
|
|
|
2455 procedure Remove_Simple_Switch
|
|
|
2456 (Simple, Separator, Param : String; Index : Integer);
|
|
|
2457 -- Removes a simple switch, with no aliasing or grouping
|
|
|
2458
|
|
|
2459 --------------------------
|
|
|
2460 -- Remove_Simple_Switch --
|
|
|
2461 --------------------------
|
|
|
2462
|
|
|
2463 procedure Remove_Simple_Switch
|
|
|
2464 (Simple, Separator, Param : String; Index : Integer)
|
|
|
2465 is
|
|
|
2466 C : Integer;
|
|
|
2467 pragma Unreferenced (Param, Separator, Index);
|
|
|
2468
|
|
|
2469 begin
|
|
|
2470 if Cmd.Expanded /= null then
|
|
|
2471 C := Cmd.Expanded'First;
|
|
|
2472 while C <= Cmd.Expanded'Last loop
|
|
|
2473 if Cmd.Expanded (C).all = Simple
|
|
|
2474 and then
|
|
|
2475 (Remove_All
|
|
|
2476 or else (Cmd.Sections (C) = null
|
|
|
2477 and then Section = "")
|
|
|
2478 or else (Cmd.Sections (C) /= null
|
|
|
2479 and then Section = Cmd.Sections (C).all))
|
|
|
2480 and then (not Has_Parameter or else Cmd.Params (C) /= null)
|
|
|
2481 then
|
|
|
2482 Remove (Cmd.Expanded, C);
|
|
|
2483 Remove (Cmd.Params, C);
|
|
|
2484 Remove (Cmd.Sections, C);
|
|
|
2485 Success := True;
|
|
|
2486
|
|
|
2487 if not Remove_All then
|
|
|
2488 return;
|
|
|
2489 end if;
|
|
|
2490
|
|
|
2491 else
|
|
|
2492 C := C + 1;
|
|
|
2493 end if;
|
|
|
2494 end loop;
|
|
|
2495 end if;
|
|
|
2496 end Remove_Simple_Switch;
|
|
|
2497
|
|
|
2498 procedure Remove_Simple_Switches is
|
|
|
2499 new For_Each_Simple_Switch (Remove_Simple_Switch);
|
|
|
2500
|
|
|
2501 -- Start of processing for Remove_Switch
|
|
|
2502
|
|
|
2503 begin
|
|
|
2504 Success := False;
|
|
|
2505 Remove_Simple_Switches
|
|
|
2506 (Cmd.Config, Section, Switch, "", Unalias => not Has_Parameter);
|
|
|
2507 Free (Cmd.Coalesce);
|
|
|
2508 end Remove_Switch;
|
|
|
2509
|
|
|
2510 -------------------
|
|
|
2511 -- Remove_Switch --
|
|
|
2512 -------------------
|
|
|
2513
|
|
|
2514 procedure Remove_Switch
|
|
|
2515 (Cmd : in out Command_Line;
|
|
|
2516 Switch : String;
|
|
|
2517 Parameter : String;
|
|
|
2518 Section : String := "")
|
|
|
2519 is
|
|
|
2520 procedure Remove_Simple_Switch
|
|
|
2521 (Simple, Separator, Param : String; Index : Integer);
|
|
|
2522 -- Removes a simple switch, with no aliasing or grouping
|
|
|
2523
|
|
|
2524 --------------------------
|
|
|
2525 -- Remove_Simple_Switch --
|
|
|
2526 --------------------------
|
|
|
2527
|
|
|
2528 procedure Remove_Simple_Switch
|
|
|
2529 (Simple, Separator, Param : String; Index : Integer)
|
|
|
2530 is
|
|
|
2531 pragma Unreferenced (Separator, Index);
|
|
|
2532 C : Integer;
|
|
|
2533
|
|
|
2534 begin
|
|
|
2535 if Cmd.Expanded /= null then
|
|
|
2536 C := Cmd.Expanded'First;
|
|
|
2537 while C <= Cmd.Expanded'Last loop
|
|
|
2538 if Cmd.Expanded (C).all = Simple
|
|
|
2539 and then
|
|
|
2540 ((Cmd.Sections (C) = null
|
|
|
2541 and then Section = "")
|
|
|
2542 or else
|
|
|
2543 (Cmd.Sections (C) /= null
|
|
|
2544 and then Section = Cmd.Sections (C).all))
|
|
|
2545 and then
|
|
|
2546 ((Cmd.Params (C) = null and then Param = "")
|
|
|
2547 or else
|
|
|
2548 (Cmd.Params (C) /= null
|
|
|
2549
|
|
|
2550 -- Ignore the separator stored in Parameter
|
|
|
2551
|
|
|
2552 and then
|
|
|
2553 Cmd.Params (C) (Cmd.Params (C)'First + 1
|
|
|
2554 .. Cmd.Params (C)'Last) = Param))
|
|
|
2555 then
|
|
|
2556 Remove (Cmd.Expanded, C);
|
|
|
2557 Remove (Cmd.Params, C);
|
|
|
2558 Remove (Cmd.Sections, C);
|
|
|
2559
|
|
|
2560 -- The switch is necessarily unique by construction of
|
|
|
2561 -- Add_Switch.
|
|
|
2562
|
|
|
2563 return;
|
|
|
2564
|
|
|
2565 else
|
|
|
2566 C := C + 1;
|
|
|
2567 end if;
|
|
|
2568 end loop;
|
|
|
2569 end if;
|
|
|
2570 end Remove_Simple_Switch;
|
|
|
2571
|
|
|
2572 procedure Remove_Simple_Switches is
|
|
|
2573 new For_Each_Simple_Switch (Remove_Simple_Switch);
|
|
|
2574
|
|
|
2575 -- Start of processing for Remove_Switch
|
|
|
2576
|
|
|
2577 begin
|
|
|
2578 Remove_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
|
|
|
2579 Free (Cmd.Coalesce);
|
|
|
2580 end Remove_Switch;
|
|
|
2581
|
|
|
2582 --------------------
|
|
|
2583 -- Group_Switches --
|
|
|
2584 --------------------
|
|
|
2585
|
|
|
2586 procedure Group_Switches
|
|
|
2587 (Cmd : Command_Line;
|
|
|
2588 Result : Argument_List_Access;
|
|
|
2589 Sections : Argument_List_Access;
|
|
|
2590 Params : Argument_List_Access)
|
|
|
2591 is
|
|
|
2592 function Compatible_Parameter (Param : String_Access) return Boolean;
|
|
|
2593 -- True when the parameter can be part of a group
|
|
|
2594
|
|
|
2595 --------------------------
|
|
|
2596 -- Compatible_Parameter --
|
|
|
2597 --------------------------
|
|
|
2598
|
|
|
2599 function Compatible_Parameter (Param : String_Access) return Boolean is
|
|
|
2600 begin
|
|
|
2601 -- No parameter OK
|
|
|
2602
|
|
|
2603 if Param = null then
|
|
|
2604 return True;
|
|
|
2605
|
|
|
2606 -- We need parameters without separators
|
|
|
2607
|
|
|
2608 elsif Param (Param'First) /= ASCII.NUL then
|
|
|
2609 return False;
|
|
|
2610
|
|
|
2611 -- Parameters must be all digits
|
|
|
2612
|
|
|
2613 else
|
|
|
2614 for J in Param'First + 1 .. Param'Last loop
|
|
|
2615 if Param (J) not in '0' .. '9' then
|
|
|
2616 return False;
|
|
|
2617 end if;
|
|
|
2618 end loop;
|
|
|
2619
|
|
|
2620 return True;
|
|
|
2621 end if;
|
|
|
2622 end Compatible_Parameter;
|
|
|
2623
|
|
|
2624 -- Local declarations
|
|
|
2625
|
|
|
2626 Group : Ada.Strings.Unbounded.Unbounded_String;
|
|
|
2627 First : Natural;
|
|
|
2628 use type Ada.Strings.Unbounded.Unbounded_String;
|
|
|
2629
|
|
|
2630 -- Start of processing for Group_Switches
|
|
|
2631
|
|
|
2632 begin
|
|
|
2633 if Cmd.Config = null or else Cmd.Config.Prefixes = null then
|
|
|
2634 return;
|
|
|
2635 end if;
|
|
|
2636
|
|
|
2637 for P in Cmd.Config.Prefixes'Range loop
|
|
|
2638 Group := Ada.Strings.Unbounded.Null_Unbounded_String;
|
|
|
2639 First := 0;
|
|
|
2640
|
|
|
2641 for C in Result'Range loop
|
|
|
2642 if Result (C) /= null
|
|
|
2643 and then Compatible_Parameter (Params (C))
|
|
|
2644 and then Looking_At
|
|
|
2645 (Result (C).all,
|
|
|
2646 Result (C)'First,
|
|
|
2647 Cmd.Config.Prefixes (P).all)
|
|
|
2648 then
|
|
|
2649 -- If we are still in the same section, group the switches
|
|
|
2650
|
|
|
2651 if First = 0
|
|
|
2652 or else
|
|
|
2653 (Sections (C) = null
|
|
|
2654 and then Sections (First) = null)
|
|
|
2655 or else
|
|
|
2656 (Sections (C) /= null
|
|
|
2657 and then Sections (First) /= null
|
|
|
2658 and then Sections (C).all = Sections (First).all)
|
|
|
2659 then
|
|
|
2660 Group :=
|
|
|
2661 Group &
|
|
|
2662 Result (C)
|
|
|
2663 (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
|
|
|
2664 Result (C)'Last);
|
|
|
2665
|
|
|
2666 if Params (C) /= null then
|
|
|
2667 Group :=
|
|
|
2668 Group &
|
|
|
2669 Params (C) (Params (C)'First + 1 .. Params (C)'Last);
|
|
|
2670 Free (Params (C));
|
|
|
2671 end if;
|
|
|
2672
|
|
|
2673 if First = 0 then
|
|
|
2674 First := C;
|
|
|
2675 end if;
|
|
|
2676
|
|
|
2677 Free (Result (C));
|
|
|
2678
|
|
|
2679 -- We changed section: we put the grouped switches to the first
|
|
|
2680 -- place, on continue with the new section.
|
|
|
2681
|
|
|
2682 else
|
|
|
2683 Result (First) :=
|
|
|
2684 new String'
|
|
|
2685 (Cmd.Config.Prefixes (P).all &
|
|
|
2686 Ada.Strings.Unbounded.To_String (Group));
|
|
|
2687 Group :=
|
|
|
2688 Ada.Strings.Unbounded.To_Unbounded_String
|
|
|
2689 (Result (C)
|
|
|
2690 (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
|
|
|
2691 Result (C)'Last));
|
|
|
2692 First := C;
|
|
|
2693 end if;
|
|
|
2694 end if;
|
|
|
2695 end loop;
|
|
|
2696
|
|
|
2697 if First > 0 then
|
|
|
2698 Result (First) :=
|
|
|
2699 new String'
|
|
|
2700 (Cmd.Config.Prefixes (P).all &
|
|
|
2701 Ada.Strings.Unbounded.To_String (Group));
|
|
|
2702 end if;
|
|
|
2703 end loop;
|
|
|
2704 end Group_Switches;
|
|
|
2705
|
|
|
2706 --------------------
|
|
|
2707 -- Alias_Switches --
|
|
|
2708 --------------------
|
|
|
2709
|
|
|
2710 procedure Alias_Switches
|
|
|
2711 (Cmd : Command_Line;
|
|
|
2712 Result : Argument_List_Access;
|
|
|
2713 Params : Argument_List_Access)
|
|
|
2714 is
|
|
|
2715 Found : Boolean;
|
|
|
2716 First : Natural;
|
|
|
2717
|
|
|
2718 procedure Check_Cb (Switch, Separator, Param : String; Index : Integer);
|
|
|
2719 -- Checks whether the command line contains [Switch]. Sets the global
|
|
|
2720 -- variable [Found] appropriately. This is called for each simple switch
|
|
|
2721 -- that make up an alias, to know whether the alias should be applied.
|
|
|
2722
|
|
|
2723 procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer);
|
|
|
2724 -- Remove the simple switch [Switch] from the command line, since it is
|
|
|
2725 -- part of a simpler alias
|
|
|
2726
|
|
|
2727 --------------
|
|
|
2728 -- Check_Cb --
|
|
|
2729 --------------
|
|
|
2730
|
|
|
2731 procedure Check_Cb
|
|
|
2732 (Switch, Separator, Param : String; Index : Integer)
|
|
|
2733 is
|
|
|
2734 pragma Unreferenced (Separator, Index);
|
|
|
2735
|
|
|
2736 begin
|
|
|
2737 if Found then
|
|
|
2738 for E in Result'Range loop
|
|
|
2739 if Result (E) /= null
|
|
|
2740 and then
|
|
|
2741 (Params (E) = null
|
|
|
2742 or else Params (E) (Params (E)'First + 1 ..
|
|
|
2743 Params (E)'Last) = Param)
|
|
|
2744 and then Result (E).all = Switch
|
|
|
2745 then
|
|
|
2746 return;
|
|
|
2747 end if;
|
|
|
2748 end loop;
|
|
|
2749
|
|
|
2750 Found := False;
|
|
|
2751 end if;
|
|
|
2752 end Check_Cb;
|
|
|
2753
|
|
|
2754 ---------------
|
|
|
2755 -- Remove_Cb --
|
|
|
2756 ---------------
|
|
|
2757
|
|
|
2758 procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer)
|
|
|
2759 is
|
|
|
2760 pragma Unreferenced (Separator, Index);
|
|
|
2761
|
|
|
2762 begin
|
|
|
2763 for E in Result'Range loop
|
|
|
2764 if Result (E) /= null
|
|
|
2765 and then
|
|
|
2766 (Params (E) = null
|
|
|
2767 or else Params (E) (Params (E)'First + 1
|
|
|
2768 .. Params (E)'Last) = Param)
|
|
|
2769 and then Result (E).all = Switch
|
|
|
2770 then
|
|
|
2771 if First > E then
|
|
|
2772 First := E;
|
|
|
2773 end if;
|
|
|
2774
|
|
|
2775 Free (Result (E));
|
|
|
2776 Free (Params (E));
|
|
|
2777 return;
|
|
|
2778 end if;
|
|
|
2779 end loop;
|
|
|
2780 end Remove_Cb;
|
|
|
2781
|
|
|
2782 procedure Check_All is new For_Each_Simple_Switch (Check_Cb);
|
|
|
2783 procedure Remove_All is new For_Each_Simple_Switch (Remove_Cb);
|
|
|
2784
|
|
|
2785 -- Start of processing for Alias_Switches
|
|
|
2786
|
|
|
2787 begin
|
|
|
2788 if Cmd.Config = null or else Cmd.Config.Aliases = null then
|
|
|
2789 return;
|
|
|
2790 end if;
|
|
|
2791
|
|
|
2792 for A in Cmd.Config.Aliases'Range loop
|
|
|
2793
|
|
|
2794 -- Compute the various simple switches that make up the alias. We
|
|
|
2795 -- split the expansion into as many simple switches as possible, and
|
|
|
2796 -- then check whether the expanded command line has all of them.
|
|
|
2797
|
|
|
2798 Found := True;
|
|
|
2799 Check_All (Cmd.Config,
|
|
|
2800 Switch => Cmd.Config.Aliases (A).Expansion.all,
|
|
|
2801 Section => Cmd.Config.Aliases (A).Section.all);
|
|
|
2802
|
|
|
2803 if Found then
|
|
|
2804 First := Integer'Last;
|
|
|
2805 Remove_All (Cmd.Config,
|
|
|
2806 Switch => Cmd.Config.Aliases (A).Expansion.all,
|
|
|
2807 Section => Cmd.Config.Aliases (A).Section.all);
|
|
|
2808 Result (First) := new String'(Cmd.Config.Aliases (A).Alias.all);
|
|
|
2809 end if;
|
|
|
2810 end loop;
|
|
|
2811 end Alias_Switches;
|
|
|
2812
|
|
|
2813 -------------------
|
|
|
2814 -- Sort_Sections --
|
|
|
2815 -------------------
|
|
|
2816
|
|
|
2817 procedure Sort_Sections
|
|
|
2818 (Line : not null GNAT.OS_Lib.Argument_List_Access;
|
|
|
2819 Sections : GNAT.OS_Lib.Argument_List_Access;
|
|
|
2820 Params : GNAT.OS_Lib.Argument_List_Access)
|
|
|
2821 is
|
|
|
2822 Sections_List : Argument_List_Access :=
|
|
|
2823 new Argument_List'(1 .. 1 => null);
|
|
|
2824 Found : Boolean;
|
|
|
2825 Old_Line : constant Argument_List := Line.all;
|
|
|
2826 Old_Sections : constant Argument_List := Sections.all;
|
|
|
2827 Old_Params : constant Argument_List := Params.all;
|
|
|
2828 Index : Natural;
|
|
|
2829
|
|
|
2830 begin
|
|
|
2831 -- First construct a list of all sections
|
|
|
2832
|
|
|
2833 for E in Line'Range loop
|
|
|
2834 if Sections (E) /= null then
|
|
|
2835 Found := False;
|
|
|
2836 for S in Sections_List'Range loop
|
|
|
2837 if (Sections_List (S) = null and then Sections (E) = null)
|
|
|
2838 or else
|
|
|
2839 (Sections_List (S) /= null
|
|
|
2840 and then Sections (E) /= null
|
|
|
2841 and then Sections_List (S).all = Sections (E).all)
|
|
|
2842 then
|
|
|
2843 Found := True;
|
|
|
2844 exit;
|
|
|
2845 end if;
|
|
|
2846 end loop;
|
|
|
2847
|
|
|
2848 if not Found then
|
|
|
2849 Add (Sections_List, Sections (E));
|
|
|
2850 end if;
|
|
|
2851 end if;
|
|
|
2852 end loop;
|
|
|
2853
|
|
|
2854 Index := Line'First;
|
|
|
2855
|
|
|
2856 for S in Sections_List'Range loop
|
|
|
2857 for E in Old_Line'Range loop
|
|
|
2858 if (Sections_List (S) = null and then Old_Sections (E) = null)
|
|
|
2859 or else
|
|
|
2860 (Sections_List (S) /= null
|
|
|
2861 and then Old_Sections (E) /= null
|
|
|
2862 and then Sections_List (S).all = Old_Sections (E).all)
|
|
|
2863 then
|
|
|
2864 Line (Index) := Old_Line (E);
|
|
|
2865 Sections (Index) := Old_Sections (E);
|
|
|
2866 Params (Index) := Old_Params (E);
|
|
|
2867 Index := Index + 1;
|
|
|
2868 end if;
|
|
|
2869 end loop;
|
|
|
2870 end loop;
|
|
|
2871
|
|
|
2872 Unchecked_Free (Sections_List);
|
|
|
2873 end Sort_Sections;
|
|
|
2874
|
|
|
2875 -----------
|
|
|
2876 -- Start --
|
|
|
2877 -----------
|
|
|
2878
|
|
|
2879 procedure Start
|
|
|
2880 (Cmd : in out Command_Line;
|
|
|
2881 Iter : in out Command_Line_Iterator;
|
|
|
2882 Expanded : Boolean := False)
|
|
|
2883 is
|
|
|
2884 begin
|
|
|
2885 if Cmd.Expanded = null then
|
|
|
2886 Iter.List := null;
|
|
|
2887 return;
|
|
|
2888 end if;
|
|
|
2889
|
|
|
2890 -- Reorder the expanded line so that sections are grouped
|
|
|
2891
|
|
|
2892 Sort_Sections (Cmd.Expanded, Cmd.Sections, Cmd.Params);
|
|
|
2893
|
|
|
2894 -- Coalesce the switches as much as possible
|
|
|
2895
|
|
|
2896 if not Expanded
|
|
|
2897 and then Cmd.Coalesce = null
|
|
|
2898 then
|
|
|
2899 Cmd.Coalesce := new Argument_List (Cmd.Expanded'Range);
|
|
|
2900 for E in Cmd.Expanded'Range loop
|
|
|
2901 Cmd.Coalesce (E) := new String'(Cmd.Expanded (E).all);
|
|
|
2902 end loop;
|
|
|
2903
|
|
|
2904 Free (Cmd.Coalesce_Sections);
|
|
|
2905 Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range);
|
|
|
2906 for E in Cmd.Sections'Range loop
|
|
|
2907 Cmd.Coalesce_Sections (E) :=
|
|
|
2908 (if Cmd.Sections (E) = null then null
|
|
|
2909 else new String'(Cmd.Sections (E).all));
|
|
|
2910 end loop;
|
|
|
2911
|
|
|
2912 Free (Cmd.Coalesce_Params);
|
|
|
2913 Cmd.Coalesce_Params := new Argument_List (Cmd.Params'Range);
|
|
|
2914 for E in Cmd.Params'Range loop
|
|
|
2915 Cmd.Coalesce_Params (E) :=
|
|
|
2916 (if Cmd.Params (E) = null then null
|
|
|
2917 else new String'(Cmd.Params (E).all));
|
|
|
2918 end loop;
|
|
|
2919
|
|
|
2920 -- Not a clone, since we will not modify the parameters anyway
|
|
|
2921
|
|
|
2922 Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Params);
|
|
|
2923 Group_Switches
|
|
|
2924 (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Coalesce_Params);
|
|
|
2925 end if;
|
|
|
2926
|
|
|
2927 if Expanded then
|
|
|
2928 Iter.List := Cmd.Expanded;
|
|
|
2929 Iter.Params := Cmd.Params;
|
|
|
2930 Iter.Sections := Cmd.Sections;
|
|
|
2931 else
|
|
|
2932 Iter.List := Cmd.Coalesce;
|
|
|
2933 Iter.Params := Cmd.Coalesce_Params;
|
|
|
2934 Iter.Sections := Cmd.Coalesce_Sections;
|
|
|
2935 end if;
|
|
|
2936
|
|
|
2937 if Iter.List = null then
|
|
|
2938 Iter.Current := Integer'Last;
|
|
|
2939 else
|
|
|
2940 Iter.Current := Iter.List'First - 1;
|
|
|
2941 Next (Iter);
|
|
|
2942 end if;
|
|
|
2943 end Start;
|
|
|
2944
|
|
|
2945 --------------------
|
|
|
2946 -- Current_Switch --
|
|
|
2947 --------------------
|
|
|
2948
|
|
|
2949 function Current_Switch (Iter : Command_Line_Iterator) return String is
|
|
|
2950 begin
|
|
|
2951 return Iter.List (Iter.Current).all;
|
|
|
2952 end Current_Switch;
|
|
|
2953
|
|
|
2954 --------------------
|
|
|
2955 -- Is_New_Section --
|
|
|
2956 --------------------
|
|
|
2957
|
|
|
2958 function Is_New_Section (Iter : Command_Line_Iterator) return Boolean is
|
|
|
2959 Section : constant String := Current_Section (Iter);
|
|
|
2960
|
|
|
2961 begin
|
|
|
2962 if Iter.Sections = null then
|
|
|
2963 return False;
|
|
|
2964
|
|
|
2965 elsif Iter.Current = Iter.Sections'First
|
|
|
2966 or else Iter.Sections (Iter.Current - 1) = null
|
|
|
2967 then
|
|
|
2968 return Section /= "";
|
|
|
2969
|
|
|
2970 else
|
|
|
2971 return Section /= Iter.Sections (Iter.Current - 1).all;
|
|
|
2972 end if;
|
|
|
2973 end Is_New_Section;
|
|
|
2974
|
|
|
2975 ---------------------
|
|
|
2976 -- Current_Section --
|
|
|
2977 ---------------------
|
|
|
2978
|
|
|
2979 function Current_Section (Iter : Command_Line_Iterator) return String is
|
|
|
2980 begin
|
|
|
2981 if Iter.Sections = null
|
|
|
2982 or else Iter.Current > Iter.Sections'Last
|
|
|
2983 or else Iter.Sections (Iter.Current) = null
|
|
|
2984 then
|
|
|
2985 return "";
|
|
|
2986 end if;
|
|
|
2987
|
|
|
2988 return Iter.Sections (Iter.Current).all;
|
|
|
2989 end Current_Section;
|
|
|
2990
|
|
|
2991 -----------------------
|
|
|
2992 -- Current_Separator --
|
|
|
2993 -----------------------
|
|
|
2994
|
|
|
2995 function Current_Separator (Iter : Command_Line_Iterator) return String is
|
|
|
2996 begin
|
|
|
2997 if Iter.Params = null
|
|
|
2998 or else Iter.Current > Iter.Params'Last
|
|
|
2999 or else Iter.Params (Iter.Current) = null
|
|
|
3000 then
|
|
|
3001 return "";
|
|
|
3002
|
|
|
3003 else
|
|
|
3004 declare
|
|
|
3005 Sep : constant Character :=
|
|
|
3006 Iter.Params (Iter.Current) (Iter.Params (Iter.Current)'First);
|
|
|
3007 begin
|
|
|
3008 if Sep = ASCII.NUL then
|
|
|
3009 return "";
|
|
|
3010 else
|
|
|
3011 return "" & Sep;
|
|
|
3012 end if;
|
|
|
3013 end;
|
|
|
3014 end if;
|
|
|
3015 end Current_Separator;
|
|
|
3016
|
|
|
3017 -----------------------
|
|
|
3018 -- Current_Parameter --
|
|
|
3019 -----------------------
|
|
|
3020
|
|
|
3021 function Current_Parameter (Iter : Command_Line_Iterator) return String is
|
|
|
3022 begin
|
|
|
3023 if Iter.Params = null
|
|
|
3024 or else Iter.Current > Iter.Params'Last
|
|
|
3025 or else Iter.Params (Iter.Current) = null
|
|
|
3026 then
|
|
|
3027 return "";
|
|
|
3028
|
|
|
3029 else
|
|
|
3030 -- Return result, skipping separator
|
|
|
3031
|
|
|
3032 declare
|
|
|
3033 P : constant String := Iter.Params (Iter.Current).all;
|
|
|
3034 begin
|
|
|
3035 return P (P'First + 1 .. P'Last);
|
|
|
3036 end;
|
|
|
3037 end if;
|
|
|
3038 end Current_Parameter;
|
|
|
3039
|
|
|
3040 --------------
|
|
|
3041 -- Has_More --
|
|
|
3042 --------------
|
|
|
3043
|
|
|
3044 function Has_More (Iter : Command_Line_Iterator) return Boolean is
|
|
|
3045 begin
|
|
|
3046 return Iter.List /= null and then Iter.Current <= Iter.List'Last;
|
|
|
3047 end Has_More;
|
|
|
3048
|
|
|
3049 ----------
|
|
|
3050 -- Next --
|
|
|
3051 ----------
|
|
|
3052
|
|
|
3053 procedure Next (Iter : in out Command_Line_Iterator) is
|
|
|
3054 begin
|
|
|
3055 Iter.Current := Iter.Current + 1;
|
|
|
3056 while Iter.Current <= Iter.List'Last
|
|
|
3057 and then Iter.List (Iter.Current) = null
|
|
|
3058 loop
|
|
|
3059 Iter.Current := Iter.Current + 1;
|
|
|
3060 end loop;
|
|
|
3061 end Next;
|
|
|
3062
|
|
|
3063 ----------
|
|
|
3064 -- Free --
|
|
|
3065 ----------
|
|
|
3066
|
|
|
3067 procedure Free (Config : in out Command_Line_Configuration) is
|
|
|
3068 procedure Unchecked_Free is new
|
|
|
3069 Ada.Unchecked_Deallocation
|
|
|
3070 (Switch_Definitions, Switch_Definitions_List);
|
|
|
3071
|
|
|
3072 procedure Unchecked_Free is new
|
|
|
3073 Ada.Unchecked_Deallocation
|
|
|
3074 (Alias_Definitions, Alias_Definitions_List);
|
|
|
3075
|
|
|
3076 begin
|
|
|
3077 if Config /= null then
|
|
|
3078 Free (Config.Prefixes);
|
|
|
3079 Free (Config.Sections);
|
|
|
3080 Free (Config.Usage);
|
|
|
3081 Free (Config.Help);
|
|
|
3082 Free (Config.Help_Msg);
|
|
|
3083
|
|
|
3084 if Config.Aliases /= null then
|
|
|
3085 for A in Config.Aliases'Range loop
|
|
|
3086 Free (Config.Aliases (A).Alias);
|
|
|
3087 Free (Config.Aliases (A).Expansion);
|
|
|
3088 Free (Config.Aliases (A).Section);
|
|
|
3089 end loop;
|
|
|
3090
|
|
|
3091 Unchecked_Free (Config.Aliases);
|
|
|
3092 end if;
|
|
|
3093
|
|
|
3094 if Config.Switches /= null then
|
|
|
3095 for S in Config.Switches'Range loop
|
|
|
3096 Free (Config.Switches (S).Switch);
|
|
|
3097 Free (Config.Switches (S).Long_Switch);
|
|
|
3098 Free (Config.Switches (S).Help);
|
|
|
3099 Free (Config.Switches (S).Section);
|
|
|
3100 Free (Config.Switches (S).Argument);
|
|
|
3101 end loop;
|
|
|
3102
|
|
|
3103 Unchecked_Free (Config.Switches);
|
|
|
3104 end if;
|
|
|
3105
|
|
|
3106 Unchecked_Free (Config);
|
|
|
3107 end if;
|
|
|
3108 end Free;
|
|
|
3109
|
|
|
3110 ----------
|
|
|
3111 -- Free --
|
|
|
3112 ----------
|
|
|
3113
|
|
|
3114 procedure Free (Cmd : in out Command_Line) is
|
|
|
3115 begin
|
|
|
3116 Free (Cmd.Expanded);
|
|
|
3117 Free (Cmd.Coalesce);
|
|
|
3118 Free (Cmd.Coalesce_Sections);
|
|
|
3119 Free (Cmd.Coalesce_Params);
|
|
|
3120 Free (Cmd.Params);
|
|
|
3121 Free (Cmd.Sections);
|
|
|
3122 end Free;
|
|
|
3123
|
|
|
3124 ---------------
|
|
|
3125 -- Set_Usage --
|
|
|
3126 ---------------
|
|
|
3127
|
|
|
3128 procedure Set_Usage
|
|
|
3129 (Config : in out Command_Line_Configuration;
|
|
|
3130 Usage : String := "[switches] [arguments]";
|
|
|
3131 Help : String := "";
|
|
|
3132 Help_Msg : String := "")
|
|
|
3133 is
|
|
|
3134 begin
|
|
|
3135 if Config = null then
|
|
|
3136 Config := new Command_Line_Configuration_Record;
|
|
|
3137 end if;
|
|
|
3138
|
|
|
3139 Free (Config.Usage);
|
|
|
3140 Free (Config.Help);
|
|
|
3141 Free (Config.Help_Msg);
|
|
|
3142
|
|
|
3143 Config.Usage := new String'(Usage);
|
|
|
3144 Config.Help := new String'(Help);
|
|
|
3145 Config.Help_Msg := new String'(Help_Msg);
|
|
|
3146 end Set_Usage;
|
|
|
3147
|
|
|
3148 ------------------
|
|
|
3149 -- Display_Help --
|
|
|
3150 ------------------
|
|
|
3151
|
|
|
3152 procedure Display_Help (Config : Command_Line_Configuration) is
|
|
|
3153 function Switch_Name
|
|
|
3154 (Def : Switch_Definition;
|
|
|
3155 Section : String) return String;
|
|
|
3156 -- Return the "-short, --long=ARG" string for Def.
|
|
|
3157 -- Returns "" if the switch is not in the section.
|
|
|
3158
|
|
|
3159 function Param_Name
|
|
|
3160 (P : Switch_Parameter_Type;
|
|
|
3161 Name : String := "ARG") return String;
|
|
|
3162 -- Return the display for a switch parameter
|
|
|
3163
|
|
|
3164 procedure Display_Section_Help (Section : String);
|
|
|
3165 -- Display the help for a specific section ("" is the default section)
|
|
|
3166
|
|
|
3167 --------------------------
|
|
|
3168 -- Display_Section_Help --
|
|
|
3169 --------------------------
|
|
|
3170
|
|
|
3171 procedure Display_Section_Help (Section : String) is
|
|
|
3172 Max_Len : Natural := 0;
|
|
|
3173
|
|
|
3174 begin
|
|
|
3175 -- ??? Special display for "*"
|
|
|
3176
|
|
|
3177 New_Line;
|
|
|
3178
|
|
|
3179 if Section /= "" then
|
|
|
3180 Put_Line ("Switches after " & Section);
|
|
|
3181 end if;
|
|
|
3182
|
|
|
3183 -- Compute size of the switches column
|
|
|
3184
|
|
|
3185 for S in Config.Switches'Range loop
|
|
|
3186 Max_Len := Natural'Max
|
|
|
3187 (Max_Len, Switch_Name (Config.Switches (S), Section)'Length);
|
|
|
3188 end loop;
|
|
|
3189
|
|
|
3190 if Config.Aliases /= null then
|
|
|
3191 for A in Config.Aliases'Range loop
|
|
|
3192 if Config.Aliases (A).Section.all = Section then
|
|
|
3193 Max_Len := Natural'Max
|
|
|
3194 (Max_Len, Config.Aliases (A).Alias'Length);
|
|
|
3195 end if;
|
|
|
3196 end loop;
|
|
|
3197 end if;
|
|
|
3198
|
|
|
3199 -- Display the switches
|
|
|
3200
|
|
|
3201 for S in Config.Switches'Range loop
|
|
|
3202 declare
|
|
|
3203 N : constant String :=
|
|
|
3204 Switch_Name (Config.Switches (S), Section);
|
|
|
3205
|
|
|
3206 begin
|
|
|
3207 if N /= "" then
|
|
|
3208 Put (" ");
|
|
|
3209 Put (N);
|
|
|
3210 Put ((1 .. Max_Len - N'Length + 1 => ' '));
|
|
|
3211
|
|
|
3212 if Config.Switches (S).Help /= null then
|
|
|
3213 Put (Config.Switches (S).Help.all);
|
|
|
3214 end if;
|
|
|
3215
|
|
|
3216 New_Line;
|
|
|
3217 end if;
|
|
|
3218 end;
|
|
|
3219 end loop;
|
|
|
3220
|
|
|
3221 -- Display the aliases
|
|
|
3222
|
|
|
3223 if Config.Aliases /= null then
|
|
|
3224 for A in Config.Aliases'Range loop
|
|
|
3225 if Config.Aliases (A).Section.all = Section then
|
|
|
3226 Put (" ");
|
|
|
3227 Put (Config.Aliases (A).Alias.all);
|
|
|
3228 Put ((1 .. Max_Len - Config.Aliases (A).Alias'Length + 1
|
|
|
3229 => ' '));
|
|
|
3230 Put ("Equivalent to " & Config.Aliases (A).Expansion.all);
|
|
|
3231 New_Line;
|
|
|
3232 end if;
|
|
|
3233 end loop;
|
|
|
3234 end if;
|
|
|
3235 end Display_Section_Help;
|
|
|
3236
|
|
|
3237 ----------------
|
|
|
3238 -- Param_Name --
|
|
|
3239 ----------------
|
|
|
3240
|
|
|
3241 function Param_Name
|
|
|
3242 (P : Switch_Parameter_Type;
|
|
|
3243 Name : String := "ARG") return String
|
|
|
3244 is
|
|
|
3245 begin
|
|
|
3246 case P is
|
|
|
3247 when Parameter_None =>
|
|
|
3248 return "";
|
|
|
3249
|
|
|
3250 when Parameter_With_Optional_Space =>
|
|
|
3251 return " " & To_Upper (Name);
|
|
|
3252
|
|
|
3253 when Parameter_With_Space_Or_Equal =>
|
|
|
3254 return "=" & To_Upper (Name);
|
|
|
3255
|
|
|
3256 when Parameter_No_Space =>
|
|
|
3257 return To_Upper (Name);
|
|
|
3258
|
|
|
3259 when Parameter_Optional =>
|
|
|
3260 return '[' & To_Upper (Name) & ']';
|
|
|
3261 end case;
|
|
|
3262 end Param_Name;
|
|
|
3263
|
|
|
3264 -----------------
|
|
|
3265 -- Switch_Name --
|
|
|
3266 -----------------
|
|
|
3267
|
|
|
3268 function Switch_Name
|
|
|
3269 (Def : Switch_Definition;
|
|
|
3270 Section : String) return String
|
|
|
3271 is
|
|
|
3272 use Ada.Strings.Unbounded;
|
|
|
3273 Result : Unbounded_String;
|
|
|
3274 P1, P2 : Switch_Parameter_Type;
|
|
|
3275 Last1, Last2 : Integer := 0;
|
|
|
3276
|
|
|
3277 begin
|
|
|
3278 if (Section = "" and then Def.Section = null)
|
|
|
3279 or else (Def.Section /= null and then Def.Section.all = Section)
|
|
|
3280 then
|
|
|
3281 if Def.Switch /= null and then Def.Switch.all = "*" then
|
|
|
3282 return "[any switch]";
|
|
|
3283 end if;
|
|
|
3284
|
|
|
3285 if Def.Switch /= null then
|
|
|
3286 Decompose_Switch (Def.Switch.all, P1, Last1);
|
|
|
3287 Append (Result, Def.Switch (Def.Switch'First .. Last1));
|
|
|
3288
|
|
|
3289 if Def.Long_Switch /= null then
|
|
|
3290 Decompose_Switch (Def.Long_Switch.all, P2, Last2);
|
|
|
3291 Append (Result, ", "
|
|
|
3292 & Def.Long_Switch (Def.Long_Switch'First .. Last2));
|
|
|
3293
|
|
|
3294 if Def.Argument = null then
|
|
|
3295 Append (Result, Param_Name (P2, "ARG"));
|
|
|
3296 else
|
|
|
3297 Append (Result, Param_Name (P2, Def.Argument.all));
|
|
|
3298 end if;
|
|
|
3299
|
|
|
3300 else
|
|
|
3301 if Def.Argument = null then
|
|
|
3302 Append (Result, Param_Name (P1, "ARG"));
|
|
|
3303 else
|
|
|
3304 Append (Result, Param_Name (P1, Def.Argument.all));
|
|
|
3305 end if;
|
|
|
3306 end if;
|
|
|
3307
|
|
|
3308 -- Def.Switch is null (Long_Switch must be non-null)
|
|
|
3309
|
|
|
3310 else
|
|
|
3311 Decompose_Switch (Def.Long_Switch.all, P2, Last2);
|
|
|
3312 Append (Result,
|
|
|
3313 Def.Long_Switch (Def.Long_Switch'First .. Last2));
|
|
|
3314
|
|
|
3315 if Def.Argument = null then
|
|
|
3316 Append (Result, Param_Name (P2, "ARG"));
|
|
|
3317 else
|
|
|
3318 Append (Result, Param_Name (P2, Def.Argument.all));
|
|
|
3319 end if;
|
|
|
3320 end if;
|
|
|
3321 end if;
|
|
|
3322
|
|
|
3323 return To_String (Result);
|
|
|
3324 end Switch_Name;
|
|
|
3325
|
|
|
3326 -- Start of processing for Display_Help
|
|
|
3327
|
|
|
3328 begin
|
|
|
3329 if Config = null then
|
|
|
3330 return;
|
|
|
3331 end if;
|
|
|
3332
|
|
|
3333 if Config.Help /= null and then Config.Help.all /= "" then
|
|
|
3334 Put_Line (Config.Help.all);
|
|
|
3335 end if;
|
|
|
3336
|
|
|
3337 if Config.Usage /= null then
|
|
|
3338 Put_Line ("Usage: "
|
|
|
3339 & Base_Name
|
|
|
3340 (Ada.Command_Line.Command_Name) & " " & Config.Usage.all);
|
|
|
3341 else
|
|
|
3342 Put_Line ("Usage: " & Base_Name (Ada.Command_Line.Command_Name)
|
|
|
3343 & " [switches] [arguments]");
|
|
|
3344 end if;
|
|
|
3345
|
|
|
3346 if Config.Help_Msg /= null and then Config.Help_Msg.all /= "" then
|
|
|
3347 Put_Line (Config.Help_Msg.all);
|
|
|
3348
|
|
|
3349 else
|
|
|
3350 Display_Section_Help ("");
|
|
|
3351
|
|
|
3352 if Config.Sections /= null and then Config.Switches /= null then
|
|
|
3353 for S in Config.Sections'Range loop
|
|
|
3354 Display_Section_Help (Config.Sections (S).all);
|
|
|
3355 end loop;
|
|
|
3356 end if;
|
|
|
3357 end if;
|
|
|
3358 end Display_Help;
|
|
|
3359
|
|
|
3360 ------------
|
|
|
3361 -- Getopt --
|
|
|
3362 ------------
|
|
|
3363
|
|
|
3364 procedure Getopt
|
|
|
3365 (Config : Command_Line_Configuration;
|
|
|
3366 Callback : Switch_Handler := null;
|
|
|
3367 Parser : Opt_Parser := Command_Line_Parser;
|
|
|
3368 Concatenate : Boolean := True)
|
|
|
3369 is
|
|
|
3370 Local_Config : Command_Line_Configuration := Config;
|
|
|
3371 Getopt_Switches : String_Access;
|
|
|
3372 C : Character := ASCII.NUL;
|
|
|
3373
|
|
|
3374 Empty_Name : aliased constant String := "";
|
|
|
3375 Current_Section : Integer := -1;
|
|
|
3376 Section_Name : not null access constant String := Empty_Name'Access;
|
|
|
3377
|
|
|
3378 procedure Simple_Callback
|
|
|
3379 (Simple_Switch : String;
|
|
|
3380 Separator : String;
|
|
|
3381 Parameter : String;
|
|
|
3382 Index : Integer);
|
|
|
3383 -- Needs comments ???
|
|
|
3384
|
|
|
3385 procedure Do_Callback (Switch, Parameter : String; Index : Integer);
|
|
|
3386
|
|
|
3387 -----------------
|
|
|
3388 -- Do_Callback --
|
|
|
3389 -----------------
|
|
|
3390
|
|
|
3391 procedure Do_Callback (Switch, Parameter : String; Index : Integer) is
|
|
|
3392 begin
|
|
|
3393 -- Do automatic handling when possible
|
|
|
3394
|
|
|
3395 if Index /= -1 then
|
|
|
3396 case Local_Config.Switches (Index).Typ is
|
|
|
3397 when Switch_Untyped =>
|
|
|
3398 null; -- no automatic handling
|
|
|
3399
|
|
|
3400 when Switch_Boolean =>
|
|
|
3401 Local_Config.Switches (Index).Boolean_Output.all :=
|
|
|
3402 Local_Config.Switches (Index).Boolean_Value;
|
|
|
3403 return;
|
|
|
3404
|
|
|
3405 when Switch_Integer =>
|
|
|
3406 begin
|
|
|
3407 if Parameter = "" then
|
|
|
3408 Local_Config.Switches (Index).Integer_Output.all :=
|
|
|
3409 Local_Config.Switches (Index).Integer_Default;
|
|
|
3410 else
|
|
|
3411 Local_Config.Switches (Index).Integer_Output.all :=
|
|
|
3412 Integer'Value (Parameter);
|
|
|
3413 end if;
|
|
|
3414
|
|
|
3415 exception
|
|
|
3416 when Constraint_Error =>
|
|
|
3417 raise Invalid_Parameter
|
|
|
3418 with "Expected integer parameter for '"
|
|
|
3419 & Switch & "'";
|
|
|
3420 end;
|
|
|
3421
|
|
|
3422 return;
|
|
|
3423
|
|
|
3424 when Switch_String =>
|
|
|
3425 Free (Local_Config.Switches (Index).String_Output.all);
|
|
|
3426 Local_Config.Switches (Index).String_Output.all :=
|
|
|
3427 new String'(Parameter);
|
|
|
3428 return;
|
|
131
|
3429
|
|
|
3430 when Switch_Callback =>
|
|
|
3431 Local_Config.Switches (Index).Callback (Switch, Parameter);
|
|
|
3432 return;
|
|
111
|
3433 end case;
|
|
|
3434 end if;
|
|
|
3435
|
|
|
3436 -- Otherwise calls the user callback if one was defined
|
|
|
3437
|
|
|
3438 if Callback /= null then
|
|
|
3439 Callback (Switch => Switch,
|
|
|
3440 Parameter => Parameter,
|
|
|
3441 Section => Section_Name.all);
|
|
|
3442 end if;
|
|
|
3443 end Do_Callback;
|
|
|
3444
|
|
|
3445 procedure For_Each_Simple
|
|
|
3446 is new For_Each_Simple_Switch (Simple_Callback);
|
|
|
3447
|
|
|
3448 ---------------------
|
|
|
3449 -- Simple_Callback --
|
|
|
3450 ---------------------
|
|
|
3451
|
|
|
3452 procedure Simple_Callback
|
|
|
3453 (Simple_Switch : String;
|
|
|
3454 Separator : String;
|
|
|
3455 Parameter : String;
|
|
|
3456 Index : Integer)
|
|
|
3457 is
|
|
|
3458 pragma Unreferenced (Separator);
|
|
|
3459 begin
|
|
|
3460 Do_Callback (Switch => Simple_Switch,
|
|
|
3461 Parameter => Parameter,
|
|
|
3462 Index => Index);
|
|
|
3463 end Simple_Callback;
|
|
|
3464
|
|
|
3465 -- Start of processing for Getopt
|
|
|
3466
|
|
|
3467 begin
|
|
|
3468 -- We work with a local copy of Config, because Config can be null, for
|
|
|
3469 -- example if Define_Switch was never called. We could modify Config
|
|
|
3470 -- itself, but then we would have to make it into an 'in out' parameter,
|
|
|
3471 -- which would be incompatible.
|
|
|
3472
|
|
|
3473 if Local_Config = null then
|
|
|
3474 Local_Config := new Command_Line_Configuration_Record;
|
|
|
3475 end if;
|
|
|
3476
|
|
|
3477 if Local_Config.Switches = null then
|
|
|
3478 Local_Config.Switches := new Switch_Definitions (1 .. 0);
|
|
|
3479 end if;
|
|
|
3480
|
|
|
3481 -- Initialize sections
|
|
|
3482
|
|
|
3483 if Local_Config.Sections = null then
|
|
|
3484 Local_Config.Sections := new Argument_List'(1 .. 0 => null);
|
|
|
3485 end if;
|
|
|
3486
|
|
|
3487 Internal_Initialize_Option_Scan
|
|
|
3488 (Parser => Parser,
|
|
|
3489 Switch_Char => Parser.Switch_Character,
|
|
|
3490 Stop_At_First_Non_Switch => Parser.Stop_At_First,
|
|
|
3491 Section_Delimiters => Section_Delimiters (Local_Config));
|
|
|
3492
|
|
|
3493 Getopt_Switches := new String'
|
|
|
3494 (Get_Switches (Local_Config, Parser.Switch_Character, Section_Name.all)
|
|
|
3495 & " h -help");
|
|
|
3496
|
|
|
3497 -- Initialize output values for automatically handled switches
|
|
|
3498
|
|
|
3499 for S in Local_Config.Switches'Range loop
|
|
|
3500 case Local_Config.Switches (S).Typ is
|
|
131
|
3501 when Switch_Untyped | Switch_Callback =>
|
|
111
|
3502 null; -- Nothing to do
|
|
|
3503
|
|
|
3504 when Switch_Boolean =>
|
|
|
3505 Local_Config.Switches (S).Boolean_Output.all :=
|
|
|
3506 not Local_Config.Switches (S).Boolean_Value;
|
|
|
3507
|
|
|
3508 when Switch_Integer =>
|
|
|
3509 Local_Config.Switches (S).Integer_Output.all :=
|
|
|
3510 Local_Config.Switches (S).Integer_Initial;
|
|
|
3511
|
|
|
3512 when Switch_String =>
|
|
|
3513 if Local_Config.Switches (S).String_Output.all = null then
|
|
|
3514 Local_Config.Switches (S).String_Output.all :=
|
|
|
3515 new String'("");
|
|
|
3516 end if;
|
|
|
3517 end case;
|
|
|
3518 end loop;
|
|
|
3519
|
|
|
3520 -- For all sections, and all switches within those sections
|
|
|
3521
|
|
|
3522 loop
|
|
|
3523 C := Getopt (Switches => Getopt_Switches.all,
|
|
|
3524 Concatenate => Concatenate,
|
|
|
3525 Parser => Parser);
|
|
|
3526
|
|
|
3527 if C = '*' then
|
|
|
3528 -- Full_Switch already includes the leading '-'
|
|
|
3529
|
|
|
3530 Do_Callback (Switch => Full_Switch (Parser),
|
|
|
3531 Parameter => Parameter (Parser),
|
|
|
3532 Index => -1);
|
|
|
3533
|
|
|
3534 elsif C /= ASCII.NUL then
|
|
|
3535 if Full_Switch (Parser) = "h"
|
|
|
3536 or else
|
|
|
3537 Full_Switch (Parser) = "-help"
|
|
|
3538 then
|
|
|
3539 Display_Help (Local_Config);
|
|
|
3540 raise Exit_From_Command_Line;
|
|
|
3541 end if;
|
|
|
3542
|
|
|
3543 -- Do switch expansion if needed
|
|
|
3544
|
|
|
3545 For_Each_Simple
|
|
|
3546 (Local_Config,
|
|
|
3547 Section => Section_Name.all,
|
|
|
3548 Switch => Parser.Switch_Character & Full_Switch (Parser),
|
|
|
3549 Parameter => Parameter (Parser));
|
|
|
3550
|
|
|
3551 else
|
|
|
3552 if Current_Section = -1 then
|
|
|
3553 Current_Section := Local_Config.Sections'First;
|
|
|
3554 else
|
|
|
3555 Current_Section := Current_Section + 1;
|
|
|
3556 end if;
|
|
|
3557
|
|
|
3558 exit when Current_Section > Local_Config.Sections'Last;
|
|
|
3559
|
|
|
3560 Section_Name := Local_Config.Sections (Current_Section);
|
|
|
3561 Goto_Section (Section_Name.all, Parser);
|
|
|
3562
|
|
|
3563 Free (Getopt_Switches);
|
|
|
3564 Getopt_Switches := new String'
|
|
|
3565 (Get_Switches
|
|
|
3566 (Local_Config, Parser.Switch_Character, Section_Name.all));
|
|
|
3567 end if;
|
|
|
3568 end loop;
|
|
|
3569
|
|
|
3570 Free (Getopt_Switches);
|
|
|
3571
|
|
|
3572 exception
|
|
|
3573 when Invalid_Switch =>
|
|
|
3574 Free (Getopt_Switches);
|
|
|
3575
|
|
|
3576 -- Message inspired by "ls" on Unix
|
|
|
3577
|
|
|
3578 Put_Line (Standard_Error,
|
|
|
3579 Base_Name (Ada.Command_Line.Command_Name)
|
|
|
3580 & ": unrecognized option '"
|
|
|
3581 & Full_Switch (Parser)
|
|
|
3582 & "'");
|
|
|
3583 Try_Help;
|
|
|
3584
|
|
|
3585 raise;
|
|
|
3586
|
|
|
3587 when others =>
|
|
|
3588 Free (Getopt_Switches);
|
|
|
3589 raise;
|
|
|
3590 end Getopt;
|
|
|
3591
|
|
|
3592 -----------
|
|
|
3593 -- Build --
|
|
|
3594 -----------
|
|
|
3595
|
|
|
3596 procedure Build
|
|
|
3597 (Line : in out Command_Line;
|
|
|
3598 Args : out GNAT.OS_Lib.Argument_List_Access;
|
|
|
3599 Expanded : Boolean := False;
|
|
|
3600 Switch_Char : Character := '-')
|
|
|
3601 is
|
|
|
3602 Iter : Command_Line_Iterator;
|
|
|
3603 Count : Natural := 0;
|
|
|
3604
|
|
|
3605 begin
|
|
|
3606 Start (Line, Iter, Expanded => Expanded);
|
|
|
3607 while Has_More (Iter) loop
|
|
|
3608 if Is_New_Section (Iter) then
|
|
|
3609 Count := Count + 1;
|
|
|
3610 end if;
|
|
|
3611
|
|
|
3612 Count := Count + 1;
|
|
|
3613 Next (Iter);
|
|
|
3614 end loop;
|
|
|
3615
|
|
|
3616 Args := new Argument_List (1 .. Count);
|
|
|
3617 Count := Args'First;
|
|
|
3618
|
|
|
3619 Start (Line, Iter, Expanded => Expanded);
|
|
|
3620 while Has_More (Iter) loop
|
|
|
3621 if Is_New_Section (Iter) then
|
|
|
3622 Args (Count) := new String'(Switch_Char & Current_Section (Iter));
|
|
|
3623 Count := Count + 1;
|
|
|
3624 end if;
|
|
|
3625
|
|
|
3626 Args (Count) := new String'(Current_Switch (Iter)
|
|
|
3627 & Current_Separator (Iter)
|
|
|
3628 & Current_Parameter (Iter));
|
|
|
3629 Count := Count + 1;
|
|
|
3630 Next (Iter);
|
|
|
3631 end loop;
|
|
|
3632 end Build;
|
|
|
3633
|
|
|
3634 --------------
|
|
|
3635 -- Try_Help --
|
|
|
3636 --------------
|
|
|
3637
|
|
|
3638 -- Note: Any change to the message displayed should also be done in
|
|
|
3639 -- gnatbind.adb that does not use this interface.
|
|
|
3640
|
|
|
3641 procedure Try_Help is
|
|
|
3642 begin
|
|
|
3643 Put_Line
|
|
|
3644 (Standard_Error,
|
|
|
3645 "try """ & Base_Name (Ada.Command_Line.Command_Name, Suffix => ".exe")
|
|
|
3646 & " --help"" for more information.");
|
|
|
3647 end Try_Help;
|
|
|
3648
|
|
|
3649 end GNAT.Command_Line;
|
