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-2017, 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
: 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.
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;
491 Parameter_Type := Parameter_With_Space_Or_Equal;
492 Switch_Last := Switch'Last - 1;
495 Parameter_Type := Parameter_No_Space;
496 Switch_Last := Switch'Last - 1;
499 Parameter_Type := Parameter_Optional;
500 Switch_Last := Switch'Last - 1;
503 Parameter_Type := Parameter_None;
504 Switch_Last := Switch'Last;
506 end Decompose_Switch;
508 ----------------------------------
509 -- Find_Longest_Matching_Switch --
510 ----------------------------------
512 procedure Find_Longest_Matching_Switch
515 Index_In_Switches : out Integer;
516 Switch_Length : out Integer;
517 Param : out Switch_Parameter_Type)
520 Length : Natural := 1;
522 P : Switch_Parameter_Type;
525 Index_In_Switches := 0;
528 -- Remove all leading spaces first to make sure that Index points
529 -- at the start of the first switch.
531 Index := Switches'First;
532 while Index <= Switches'Last and then Switches (Index) = ' ' loop
536 while Index <= Switches'Last loop
538 -- Search the length of the parameter at this position in Switches
541 while Length <= Switches'Last
542 and then Switches (Length) /= ' '
544 Length := Length + 1;
547 -- Length now marks the separator after the current switch. Last will
548 -- mark the last character of the name of the switch.
550 if Length = Index + 1 then
554 Decompose_Switch (Switches (Index .. Length - 1), P, Last);
557 -- If it is the one we searched, it may be a candidate
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
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) = '=')
569 Index_In_Switches := Index;
570 Switch_Length := Last - Index + 1;
573 -- Look for the next switch in Switches
575 while Index <= Switches'Last
576 and then Switches (Index) /= ' '
583 end Find_Longest_Matching_Switch;
591 Concatenate : Boolean := True;
592 Parser : Opt_Parser := Command_Line_Parser) return Character
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
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))
611 -- By default, the switch will not have a parameter
613 Parser.The_Parameter :=
614 (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL);
615 Parser.The_Separator := ASCII.NUL;
618 Arg : constant String :=
619 Argument (Parser, Parser.Current_Argument);
620 Index_Switches : Natural := 0;
621 Max_Length : Natural := 0;
623 Param : Switch_Parameter_Type;
625 -- If we are on a new item, test if this might be a switch
627 if Parser.Current_Index = Arg'First then
628 if Arg = "" or else Arg (Arg'First) /= Parser.Switch_Character then
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.
634 if Switches (Switches'First) = '*' then
637 Arg_Num => Parser.Current_Argument,
640 Parser.Is_Switch (Parser.Current_Argument) := True;
641 Dummy := Goto_Next_Argument_In_Section (Parser);
645 if Parser.Stop_At_First then
646 Parser.Current_Argument := Positive'Last;
649 elsif not Goto_Next_Argument_In_Section (Parser) then
653 -- Recurse to get the next switch on the command line
659 -- We are on the first character of a new command line argument,
660 -- which starts with Switch_Character. Further analysis is needed.
662 Parser.Current_Index := Parser.Current_Index + 1;
663 Parser.Is_Switch (Parser.Current_Argument) := True;
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,
673 -- If switch is not accepted, it is either invalid or is returned
674 -- in the context of '*'.
676 if Index_Switches = 0 then
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
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".
687 -- * for short switches, wihtout Concatenate:
688 -- we should report the invalid switch as "-daf".
690 -- * for long switches:
691 -- if the commadn line is "--long" we should report --long
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
700 -- Long switch case (starting with double switch character)
702 if Arg (Arg'First + 1) = Parser.Switch_Character then
703 End_Index := Arg'Last;
709 (if Concatenate then Parser.Current_Index else Arg'Last);
712 if Switches /= "" and then Switches (Switches'First) = '*' then
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.
719 if Parser.Section (Parser.Current_Argument) = 0 then
721 -- A section transition should not be returned to the user
723 Dummy := Goto_Next_Argument_In_Section (Parser);
729 Arg_Num => Parser.Current_Argument,
730 First => Parser.Current_Index,
732 Extra => Parser.Switch_Character);
733 Parser.Is_Switch (Parser.Current_Argument) := True;
734 Dummy := Goto_Next_Argument_In_Section (Parser);
739 if Parser.Current_Index = Arg'First then
742 Arg_Num => Parser.Current_Argument,
743 First => Parser.Current_Index,
748 Arg_Num => Parser.Current_Argument,
749 First => Parser.Current_Index,
751 Extra => Parser.Switch_Character);
754 Parser.Current_Index := End_Index + 1;
756 raise Invalid_Switch;
759 End_Index := Parser.Current_Index + Max_Length - 1;
762 Arg_Num => Parser.Current_Argument,
763 First => Parser.Current_Index,
767 when Parameter_With_Optional_Space =>
768 if End_Index < Arg'Last then
770 (Parser.The_Parameter,
771 Arg_Num => Parser.Current_Argument,
772 First => End_Index + 1,
774 Dummy := Goto_Next_Argument_In_Section (Parser);
776 elsif Parser.Current_Argument < Parser.Arg_Count
777 and then Parser.Section (Parser.Current_Argument + 1) /= 0
779 Parser.Current_Argument := Parser.Current_Argument + 1;
780 Parser.The_Separator := ' ';
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);
790 Parser.Current_Index := End_Index + 1;
791 raise Invalid_Parameter;
794 when Parameter_With_Space_Or_Equal =>
796 -- If the switch is of the form <switch>=xxx
798 if End_Index < Arg'Last then
799 if Arg (End_Index + 1) = '='
800 and then End_Index + 1 < Arg'Last
802 Parser.The_Separator := '=';
804 (Parser.The_Parameter,
805 Arg_Num => Parser.Current_Argument,
806 First => End_Index + 2,
808 Dummy := Goto_Next_Argument_In_Section (Parser);
811 Parser.Current_Index := End_Index + 1;
812 raise Invalid_Parameter;
815 -- Case of switch of the form <switch> xxx
817 elsif Parser.Current_Argument < Parser.Arg_Count
818 and then Parser.Section (Parser.Current_Argument + 1) /= 0
820 Parser.Current_Argument := Parser.Current_Argument + 1;
821 Parser.The_Separator := ' ';
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);
831 Parser.Current_Index := End_Index + 1;
832 raise Invalid_Parameter;
835 when Parameter_No_Space =>
836 if End_Index < Arg'Last then
838 (Parser.The_Parameter,
839 Arg_Num => Parser.Current_Argument,
840 First => End_Index + 1,
842 Dummy := Goto_Next_Argument_In_Section (Parser);
845 Parser.Current_Index := End_Index + 1;
846 raise Invalid_Parameter;
849 when Parameter_Optional =>
850 if End_Index < Arg'Last then
852 (Parser.The_Parameter,
853 Arg_Num => Parser.Current_Argument,
854 First => End_Index + 1,
858 Dummy := Goto_Next_Argument_In_Section (Parser);
860 when Parameter_None =>
861 if Concatenate or else End_Index = Arg'Last then
862 Parser.Current_Index := End_Index + 1;
865 -- If Concatenate is False and the full argument is not
866 -- recognized as a switch, this is an invalid switch.
868 if Switches (Switches'First) = '*' then
871 Arg_Num => Parser.Current_Argument,
874 Parser.Is_Switch (Parser.Current_Argument) := True;
875 Dummy := Goto_Next_Argument_In_Section (Parser);
881 Arg_Num => Parser.Current_Argument,
882 First => Parser.Current_Index,
884 Extra => Parser.Switch_Character);
885 Parser.Current_Index := Arg'Last + 1;
886 raise Invalid_Switch;
890 return Switches (Index_Switches);
894 -----------------------------------
895 -- Goto_Next_Argument_In_Section --
896 -----------------------------------
898 function Goto_Next_Argument_In_Section
899 (Parser : Opt_Parser) return Boolean
902 Parser.Current_Argument := Parser.Current_Argument + 1;
904 if Parser.Current_Argument > Parser.Arg_Count
905 or else Parser.Section (Parser.Current_Argument) = 0
908 Parser.Current_Argument := Parser.Current_Argument + 1;
910 if Parser.Current_Argument > Parser.Arg_Count then
911 Parser.Current_Index := 1;
915 exit when Parser.Section (Parser.Current_Argument) =
916 Parser.Current_Section;
920 Parser.Current_Index :=
921 Argument (Parser, Parser.Current_Argument)'First;
924 end Goto_Next_Argument_In_Section;
930 procedure Goto_Section
931 (Name : String := "";
932 Parser : Opt_Parser := Command_Line_Parser)
937 Parser.In_Expansion := False;
940 Parser.Current_Argument := 1;
941 Parser.Current_Index := 1;
942 Parser.Current_Section := 1;
947 while Index <= Parser.Arg_Count loop
948 if Parser.Section (Index) = 0
949 and then Argument (Parser, Index) = Parser.Switch_Character & Name
951 Parser.Current_Argument := Index + 1;
952 Parser.Current_Index := 1;
954 if Parser.Current_Argument <= Parser.Arg_Count then
955 Parser.Current_Section :=
956 Parser.Section (Parser.Current_Argument);
959 -- Exit from loop if we have the start of another section
961 if Index = Parser.Section'Last
962 or else Parser.Section (Index + 1) /= 0
971 Parser.Current_Argument := Positive'Last;
972 Parser.Current_Index := 2; -- so that Get_Argument returns nothing
975 ----------------------------
976 -- Initialize_Option_Scan --
977 ----------------------------
979 procedure Initialize_Option_Scan
980 (Switch_Char : Character := '-';
981 Stop_At_First_Non_Switch : Boolean := False;
982 Section_Delimiters : String := "")
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;
992 ----------------------------
993 -- Initialize_Option_Scan --
994 ----------------------------
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 := "")
1006 if Command_Line = null then
1007 Parser := new Opt_Parser_Data (CL.Argument_Count);
1008 Internal_Initialize_Option_Scan
1010 Switch_Char => Switch_Char,
1011 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
1012 Section_Delimiters => Section_Delimiters);
1014 Parser := new Opt_Parser_Data (Command_Line'Length);
1015 Parser.Arguments := Command_Line;
1016 Internal_Initialize_Option_Scan
1018 Switch_Char => Switch_Char,
1019 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
1020 Section_Delimiters => Section_Delimiters);
1022 end Initialize_Option_Scan;
1024 -------------------------------------
1025 -- Internal_Initialize_Option_Scan --
1026 -------------------------------------
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)
1034 Section_Num : Section_Number;
1035 Section_Index : Integer;
1037 Delimiter_Found : Boolean;
1040 pragma Warnings (Off, Discard);
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);
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
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) /= ' '
1064 Delimiter_Found := False;
1065 Section_Num := Section_Num + 1;
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
1072 Argument (Parser, Index) = Parser.Switch_Character &
1074 (Section_Index .. Last - 1)
1076 Parser.Section (Index) := 0;
1077 Delimiter_Found := True;
1079 elsif Parser.Section (Index) = 0 then
1081 -- A previous section delimiter
1083 Delimiter_Found := False;
1085 elsif Delimiter_Found then
1086 Parser.Section (Index) := Section_Num;
1090 Section_Index := Last + 1;
1091 while Section_Index <= Section_Delimiters'Last
1092 and then Section_Delimiters (Section_Index) = ' '
1094 Section_Index := Section_Index + 1;
1098 Discard := Goto_Next_Argument_In_Section (Parser);
1099 end Internal_Initialize_Option_Scan;
1106 (Parser : Opt_Parser := Command_Line_Parser) return String
1109 if Parser.The_Parameter.First > Parser.The_Parameter.Last then
1110 return String'(1 .. 0 => ' ');
1112 return Argument
(Parser
, Parser
.The_Parameter
.Arg_Num
)
1113 (Parser
.The_Parameter
.First
.. Parser
.The_Parameter
.Last
);
1122 (Parser
: Opt_Parser
:= Command_Line_Parser
) return Character
1125 return Parser
.The_Separator
;
1132 procedure Set_Parameter
1133 (Variable
: out Parameter_Type
;
1137 Extra
: Character := ASCII
.NUL
)
1140 Variable
.Arg_Num
:= Arg_Num
;
1141 Variable
.First
:= First
;
1142 Variable
.Last
:= Last
;
1143 Variable
.Extra
:= Extra
;
1146 ---------------------
1147 -- Start_Expansion --
1148 ---------------------
1150 procedure Start_Expansion
1151 (Iterator
: out Expansion_Iterator
;
1153 Directory
: String := "";
1154 Basic_Regexp
: Boolean := True)
1156 Directory_Separator
: Character;
1157 pragma Import
(C
, Directory_Separator
, "__gnat_dir_separator");
1159 First
: Positive := Pattern
'First;
1160 Pat
: String := Pattern
;
1163 Canonical_Case_File_Name
(Pat
);
1164 Iterator
.Current_Depth
:= 1;
1166 -- If Directory is unspecified, use the current directory ("./" or ".\")
1168 if Directory
= "" then
1169 Iterator
.Dir_Name
(1 .. 2) := "." & Directory_Separator
;
1170 Iterator
.Start
:= 3;
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));
1177 -- Make sure that the last character is a directory separator
1179 if Directory
(Directory
'Last) /= Directory_Separator
then
1180 Iterator
.Dir_Name
(Iterator
.Start
) := Directory_Separator
;
1181 Iterator
.Start
:= Iterator
.Start
+ 1;
1185 Iterator
.Levels
(1).Name_Last
:= Iterator
.Start
- 1;
1187 -- Open the initial Directory, at depth 1
1189 GNAT
.Directory_Operations
.Open
1190 (Iterator
.Levels
(1).Dir
, Iterator
.Dir_Name
(1 .. Iterator
.Start
- 1));
1192 -- If in the current directory and the pattern starts with "./" or ".\",
1193 -- drop the "./" or ".\" from the pattern.
1195 if Directory
= "" and then Pat
'Length > 2
1196 and then Pat
(Pat
'First) = '.'
1197 and then Pat
(Pat
'First + 1) = Directory_Separator
1199 First
:= Pat
'First + 2;
1203 GNAT
.Regexp
.Compile
(Pat
(First
.. Pat
'Last), Basic_Regexp
, True);
1205 Iterator
.Maximum_Depth
:= 1;
1207 -- Maximum_Depth is equal to 1 plus the number of directory separators
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
;
1216 end Start_Expansion
;
1222 procedure Free
(Parser
: in out Opt_Parser
) is
1223 procedure Unchecked_Free
is new
1224 Ada
.Unchecked_Deallocation
(Opt_Parser_Data
, Opt_Parser
);
1226 if Parser
/= null and then Parser
/= Command_Line_Parser
then
1227 Free
(Parser
.Arguments
);
1228 Unchecked_Free
(Parser
);
1236 procedure Define_Alias
1237 (Config
: in out Command_Line_Configuration
;
1240 Section
: String := "")
1242 Def
: Alias_Definition
;
1245 if Config
= null then
1246 Config
:= new Command_Line_Configuration_Record
;
1249 Def
.Alias
:= new String'(Switch);
1250 Def.Expansion := new String'(Expanded
);
1251 Def
.Section
:= new String'(Section);
1252 Add (Config.Aliases, Def);
1259 procedure Define_Prefix
1260 (Config : in out Command_Line_Configuration;
1264 if Config = null then
1265 Config := new Command_Line_Configuration_Record;
1268 Add (Config.Prefixes, new String'(Prefix
));
1276 (Config
: in out Command_Line_Configuration
;
1277 Switch
: Switch_Definition
)
1279 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
1280 (Switch_Definitions
, Switch_Definitions_List
);
1282 Tmp
: Switch_Definitions_List
;
1285 if Config
= null then
1286 Config
:= new Command_Line_Configuration_Record
;
1289 Tmp
:= Config
.Switches
;
1292 Config
.Switches
:= new Switch_Definitions
(1 .. 1);
1294 Config
.Switches
:= new Switch_Definitions
(1 .. Tmp
'Length + 1);
1295 Config
.Switches
(1 .. Tmp
'Length) := Tmp
.all;
1296 Unchecked_Free
(Tmp
);
1299 if Switch
.Switch
/= null and then Switch
.Switch
.all = "*" then
1300 Config
.Star_Switch
:= True;
1303 Config
.Switches
(Config
.Switches
'Last) := Switch
;
1311 (Def
: in out Alias_Definitions_List
;
1312 Alias
: Alias_Definition
)
1314 procedure Unchecked_Free
is new
1315 Ada
.Unchecked_Deallocation
1316 (Alias_Definitions
, Alias_Definitions_List
);
1318 Tmp
: Alias_Definitions_List
:= Def
;
1322 Def
:= new Alias_Definitions
(1 .. 1);
1324 Def
:= new Alias_Definitions
(1 .. Tmp
'Length + 1);
1325 Def
(1 .. Tmp
'Length) := Tmp
.all;
1326 Unchecked_Free
(Tmp
);
1329 Def
(Def
'Last) := Alias
;
1332 ---------------------------
1333 -- Initialize_Switch_Def --
1334 ---------------------------
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")
1344 P1
, P2
: Switch_Parameter_Type
:= Parameter_None
;
1345 Last1
, Last2
: Integer;
1348 if Switch
/= "" then
1349 Def
.Switch
:= new String'(Switch);
1350 Decompose_Switch (Switch, P1, Last1);
1353 if Long_Switch /= "" then
1354 Def.Long_Switch := new String'(Long_Switch
);
1355 Decompose_Switch
(Long_Switch
, P2
, Last2
);
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
)
1364 raise Invalid_Switch
1365 with "Inconsistent parameter types for "
1366 & Switch
& " and " & Long_Switch
;
1370 if Section
/= "" then
1371 Def
.Section
:= new String'(Section);
1374 if Argument /= "ARG" then
1375 Def.Argument := new String'(Argument
);
1379 Def
.Help
:= new String'(Help);
1381 end Initialize_Switch_Def;
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")
1395 Def : Switch_Definition;
1397 if Switch /= "" or else Long_Switch /= "" then
1398 Initialize_Switch_Def
1399 (Def, Switch, Long_Switch, Help, Section, Argument);
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)
1417 Def : Switch_Definition (Switch_Boolean);
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;
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")
1442 Def : Switch_Definition (Switch_Integer);
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;
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")
1467 Def : Switch_Definition (Switch_String);
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;
1477 --------------------
1478 -- Define_Section --
1479 --------------------
1481 procedure Define_Section
1482 (Config : in out Command_Line_Configuration;
1486 if Config = null then
1487 Config := new Command_Line_Configuration_Record;
1490 Add (Config.Sections, new String'(Section
));
1493 --------------------
1494 -- Foreach_Switch --
1495 --------------------
1497 procedure Foreach_Switch
1498 (Config
: Command_Line_Configuration
;
1502 if Config
/= null and then Config
.Switches
/= null then
1503 for J
in Config
.Switches
'Range loop
1504 if (Section
= "" and then Config
.Switches
(J
).Section
= null)
1506 (Config
.Switches
(J
).Section
/= null
1507 and then Config
.Switches
(J
).Section
.all = Section
)
1509 exit when Config
.Switches
(J
).Switch
/= null
1510 and then not Callback
(Config
.Switches
(J
).Switch
.all, J
);
1512 exit when Config
.Switches
(J
).Long_Switch
/= null
1514 not Callback
(Config
.Switches
(J
).Long_Switch
.all, J
);
1524 function Get_Switches
1525 (Config
: Command_Line_Configuration
;
1526 Switch_Char
: Character := '-';
1527 Section
: String := "") return String
1529 Ret
: Ada
.Strings
.Unbounded
.Unbounded_String
;
1530 use Ada
.Strings
.Unbounded
;
1532 function Add_Switch
(S
: String; Index
: Integer) return Boolean;
1533 -- Add a switch to Ret
1539 function Add_Switch
(S
: String; Index
: Integer) return Boolean is
1540 pragma Unreferenced
(Index
);
1543 Ret
:= "*" & Ret
; -- Always first
1544 elsif S
(S
'First) = Switch_Char
then
1545 Append
(Ret
, " " & S
(S
'First + 1 .. S
'Last));
1547 Append
(Ret
, " " & S
);
1554 pragma Unreferenced
(Tmp
);
1556 procedure Foreach
is new Foreach_Switch
(Add_Switch
);
1558 -- Start of processing for Get_Switches
1561 if Config
= null then
1565 Foreach
(Config
, Section
=> Section
);
1567 -- Add relevant aliases
1569 if Config
.Aliases
/= null then
1570 for A
in Config
.Aliases
'Range loop
1571 if Config
.Aliases
(A
).Section
.all = Section
then
1572 Tmp
:= Add_Switch
(Config
.Aliases
(A
).Alias
.all, -1);
1577 return To_String
(Ret
);
1580 ------------------------
1581 -- Section_Delimiters --
1582 ------------------------
1584 function Section_Delimiters
1585 (Config
: Command_Line_Configuration
) return String
1587 use Ada
.Strings
.Unbounded
;
1588 Result
: Unbounded_String
;
1591 if Config
/= null and then Config
.Sections
/= null then
1592 for S
in Config
.Sections
'Range loop
1593 Append
(Result
, " " & Config
.Sections
(S
).all);
1597 return To_String
(Result
);
1598 end Section_Delimiters
;
1600 -----------------------
1601 -- Set_Configuration --
1602 -----------------------
1604 procedure Set_Configuration
1605 (Cmd
: in out Command_Line
;
1606 Config
: Command_Line_Configuration
)
1609 Cmd
.Config
:= Config
;
1610 end Set_Configuration
;
1612 -----------------------
1613 -- Get_Configuration --
1614 -----------------------
1616 function Get_Configuration
1617 (Cmd
: Command_Line
) return Command_Line_Configuration
1621 end Get_Configuration
;
1623 ----------------------
1624 -- Set_Command_Line --
1625 ----------------------
1627 procedure Set_Command_Line
1628 (Cmd
: in out Command_Line
;
1630 Getopt_Description
: String := "";
1631 Switch_Char
: Character := '-')
1633 Tmp
: Argument_List_Access
;
1634 Parser
: Opt_Parser
;
1636 Section
: String_Access
:= null;
1638 function Real_Full_Switch
1640 Parser
: Opt_Parser
) return String;
1641 -- Ensure that the returned switch value contains the Switch_Char prefix
1644 ----------------------
1645 -- Real_Full_Switch --
1646 ----------------------
1648 function Real_Full_Switch
1650 Parser
: Opt_Parser
) return String
1654 return Full_Switch
(Parser
);
1656 return Switch_Char
& Full_Switch
(Parser
);
1658 end Real_Full_Switch
;
1660 -- Start of processing for Set_Command_Line
1663 Free
(Cmd
.Expanded
);
1666 if Switches
/= "" then
1667 Tmp
:= Argument_String_To_List
(Switches
);
1668 Initialize_Option_Scan
(Parser
, Tmp
, Switch_Char
);
1672 if Cmd
.Config
/= null then
1674 -- Do not use Getopt_Description in this case. Otherwise,
1675 -- if we have defined a prefix -gnaty, and two switches
1676 -- -gnatya and -gnatyL!, we would have a different behavior
1677 -- depending on the order of switches:
1679 -- -gnatyL1a => -gnatyL with argument "1a"
1680 -- -gnatyaL1 => -gnatya and -gnatyL with argument "1"
1682 -- This is because the call to Getopt below knows nothing
1683 -- about prefixes, and in the first case finds a valid
1684 -- switch with arguments, so returns it without analyzing
1685 -- the argument. In the second case, the switch matches "*",
1686 -- and is then decomposed below.
1688 -- Note: When a Command_Line object is associated with a
1689 -- Command_Line_Config (which is mostly the case for tools
1690 -- that let users choose the command line before spawning
1691 -- other tools, for instance IDEs), the configuration of
1692 -- the switches must be taken from the Command_Line_Config.
1694 S
:= Getopt
(Switches
=> "* " & Get_Switches
(Cmd
.Config
),
1695 Concatenate
=> False,
1699 S
:= Getopt
(Switches
=> "* " & Getopt_Description
,
1700 Concatenate
=> False,
1704 exit when S
= ASCII
.NUL
;
1707 Sw
: constant String := Real_Full_Switch
(S
, Parser
);
1708 Is_Section
: Boolean := False;
1711 if Cmd
.Config
/= null
1712 and then Cmd
.Config
.Sections
/= null
1715 for S
in Cmd
.Config
.Sections
'Range loop
1716 if Sw
= Cmd
.Config
.Sections
(S
).all then
1717 Section
:= Cmd
.Config
.Sections
(S
);
1720 exit Section_Search
;
1722 end loop Section_Search
;
1725 if not Is_Section
then
1726 if Section
= null then
1727 Add_Switch
(Cmd
, Sw
, Parameter
(Parser
));
1730 (Cmd
, Sw
, Parameter
(Parser
),
1731 Section
=> Section
.all);
1737 when Invalid_Parameter
=>
1739 -- Add it with no parameter, if that's the way the user
1742 -- Specify the separator in all cases, as the switch might
1743 -- need to be unaliased, and the alias might contain
1744 -- switches with parameters.
1746 if Section
= null then
1748 (Cmd
, Switch_Char
& Full_Switch
(Parser
));
1751 (Cmd
, Switch_Char
& Full_Switch
(Parser
),
1752 Section
=> Section
.all);
1759 end Set_Command_Line
;
1768 Substring
: String) return Boolean
1771 return Index
+ Substring
'Length - 1 <= Type_Str
'Last
1772 and then Type_Str
(Index
.. Index
+ Substring
'Length - 1) = Substring
;
1775 ------------------------
1776 -- Can_Have_Parameter --
1777 ------------------------
1779 function Can_Have_Parameter
(S
: String) return Boolean is
1781 if S
'Length <= 1 then
1786 when '!' |
':' |
'?' |
'=' =>
1791 end Can_Have_Parameter
;
1793 -----------------------
1794 -- Require_Parameter --
1795 -----------------------
1797 function Require_Parameter
(S
: String) return Boolean is
1799 if S
'Length <= 1 then
1804 when '!' |
':' |
'=' =>
1809 end Require_Parameter
;
1815 function Actual_Switch
(S
: String) return String is
1817 if S
'Length <= 1 then
1822 when '!' |
':' |
'?' |
'=' =>
1823 return S
(S
'First .. S
'Last - 1);
1829 ----------------------------
1830 -- For_Each_Simple_Switch --
1831 ----------------------------
1833 procedure For_Each_Simple_Switch
1834 (Config
: Command_Line_Configuration
;
1837 Parameter
: String := "";
1838 Unalias
: Boolean := True)
1840 function Group_Analysis
1842 Group
: String) return Boolean;
1843 -- Perform the analysis of a group of switches
1845 Found_In_Config
: Boolean := False;
1846 function Is_In_Config
1847 (Config_Switch
: String; Index
: Integer) return Boolean;
1848 -- If Switch is the same as Config_Switch, run the callback and sets
1849 -- Found_In_Config to True.
1851 function Starts_With
1852 (Config_Switch
: String; Index
: Integer) return Boolean;
1853 -- if Switch starts with Config_Switch, sets Found_In_Config to True.
1854 -- The return value is for the Foreach_Switch iterator.
1856 --------------------
1857 -- Group_Analysis --
1858 --------------------
1860 function Group_Analysis
1862 Group
: String) return Boolean
1867 function Analyze_Simple_Switch
1868 (Switch
: String; Index
: Integer) return Boolean;
1869 -- "Switches" is one of the switch definitions passed to the
1870 -- configuration, not one of the switches found on the command line.
1872 ---------------------------
1873 -- Analyze_Simple_Switch --
1874 ---------------------------
1876 function Analyze_Simple_Switch
1877 (Switch
: String; Index
: Integer) return Boolean
1879 pragma Unreferenced
(Index
);
1881 Full
: constant String := Prefix
& Group
(Idx
.. Group
'Last);
1883 Sw
: constant String := Actual_Switch
(Switch
);
1884 -- Switches definition minus argument definition
1890 -- Verify that sw starts with Prefix
1892 if Looking_At
(Sw
, Sw
'First, Prefix
)
1894 -- Verify that the group starts with sw
1896 and then Looking_At
(Full
, Full
'First, Sw
)
1898 Last
:= Idx
+ Sw
'Length - Prefix
'Length - 1;
1901 if Can_Have_Parameter
(Switch
) then
1903 -- Include potential parameter to the recursive call. Only
1904 -- numbers are allowed.
1906 while Last
< Group
'Last
1907 and then Group
(Last
+ 1) in '0' .. '9'
1913 if not Require_Parameter
(Switch
) or else Last
>= Param
then
1914 if Idx
= Group
'First
1915 and then Last
= Group
'Last
1916 and then Last
< Param
1918 -- The group only concerns a single switch. Do not
1919 -- perform recursive call.
1921 -- Note that we still perform a recursive call if
1922 -- a parameter is detected in the switch, as this
1923 -- is a way to correctly identify such a parameter
1931 -- Recursive call, using the detected parameter if any
1933 if Last
>= Param
then
1934 For_Each_Simple_Switch
1937 Prefix
& Group
(Idx
.. Param
- 1),
1938 Group
(Param
.. Last
));
1941 For_Each_Simple_Switch
1942 (Config
, Section
, Prefix
& Group
(Idx
.. Last
), "");
1951 end Analyze_Simple_Switch
;
1953 procedure Foreach
is new Foreach_Switch
(Analyze_Simple_Switch
);
1955 -- Start of processing for Group_Analysis
1959 while Idx
<= Group
'Last loop
1961 Foreach
(Config
, Section
);
1964 For_Each_Simple_Switch
1965 (Config
, Section
, Prefix
& Group
(Idx
), "");
1977 function Is_In_Config
1978 (Config_Switch
: String; Index
: Integer) return Boolean
1981 P
: Switch_Parameter_Type
;
1984 Decompose_Switch
(Config_Switch
, P
, Last
);
1986 if Config_Switch
(Config_Switch
'First .. Last
) = Switch
then
1988 when Parameter_None
=>
1989 if Parameter
= "" then
1990 Callback
(Switch
, "", "", Index
=> Index
);
1991 Found_In_Config
:= True;
1995 when Parameter_With_Optional_Space
=>
1996 Callback
(Switch
, " ", Parameter
, Index
=> Index
);
1997 Found_In_Config
:= True;
2000 when Parameter_With_Space_Or_Equal
=>
2001 Callback
(Switch
, "=", Parameter
, Index
=> Index
);
2002 Found_In_Config
:= True;
2005 when Parameter_No_Space
2006 | Parameter_Optional
2008 Callback
(Switch
, "", Parameter
, Index
);
2009 Found_In_Config
:= True;
2021 function Starts_With
2022 (Config_Switch
: String; Index
: Integer) return Boolean
2026 P
: Switch_Parameter_Type
;
2029 -- This function is called when we believe the parameter was
2030 -- specified as part of the switch, instead of separately. Thus we
2031 -- look in the config to find all possible switches.
2033 Decompose_Switch
(Config_Switch
, P
, Last
);
2036 (Switch
, Switch
'First,
2037 Config_Switch
(Config_Switch
'First .. Last
))
2039 -- Set first char of Param, and last char of Switch
2041 Param
:= Switch
'First + Last
;
2042 Last
:= Switch
'First + Last
- Config_Switch
'First;
2046 -- None is already handled in Is_In_Config
2048 when Parameter_None
=>
2051 when Parameter_With_Space_Or_Equal
=>
2052 if Param
<= Switch
'Last
2054 (Switch
(Param
) = ' ' or else Switch
(Param
) = '=')
2056 Callback
(Switch
(Switch
'First .. Last
),
2057 "=", Switch
(Param
+ 1 .. Switch
'Last), Index
);
2058 Found_In_Config
:= True;
2062 when Parameter_With_Optional_Space
=>
2063 if Param
<= Switch
'Last and then Switch
(Param
) = ' ' then
2067 Callback
(Switch
(Switch
'First .. Last
),
2068 " ", Switch
(Param
.. Switch
'Last), Index
);
2069 Found_In_Config
:= True;
2072 when Parameter_No_Space
2073 | Parameter_Optional
2075 Callback
(Switch
(Switch
'First .. Last
),
2076 "", Switch
(Param
.. Switch
'Last), Index
);
2077 Found_In_Config
:= True;
2084 procedure Foreach_In_Config
is new Foreach_Switch
(Is_In_Config
);
2085 procedure Foreach_Starts_With
is new Foreach_Switch
(Starts_With
);
2087 -- Start of processing for For_Each_Simple_Switch
2090 -- First determine if the switch corresponds to one belonging to the
2091 -- configuration. If so, run callback and exit.
2093 -- ??? Is this necessary. On simple tests, we seem to have the same
2094 -- results with or without this call.
2096 Foreach_In_Config
(Config
, Section
);
2098 if Found_In_Config
then
2102 -- If adding a switch that can in fact be expanded through aliases,
2103 -- add separately each of its expansions.
2105 -- This takes care of expansions like "-T" -> "-gnatwrs", where the
2106 -- alias and its expansion do not have the same prefix. Given the order
2107 -- in which we do things here, the expansion of the alias will itself
2108 -- be checked for a common prefix and split into simple switches.
2111 and then Config
/= null
2112 and then Config
.Aliases
/= null
2114 for A
in Config
.Aliases
'Range loop
2115 if Config
.Aliases
(A
).Section
.all = Section
2116 and then Config
.Aliases
(A
).Alias
.all = Switch
2117 and then Parameter
= ""
2119 For_Each_Simple_Switch
2120 (Config
, Section
, Config
.Aliases
(A
).Expansion
.all, "");
2126 -- If adding a switch grouping several switches, add each of the simple
2127 -- switches instead.
2129 if Config
/= null and then Config
.Prefixes
/= null then
2130 for P
in Config
.Prefixes
'Range loop
2131 if Switch
'Length > Config
.Prefixes
(P
)'Length + 1
2133 Looking_At
(Switch
, Switch
'First, Config
.Prefixes
(P
).all)
2135 -- Alias expansion will be done recursively
2137 if Config
.Switches
= null then
2138 for S
in Switch
'First + Config
.Prefixes
(P
)'Length
2141 For_Each_Simple_Switch
2143 Config
.Prefixes
(P
).all & Switch
(S
), "");
2148 elsif Group_Analysis
2149 (Config
.Prefixes
(P
).all,
2151 (Switch
'First + Config
.Prefixes
(P
)'Length .. Switch
'Last))
2153 -- Recursive calls already done on each switch of the group:
2154 -- Return without executing Callback.
2162 -- Test if added switch is a known switch with parameter attached
2163 -- instead of being specified separately
2166 and then Config
/= null
2167 and then Config
.Switches
/= null
2169 Found_In_Config
:= False;
2170 Foreach_Starts_With
(Config
, Section
);
2172 if Found_In_Config
then
2177 -- The switch is invalid in the config, but we still want to report it.
2178 -- The config could, for instance, include "*" to specify it accepts
2181 Callback
(Switch
, " ", Parameter
, Index
=> -1);
2182 end For_Each_Simple_Switch
;
2188 procedure Add_Switch
2189 (Cmd
: in out Command_Line
;
2191 Parameter
: String := "";
2192 Separator
: Character := ASCII
.NUL
;
2193 Section
: String := "";
2194 Add_Before
: Boolean := False)
2197 pragma Unreferenced
(Success
);
2199 Add_Switch
(Cmd
, Switch
, Parameter
, Separator
,
2200 Section
, Add_Before
, Success
);
2207 procedure Add_Switch
2208 (Cmd
: in out Command_Line
;
2210 Parameter
: String := "";
2211 Separator
: Character := ASCII
.NUL
;
2212 Section
: String := "";
2213 Add_Before
: Boolean := False;
2214 Success
: out Boolean)
2216 procedure Add_Simple_Switch
2221 -- Add a new switch that has had all its aliases expanded, and switches
2222 -- ungrouped. We know there are no more aliases in Switches.
2224 -----------------------
2225 -- Add_Simple_Switch --
2226 -----------------------
2228 procedure Add_Simple_Switch
2238 and then Cmd
.Config
/= null
2239 and then not Cmd
.Config
.Star_Switch
2241 raise Invalid_Switch
2242 with "Invalid switch " & Simple
;
2245 if Separator
/= ASCII
.NUL
then
2248 elsif Sepa
= "" then
2251 Sep
:= Sepa
(Sepa
'First);
2254 if Cmd
.Expanded
= null then
2255 Cmd
.Expanded
:= new Argument_List
'(1 .. 1 => new String'(Simple
));
2259 new Argument_List
'(1 .. 1 => new String'(Sep
& Param
));
2261 Cmd
.Params
:= new Argument_List
'(1 .. 1 => null);
2264 if Section = "" then
2265 Cmd.Sections := new Argument_List'(1 .. 1 => null);
2268 new Argument_List
'(1 .. 1 => new String'(Section
));
2272 -- Do we already have this switch?
2274 for C
in Cmd
.Expanded
'Range loop
2275 if Cmd
.Expanded
(C
).all = Simple
2277 ((Cmd
.Params
(C
) = null and then Param
= "")
2279 (Cmd
.Params
(C
) /= null
2280 and then Cmd
.Params
(C
).all = Sep
& Param
))
2282 ((Cmd
.Sections
(C
) = null and then Section
= "")
2284 (Cmd
.Sections
(C
) /= null
2285 and then Cmd
.Sections
(C
).all = Section
))
2291 -- Inserting at least one switch
2294 Add
(Cmd
.Expanded
, new String'(Simple), Add_Before);
2299 new String'(Sep
& Param
),
2308 if Section
= "" then
2316 new String'(Section),
2320 end Add_Simple_Switch;
2322 procedure Add_Simple_Switches is
2323 new For_Each_Simple_Switch (Add_Simple_Switch);
2327 Section_Valid : Boolean := False;
2329 -- Start of processing for Add_Switch
2332 if Section /= "" and then Cmd.Config /= null then
2333 for S in Cmd.Config.Sections'Range loop
2334 if Section = Cmd.Config.Sections (S).all then
2335 Section_Valid := True;
2340 if not Section_Valid then
2341 raise Invalid_Section;
2346 Add_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
2347 Free (Cmd.Coalesce);
2354 procedure Remove (Line : in out Argument_List_Access; Index : Integer) is
2355 Tmp : Argument_List_Access := Line;
2358 Line := new Argument_List (Tmp'First .. Tmp'Last - 1);
2360 if Index /= Tmp'First then
2361 Line (Tmp'First .. Index - 1) := Tmp (Tmp'First .. Index - 1);
2366 if Index /= Tmp'Last then
2367 Line (Index .. Tmp'Last - 1) := Tmp (Index + 1 .. Tmp'Last);
2370 Unchecked_Free (Tmp);
2378 (Line : in out Argument_List_Access;
2379 Str : String_Access;
2380 Before : Boolean := False)
2382 Tmp : Argument_List_Access := Line;
2386 Line := new Argument_List (Tmp'First .. Tmp'Last + 1);
2389 Line (Tmp'First) := Str;
2390 Line (Tmp'First + 1 .. Tmp'Last + 1) := Tmp.all;
2392 Line (Tmp'Range) := Tmp.all;
2393 Line (Tmp'Last + 1) := Str;
2396 Unchecked_Free (Tmp);
2399 Line := new Argument_List'(1 .. 1 => Str
);
2407 procedure Remove_Switch
2408 (Cmd
: in out Command_Line
;
2410 Remove_All
: Boolean := False;
2411 Has_Parameter
: Boolean := False;
2412 Section
: String := "")
2415 pragma Unreferenced
(Success
);
2417 Remove_Switch
(Cmd
, Switch
, Remove_All
, Has_Parameter
, Section
, Success
);
2424 procedure Remove_Switch
2425 (Cmd
: in out Command_Line
;
2427 Remove_All
: Boolean := False;
2428 Has_Parameter
: Boolean := False;
2429 Section
: String := "";
2430 Success
: out Boolean)
2432 procedure Remove_Simple_Switch
2433 (Simple
, Separator
, Param
: String; Index
: Integer);
2434 -- Removes a simple switch, with no aliasing or grouping
2436 --------------------------
2437 -- Remove_Simple_Switch --
2438 --------------------------
2440 procedure Remove_Simple_Switch
2441 (Simple
, Separator
, Param
: String; Index
: Integer)
2444 pragma Unreferenced
(Param
, Separator
, Index
);
2447 if Cmd
.Expanded
/= null then
2448 C
:= Cmd
.Expanded
'First;
2449 while C
<= Cmd
.Expanded
'Last loop
2450 if Cmd
.Expanded
(C
).all = Simple
2453 or else (Cmd
.Sections
(C
) = null
2454 and then Section
= "")
2455 or else (Cmd
.Sections
(C
) /= null
2456 and then Section
= Cmd
.Sections
(C
).all))
2457 and then (not Has_Parameter
or else Cmd
.Params
(C
) /= null)
2459 Remove
(Cmd
.Expanded
, C
);
2460 Remove
(Cmd
.Params
, C
);
2461 Remove
(Cmd
.Sections
, C
);
2464 if not Remove_All
then
2473 end Remove_Simple_Switch
;
2475 procedure Remove_Simple_Switches
is
2476 new For_Each_Simple_Switch
(Remove_Simple_Switch
);
2478 -- Start of processing for Remove_Switch
2482 Remove_Simple_Switches
2483 (Cmd
.Config
, Section
, Switch
, "", Unalias
=> not Has_Parameter
);
2484 Free
(Cmd
.Coalesce
);
2491 procedure Remove_Switch
2492 (Cmd
: in out Command_Line
;
2495 Section
: String := "")
2497 procedure Remove_Simple_Switch
2498 (Simple
, Separator
, Param
: String; Index
: Integer);
2499 -- Removes a simple switch, with no aliasing or grouping
2501 --------------------------
2502 -- Remove_Simple_Switch --
2503 --------------------------
2505 procedure Remove_Simple_Switch
2506 (Simple
, Separator
, Param
: String; Index
: Integer)
2508 pragma Unreferenced
(Separator
, Index
);
2512 if Cmd
.Expanded
/= null then
2513 C
:= Cmd
.Expanded
'First;
2514 while C
<= Cmd
.Expanded
'Last loop
2515 if Cmd
.Expanded
(C
).all = Simple
2517 ((Cmd
.Sections
(C
) = null
2518 and then Section
= "")
2520 (Cmd
.Sections
(C
) /= null
2521 and then Section
= Cmd
.Sections
(C
).all))
2523 ((Cmd
.Params
(C
) = null and then Param
= "")
2525 (Cmd
.Params
(C
) /= null
2527 -- Ignore the separator stored in Parameter
2530 Cmd
.Params
(C
) (Cmd
.Params
(C
)'First + 1
2531 .. Cmd
.Params
(C
)'Last) = Param
))
2533 Remove
(Cmd
.Expanded
, C
);
2534 Remove
(Cmd
.Params
, C
);
2535 Remove
(Cmd
.Sections
, C
);
2537 -- The switch is necessarily unique by construction of
2547 end Remove_Simple_Switch
;
2549 procedure Remove_Simple_Switches
is
2550 new For_Each_Simple_Switch
(Remove_Simple_Switch
);
2552 -- Start of processing for Remove_Switch
2555 Remove_Simple_Switches
(Cmd
.Config
, Section
, Switch
, Parameter
);
2556 Free
(Cmd
.Coalesce
);
2559 --------------------
2560 -- Group_Switches --
2561 --------------------
2563 procedure Group_Switches
2564 (Cmd
: Command_Line
;
2565 Result
: Argument_List_Access
;
2566 Sections
: Argument_List_Access
;
2567 Params
: Argument_List_Access
)
2569 function Compatible_Parameter
(Param
: String_Access
) return Boolean;
2570 -- True when the parameter can be part of a group
2572 --------------------------
2573 -- Compatible_Parameter --
2574 --------------------------
2576 function Compatible_Parameter
(Param
: String_Access
) return Boolean is
2580 if Param
= null then
2583 -- We need parameters without separators
2585 elsif Param
(Param
'First) /= ASCII
.NUL
then
2588 -- Parameters must be all digits
2591 for J
in Param
'First + 1 .. Param
'Last loop
2592 if Param
(J
) not in '0' .. '9' then
2599 end Compatible_Parameter
;
2601 -- Local declarations
2603 Group
: Ada
.Strings
.Unbounded
.Unbounded_String
;
2605 use type Ada
.Strings
.Unbounded
.Unbounded_String
;
2607 -- Start of processing for Group_Switches
2610 if Cmd
.Config
= null or else Cmd
.Config
.Prefixes
= null then
2614 for P
in Cmd
.Config
.Prefixes
'Range loop
2615 Group
:= Ada
.Strings
.Unbounded
.Null_Unbounded_String
;
2618 for C
in Result
'Range loop
2619 if Result
(C
) /= null
2620 and then Compatible_Parameter
(Params
(C
))
2624 Cmd
.Config
.Prefixes
(P
).all)
2626 -- If we are still in the same section, group the switches
2630 (Sections
(C
) = null
2631 and then Sections
(First
) = null)
2633 (Sections
(C
) /= null
2634 and then Sections
(First
) /= null
2635 and then Sections
(C
).all = Sections
(First
).all)
2640 (Result
(C
)'First + Cmd
.Config
.Prefixes
(P
)'Length ..
2643 if Params
(C
) /= null then
2646 Params
(C
) (Params
(C
)'First + 1 .. Params
(C
)'Last);
2656 -- We changed section: we put the grouped switches to the first
2657 -- place, on continue with the new section.
2662 (Cmd.Config.Prefixes (P).all &
2663 Ada.Strings.Unbounded.To_String (Group));
2665 Ada.Strings.Unbounded.To_Unbounded_String
2667 (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2677 (Cmd
.Config
.Prefixes
(P
).all &
2678 Ada
.Strings
.Unbounded
.To_String
(Group
));
2683 --------------------
2684 -- Alias_Switches --
2685 --------------------
2687 procedure Alias_Switches
2688 (Cmd
: Command_Line
;
2689 Result
: Argument_List_Access
;
2690 Params
: Argument_List_Access
)
2695 procedure Check_Cb
(Switch
, Separator
, Param
: String; Index
: Integer);
2696 -- Checks whether the command line contains [Switch]. Sets the global
2697 -- variable [Found] appropriately. This is called for each simple switch
2698 -- that make up an alias, to know whether the alias should be applied.
2700 procedure Remove_Cb
(Switch
, Separator
, Param
: String; Index
: Integer);
2701 -- Remove the simple switch [Switch] from the command line, since it is
2702 -- part of a simpler alias
2709 (Switch
, Separator
, Param
: String; Index
: Integer)
2711 pragma Unreferenced
(Separator
, Index
);
2715 for E
in Result
'Range loop
2716 if Result
(E
) /= null
2719 or else Params
(E
) (Params
(E
)'First + 1 ..
2720 Params
(E
)'Last) = Param
)
2721 and then Result
(E
).all = Switch
2735 procedure Remove_Cb
(Switch
, Separator
, Param
: String; Index
: Integer)
2737 pragma Unreferenced
(Separator
, Index
);
2740 for E
in Result
'Range loop
2741 if Result
(E
) /= null
2744 or else Params
(E
) (Params
(E
)'First + 1
2745 .. Params
(E
)'Last) = Param
)
2746 and then Result
(E
).all = Switch
2759 procedure Check_All
is new For_Each_Simple_Switch
(Check_Cb
);
2760 procedure Remove_All
is new For_Each_Simple_Switch
(Remove_Cb
);
2762 -- Start of processing for Alias_Switches
2765 if Cmd
.Config
= null or else Cmd
.Config
.Aliases
= null then
2769 for A
in Cmd
.Config
.Aliases
'Range loop
2771 -- Compute the various simple switches that make up the alias. We
2772 -- split the expansion into as many simple switches as possible, and
2773 -- then check whether the expanded command line has all of them.
2776 Check_All
(Cmd
.Config
,
2777 Switch
=> Cmd
.Config
.Aliases
(A
).Expansion
.all,
2778 Section
=> Cmd
.Config
.Aliases
(A
).Section
.all);
2781 First
:= Integer'Last;
2782 Remove_All
(Cmd
.Config
,
2783 Switch
=> Cmd
.Config
.Aliases
(A
).Expansion
.all,
2784 Section
=> Cmd
.Config
.Aliases
(A
).Section
.all);
2785 Result
(First
) := new String'(Cmd.Config.Aliases (A).Alias.all);
2794 procedure Sort_Sections
2795 (Line : not null GNAT.OS_Lib.Argument_List_Access;
2796 Sections : GNAT.OS_Lib.Argument_List_Access;
2797 Params : GNAT.OS_Lib.Argument_List_Access)
2799 Sections_List : Argument_List_Access :=
2800 new Argument_List'(1 .. 1 => null);
2802 Old_Line
: constant Argument_List
:= Line
.all;
2803 Old_Sections
: constant Argument_List
:= Sections
.all;
2804 Old_Params
: constant Argument_List
:= Params
.all;
2808 -- First construct a list of all sections
2810 for E
in Line
'Range loop
2811 if Sections
(E
) /= null then
2813 for S
in Sections_List
'Range loop
2814 if (Sections_List
(S
) = null and then Sections
(E
) = null)
2816 (Sections_List
(S
) /= null
2817 and then Sections
(E
) /= null
2818 and then Sections_List
(S
).all = Sections
(E
).all)
2826 Add
(Sections_List
, Sections
(E
));
2831 Index
:= Line
'First;
2833 for S
in Sections_List
'Range loop
2834 for E
in Old_Line
'Range loop
2835 if (Sections_List
(S
) = null and then Old_Sections
(E
) = null)
2837 (Sections_List
(S
) /= null
2838 and then Old_Sections
(E
) /= null
2839 and then Sections_List
(S
).all = Old_Sections
(E
).all)
2841 Line
(Index
) := Old_Line
(E
);
2842 Sections
(Index
) := Old_Sections
(E
);
2843 Params
(Index
) := Old_Params
(E
);
2849 Unchecked_Free
(Sections_List
);
2857 (Cmd
: in out Command_Line
;
2858 Iter
: in out Command_Line_Iterator
;
2859 Expanded
: Boolean := False)
2862 if Cmd
.Expanded
= null then
2867 -- Reorder the expanded line so that sections are grouped
2869 Sort_Sections
(Cmd
.Expanded
, Cmd
.Sections
, Cmd
.Params
);
2871 -- Coalesce the switches as much as possible
2874 and then Cmd
.Coalesce
= null
2876 Cmd
.Coalesce
:= new Argument_List
(Cmd
.Expanded
'Range);
2877 for E
in Cmd
.Expanded
'Range loop
2878 Cmd
.Coalesce
(E
) := new String'(Cmd.Expanded (E).all);
2881 Free (Cmd.Coalesce_Sections);
2882 Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range);
2883 for E in Cmd.Sections'Range loop
2884 Cmd.Coalesce_Sections (E) :=
2885 (if Cmd.Sections (E) = null then null
2886 else new String'(Cmd
.Sections
(E
).all));
2889 Free
(Cmd
.Coalesce_Params
);
2890 Cmd
.Coalesce_Params
:= new Argument_List
(Cmd
.Params
'Range);
2891 for E
in Cmd
.Params
'Range loop
2892 Cmd
.Coalesce_Params
(E
) :=
2893 (if Cmd
.Params
(E
) = null then null
2894 else new String'(Cmd.Params (E).all));
2897 -- Not a clone, since we will not modify the parameters anyway
2899 Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Params);
2901 (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Coalesce_Params);
2905 Iter.List := Cmd.Expanded;
2906 Iter.Params := Cmd.Params;
2907 Iter.Sections := Cmd.Sections;
2909 Iter.List := Cmd.Coalesce;
2910 Iter.Params := Cmd.Coalesce_Params;
2911 Iter.Sections := Cmd.Coalesce_Sections;
2914 if Iter.List = null then
2915 Iter.Current := Integer'Last;
2917 Iter.Current := Iter.List'First - 1;
2922 --------------------
2923 -- Current_Switch --
2924 --------------------
2926 function Current_Switch (Iter : Command_Line_Iterator) return String is
2928 return Iter.List (Iter.Current).all;
2931 --------------------
2932 -- Is_New_Section --
2933 --------------------
2935 function Is_New_Section (Iter : Command_Line_Iterator) return Boolean is
2936 Section : constant String := Current_Section (Iter);
2939 if Iter.Sections = null then
2942 elsif Iter.Current = Iter.Sections'First
2943 or else Iter.Sections (Iter.Current - 1) = null
2945 return Section /= "";
2948 return Section /= Iter.Sections (Iter.Current - 1).all;
2952 ---------------------
2953 -- Current_Section --
2954 ---------------------
2956 function Current_Section (Iter : Command_Line_Iterator) return String is
2958 if Iter.Sections = null
2959 or else Iter.Current > Iter.Sections'Last
2960 or else Iter.Sections (Iter.Current) = null
2965 return Iter.Sections (Iter.Current).all;
2966 end Current_Section;
2968 -----------------------
2969 -- Current_Separator --
2970 -----------------------
2972 function Current_Separator (Iter : Command_Line_Iterator) return String is
2974 if Iter.Params = null
2975 or else Iter.Current > Iter.Params'Last
2976 or else Iter.Params (Iter.Current) = null
2982 Sep : constant Character :=
2983 Iter.Params (Iter.Current) (Iter.Params (Iter.Current)'First);
2985 if Sep = ASCII.NUL then
2992 end Current_Separator;
2994 -----------------------
2995 -- Current_Parameter --
2996 -----------------------
2998 function Current_Parameter (Iter : Command_Line_Iterator) return String is
3000 if Iter.Params = null
3001 or else Iter.Current > Iter.Params'Last
3002 or else Iter.Params (Iter.Current) = null
3007 -- Return result, skipping separator
3010 P : constant String := Iter.Params (Iter.Current).all;
3012 return P (P'First + 1 .. P'Last);
3015 end Current_Parameter;
3021 function Has_More (Iter : Command_Line_Iterator) return Boolean is
3023 return Iter.List /= null and then Iter.Current <= Iter.List'Last;
3030 procedure Next (Iter : in out Command_Line_Iterator) is
3032 Iter.Current := Iter.Current + 1;
3033 while Iter.Current <= Iter.List'Last
3034 and then Iter.List (Iter.Current) = null
3036 Iter.Current := Iter.Current + 1;
3044 procedure Free (Config : in out Command_Line_Configuration) is
3045 procedure Unchecked_Free is new
3046 Ada.Unchecked_Deallocation
3047 (Switch_Definitions, Switch_Definitions_List);
3049 procedure Unchecked_Free is new
3050 Ada.Unchecked_Deallocation
3051 (Alias_Definitions, Alias_Definitions_List);
3054 if Config /= null then
3055 Free (Config.Prefixes);
3056 Free (Config.Sections);
3057 Free (Config.Usage);
3059 Free (Config.Help_Msg);
3061 if Config.Aliases /= null then
3062 for A in Config.Aliases'Range loop
3063 Free (Config.Aliases (A).Alias);
3064 Free (Config.Aliases (A).Expansion);
3065 Free (Config.Aliases (A).Section);
3068 Unchecked_Free (Config.Aliases);
3071 if Config.Switches /= null then
3072 for S in Config.Switches'Range loop
3073 Free (Config.Switches (S).Switch);
3074 Free (Config.Switches (S).Long_Switch);
3075 Free (Config.Switches (S).Help);
3076 Free (Config.Switches (S).Section);
3077 Free (Config.Switches (S).Argument);
3080 Unchecked_Free (Config.Switches);
3083 Unchecked_Free (Config);
3091 procedure Free (Cmd : in out Command_Line) is
3093 Free (Cmd.Expanded);
3094 Free (Cmd.Coalesce);
3095 Free (Cmd.Coalesce_Sections);
3096 Free (Cmd.Coalesce_Params);
3098 Free (Cmd.Sections);
3106 (Config : in out Command_Line_Configuration;
3107 Usage : String := "[switches] [arguments]";
3108 Help : String := "";
3109 Help_Msg : String := "")
3112 if Config = null then
3113 Config := new Command_Line_Configuration_Record;
3116 Free (Config.Usage);
3118 Free (Config.Help_Msg);
3120 Config.Usage := new String'(Usage
);
3121 Config
.Help
:= new String'(Help);
3122 Config.Help_Msg := new String'(Help_Msg
);
3129 procedure Display_Help
(Config
: Command_Line_Configuration
) is
3130 function Switch_Name
3131 (Def
: Switch_Definition
;
3132 Section
: String) return String;
3133 -- Return the "-short, --long=ARG" string for Def.
3134 -- Returns "" if the switch is not in the section.
3137 (P
: Switch_Parameter_Type
;
3138 Name
: String := "ARG") return String;
3139 -- Return the display for a switch parameter
3141 procedure Display_Section_Help
(Section
: String);
3142 -- Display the help for a specific section ("" is the default section)
3144 --------------------------
3145 -- Display_Section_Help --
3146 --------------------------
3148 procedure Display_Section_Help
(Section
: String) is
3149 Max_Len
: Natural := 0;
3152 -- ??? Special display for "*"
3156 if Section
/= "" and then Config
.Switches
/= null then
3157 Put_Line
("Switches after " & Section
);
3160 -- Compute size of the switches column
3162 if Config
.Switches
/= null then
3163 for S
in Config
.Switches
'Range loop
3164 Max_Len
:= Natural'Max
3165 (Max_Len
, Switch_Name
(Config
.Switches
(S
), Section
)'Length);
3169 if Config
.Aliases
/= null then
3170 for A
in Config
.Aliases
'Range loop
3171 if Config
.Aliases
(A
).Section
.all = Section
then
3172 Max_Len
:= Natural'Max
3173 (Max_Len
, Config
.Aliases
(A
).Alias
'Length);
3178 -- Display the switches
3180 if Config
.Switches
/= null then
3181 for S
in Config
.Switches
'Range loop
3183 N
: constant String :=
3184 Switch_Name
(Config
.Switches
(S
), Section
);
3190 Put
((1 .. Max_Len
- N
'Length + 1 => ' '));
3192 if Config
.Switches
(S
).Help
/= null then
3193 Put
(Config
.Switches
(S
).Help
.all);
3202 -- Display the aliases
3204 if Config
.Aliases
/= null then
3205 for A
in Config
.Aliases
'Range loop
3206 if Config
.Aliases
(A
).Section
.all = Section
then
3208 Put
(Config
.Aliases
(A
).Alias
.all);
3209 Put
((1 .. Max_Len
- Config
.Aliases
(A
).Alias
'Length + 1
3211 Put
("Equivalent to " & Config
.Aliases
(A
).Expansion
.all);
3216 end Display_Section_Help
;
3223 (P
: Switch_Parameter_Type
;
3224 Name
: String := "ARG") return String
3228 when Parameter_None
=>
3231 when Parameter_With_Optional_Space
=>
3232 return " " & To_Upper
(Name
);
3234 when Parameter_With_Space_Or_Equal
=>
3235 return "=" & To_Upper
(Name
);
3237 when Parameter_No_Space
=>
3238 return To_Upper
(Name
);
3240 when Parameter_Optional
=>
3241 return '[' & To_Upper
(Name
) & ']';
3249 function Switch_Name
3250 (Def
: Switch_Definition
;
3251 Section
: String) return String
3253 use Ada
.Strings
.Unbounded
;
3254 Result
: Unbounded_String
;
3255 P1
, P2
: Switch_Parameter_Type
;
3256 Last1
, Last2
: Integer := 0;
3259 if (Section
= "" and then Def
.Section
= null)
3260 or else (Def
.Section
/= null and then Def
.Section
.all = Section
)
3262 if Def
.Switch
/= null and then Def
.Switch
.all = "*" then
3263 return "[any switch]";
3266 if Def
.Switch
/= null then
3267 Decompose_Switch
(Def
.Switch
.all, P1
, Last1
);
3268 Append
(Result
, Def
.Switch
(Def
.Switch
'First .. Last1
));
3270 if Def
.Long_Switch
/= null then
3271 Decompose_Switch
(Def
.Long_Switch
.all, P2
, Last2
);
3272 Append
(Result
, ", "
3273 & Def
.Long_Switch
(Def
.Long_Switch
'First .. Last2
));
3275 if Def
.Argument
= null then
3276 Append
(Result
, Param_Name
(P2
, "ARG"));
3278 Append
(Result
, Param_Name
(P2
, Def
.Argument
.all));
3282 if Def
.Argument
= null then
3283 Append
(Result
, Param_Name
(P1
, "ARG"));
3285 Append
(Result
, Param_Name
(P1
, Def
.Argument
.all));
3289 -- Def.Switch is null (Long_Switch must be non-null)
3292 Decompose_Switch
(Def
.Long_Switch
.all, P2
, Last2
);
3294 Def
.Long_Switch
(Def
.Long_Switch
'First .. Last2
));
3296 if Def
.Argument
= null then
3297 Append
(Result
, Param_Name
(P2
, "ARG"));
3299 Append
(Result
, Param_Name
(P2
, Def
.Argument
.all));
3304 return To_String
(Result
);
3307 -- Start of processing for Display_Help
3310 if Config
= null then
3314 if Config
.Help
/= null and then Config
.Help
.all /= "" then
3315 Put_Line
(Config
.Help
.all);
3318 if Config
.Usage
/= null then
3321 (Ada
.Command_Line
.Command_Name
) & " " & Config
.Usage
.all);
3323 Put_Line
("Usage: " & Base_Name
(Ada
.Command_Line
.Command_Name
)
3324 & " [switches] [arguments]");
3327 if Config
.Help_Msg
/= null and then Config
.Help_Msg
.all /= "" then
3328 Put_Line
(Config
.Help_Msg
.all);
3331 Display_Section_Help
("");
3333 if Config
.Sections
/= null and then Config
.Switches
/= null then
3334 for S
in Config
.Sections
'Range loop
3335 Display_Section_Help
(Config
.Sections
(S
).all);
3346 (Config
: Command_Line_Configuration
;
3347 Callback
: Switch_Handler
:= null;
3348 Parser
: Opt_Parser
:= Command_Line_Parser
;
3349 Concatenate
: Boolean := True)
3351 Getopt_Switches
: String_Access
;
3352 C
: Character := ASCII
.NUL
;
3354 Empty_Name
: aliased constant String := "";
3355 Current_Section
: Integer := -1;
3356 Section_Name
: not null access constant String := Empty_Name
'Access;
3358 procedure Simple_Callback
3359 (Simple_Switch
: String;
3363 -- Needs comments ???
3365 procedure Do_Callback
(Switch
, Parameter
: String; Index
: Integer);
3371 procedure Do_Callback
(Switch
, Parameter
: String; Index
: Integer) is
3373 -- Do automatic handling when possible
3376 case Config
.Switches
(Index
).Typ
is
3377 when Switch_Untyped
=>
3378 null; -- no automatic handling
3380 when Switch_Boolean
=>
3381 Config
.Switches
(Index
).Boolean_Output
.all :=
3382 Config
.Switches
(Index
).Boolean_Value
;
3385 when Switch_Integer
=>
3387 if Parameter
= "" then
3388 Config
.Switches
(Index
).Integer_Output
.all :=
3389 Config
.Switches
(Index
).Integer_Default
;
3391 Config
.Switches
(Index
).Integer_Output
.all :=
3392 Integer'Value (Parameter
);
3396 when Constraint_Error
=>
3397 raise Invalid_Parameter
3398 with "Expected integer parameter for '"
3404 when Switch_String
=>
3405 Free
(Config
.Switches
(Index
).String_Output
.all);
3406 Config
.Switches
(Index
).String_Output
.all :=
3407 new String'(Parameter);
3412 -- Otherwise calls the user callback if one was defined
3414 if Callback /= null then
3415 Callback (Switch => Switch,
3416 Parameter => Parameter,
3417 Section => Section_Name.all);
3421 procedure For_Each_Simple
3422 is new For_Each_Simple_Switch (Simple_Callback);
3424 ---------------------
3425 -- Simple_Callback --
3426 ---------------------
3428 procedure Simple_Callback
3429 (Simple_Switch : String;
3434 pragma Unreferenced (Separator);
3436 Do_Callback (Switch => Simple_Switch,
3437 Parameter => Parameter,
3439 end Simple_Callback;
3441 -- Start of processing for Getopt
3444 -- Initialize sections
3446 if Config.Sections = null then
3447 Config.Sections := new Argument_List'(1 .. 0 => null);
3450 Internal_Initialize_Option_Scan
3452 Switch_Char
=> Parser
.Switch_Character
,
3453 Stop_At_First_Non_Switch
=> Parser
.Stop_At_First
,
3454 Section_Delimiters
=> Section_Delimiters
(Config
));
3456 Getopt_Switches
:= new String'
3457 (Get_Switches (Config, Parser.Switch_Character, Section_Name.all)
3460 -- Initialize output values for automatically handled switches
3462 if Config.Switches /= null then
3463 for S in Config.Switches'Range loop
3464 case Config.Switches (S).Typ is
3465 when Switch_Untyped =>
3466 null; -- Nothing to do
3468 when Switch_Boolean =>
3469 Config.Switches (S).Boolean_Output.all :=
3470 not Config.Switches (S).Boolean_Value;
3472 when Switch_Integer =>
3473 Config.Switches (S).Integer_Output.all :=
3474 Config.Switches (S).Integer_Initial;
3476 when Switch_String =>
3477 if Config.Switches (S).String_Output.all = null then
3478 Config.Switches (S).String_Output.all := new String'("");
3484 -- For all sections, and all switches within those sections
3487 C
:= Getopt
(Switches
=> Getopt_Switches
.all,
3488 Concatenate
=> Concatenate
,
3492 -- Full_Switch already includes the leading '-'
3494 Do_Callback
(Switch
=> Full_Switch
(Parser
),
3495 Parameter
=> Parameter
(Parser
),
3498 elsif C
/= ASCII
.NUL
then
3499 if Full_Switch
(Parser
) = "h"
3501 Full_Switch
(Parser
) = "-help"
3503 Display_Help
(Config
);
3504 raise Exit_From_Command_Line
;
3507 -- Do switch expansion if needed
3511 Section
=> Section_Name
.all,
3512 Switch
=> Parser
.Switch_Character
& Full_Switch
(Parser
),
3513 Parameter
=> Parameter
(Parser
));
3516 if Current_Section
= -1 then
3517 Current_Section
:= Config
.Sections
'First;
3519 Current_Section
:= Current_Section
+ 1;
3522 exit when Current_Section
> Config
.Sections
'Last;
3524 Section_Name
:= Config
.Sections
(Current_Section
);
3525 Goto_Section
(Section_Name
.all, Parser
);
3527 Free
(Getopt_Switches
);
3528 Getopt_Switches
:= new String'
3530 (Config, Parser.Switch_Character, Section_Name.all));
3534 Free (Getopt_Switches);
3537 when Invalid_Switch =>
3538 Free (Getopt_Switches);
3540 -- Message inspired by "ls" on Unix
3542 Put_Line (Standard_Error,
3543 Base_Name (Ada.Command_Line.Command_Name)
3544 & ": unrecognized option '"
3545 & Full_Switch (Parser)
3552 Free (Getopt_Switches);
3561 (Line : in out Command_Line;
3562 Args : out GNAT.OS_Lib.Argument_List_Access;
3563 Expanded : Boolean := False;
3564 Switch_Char : Character := '-')
3566 Iter : Command_Line_Iterator;
3567 Count : Natural := 0;
3570 Start (Line, Iter, Expanded => Expanded);
3571 while Has_More (Iter) loop
3572 if Is_New_Section (Iter) then
3580 Args := new Argument_List (1 .. Count);
3581 Count := Args'First;
3583 Start (Line, Iter, Expanded => Expanded);
3584 while Has_More (Iter) loop
3585 if Is_New_Section (Iter) then
3586 Args (Count) := new String'(Switch_Char
& Current_Section
(Iter
));
3590 Args
(Count
) := new String'(Current_Switch (Iter)
3591 & Current_Separator (Iter)
3592 & Current_Parameter (Iter));
3602 -- Note: Any change to the message displayed should also be done in
3603 -- gnatbind.adb that does not use this interface.
3605 procedure Try_Help is
3609 "try """ & Base_Name (Ada.Command_Line.Command_Name)
3610 & " --help"" for more information.");
3613 end GNAT.Command_Line;