1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- G N A T . C O M M A N D _ L I N E --
9 -- Copyright (C) 1999-2016, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
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
;
37 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
38 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
40 package body GNAT
.Command_Line
is
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 ???
46 package CL
renames Ada
.Command_Line
;
48 type Switch_Parameter_Type
is
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
55 procedure Set_Parameter
56 (Variable
: out Parameter_Type
;
60 Extra
: Character := ASCII
.NUL
);
61 pragma Inline
(Set_Parameter
);
62 -- Set the parameter that will be returned by Parameter below
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 '*'.
69 -- Parameters need to be defined ???
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.
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");
81 File_Names_Case_Sensitive
: constant Boolean :=
82 Get_File_Names_Case_Sensitive
/= 0;
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.
92 procedure Internal_Initialize_Option_Scan
94 Switch_Char
: Character;
95 Stop_At_First_Non_Switch
: Boolean;
96 Section_Delimiters
: String);
97 -- Initialize Parser, which must have been allocated already
99 function Argument
(Parser
: Opt_Parser
; Index
: Integer) return String;
100 -- Return the index-th command line argument
102 procedure Find_Longest_Matching_Switch
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???
112 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
113 (Argument_List
, Argument_List_Access
);
115 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
116 (Command_Line_Configuration_Record
, Command_Line_Configuration
);
118 procedure Remove
(Line
: in out Argument_List_Access
; Index
: Integer);
119 -- Remove a specific element from Line
122 (Line
: in out Argument_List_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.
129 (Config
: in out Command_Line_Configuration
;
130 Switch
: Switch_Definition
);
132 (Def
: in out Alias_Definitions_List
;
133 Alias
: Alias_Definition
);
134 -- Add a new element to Def
136 procedure Initialize_Switch_Def
137 (Def
: out Switch_Definition
;
138 Switch
: String := "";
139 Long_Switch
: 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.
147 procedure Decompose_Switch
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
154 function Can_Have_Parameter
(S
: String) return Boolean;
155 -- True if S can have a parameter
157 function Require_Parameter
(S
: String) return Boolean;
158 -- True if S requires a parameter
160 function Actual_Switch
(S
: String) return String;
161 -- Remove any possible trailing '!', ':', '?' and '='
164 with procedure Callback
165 (Simple_Switch
: String;
168 Index
: Integer); -- Index in Config.Switches, or -1
169 procedure For_Each_Simple_Switch
170 (Config
: Command_Line_Configuration
;
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
179 procedure Sort_Sections
180 (Line
: 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.
186 procedure Group_Switches
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.
194 procedure Alias_Switches
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
204 Substring
: String) return Boolean;
205 -- Return True if the characters starting at Index in Type_Str are
206 -- equivalent to Substring.
209 with function Callback
(S
: String; Index
: Integer) return Boolean;
210 procedure Foreach_Switch
211 (Config
: Command_Line_Configuration
;
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.
221 function Argument
(Parser
: Opt_Parser
; Index
: Integer) return String is
223 if Parser
.Arguments
/= null then
224 return Parser
.Arguments
(Index
+ Parser
.Arguments
'First - 1).all;
226 return CL
.Argument
(Index
);
230 ------------------------------
231 -- Canonical_Case_File_Name --
232 ------------------------------
234 procedure Canonical_Case_File_Name
(S
: in out String) is
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')));
245 end Canonical_Case_File_Name
;
251 function Expansion
(Iterator
: Expansion_Iterator
) return String is
252 type Pointer
is access all Expansion_Iterator
;
254 It
: constant Pointer
:= Iterator
'Unrestricted_Access;
255 S
: String (1 .. 1024);
258 Current
: Depth
:= It
.Current_Depth
;
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.
267 Read
(It
.Levels
(Current
).Dir
, S
, Last
);
269 -- If we have exhausted the directory, close it and go back one level
272 Close
(It
.Levels
(Current
).Dir
);
274 -- If we are at level 1, we are finished; return an empty string
277 return String'(1 .. 0 => ' ');
279 -- Otherwise continue with the directory at the previous level
282 Current := Current - 1;
283 It.Current_Depth := Current;
286 -- If this is a directory, that is neither "." or "..", attempt to
287 -- go to the next level.
290 (It.Dir_Name (1 .. It.Levels (Current).Name_Last) &
292 and then S (1 .. Last) /= "."
293 and then S (1 .. Last) /= ".."
295 -- We can go to the next level only if we have not reached the
298 if Current < It.Maximum_Depth then
299 NL := It.Levels (Current).Name_Last;
301 -- And if relative path of this new directory is not too long
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);
308 It.Dir_Name (NL) := Directory_Separator;
309 It.Levels (Current).Name_Last := NL;
310 Canonical_Case_File_Name (It.Dir_Name (1 .. NL));
312 -- Open the new directory, and read from it
314 GNAT.Directory_Operations.Open
315 (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
320 -- Check the relative path against the pattern
322 -- Note that we try to match also against directory names, since
323 -- clients of this function may expect to retrieve directories.
327 It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
331 Canonical_Case_File_Name (Name);
333 -- If it matches return the relative path
335 if GNAT.Regexp.Match (Name, Iterator.Regexp) then
342 ---------------------
343 -- Current_Section --
344 ---------------------
346 function Current_Section
347 (Parser : Opt_Parser := Command_Line_Parser) return String
350 if Parser.Current_Section = 1 then
354 for Index in reverse 1 .. Integer'Min (Parser.Current_Argument - 1,
357 if Parser.Section (Index) = 0 then
358 return Argument (Parser, Index);
370 (Parser : Opt_Parser := Command_Line_Parser) return String
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);
377 return Parser.The_Switch.Extra
378 & Argument (Parser, Parser.The_Switch.Arg_Num)
379 (Parser.The_Switch.First .. Parser.The_Switch.Last);
387 function Get_Argument
388 (Do_Expansion : Boolean := False;
389 Parser : Opt_Parser := Command_Line_Parser) return String
392 if Parser.In_Expansion then
394 S : constant String := Expansion (Parser.Expansion_It);
396 if S'Length /= 0 then
399 Parser.In_Expansion := False;
404 if Parser.Current_Argument > Parser.Arg_Count then
406 -- If this is the first time this function is called
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
414 Parser.Current_Argument := Parser.Current_Argument + 1;
418 return String'(1 .. 0 => ' ');
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
426 Parser
.Current_Argument
:= Parser
.Current_Argument
+ 1;
430 Parser
.Current_Index
:= Integer'Last;
432 while Parser
.Current_Argument
<= Parser
.Arg_Count
433 and then Parser
.Is_Switch
(Parser
.Current_Argument
)
435 Parser
.Current_Argument
:= Parser
.Current_Argument
+ 1;
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);
444 Parser.Current_Argument := Parser.Current_Argument + 1;
446 -- Could it be a file name with wild cards to expand?
450 Arg : constant String :=
451 Argument (Parser, Parser.Current_Argument - 1);
453 for Index in Arg'Range loop
455 or else Arg (Index) = '?
'
456 or else Arg (Index) = '['
458 Parser.In_Expansion := True;
459 Start_Expansion (Parser.Expansion_It, Arg);
460 return Get_Argument (Do_Expansion, Parser);
466 return Argument (Parser, Parser.Current_Argument - 1);
469 ----------------------
470 -- Decompose_Switch --
471 ----------------------
473 procedure Decompose_Switch
475 Parameter_Type : out Switch_Parameter_Type;
476 Switch_Last : out Integer)
480 Parameter_Type := Parameter_None;
481 Switch_Last := Switch'Last;
485 case Switch (Switch'Last) is
487 Parameter_Type := Parameter_With_Optional_Space;
488 Switch_Last := Switch'Last - 1;
490 Parameter_Type := Parameter_With_Space_Or_Equal;
491 Switch_Last := Switch'Last - 1;
493 Parameter_Type := Parameter_No_Space;
494 Switch_Last := Switch'Last - 1;
496 Parameter_Type := Parameter_Optional;
497 Switch_Last := Switch'Last - 1;
499 Parameter_Type := Parameter_None;
500 Switch_Last := Switch'Last;
502 end Decompose_Switch;
504 ----------------------------------
505 -- Find_Longest_Matching_Switch --
506 ----------------------------------
508 procedure Find_Longest_Matching_Switch
511 Index_In_Switches : out Integer;
512 Switch_Length : out Integer;
513 Param : out Switch_Parameter_Type)
516 Length : Natural := 1;
518 P : Switch_Parameter_Type;
521 Index_In_Switches := 0;
524 -- Remove all leading spaces first to make sure that Index points
525 -- at the start of the first switch.
527 Index := Switches'First;
528 while Index <= Switches'Last and then Switches (Index) = ' ' loop
532 while Index <= Switches'Last loop
534 -- Search the length of the parameter at this position in Switches
537 while Length <= Switches'Last
538 and then Switches (Length) /= ' '
540 Length := Length + 1;
543 -- Length now marks the separator after the current switch. Last will
544 -- mark the last character of the name of the switch.
546 if Length = Index + 1 then
550 Decompose_Switch (Switches (Index .. Length - 1), P, Last);
553 -- If it is the one we searched, it may be a candidate
555 if Arg'First + Last - Index <= Arg'Last
556 and then Switches (Index .. Last) =
557 Arg (Arg'First .. Arg'First + Last - Index)
558 and then Last - Index + 1 > Switch_Length
560 (P /= Parameter_With_Space_Or_Equal
561 or else Arg'Last = Arg'First + Last - Index
562 or else Arg (Arg'First + Last - Index + 1) = '=')
565 Index_In_Switches := Index;
566 Switch_Length := Last - Index + 1;
569 -- Look for the next switch in Switches
571 while Index <= Switches'Last
572 and then Switches (Index) /= ' '
579 end Find_Longest_Matching_Switch;
587 Concatenate : Boolean := True;
588 Parser : Opt_Parser := Command_Line_Parser) return Character
595 -- If we have finished parsing the current command line item (there
596 -- might be multiple switches in a single item), then go to the next
599 if Parser.Current_Argument > Parser.Arg_Count
600 or else (Parser.Current_Index >
601 Argument (Parser, Parser.Current_Argument)'Last
602 and then not Goto_Next_Argument_In_Section (Parser))
607 -- By default, the switch will not have a parameter
609 Parser.The_Parameter :=
610 (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL);
611 Parser.The_Separator := ASCII.NUL;
614 Arg : constant String :=
615 Argument (Parser, Parser.Current_Argument);
616 Index_Switches : Natural := 0;
617 Max_Length : Natural := 0;
619 Param : Switch_Parameter_Type;
621 -- If we are on a new item, test if this might be a switch
623 if Parser.Current_Index = Arg'First then
624 if Arg = "" or else Arg (Arg'First) /= Parser.Switch_Character then
626 -- If it isn't a switch, return it immediately. We also know it
627 -- isn't the parameter to a previous switch, since that has
628 -- already been handled.
630 if Switches (Switches'First) = '*' then
633 Arg_Num => Parser.Current_Argument,
636 Parser.Is_Switch (Parser.Current_Argument) := True;
637 Dummy := Goto_Next_Argument_In_Section (Parser);
641 if Parser.Stop_At_First then
642 Parser.Current_Argument := Positive'Last;
645 elsif not Goto_Next_Argument_In_Section (Parser) then
649 -- Recurse to get the next switch on the command line
655 -- We are on the first character of a new command line argument,
656 -- which starts with Switch_Character. Further analysis is needed.
658 Parser.Current_Index := Parser.Current_Index + 1;
659 Parser.Is_Switch (Parser.Current_Argument) := True;
662 Find_Longest_Matching_Switch
663 (Switches => Switches,
664 Arg => Arg (Parser.Current_Index .. Arg'Last),
665 Index_In_Switches => Index_Switches,
666 Switch_Length => Max_Length,
669 -- If switch is not accepted, it is either invalid or is returned
670 -- in the context of '*'.
672 if Index_Switches = 0 then
674 -- Find the current switch that we did not recognize. This is in
675 -- fact difficult because Getopt does not know explicitly about
676 -- short and long switches. Ideally, we would want the following
679 -- * for short switches, with Concatenate:
680 -- if -a is not recognized, and the command line has -daf
681 -- we should report the invalid switch as "-a".
683 -- * for short switches, wihtout Concatenate:
684 -- we should report the invalid switch as "-daf".
686 -- * for long switches:
687 -- if the commadn line is "--long" we should report --long
690 -- Unfortunately, the fact that long switches start with a
691 -- duplicate switch character is just a convention (so we could
692 -- have a long switch "-long" for instance). We'll still rely on
693 -- this convention here to try and get as helpful an error message
696 -- Long switch case (starting with double switch character)
698 if Arg (Arg'First + 1) = Parser.Switch_Character then
699 End_Index := Arg'Last;
705 (if Concatenate then Parser.Current_Index else Arg'Last);
708 if Switches /= "" and then Switches (Switches'First) = '*' then
710 -- Always prepend the switch character, so that users know
711 -- that this comes from a switch on the command line. This
712 -- is especially important when Concatenate is False, since
713 -- otherwise the current argument first character is lost.
715 if Parser.Section (Parser.Current_Argument) = 0 then
717 -- A section transition should not be returned to the user
719 Dummy := Goto_Next_Argument_In_Section (Parser);
725 Arg_Num => Parser.Current_Argument,
726 First => Parser.Current_Index,
728 Extra => Parser.Switch_Character);
729 Parser.Is_Switch (Parser.Current_Argument) := True;
730 Dummy := Goto_Next_Argument_In_Section (Parser);
735 if Parser.Current_Index = Arg'First then
738 Arg_Num => Parser.Current_Argument,
739 First => Parser.Current_Index,
744 Arg_Num => Parser.Current_Argument,
745 First => Parser.Current_Index,
747 Extra => Parser.Switch_Character);
750 Parser.Current_Index := End_Index + 1;
752 raise Invalid_Switch;
755 End_Index := Parser.Current_Index + Max_Length - 1;
758 Arg_Num => Parser.Current_Argument,
759 First => Parser.Current_Index,
763 when Parameter_With_Optional_Space =>
764 if End_Index < Arg'Last then
766 (Parser.The_Parameter,
767 Arg_Num => Parser.Current_Argument,
768 First => End_Index + 1,
770 Dummy := Goto_Next_Argument_In_Section (Parser);
772 elsif Parser.Current_Argument < Parser.Arg_Count
773 and then Parser.Section (Parser.Current_Argument + 1) /= 0
775 Parser.Current_Argument := Parser.Current_Argument + 1;
776 Parser.The_Separator := ' ';
778 (Parser.The_Parameter,
779 Arg_Num => Parser.Current_Argument,
780 First => Argument (Parser, Parser.Current_Argument)'First,
781 Last => Argument (Parser, Parser.Current_Argument)'Last);
782 Parser.Is_Switch (Parser.Current_Argument) := True;
783 Dummy := Goto_Next_Argument_In_Section (Parser);
786 Parser.Current_Index := End_Index + 1;
787 raise Invalid_Parameter;
790 when Parameter_With_Space_Or_Equal =>
792 -- If the switch is of the form <switch>=xxx
794 if End_Index < Arg'Last then
795 if Arg (End_Index + 1) = '='
796 and then End_Index + 1 < Arg'Last
798 Parser.The_Separator := '=';
800 (Parser.The_Parameter,
801 Arg_Num => Parser.Current_Argument,
802 First => End_Index + 2,
804 Dummy := Goto_Next_Argument_In_Section (Parser);
807 Parser.Current_Index := End_Index + 1;
808 raise Invalid_Parameter;
811 -- Case of switch of the form <switch> xxx
813 elsif Parser.Current_Argument < Parser.Arg_Count
814 and then Parser.Section (Parser.Current_Argument + 1) /= 0
816 Parser.Current_Argument := Parser.Current_Argument + 1;
817 Parser.The_Separator := ' ';
819 (Parser.The_Parameter,
820 Arg_Num => Parser.Current_Argument,
821 First => Argument (Parser, Parser.Current_Argument)'First,
822 Last => Argument (Parser, Parser.Current_Argument)'Last);
823 Parser.Is_Switch (Parser.Current_Argument) := True;
824 Dummy := Goto_Next_Argument_In_Section (Parser);
827 Parser.Current_Index := End_Index + 1;
828 raise Invalid_Parameter;
831 when Parameter_No_Space =>
832 if End_Index < Arg'Last then
834 (Parser.The_Parameter,
835 Arg_Num => Parser.Current_Argument,
836 First => End_Index + 1,
838 Dummy := Goto_Next_Argument_In_Section (Parser);
841 Parser.Current_Index := End_Index + 1;
842 raise Invalid_Parameter;
845 when Parameter_Optional =>
846 if End_Index < Arg'Last then
848 (Parser.The_Parameter,
849 Arg_Num => Parser.Current_Argument,
850 First => End_Index + 1,
854 Dummy := Goto_Next_Argument_In_Section (Parser);
856 when Parameter_None =>
857 if Concatenate or else End_Index = Arg'Last then
858 Parser.Current_Index := End_Index + 1;
861 -- If Concatenate is False and the full argument is not
862 -- recognized as a switch, this is an invalid switch.
864 if Switches (Switches'First) = '*' then
867 Arg_Num => Parser.Current_Argument,
870 Parser.Is_Switch (Parser.Current_Argument) := True;
871 Dummy := Goto_Next_Argument_In_Section (Parser);
877 Arg_Num => Parser.Current_Argument,
878 First => Parser.Current_Index,
880 Extra => Parser.Switch_Character);
881 Parser.Current_Index := Arg'Last + 1;
882 raise Invalid_Switch;
886 return Switches (Index_Switches);
890 -----------------------------------
891 -- Goto_Next_Argument_In_Section --
892 -----------------------------------
894 function Goto_Next_Argument_In_Section
895 (Parser : Opt_Parser) return Boolean
898 Parser.Current_Argument := Parser.Current_Argument + 1;
900 if Parser.Current_Argument > Parser.Arg_Count
901 or else Parser.Section (Parser.Current_Argument) = 0
904 Parser.Current_Argument := Parser.Current_Argument + 1;
906 if Parser.Current_Argument > Parser.Arg_Count then
907 Parser.Current_Index := 1;
911 exit when Parser.Section (Parser.Current_Argument) =
912 Parser.Current_Section;
916 Parser.Current_Index :=
917 Argument (Parser, Parser.Current_Argument)'First;
920 end Goto_Next_Argument_In_Section;
926 procedure Goto_Section
927 (Name : String := "";
928 Parser : Opt_Parser := Command_Line_Parser)
933 Parser.In_Expansion := False;
936 Parser.Current_Argument := 1;
937 Parser.Current_Index := 1;
938 Parser.Current_Section := 1;
943 while Index <= Parser.Arg_Count loop
944 if Parser.Section (Index) = 0
945 and then Argument (Parser, Index) = Parser.Switch_Character & Name
947 Parser.Current_Argument := Index + 1;
948 Parser.Current_Index := 1;
950 if Parser.Current_Argument <= Parser.Arg_Count then
951 Parser.Current_Section :=
952 Parser.Section (Parser.Current_Argument);
955 -- Exit from loop if we have the start of another section
957 if Index = Parser.Section'Last
958 or else Parser.Section (Index + 1) /= 0
967 Parser.Current_Argument := Positive'Last;
968 Parser.Current_Index := 2; -- so that Get_Argument returns nothing
971 ----------------------------
972 -- Initialize_Option_Scan --
973 ----------------------------
975 procedure Initialize_Option_Scan
976 (Switch_Char : Character := '-';
977 Stop_At_First_Non_Switch : Boolean := False;
978 Section_Delimiters : String := "")
981 Internal_Initialize_Option_Scan
982 (Parser => Command_Line_Parser,
983 Switch_Char => Switch_Char,
984 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
985 Section_Delimiters => Section_Delimiters);
986 end Initialize_Option_Scan;
988 ----------------------------
989 -- Initialize_Option_Scan --
990 ----------------------------
992 procedure Initialize_Option_Scan
993 (Parser : out Opt_Parser;
994 Command_Line : GNAT.OS_Lib.Argument_List_Access;
995 Switch_Char : Character := '-';
996 Stop_At_First_Non_Switch : Boolean := False;
997 Section_Delimiters : String := "")
1002 if Command_Line = null then
1003 Parser := new Opt_Parser_Data (CL.Argument_Count);
1004 Internal_Initialize_Option_Scan
1006 Switch_Char => Switch_Char,
1007 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
1008 Section_Delimiters => Section_Delimiters);
1010 Parser := new Opt_Parser_Data (Command_Line'Length);
1011 Parser.Arguments := Command_Line;
1012 Internal_Initialize_Option_Scan
1014 Switch_Char => Switch_Char,
1015 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
1016 Section_Delimiters => Section_Delimiters);
1018 end Initialize_Option_Scan;
1020 -------------------------------------
1021 -- Internal_Initialize_Option_Scan --
1022 -------------------------------------
1024 procedure Internal_Initialize_Option_Scan
1025 (Parser : Opt_Parser;
1026 Switch_Char : Character;
1027 Stop_At_First_Non_Switch : Boolean;
1028 Section_Delimiters : String)
1030 Section_Num : Section_Number;
1031 Section_Index : Integer;
1033 Delimiter_Found : Boolean;
1036 pragma Warnings (Off, Discard);
1039 Parser.Current_Argument := 0;
1040 Parser.Current_Index := 0;
1041 Parser.In_Expansion := False;
1042 Parser.Switch_Character := Switch_Char;
1043 Parser.Stop_At_First := Stop_At_First_Non_Switch;
1044 Parser.Section := (others => 1);
1046 -- If we are using sections, we have to preprocess the command line to
1047 -- delimit them. A section can be repeated, so we just give each item
1048 -- on the command line a section number
1051 Section_Index := Section_Delimiters'First;
1052 while Section_Index <= Section_Delimiters'Last loop
1053 Last := Section_Index;
1054 while Last <= Section_Delimiters'Last
1055 and then Section_Delimiters (Last) /= ' '
1060 Delimiter_Found := False;
1061 Section_Num := Section_Num + 1;
1063 for Index in 1 .. Parser.Arg_Count loop
1064 pragma Assert (Argument (Parser, Index)'First = 1);
1065 if Argument (Parser, Index) /= ""
1066 and then Argument (Parser, Index)(1) = Parser.Switch_Character
1068 Argument (Parser, Index) = Parser.Switch_Character &
1070 (Section_Index .. Last - 1)
1072 Parser.Section (Index) := 0;
1073 Delimiter_Found := True;
1075 elsif Parser.Section (Index) = 0 then
1077 -- A previous section delimiter
1079 Delimiter_Found := False;
1081 elsif Delimiter_Found then
1082 Parser.Section (Index) := Section_Num;
1086 Section_Index := Last + 1;
1087 while Section_Index <= Section_Delimiters'Last
1088 and then Section_Delimiters (Section_Index) = ' '
1090 Section_Index := Section_Index + 1;
1094 Discard := Goto_Next_Argument_In_Section (Parser);
1095 end Internal_Initialize_Option_Scan;
1102 (Parser : Opt_Parser := Command_Line_Parser) return String
1105 if Parser.The_Parameter.First > Parser.The_Parameter.Last then
1106 return String'(1 .. 0 => ' ');
1108 return Argument
(Parser
, Parser
.The_Parameter
.Arg_Num
)
1109 (Parser
.The_Parameter
.First
.. Parser
.The_Parameter
.Last
);
1118 (Parser
: Opt_Parser
:= Command_Line_Parser
) return Character
1121 return Parser
.The_Separator
;
1128 procedure Set_Parameter
1129 (Variable
: out Parameter_Type
;
1133 Extra
: Character := ASCII
.NUL
)
1136 Variable
.Arg_Num
:= Arg_Num
;
1137 Variable
.First
:= First
;
1138 Variable
.Last
:= Last
;
1139 Variable
.Extra
:= Extra
;
1142 ---------------------
1143 -- Start_Expansion --
1144 ---------------------
1146 procedure Start_Expansion
1147 (Iterator
: out Expansion_Iterator
;
1149 Directory
: String := "";
1150 Basic_Regexp
: Boolean := True)
1152 Directory_Separator
: Character;
1153 pragma Import
(C
, Directory_Separator
, "__gnat_dir_separator");
1155 First
: Positive := Pattern
'First;
1156 Pat
: String := Pattern
;
1159 Canonical_Case_File_Name
(Pat
);
1160 Iterator
.Current_Depth
:= 1;
1162 -- If Directory is unspecified, use the current directory ("./" or ".\")
1164 if Directory
= "" then
1165 Iterator
.Dir_Name
(1 .. 2) := "." & Directory_Separator
;
1166 Iterator
.Start
:= 3;
1169 Iterator
.Dir_Name
(1 .. Directory
'Length) := Directory
;
1170 Iterator
.Start
:= Directory
'Length + 1;
1171 Canonical_Case_File_Name
(Iterator
.Dir_Name
(1 .. Directory
'Length));
1173 -- Make sure that the last character is a directory separator
1175 if Directory
(Directory
'Last) /= Directory_Separator
then
1176 Iterator
.Dir_Name
(Iterator
.Start
) := Directory_Separator
;
1177 Iterator
.Start
:= Iterator
.Start
+ 1;
1181 Iterator
.Levels
(1).Name_Last
:= Iterator
.Start
- 1;
1183 -- Open the initial Directory, at depth 1
1185 GNAT
.Directory_Operations
.Open
1186 (Iterator
.Levels
(1).Dir
, Iterator
.Dir_Name
(1 .. Iterator
.Start
- 1));
1188 -- If in the current directory and the pattern starts with "./" or ".\",
1189 -- drop the "./" or ".\" from the pattern.
1191 if Directory
= "" and then Pat
'Length > 2
1192 and then Pat
(Pat
'First) = '.'
1193 and then Pat
(Pat
'First + 1) = Directory_Separator
1195 First
:= Pat
'First + 2;
1199 GNAT
.Regexp
.Compile
(Pat
(First
.. Pat
'Last), Basic_Regexp
, True);
1201 Iterator
.Maximum_Depth
:= 1;
1203 -- Maximum_Depth is equal to 1 plus the number of directory separators
1206 for Index
in First
.. Pat
'Last loop
1207 if Pat
(Index
) = Directory_Separator
then
1208 Iterator
.Maximum_Depth
:= Iterator
.Maximum_Depth
+ 1;
1209 exit when Iterator
.Maximum_Depth
= Max_Depth
;
1212 end Start_Expansion
;
1218 procedure Free
(Parser
: in out Opt_Parser
) is
1219 procedure Unchecked_Free
is new
1220 Ada
.Unchecked_Deallocation
(Opt_Parser_Data
, Opt_Parser
);
1222 if Parser
/= null and then Parser
/= Command_Line_Parser
then
1223 Free
(Parser
.Arguments
);
1224 Unchecked_Free
(Parser
);
1232 procedure Define_Alias
1233 (Config
: in out Command_Line_Configuration
;
1236 Section
: String := "")
1238 Def
: Alias_Definition
;
1241 if Config
= null then
1242 Config
:= new Command_Line_Configuration_Record
;
1245 Def
.Alias
:= new String'(Switch);
1246 Def.Expansion := new String'(Expanded
);
1247 Def
.Section
:= new String'(Section);
1248 Add (Config.Aliases, Def);
1255 procedure Define_Prefix
1256 (Config : in out Command_Line_Configuration;
1260 if Config = null then
1261 Config := new Command_Line_Configuration_Record;
1264 Add (Config.Prefixes, new String'(Prefix
));
1272 (Config
: in out Command_Line_Configuration
;
1273 Switch
: Switch_Definition
)
1275 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
1276 (Switch_Definitions
, Switch_Definitions_List
);
1278 Tmp
: Switch_Definitions_List
;
1281 if Config
= null then
1282 Config
:= new Command_Line_Configuration_Record
;
1285 Tmp
:= Config
.Switches
;
1288 Config
.Switches
:= new Switch_Definitions
(1 .. 1);
1290 Config
.Switches
:= new Switch_Definitions
(1 .. Tmp
'Length + 1);
1291 Config
.Switches
(1 .. Tmp
'Length) := Tmp
.all;
1292 Unchecked_Free
(Tmp
);
1295 if Switch
.Switch
/= null and then Switch
.Switch
.all = "*" then
1296 Config
.Star_Switch
:= True;
1299 Config
.Switches
(Config
.Switches
'Last) := Switch
;
1307 (Def
: in out Alias_Definitions_List
;
1308 Alias
: Alias_Definition
)
1310 procedure Unchecked_Free
is new
1311 Ada
.Unchecked_Deallocation
1312 (Alias_Definitions
, Alias_Definitions_List
);
1314 Tmp
: Alias_Definitions_List
:= Def
;
1318 Def
:= new Alias_Definitions
(1 .. 1);
1320 Def
:= new Alias_Definitions
(1 .. Tmp
'Length + 1);
1321 Def
(1 .. Tmp
'Length) := Tmp
.all;
1322 Unchecked_Free
(Tmp
);
1325 Def
(Def
'Last) := Alias
;
1328 ---------------------------
1329 -- Initialize_Switch_Def --
1330 ---------------------------
1332 procedure Initialize_Switch_Def
1333 (Def
: out Switch_Definition
;
1334 Switch
: String := "";
1335 Long_Switch
: String := "";
1336 Help
: String := "";
1337 Section
: String := "";
1338 Argument
: String := "ARG")
1340 P1
, P2
: Switch_Parameter_Type
:= Parameter_None
;
1341 Last1
, Last2
: Integer;
1344 if Switch
/= "" then
1345 Def
.Switch
:= new String'(Switch);
1346 Decompose_Switch (Switch, P1, Last1);
1349 if Long_Switch /= "" then
1350 Def.Long_Switch := new String'(Long_Switch
);
1351 Decompose_Switch
(Long_Switch
, P2
, Last2
);
1354 if Switch
/= "" and then Long_Switch
/= "" then
1355 if (P1
= Parameter_None
and then P2
/= P1
)
1356 or else (P2
= Parameter_None
and then P1
/= P2
)
1357 or else (P1
= Parameter_Optional
and then P2
/= P1
)
1358 or else (P2
= Parameter_Optional
and then P2
/= P1
)
1360 raise Invalid_Switch
1361 with "Inconsistent parameter types for "
1362 & Switch
& " and " & Long_Switch
;
1366 if Section
/= "" then
1367 Def
.Section
:= new String'(Section);
1370 if Argument /= "ARG" then
1371 Def.Argument := new String'(Argument
);
1375 Def
.Help
:= new String'(Help);
1377 end Initialize_Switch_Def;
1383 procedure Define_Switch
1384 (Config : in out Command_Line_Configuration;
1385 Switch : String := "";
1386 Long_Switch : String := "";
1387 Help : String := "";
1388 Section : String := "";
1389 Argument : String := "ARG")
1391 Def : Switch_Definition;
1393 if Switch /= "" or else Long_Switch /= "" then
1394 Initialize_Switch_Def
1395 (Def, Switch, Long_Switch, Help, Section, Argument);
1404 procedure Define_Switch
1405 (Config : in out Command_Line_Configuration;
1406 Output : access Boolean;
1407 Switch : String := "";
1408 Long_Switch : String := "";
1409 Help : String := "";
1410 Section : String := "";
1411 Value : Boolean := True)
1413 Def : Switch_Definition (Switch_Boolean);
1415 if Switch /= "" or else Long_Switch /= "" then
1416 Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
1417 Def.Boolean_Output := Output.all'Unchecked_Access;
1418 Def.Boolean_Value := Value;
1427 procedure Define_Switch
1428 (Config : in out Command_Line_Configuration;
1429 Output : access Integer;
1430 Switch : String := "";
1431 Long_Switch : String := "";
1432 Help : String := "";
1433 Section : String := "";
1434 Initial : Integer := 0;
1435 Default : Integer := 1;
1436 Argument : String := "ARG")
1438 Def : Switch_Definition (Switch_Integer);
1440 if Switch /= "" or else Long_Switch /= "" then
1441 Initialize_Switch_Def
1442 (Def, Switch, Long_Switch, Help, Section, Argument);
1443 Def.Integer_Output := Output.all'Unchecked_Access;
1444 Def.Integer_Default := Default;
1445 Def.Integer_Initial := Initial;
1454 procedure Define_Switch
1455 (Config : in out Command_Line_Configuration;
1456 Output : access GNAT.Strings.String_Access;
1457 Switch : String := "";
1458 Long_Switch : String := "";
1459 Help : String := "";
1460 Section : String := "";
1461 Argument : String := "ARG")
1463 Def : Switch_Definition (Switch_String);
1465 if Switch /= "" or else Long_Switch /= "" then
1466 Initialize_Switch_Def
1467 (Def, Switch, Long_Switch, Help, Section, Argument);
1468 Def.String_Output := Output.all'Unchecked_Access;
1473 --------------------
1474 -- Define_Section --
1475 --------------------
1477 procedure Define_Section
1478 (Config : in out Command_Line_Configuration;
1482 if Config = null then
1483 Config := new Command_Line_Configuration_Record;
1486 Add (Config.Sections, new String'(Section
));
1489 --------------------
1490 -- Foreach_Switch --
1491 --------------------
1493 procedure Foreach_Switch
1494 (Config
: Command_Line_Configuration
;
1498 if Config
/= null and then Config
.Switches
/= null then
1499 for J
in Config
.Switches
'Range loop
1500 if (Section
= "" and then Config
.Switches
(J
).Section
= null)
1502 (Config
.Switches
(J
).Section
/= null
1503 and then Config
.Switches
(J
).Section
.all = Section
)
1505 exit when Config
.Switches
(J
).Switch
/= null
1506 and then not Callback
(Config
.Switches
(J
).Switch
.all, J
);
1508 exit when Config
.Switches
(J
).Long_Switch
/= null
1510 not Callback
(Config
.Switches
(J
).Long_Switch
.all, J
);
1520 function Get_Switches
1521 (Config
: Command_Line_Configuration
;
1522 Switch_Char
: Character := '-';
1523 Section
: String := "") return String
1525 Ret
: Ada
.Strings
.Unbounded
.Unbounded_String
;
1526 use Ada
.Strings
.Unbounded
;
1528 function Add_Switch
(S
: String; Index
: Integer) return Boolean;
1529 -- Add a switch to Ret
1535 function Add_Switch
(S
: String; Index
: Integer) return Boolean is
1536 pragma Unreferenced
(Index
);
1539 Ret
:= "*" & Ret
; -- Always first
1540 elsif S
(S
'First) = Switch_Char
then
1541 Append
(Ret
, " " & S
(S
'First + 1 .. S
'Last));
1543 Append
(Ret
, " " & S
);
1550 pragma Unreferenced
(Tmp
);
1552 procedure Foreach
is new Foreach_Switch
(Add_Switch
);
1554 -- Start of processing for Get_Switches
1557 if Config
= null then
1561 Foreach
(Config
, Section
=> Section
);
1563 -- Add relevant aliases
1565 if Config
.Aliases
/= null then
1566 for A
in Config
.Aliases
'Range loop
1567 if Config
.Aliases
(A
).Section
.all = Section
then
1568 Tmp
:= Add_Switch
(Config
.Aliases
(A
).Alias
.all, -1);
1573 return To_String
(Ret
);
1576 ------------------------
1577 -- Section_Delimiters --
1578 ------------------------
1580 function Section_Delimiters
1581 (Config
: Command_Line_Configuration
) return String
1583 use Ada
.Strings
.Unbounded
;
1584 Result
: Unbounded_String
;
1587 if Config
/= null and then Config
.Sections
/= null then
1588 for S
in Config
.Sections
'Range loop
1589 Append
(Result
, " " & Config
.Sections
(S
).all);
1593 return To_String
(Result
);
1594 end Section_Delimiters
;
1596 -----------------------
1597 -- Set_Configuration --
1598 -----------------------
1600 procedure Set_Configuration
1601 (Cmd
: in out Command_Line
;
1602 Config
: Command_Line_Configuration
)
1605 Cmd
.Config
:= Config
;
1606 end Set_Configuration
;
1608 -----------------------
1609 -- Get_Configuration --
1610 -----------------------
1612 function Get_Configuration
1613 (Cmd
: Command_Line
) return Command_Line_Configuration
1617 end Get_Configuration
;
1619 ----------------------
1620 -- Set_Command_Line --
1621 ----------------------
1623 procedure Set_Command_Line
1624 (Cmd
: in out Command_Line
;
1626 Getopt_Description
: String := "";
1627 Switch_Char
: Character := '-')
1629 Tmp
: Argument_List_Access
;
1630 Parser
: Opt_Parser
;
1632 Section
: String_Access
:= null;
1634 function Real_Full_Switch
1636 Parser
: Opt_Parser
) return String;
1637 -- Ensure that the returned switch value contains the Switch_Char prefix
1640 ----------------------
1641 -- Real_Full_Switch --
1642 ----------------------
1644 function Real_Full_Switch
1646 Parser
: Opt_Parser
) return String
1650 return Full_Switch
(Parser
);
1652 return Switch_Char
& Full_Switch
(Parser
);
1654 end Real_Full_Switch
;
1656 -- Start of processing for Set_Command_Line
1659 Free
(Cmd
.Expanded
);
1662 if Switches
/= "" then
1663 Tmp
:= Argument_String_To_List
(Switches
);
1664 Initialize_Option_Scan
(Parser
, Tmp
, Switch_Char
);
1668 if Cmd
.Config
/= null then
1670 -- Do not use Getopt_Description in this case. Otherwise,
1671 -- if we have defined a prefix -gnaty, and two switches
1672 -- -gnatya and -gnatyL!, we would have a different behavior
1673 -- depending on the order of switches:
1675 -- -gnatyL1a => -gnatyL with argument "1a"
1676 -- -gnatyaL1 => -gnatya and -gnatyL with argument "1"
1678 -- This is because the call to Getopt below knows nothing
1679 -- about prefixes, and in the first case finds a valid
1680 -- switch with arguments, so returns it without analyzing
1681 -- the argument. In the second case, the switch matches "*",
1682 -- and is then decomposed below.
1684 -- Note: When a Command_Line object is associated with a
1685 -- Command_Line_Config (which is mostly the case for tools
1686 -- that let users choose the command line before spawning
1687 -- other tools, for instance IDEs), the configuration of
1688 -- the switches must be taken from the Command_Line_Config.
1690 S
:= Getopt
(Switches
=> "* " & Get_Switches
(Cmd
.Config
),
1691 Concatenate
=> False,
1695 S
:= Getopt
(Switches
=> "* " & Getopt_Description
,
1696 Concatenate
=> False,
1700 exit when S
= ASCII
.NUL
;
1703 Sw
: constant String := Real_Full_Switch
(S
, Parser
);
1704 Is_Section
: Boolean := False;
1707 if Cmd
.Config
/= null
1708 and then Cmd
.Config
.Sections
/= null
1711 for S
in Cmd
.Config
.Sections
'Range loop
1712 if Sw
= Cmd
.Config
.Sections
(S
).all then
1713 Section
:= Cmd
.Config
.Sections
(S
);
1716 exit Section_Search
;
1718 end loop Section_Search
;
1721 if not Is_Section
then
1722 if Section
= null then
1723 Add_Switch
(Cmd
, Sw
, Parameter
(Parser
));
1726 (Cmd
, Sw
, Parameter
(Parser
),
1727 Section
=> Section
.all);
1733 when Invalid_Parameter
=>
1735 -- Add it with no parameter, if that's the way the user
1738 -- Specify the separator in all cases, as the switch might
1739 -- need to be unaliased, and the alias might contain
1740 -- switches with parameters.
1742 if Section
= null then
1744 (Cmd
, Switch_Char
& Full_Switch
(Parser
));
1747 (Cmd
, Switch_Char
& Full_Switch
(Parser
),
1748 Section
=> Section
.all);
1755 end Set_Command_Line
;
1764 Substring
: String) return Boolean
1767 return Index
+ Substring
'Length - 1 <= Type_Str
'Last
1768 and then Type_Str
(Index
.. Index
+ Substring
'Length - 1) = Substring
;
1771 ------------------------
1772 -- Can_Have_Parameter --
1773 ------------------------
1775 function Can_Have_Parameter
(S
: String) return Boolean is
1777 if S
'Length <= 1 then
1782 when '!' |
':' |
'?' |
'=' =>
1787 end Can_Have_Parameter
;
1789 -----------------------
1790 -- Require_Parameter --
1791 -----------------------
1793 function Require_Parameter
(S
: String) return Boolean is
1795 if S
'Length <= 1 then
1800 when '!' |
':' |
'=' =>
1805 end Require_Parameter
;
1811 function Actual_Switch
(S
: String) return String is
1813 if S
'Length <= 1 then
1818 when '!' |
':' |
'?' |
'=' =>
1819 return S
(S
'First .. S
'Last - 1);
1825 ----------------------------
1826 -- For_Each_Simple_Switch --
1827 ----------------------------
1829 procedure For_Each_Simple_Switch
1830 (Config
: Command_Line_Configuration
;
1833 Parameter
: String := "";
1834 Unalias
: Boolean := True)
1836 function Group_Analysis
1838 Group
: String) return Boolean;
1839 -- Perform the analysis of a group of switches
1841 Found_In_Config
: Boolean := False;
1842 function Is_In_Config
1843 (Config_Switch
: String; Index
: Integer) return Boolean;
1844 -- If Switch is the same as Config_Switch, run the callback and sets
1845 -- Found_In_Config to True.
1847 function Starts_With
1848 (Config_Switch
: String; Index
: Integer) return Boolean;
1849 -- if Switch starts with Config_Switch, sets Found_In_Config to True.
1850 -- The return value is for the Foreach_Switch iterator.
1852 --------------------
1853 -- Group_Analysis --
1854 --------------------
1856 function Group_Analysis
1858 Group
: String) return Boolean
1863 function Analyze_Simple_Switch
1864 (Switch
: String; Index
: Integer) return Boolean;
1865 -- "Switches" is one of the switch definitions passed to the
1866 -- configuration, not one of the switches found on the command line.
1868 ---------------------------
1869 -- Analyze_Simple_Switch --
1870 ---------------------------
1872 function Analyze_Simple_Switch
1873 (Switch
: String; Index
: Integer) return Boolean
1875 pragma Unreferenced
(Index
);
1877 Full
: constant String := Prefix
& Group
(Idx
.. Group
'Last);
1879 Sw
: constant String := Actual_Switch
(Switch
);
1880 -- Switches definition minus argument definition
1886 -- Verify that sw starts with Prefix
1888 if Looking_At
(Sw
, Sw
'First, Prefix
)
1890 -- Verify that the group starts with sw
1892 and then Looking_At
(Full
, Full
'First, Sw
)
1894 Last
:= Idx
+ Sw
'Length - Prefix
'Length - 1;
1897 if Can_Have_Parameter
(Switch
) then
1899 -- Include potential parameter to the recursive call. Only
1900 -- numbers are allowed.
1902 while Last
< Group
'Last
1903 and then Group
(Last
+ 1) in '0' .. '9'
1909 if not Require_Parameter
(Switch
) or else Last
>= Param
then
1910 if Idx
= Group
'First
1911 and then Last
= Group
'Last
1912 and then Last
< Param
1914 -- The group only concerns a single switch. Do not
1915 -- perform recursive call.
1917 -- Note that we still perform a recursive call if
1918 -- a parameter is detected in the switch, as this
1919 -- is a way to correctly identify such a parameter
1927 -- Recursive call, using the detected parameter if any
1929 if Last
>= Param
then
1930 For_Each_Simple_Switch
1933 Prefix
& Group
(Idx
.. Param
- 1),
1934 Group
(Param
.. Last
));
1937 For_Each_Simple_Switch
1938 (Config
, Section
, Prefix
& Group
(Idx
.. Last
), "");
1947 end Analyze_Simple_Switch
;
1949 procedure Foreach
is new Foreach_Switch
(Analyze_Simple_Switch
);
1951 -- Start of processing for Group_Analysis
1955 while Idx
<= Group
'Last loop
1957 Foreach
(Config
, Section
);
1960 For_Each_Simple_Switch
1961 (Config
, Section
, Prefix
& Group
(Idx
), "");
1973 function Is_In_Config
1974 (Config_Switch
: String; Index
: Integer) return Boolean
1977 P
: Switch_Parameter_Type
;
1980 Decompose_Switch
(Config_Switch
, P
, Last
);
1982 if Config_Switch
(Config_Switch
'First .. Last
) = Switch
then
1984 when Parameter_None
=>
1985 if Parameter
= "" then
1986 Callback
(Switch
, "", "", Index
=> Index
);
1987 Found_In_Config
:= True;
1991 when Parameter_With_Optional_Space
=>
1992 Callback
(Switch
, " ", Parameter
, Index
=> Index
);
1993 Found_In_Config
:= True;
1996 when Parameter_With_Space_Or_Equal
=>
1997 Callback
(Switch
, "=", Parameter
, Index
=> Index
);
1998 Found_In_Config
:= True;
2001 when Parameter_No_Space
=>
2002 Callback
(Switch
, "", Parameter
, Index
);
2003 Found_In_Config
:= True;
2006 when Parameter_Optional
=>
2007 Callback
(Switch
, "", Parameter
, Index
);
2008 Found_In_Config
:= True;
2020 function Starts_With
2021 (Config_Switch
: String; Index
: Integer) return Boolean
2025 P
: Switch_Parameter_Type
;
2028 -- This function is called when we believe the parameter was
2029 -- specified as part of the switch, instead of separately. Thus we
2030 -- look in the config to find all possible switches.
2032 Decompose_Switch
(Config_Switch
, P
, Last
);
2035 (Switch
, Switch
'First,
2036 Config_Switch
(Config_Switch
'First .. Last
))
2038 -- Set first char of Param, and last char of Switch
2040 Param
:= Switch
'First + Last
;
2041 Last
:= Switch
'First + Last
- Config_Switch
'First;
2045 -- None is already handled in Is_In_Config
2047 when Parameter_None
=>
2050 when Parameter_With_Space_Or_Equal
=>
2051 if Param
<= Switch
'Last
2053 (Switch
(Param
) = ' ' or else Switch
(Param
) = '=')
2055 Callback
(Switch
(Switch
'First .. Last
),
2056 "=", Switch
(Param
+ 1 .. Switch
'Last), Index
);
2057 Found_In_Config
:= True;
2061 when Parameter_With_Optional_Space
=>
2062 if Param
<= Switch
'Last and then Switch
(Param
) = ' ' then
2066 Callback
(Switch
(Switch
'First .. Last
),
2067 " ", Switch
(Param
.. Switch
'Last), Index
);
2068 Found_In_Config
:= True;
2071 when Parameter_No_Space | Parameter_Optional
=>
2072 Callback
(Switch
(Switch
'First .. Last
),
2073 "", Switch
(Param
.. Switch
'Last), Index
);
2074 Found_In_Config
:= True;
2081 procedure Foreach_In_Config
is new Foreach_Switch
(Is_In_Config
);
2082 procedure Foreach_Starts_With
is new Foreach_Switch
(Starts_With
);
2084 -- Start of processing for For_Each_Simple_Switch
2087 -- First determine if the switch corresponds to one belonging to the
2088 -- configuration. If so, run callback and exit.
2090 -- ??? Is this necessary. On simple tests, we seem to have the same
2091 -- results with or without this call.
2093 Foreach_In_Config
(Config
, Section
);
2095 if Found_In_Config
then
2099 -- If adding a switch that can in fact be expanded through aliases,
2100 -- add separately each of its expansions.
2102 -- This takes care of expansions like "-T" -> "-gnatwrs", where the
2103 -- alias and its expansion do not have the same prefix. Given the order
2104 -- in which we do things here, the expansion of the alias will itself
2105 -- be checked for a common prefix and split into simple switches.
2108 and then Config
/= null
2109 and then Config
.Aliases
/= null
2111 for A
in Config
.Aliases
'Range loop
2112 if Config
.Aliases
(A
).Section
.all = Section
2113 and then Config
.Aliases
(A
).Alias
.all = Switch
2114 and then Parameter
= ""
2116 For_Each_Simple_Switch
2117 (Config
, Section
, Config
.Aliases
(A
).Expansion
.all, "");
2123 -- If adding a switch grouping several switches, add each of the simple
2124 -- switches instead.
2126 if Config
/= null and then Config
.Prefixes
/= null then
2127 for P
in Config
.Prefixes
'Range loop
2128 if Switch
'Length > Config
.Prefixes
(P
)'Length + 1
2130 Looking_At
(Switch
, Switch
'First, Config
.Prefixes
(P
).all)
2132 -- Alias expansion will be done recursively
2134 if Config
.Switches
= null then
2135 for S
in Switch
'First + Config
.Prefixes
(P
)'Length
2138 For_Each_Simple_Switch
2140 Config
.Prefixes
(P
).all & Switch
(S
), "");
2145 elsif Group_Analysis
2146 (Config
.Prefixes
(P
).all,
2148 (Switch
'First + Config
.Prefixes
(P
)'Length .. Switch
'Last))
2150 -- Recursive calls already done on each switch of the group:
2151 -- Return without executing Callback.
2159 -- Test if added switch is a known switch with parameter attached
2160 -- instead of being specified separately
2163 and then Config
/= null
2164 and then Config
.Switches
/= null
2166 Found_In_Config
:= False;
2167 Foreach_Starts_With
(Config
, Section
);
2169 if Found_In_Config
then
2174 -- The switch is invalid in the config, but we still want to report it.
2175 -- The config could, for instance, include "*" to specify it accepts
2178 Callback
(Switch
, " ", Parameter
, Index
=> -1);
2179 end For_Each_Simple_Switch
;
2185 procedure Add_Switch
2186 (Cmd
: in out Command_Line
;
2188 Parameter
: String := "";
2189 Separator
: Character := ASCII
.NUL
;
2190 Section
: String := "";
2191 Add_Before
: Boolean := False)
2194 pragma Unreferenced
(Success
);
2196 Add_Switch
(Cmd
, Switch
, Parameter
, Separator
,
2197 Section
, Add_Before
, Success
);
2204 procedure Add_Switch
2205 (Cmd
: in out Command_Line
;
2207 Parameter
: String := "";
2208 Separator
: Character := ASCII
.NUL
;
2209 Section
: String := "";
2210 Add_Before
: Boolean := False;
2211 Success
: out Boolean)
2213 procedure Add_Simple_Switch
2218 -- Add a new switch that has had all its aliases expanded, and switches
2219 -- ungrouped. We know there are no more aliases in Switches.
2221 -----------------------
2222 -- Add_Simple_Switch --
2223 -----------------------
2225 procedure Add_Simple_Switch
2235 and then Cmd
.Config
/= null
2236 and then not Cmd
.Config
.Star_Switch
2238 raise Invalid_Switch
2239 with "Invalid switch " & Simple
;
2242 if Separator
/= ASCII
.NUL
then
2245 elsif Sepa
= "" then
2248 Sep
:= Sepa
(Sepa
'First);
2251 if Cmd
.Expanded
= null then
2252 Cmd
.Expanded
:= new Argument_List
'(1 .. 1 => new String'(Simple
));
2256 new Argument_List
'(1 .. 1 => new String'(Sep
& Param
));
2258 Cmd
.Params
:= new Argument_List
'(1 .. 1 => null);
2261 if Section = "" then
2262 Cmd.Sections := new Argument_List'(1 .. 1 => null);
2265 new Argument_List
'(1 .. 1 => new String'(Section
));
2269 -- Do we already have this switch?
2271 for C
in Cmd
.Expanded
'Range loop
2272 if Cmd
.Expanded
(C
).all = Simple
2274 ((Cmd
.Params
(C
) = null and then Param
= "")
2276 (Cmd
.Params
(C
) /= null
2277 and then Cmd
.Params
(C
).all = Sep
& Param
))
2279 ((Cmd
.Sections
(C
) = null and then Section
= "")
2281 (Cmd
.Sections
(C
) /= null
2282 and then Cmd
.Sections
(C
).all = Section
))
2288 -- Inserting at least one switch
2291 Add
(Cmd
.Expanded
, new String'(Simple), Add_Before);
2296 new String'(Sep
& Param
),
2305 if Section
= "" then
2313 new String'(Section),
2317 end Add_Simple_Switch;
2319 procedure Add_Simple_Switches is
2320 new For_Each_Simple_Switch (Add_Simple_Switch);
2324 Section_Valid : Boolean := False;
2326 -- Start of processing for Add_Switch
2329 if Section /= "" and then Cmd.Config /= null then
2330 for S in Cmd.Config.Sections'Range loop
2331 if Section = Cmd.Config.Sections (S).all then
2332 Section_Valid := True;
2337 if not Section_Valid then
2338 raise Invalid_Section;
2343 Add_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
2344 Free (Cmd.Coalesce);
2351 procedure Remove (Line : in out Argument_List_Access; Index : Integer) is
2352 Tmp : Argument_List_Access := Line;
2355 Line := new Argument_List (Tmp'First .. Tmp'Last - 1);
2357 if Index /= Tmp'First then
2358 Line (Tmp'First .. Index - 1) := Tmp (Tmp'First .. Index - 1);
2363 if Index /= Tmp'Last then
2364 Line (Index .. Tmp'Last - 1) := Tmp (Index + 1 .. Tmp'Last);
2367 Unchecked_Free (Tmp);
2375 (Line : in out Argument_List_Access;
2376 Str : String_Access;
2377 Before : Boolean := False)
2379 Tmp : Argument_List_Access := Line;
2383 Line := new Argument_List (Tmp'First .. Tmp'Last + 1);
2386 Line (Tmp'First) := Str;
2387 Line (Tmp'First + 1 .. Tmp'Last + 1) := Tmp.all;
2389 Line (Tmp'Range) := Tmp.all;
2390 Line (Tmp'Last + 1) := Str;
2393 Unchecked_Free (Tmp);
2396 Line := new Argument_List'(1 .. 1 => Str
);
2404 procedure Remove_Switch
2405 (Cmd
: in out Command_Line
;
2407 Remove_All
: Boolean := False;
2408 Has_Parameter
: Boolean := False;
2409 Section
: String := "")
2412 pragma Unreferenced
(Success
);
2414 Remove_Switch
(Cmd
, Switch
, Remove_All
, Has_Parameter
, Section
, Success
);
2421 procedure Remove_Switch
2422 (Cmd
: in out Command_Line
;
2424 Remove_All
: Boolean := False;
2425 Has_Parameter
: Boolean := False;
2426 Section
: String := "";
2427 Success
: out Boolean)
2429 procedure Remove_Simple_Switch
2430 (Simple
, Separator
, Param
: String; Index
: Integer);
2431 -- Removes a simple switch, with no aliasing or grouping
2433 --------------------------
2434 -- Remove_Simple_Switch --
2435 --------------------------
2437 procedure Remove_Simple_Switch
2438 (Simple
, Separator
, Param
: String; Index
: Integer)
2441 pragma Unreferenced
(Param
, Separator
, Index
);
2444 if Cmd
.Expanded
/= null then
2445 C
:= Cmd
.Expanded
'First;
2446 while C
<= Cmd
.Expanded
'Last loop
2447 if Cmd
.Expanded
(C
).all = Simple
2450 or else (Cmd
.Sections
(C
) = null
2451 and then Section
= "")
2452 or else (Cmd
.Sections
(C
) /= null
2453 and then Section
= Cmd
.Sections
(C
).all))
2454 and then (not Has_Parameter
or else Cmd
.Params
(C
) /= null)
2456 Remove
(Cmd
.Expanded
, C
);
2457 Remove
(Cmd
.Params
, C
);
2458 Remove
(Cmd
.Sections
, C
);
2461 if not Remove_All
then
2470 end Remove_Simple_Switch
;
2472 procedure Remove_Simple_Switches
is
2473 new For_Each_Simple_Switch
(Remove_Simple_Switch
);
2475 -- Start of processing for Remove_Switch
2479 Remove_Simple_Switches
2480 (Cmd
.Config
, Section
, Switch
, "", Unalias
=> not Has_Parameter
);
2481 Free
(Cmd
.Coalesce
);
2488 procedure Remove_Switch
2489 (Cmd
: in out Command_Line
;
2492 Section
: String := "")
2494 procedure Remove_Simple_Switch
2495 (Simple
, Separator
, Param
: String; Index
: Integer);
2496 -- Removes a simple switch, with no aliasing or grouping
2498 --------------------------
2499 -- Remove_Simple_Switch --
2500 --------------------------
2502 procedure Remove_Simple_Switch
2503 (Simple
, Separator
, Param
: String; Index
: Integer)
2505 pragma Unreferenced
(Separator
, Index
);
2509 if Cmd
.Expanded
/= null then
2510 C
:= Cmd
.Expanded
'First;
2511 while C
<= Cmd
.Expanded
'Last loop
2512 if Cmd
.Expanded
(C
).all = Simple
2514 ((Cmd
.Sections
(C
) = null
2515 and then Section
= "")
2517 (Cmd
.Sections
(C
) /= null
2518 and then Section
= Cmd
.Sections
(C
).all))
2520 ((Cmd
.Params
(C
) = null and then Param
= "")
2522 (Cmd
.Params
(C
) /= null
2524 -- Ignore the separator stored in Parameter
2527 Cmd
.Params
(C
) (Cmd
.Params
(C
)'First + 1
2528 .. Cmd
.Params
(C
)'Last) = Param
))
2530 Remove
(Cmd
.Expanded
, C
);
2531 Remove
(Cmd
.Params
, C
);
2532 Remove
(Cmd
.Sections
, C
);
2534 -- The switch is necessarily unique by construction of
2544 end Remove_Simple_Switch
;
2546 procedure Remove_Simple_Switches
is
2547 new For_Each_Simple_Switch
(Remove_Simple_Switch
);
2549 -- Start of processing for Remove_Switch
2552 Remove_Simple_Switches
(Cmd
.Config
, Section
, Switch
, Parameter
);
2553 Free
(Cmd
.Coalesce
);
2556 --------------------
2557 -- Group_Switches --
2558 --------------------
2560 procedure Group_Switches
2561 (Cmd
: Command_Line
;
2562 Result
: Argument_List_Access
;
2563 Sections
: Argument_List_Access
;
2564 Params
: Argument_List_Access
)
2566 function Compatible_Parameter
(Param
: String_Access
) return Boolean;
2567 -- True when the parameter can be part of a group
2569 --------------------------
2570 -- Compatible_Parameter --
2571 --------------------------
2573 function Compatible_Parameter
(Param
: String_Access
) return Boolean is
2577 if Param
= null then
2580 -- We need parameters without separators
2582 elsif Param
(Param
'First) /= ASCII
.NUL
then
2585 -- Parameters must be all digits
2588 for J
in Param
'First + 1 .. Param
'Last loop
2589 if Param
(J
) not in '0' .. '9' then
2596 end Compatible_Parameter
;
2598 -- Local declarations
2600 Group
: Ada
.Strings
.Unbounded
.Unbounded_String
;
2602 use type Ada
.Strings
.Unbounded
.Unbounded_String
;
2604 -- Start of processing for Group_Switches
2607 if Cmd
.Config
= null or else Cmd
.Config
.Prefixes
= null then
2611 for P
in Cmd
.Config
.Prefixes
'Range loop
2612 Group
:= Ada
.Strings
.Unbounded
.Null_Unbounded_String
;
2615 for C
in Result
'Range loop
2616 if Result
(C
) /= null
2617 and then Compatible_Parameter
(Params
(C
))
2621 Cmd
.Config
.Prefixes
(P
).all)
2623 -- If we are still in the same section, group the switches
2627 (Sections
(C
) = null
2628 and then Sections
(First
) = null)
2630 (Sections
(C
) /= null
2631 and then Sections
(First
) /= null
2632 and then Sections
(C
).all = Sections
(First
).all)
2637 (Result
(C
)'First + Cmd
.Config
.Prefixes
(P
)'Length ..
2640 if Params
(C
) /= null then
2643 Params
(C
) (Params
(C
)'First + 1 .. Params
(C
)'Last);
2653 -- We changed section: we put the grouped switches to the first
2654 -- place, on continue with the new section.
2659 (Cmd.Config.Prefixes (P).all &
2660 Ada.Strings.Unbounded.To_String (Group));
2662 Ada.Strings.Unbounded.To_Unbounded_String
2664 (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2674 (Cmd
.Config
.Prefixes
(P
).all &
2675 Ada
.Strings
.Unbounded
.To_String
(Group
));
2680 --------------------
2681 -- Alias_Switches --
2682 --------------------
2684 procedure Alias_Switches
2685 (Cmd
: Command_Line
;
2686 Result
: Argument_List_Access
;
2687 Params
: Argument_List_Access
)
2692 procedure Check_Cb
(Switch
, Separator
, Param
: String; Index
: Integer);
2693 -- Checks whether the command line contains [Switch]. Sets the global
2694 -- variable [Found] appropriately. This is called for each simple switch
2695 -- that make up an alias, to know whether the alias should be applied.
2697 procedure Remove_Cb
(Switch
, Separator
, Param
: String; Index
: Integer);
2698 -- Remove the simple switch [Switch] from the command line, since it is
2699 -- part of a simpler alias
2706 (Switch
, Separator
, Param
: String; Index
: Integer)
2708 pragma Unreferenced
(Separator
, Index
);
2712 for E
in Result
'Range loop
2713 if Result
(E
) /= null
2716 or else Params
(E
) (Params
(E
)'First + 1 ..
2717 Params
(E
)'Last) = Param
)
2718 and then Result
(E
).all = Switch
2732 procedure Remove_Cb
(Switch
, Separator
, Param
: String; Index
: Integer)
2734 pragma Unreferenced
(Separator
, Index
);
2737 for E
in Result
'Range loop
2738 if Result
(E
) /= null
2741 or else Params
(E
) (Params
(E
)'First + 1
2742 .. Params
(E
)'Last) = Param
)
2743 and then Result
(E
).all = Switch
2756 procedure Check_All
is new For_Each_Simple_Switch
(Check_Cb
);
2757 procedure Remove_All
is new For_Each_Simple_Switch
(Remove_Cb
);
2759 -- Start of processing for Alias_Switches
2762 if Cmd
.Config
= null or else Cmd
.Config
.Aliases
= null then
2766 for A
in Cmd
.Config
.Aliases
'Range loop
2768 -- Compute the various simple switches that make up the alias. We
2769 -- split the expansion into as many simple switches as possible, and
2770 -- then check whether the expanded command line has all of them.
2773 Check_All
(Cmd
.Config
,
2774 Switch
=> Cmd
.Config
.Aliases
(A
).Expansion
.all,
2775 Section
=> Cmd
.Config
.Aliases
(A
).Section
.all);
2778 First
:= Integer'Last;
2779 Remove_All
(Cmd
.Config
,
2780 Switch
=> Cmd
.Config
.Aliases
(A
).Expansion
.all,
2781 Section
=> Cmd
.Config
.Aliases
(A
).Section
.all);
2782 Result
(First
) := new String'(Cmd.Config.Aliases (A).Alias.all);
2791 procedure Sort_Sections
2792 (Line : GNAT.OS_Lib.Argument_List_Access;
2793 Sections : GNAT.OS_Lib.Argument_List_Access;
2794 Params : GNAT.OS_Lib.Argument_List_Access)
2796 Sections_List : Argument_List_Access :=
2797 new Argument_List'(1 .. 1 => null);
2799 Old_Line
: constant Argument_List
:= Line
.all;
2800 Old_Sections
: constant Argument_List
:= Sections
.all;
2801 Old_Params
: constant Argument_List
:= Params
.all;
2809 -- First construct a list of all sections
2811 for E
in Line
'Range loop
2812 if Sections
(E
) /= null then
2814 for S
in Sections_List
'Range loop
2815 if (Sections_List
(S
) = null and then Sections
(E
) = null)
2817 (Sections_List
(S
) /= null
2818 and then Sections
(E
) /= null
2819 and then Sections_List
(S
).all = Sections
(E
).all)
2827 Add
(Sections_List
, Sections
(E
));
2832 Index
:= Line
'First;
2834 for S
in Sections_List
'Range loop
2835 for E
in Old_Line
'Range loop
2836 if (Sections_List
(S
) = null and then Old_Sections
(E
) = null)
2838 (Sections_List
(S
) /= null
2839 and then Old_Sections
(E
) /= null
2840 and then Sections_List
(S
).all = Old_Sections
(E
).all)
2842 Line
(Index
) := Old_Line
(E
);
2843 Sections
(Index
) := Old_Sections
(E
);
2844 Params
(Index
) := Old_Params
(E
);
2850 Unchecked_Free
(Sections_List
);
2858 (Cmd
: in out Command_Line
;
2859 Iter
: in out Command_Line_Iterator
;
2860 Expanded
: Boolean := False)
2863 if Cmd
.Expanded
= null then
2868 -- Reorder the expanded line so that sections are grouped
2870 Sort_Sections
(Cmd
.Expanded
, Cmd
.Sections
, Cmd
.Params
);
2872 -- Coalesce the switches as much as possible
2875 and then Cmd
.Coalesce
= null
2877 Cmd
.Coalesce
:= new Argument_List
(Cmd
.Expanded
'Range);
2878 for E
in Cmd
.Expanded
'Range loop
2879 Cmd
.Coalesce
(E
) := new String'(Cmd.Expanded (E).all);
2882 Free (Cmd.Coalesce_Sections);
2883 Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range);
2884 for E in Cmd.Sections'Range loop
2885 Cmd.Coalesce_Sections (E) :=
2886 (if Cmd.Sections (E) = null then null
2887 else new String'(Cmd
.Sections
(E
).all));
2890 Free
(Cmd
.Coalesce_Params
);
2891 Cmd
.Coalesce_Params
:= new Argument_List
(Cmd
.Params
'Range);
2892 for E
in Cmd
.Params
'Range loop
2893 Cmd
.Coalesce_Params
(E
) :=
2894 (if Cmd
.Params
(E
) = null then null
2895 else new String'(Cmd.Params (E).all));
2898 -- Not a clone, since we will not modify the parameters anyway
2900 Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Params);
2902 (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Coalesce_Params);
2906 Iter.List := Cmd.Expanded;
2907 Iter.Params := Cmd.Params;
2908 Iter.Sections := Cmd.Sections;
2910 Iter.List := Cmd.Coalesce;
2911 Iter.Params := Cmd.Coalesce_Params;
2912 Iter.Sections := Cmd.Coalesce_Sections;
2915 if Iter.List = null then
2916 Iter.Current := Integer'Last;
2918 Iter.Current := Iter.List'First - 1;
2923 --------------------
2924 -- Current_Switch --
2925 --------------------
2927 function Current_Switch (Iter : Command_Line_Iterator) return String is
2929 return Iter.List (Iter.Current).all;
2932 --------------------
2933 -- Is_New_Section --
2934 --------------------
2936 function Is_New_Section (Iter : Command_Line_Iterator) return Boolean is
2937 Section : constant String := Current_Section (Iter);
2940 if Iter.Sections = null then
2943 elsif Iter.Current = Iter.Sections'First
2944 or else Iter.Sections (Iter.Current - 1) = null
2946 return Section /= "";
2949 return Section /= Iter.Sections (Iter.Current - 1).all;
2953 ---------------------
2954 -- Current_Section --
2955 ---------------------
2957 function Current_Section (Iter : Command_Line_Iterator) return String is
2959 if Iter.Sections = null
2960 or else Iter.Current > Iter.Sections'Last
2961 or else Iter.Sections (Iter.Current) = null
2966 return Iter.Sections (Iter.Current).all;
2967 end Current_Section;
2969 -----------------------
2970 -- Current_Separator --
2971 -----------------------
2973 function Current_Separator (Iter : Command_Line_Iterator) return String is
2975 if Iter.Params = null
2976 or else Iter.Current > Iter.Params'Last
2977 or else Iter.Params (Iter.Current) = null
2983 Sep : constant Character :=
2984 Iter.Params (Iter.Current) (Iter.Params (Iter.Current)'First);
2986 if Sep = ASCII.NUL then
2993 end Current_Separator;
2995 -----------------------
2996 -- Current_Parameter --
2997 -----------------------
2999 function Current_Parameter (Iter : Command_Line_Iterator) return String is
3001 if Iter.Params = null
3002 or else Iter.Current > Iter.Params'Last
3003 or else Iter.Params (Iter.Current) = null
3008 -- Return result, skipping separator
3011 P : constant String := Iter.Params (Iter.Current).all;
3013 return P (P'First + 1 .. P'Last);
3016 end Current_Parameter;
3022 function Has_More (Iter : Command_Line_Iterator) return Boolean is
3024 return Iter.List /= null and then Iter.Current <= Iter.List'Last;
3031 procedure Next (Iter : in out Command_Line_Iterator) is
3033 Iter.Current := Iter.Current + 1;
3034 while Iter.Current <= Iter.List'Last
3035 and then Iter.List (Iter.Current) = null
3037 Iter.Current := Iter.Current + 1;
3045 procedure Free (Config : in out Command_Line_Configuration) is
3046 procedure Unchecked_Free is new
3047 Ada.Unchecked_Deallocation
3048 (Switch_Definitions, Switch_Definitions_List);
3050 procedure Unchecked_Free is new
3051 Ada.Unchecked_Deallocation
3052 (Alias_Definitions, Alias_Definitions_List);
3055 if Config /= null then
3056 Free (Config.Prefixes);
3057 Free (Config.Sections);
3058 Free (Config.Usage);
3060 Free (Config.Help_Msg);
3062 if Config.Aliases /= null then
3063 for A in Config.Aliases'Range loop
3064 Free (Config.Aliases (A).Alias);
3065 Free (Config.Aliases (A).Expansion);
3066 Free (Config.Aliases (A).Section);
3069 Unchecked_Free (Config.Aliases);
3072 if Config.Switches /= null then
3073 for S in Config.Switches'Range loop
3074 Free (Config.Switches (S).Switch);
3075 Free (Config.Switches (S).Long_Switch);
3076 Free (Config.Switches (S).Help);
3077 Free (Config.Switches (S).Section);
3078 Free (Config.Switches (S).Argument);
3081 Unchecked_Free (Config.Switches);
3084 Unchecked_Free (Config);
3092 procedure Free (Cmd : in out Command_Line) is
3094 Free (Cmd.Expanded);
3095 Free (Cmd.Coalesce);
3096 Free (Cmd.Coalesce_Sections);
3097 Free (Cmd.Coalesce_Params);
3099 Free (Cmd.Sections);
3107 (Config : in out Command_Line_Configuration;
3108 Usage : String := "[switches] [arguments]";
3109 Help : String := "";
3110 Help_Msg : String := "")
3113 if Config = null then
3114 Config := new Command_Line_Configuration_Record;
3117 Free (Config.Usage);
3119 Free (Config.Help_Msg);
3121 Config.Usage := new String'(Usage
);
3122 Config
.Help
:= new String'(Help);
3123 Config.Help_Msg := new String'(Help_Msg
);
3130 procedure Display_Help
(Config
: Command_Line_Configuration
) is
3131 function Switch_Name
3132 (Def
: Switch_Definition
;
3133 Section
: String) return String;
3134 -- Return the "-short, --long=ARG" string for Def.
3135 -- Returns "" if the switch is not in the section.
3138 (P
: Switch_Parameter_Type
;
3139 Name
: String := "ARG") return String;
3140 -- Return the display for a switch parameter
3142 procedure Display_Section_Help
(Section
: String);
3143 -- Display the help for a specific section ("" is the default section)
3145 --------------------------
3146 -- Display_Section_Help --
3147 --------------------------
3149 procedure Display_Section_Help
(Section
: String) is
3150 Max_Len
: Natural := 0;
3153 -- ??? Special display for "*"
3157 if Section
/= "" and then Config
.Switches
/= null then
3158 Put_Line
("Switches after " & Section
);
3161 -- Compute size of the switches column
3163 if Config
.Switches
/= null then
3164 for S
in Config
.Switches
'Range loop
3165 Max_Len
:= Natural'Max
3166 (Max_Len
, Switch_Name
(Config
.Switches
(S
), Section
)'Length);
3170 if Config
.Aliases
/= null then
3171 for A
in Config
.Aliases
'Range loop
3172 if Config
.Aliases
(A
).Section
.all = Section
then
3173 Max_Len
:= Natural'Max
3174 (Max_Len
, Config
.Aliases
(A
).Alias
'Length);
3179 -- Display the switches
3181 if Config
.Switches
/= null then
3182 for S
in Config
.Switches
'Range loop
3184 N
: constant String :=
3185 Switch_Name
(Config
.Switches
(S
), Section
);
3191 Put
((1 .. Max_Len
- N
'Length + 1 => ' '));
3193 if Config
.Switches
(S
).Help
/= null then
3194 Put
(Config
.Switches
(S
).Help
.all);
3203 -- Display the aliases
3205 if Config
.Aliases
/= null then
3206 for A
in Config
.Aliases
'Range loop
3207 if Config
.Aliases
(A
).Section
.all = Section
then
3209 Put
(Config
.Aliases
(A
).Alias
.all);
3210 Put
((1 .. Max_Len
- Config
.Aliases
(A
).Alias
'Length + 1
3212 Put
("Equivalent to " & Config
.Aliases
(A
).Expansion
.all);
3217 end Display_Section_Help
;
3224 (P
: Switch_Parameter_Type
;
3225 Name
: String := "ARG") return String
3229 when Parameter_None
=>
3232 when Parameter_With_Optional_Space
=>
3233 return " " & To_Upper
(Name
);
3235 when Parameter_With_Space_Or_Equal
=>
3236 return "=" & To_Upper
(Name
);
3238 when Parameter_No_Space
=>
3239 return To_Upper
(Name
);
3241 when Parameter_Optional
=>
3242 return '[' & To_Upper
(Name
) & ']';
3250 function Switch_Name
3251 (Def
: Switch_Definition
;
3252 Section
: String) return String
3254 use Ada
.Strings
.Unbounded
;
3255 Result
: Unbounded_String
;
3256 P1
, P2
: Switch_Parameter_Type
;
3257 Last1
, Last2
: Integer := 0;
3260 if (Section
= "" and then Def
.Section
= null)
3261 or else (Def
.Section
/= null and then Def
.Section
.all = Section
)
3263 if Def
.Switch
/= null and then Def
.Switch
.all = "*" then
3264 return "[any switch]";
3267 if Def
.Switch
/= null then
3268 Decompose_Switch
(Def
.Switch
.all, P1
, Last1
);
3269 Append
(Result
, Def
.Switch
(Def
.Switch
'First .. Last1
));
3271 if Def
.Long_Switch
/= null then
3272 Decompose_Switch
(Def
.Long_Switch
.all, P2
, Last2
);
3273 Append
(Result
, ", "
3274 & Def
.Long_Switch
(Def
.Long_Switch
'First .. Last2
));
3276 if Def
.Argument
= null then
3277 Append
(Result
, Param_Name
(P2
, "ARG"));
3279 Append
(Result
, Param_Name
(P2
, Def
.Argument
.all));
3283 if Def
.Argument
= null then
3284 Append
(Result
, Param_Name
(P1
, "ARG"));
3286 Append
(Result
, Param_Name
(P1
, Def
.Argument
.all));
3290 -- Def.Switch is null (Long_Switch must be non-null)
3293 Decompose_Switch
(Def
.Long_Switch
.all, P2
, Last2
);
3295 Def
.Long_Switch
(Def
.Long_Switch
'First .. Last2
));
3297 if Def
.Argument
= null then
3298 Append
(Result
, Param_Name
(P2
, "ARG"));
3300 Append
(Result
, Param_Name
(P2
, Def
.Argument
.all));
3305 return To_String
(Result
);
3308 -- Start of processing for Display_Help
3311 if Config
= null then
3315 if Config
.Help
/= null and then Config
.Help
.all /= "" then
3316 Put_Line
(Config
.Help
.all);
3319 if Config
.Usage
/= null then
3322 (Ada
.Command_Line
.Command_Name
) & " " & Config
.Usage
.all);
3324 Put_Line
("Usage: " & Base_Name
(Ada
.Command_Line
.Command_Name
)
3325 & " [switches] [arguments]");
3328 if Config
.Help_Msg
/= null and then Config
.Help_Msg
.all /= "" then
3329 Put_Line
(Config
.Help_Msg
.all);
3332 Display_Section_Help
("");
3334 if Config
.Sections
/= null and then Config
.Switches
/= null then
3335 for S
in Config
.Sections
'Range loop
3336 Display_Section_Help
(Config
.Sections
(S
).all);
3347 (Config
: Command_Line_Configuration
;
3348 Callback
: Switch_Handler
:= null;
3349 Parser
: Opt_Parser
:= Command_Line_Parser
;
3350 Concatenate
: Boolean := True)
3352 Getopt_Switches
: String_Access
;
3353 C
: Character := ASCII
.NUL
;
3355 Empty_Name
: aliased constant String := "";
3356 Current_Section
: Integer := -1;
3357 Section_Name
: not null access constant String := Empty_Name
'Access;
3359 procedure Simple_Callback
3360 (Simple_Switch
: String;
3364 -- Needs comments ???
3366 procedure Do_Callback
(Switch
, Parameter
: String; Index
: Integer);
3372 procedure Do_Callback
(Switch
, Parameter
: String; Index
: Integer) is
3374 -- Do automatic handling when possible
3377 case Config
.Switches
(Index
).Typ
is
3378 when Switch_Untyped
=>
3379 null; -- no automatic handling
3381 when Switch_Boolean
=>
3382 Config
.Switches
(Index
).Boolean_Output
.all :=
3383 Config
.Switches
(Index
).Boolean_Value
;
3386 when Switch_Integer
=>
3388 if Parameter
= "" then
3389 Config
.Switches
(Index
).Integer_Output
.all :=
3390 Config
.Switches
(Index
).Integer_Default
;
3392 Config
.Switches
(Index
).Integer_Output
.all :=
3393 Integer'Value (Parameter
);
3397 when Constraint_Error
=>
3398 raise Invalid_Parameter
3399 with "Expected integer parameter for '"
3405 when Switch_String
=>
3406 Free
(Config
.Switches
(Index
).String_Output
.all);
3407 Config
.Switches
(Index
).String_Output
.all :=
3408 new String'(Parameter);
3414 -- Otherwise calls the user callback if one was defined
3416 if Callback /= null then
3417 Callback (Switch => Switch,
3418 Parameter => Parameter,
3419 Section => Section_Name.all);
3423 procedure For_Each_Simple
3424 is new For_Each_Simple_Switch (Simple_Callback);
3426 ---------------------
3427 -- Simple_Callback --
3428 ---------------------
3430 procedure Simple_Callback
3431 (Simple_Switch : String;
3436 pragma Unreferenced (Separator);
3438 Do_Callback (Switch => Simple_Switch,
3439 Parameter => Parameter,
3441 end Simple_Callback;
3443 -- Start of processing for Getopt
3446 -- Initialize sections
3448 if Config.Sections = null then
3449 Config.Sections := new Argument_List'(1 .. 0 => null);
3452 Internal_Initialize_Option_Scan
3454 Switch_Char
=> Parser
.Switch_Character
,
3455 Stop_At_First_Non_Switch
=> Parser
.Stop_At_First
,
3456 Section_Delimiters
=> Section_Delimiters
(Config
));
3458 Getopt_Switches
:= new String'
3459 (Get_Switches (Config, Parser.Switch_Character, Section_Name.all)
3462 -- Initialize output values for automatically handled switches
3464 if Config.Switches /= null then
3465 for S in Config.Switches'Range loop
3466 case Config.Switches (S).Typ is
3467 when Switch_Untyped =>
3468 null; -- Nothing to do
3470 when Switch_Boolean =>
3471 Config.Switches (S).Boolean_Output.all :=
3472 not Config.Switches (S).Boolean_Value;
3474 when Switch_Integer =>
3475 Config.Switches (S).Integer_Output.all :=
3476 Config.Switches (S).Integer_Initial;
3478 when Switch_String =>
3479 if Config.Switches (S).String_Output.all = null then
3480 Config.Switches (S).String_Output.all := new String'("");
3486 -- For all sections, and all switches within those sections
3489 C
:= Getopt
(Switches
=> Getopt_Switches
.all,
3490 Concatenate
=> Concatenate
,
3494 -- Full_Switch already includes the leading '-'
3496 Do_Callback
(Switch
=> Full_Switch
(Parser
),
3497 Parameter
=> Parameter
(Parser
),
3500 elsif C
/= ASCII
.NUL
then
3501 if Full_Switch
(Parser
) = "h"
3503 Full_Switch
(Parser
) = "-help"
3505 Display_Help
(Config
);
3506 raise Exit_From_Command_Line
;
3509 -- Do switch expansion if needed
3513 Section
=> Section_Name
.all,
3514 Switch
=> Parser
.Switch_Character
& Full_Switch
(Parser
),
3515 Parameter
=> Parameter
(Parser
));
3518 if Current_Section
= -1 then
3519 Current_Section
:= Config
.Sections
'First;
3521 Current_Section
:= Current_Section
+ 1;
3524 exit when Current_Section
> Config
.Sections
'Last;
3526 Section_Name
:= Config
.Sections
(Current_Section
);
3527 Goto_Section
(Section_Name
.all, Parser
);
3529 Free
(Getopt_Switches
);
3530 Getopt_Switches
:= new String'
3532 (Config, Parser.Switch_Character, Section_Name.all));
3536 Free (Getopt_Switches);
3539 when Invalid_Switch =>
3540 Free (Getopt_Switches);
3542 -- Message inspired by "ls" on Unix
3544 Put_Line (Standard_Error,
3545 Base_Name (Ada.Command_Line.Command_Name)
3546 & ": unrecognized option '"
3547 & Full_Switch (Parser)
3554 Free (Getopt_Switches);
3563 (Line : in out Command_Line;
3564 Args : out GNAT.OS_Lib.Argument_List_Access;
3565 Expanded : Boolean := False;
3566 Switch_Char : Character := '-')
3568 Iter : Command_Line_Iterator;
3569 Count : Natural := 0;
3572 Start (Line, Iter, Expanded => Expanded);
3573 while Has_More (Iter) loop
3574 if Is_New_Section (Iter) then
3582 Args := new Argument_List (1 .. Count);
3583 Count := Args'First;
3585 Start (Line, Iter, Expanded => Expanded);
3586 while Has_More (Iter) loop
3587 if Is_New_Section (Iter) then
3588 Args (Count) := new String'(Switch_Char
& Current_Section
(Iter
));
3592 Args
(Count
) := new String'(Current_Switch (Iter)
3593 & Current_Separator (Iter)
3594 & Current_Parameter (Iter));
3604 -- Note: Any change to the message displayed should also be done in
3605 -- gnatbind.adb that does not use this interface.
3607 procedure Try_Help is
3611 "try """ & Base_Name (Ada.Command_Line.Command_Name)
3612 & " --help"" for more information.");
3615 end GNAT.Command_Line;