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-2012, 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 package CL
renames Ada
.Command_Line
;
44 type Switch_Parameter_Type
is
46 Parameter_With_Optional_Space
, -- ':' in getopt
47 Parameter_With_Space_Or_Equal
, -- '=' in getopt
48 Parameter_No_Space
, -- '!' in getopt
49 Parameter_Optional
); -- '?' in getopt
51 procedure Set_Parameter
52 (Variable
: out Parameter_Type
;
56 Extra
: Character := ASCII
.NUL
);
57 pragma Inline
(Set_Parameter
);
58 -- Set the parameter that will be returned by Parameter below
59 -- Parameters need to be defined ???
61 function Goto_Next_Argument_In_Section
(Parser
: Opt_Parser
) return Boolean;
62 -- Go to the next argument on the command line. If we are at the end of
63 -- the current section, we want to make sure there is no other identical
64 -- section on the command line (there might be multiple instances of
65 -- -largs). Returns True iff there is another argument.
67 function Get_File_Names_Case_Sensitive
return Integer;
68 pragma Import
(C
, Get_File_Names_Case_Sensitive
,
69 "__gnat_get_file_names_case_sensitive");
71 File_Names_Case_Sensitive
: constant Boolean :=
72 Get_File_Names_Case_Sensitive
/= 0;
74 procedure Canonical_Case_File_Name
(S
: in out String);
75 -- Given a file name, converts it to canonical case form. For systems where
76 -- file names are case sensitive, this procedure has no effect. If file
77 -- names are not case sensitive (i.e. for example if you have the file
78 -- "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then this call
79 -- converts the given string to canonical all lower case form, so that two
80 -- file names compare equal if they refer to the same file.
82 procedure Internal_Initialize_Option_Scan
84 Switch_Char
: Character;
85 Stop_At_First_Non_Switch
: Boolean;
86 Section_Delimiters
: String);
87 -- Initialize Parser, which must have been allocated already
89 function Argument
(Parser
: Opt_Parser
; Index
: Integer) return String;
90 -- Return the index-th command line argument
92 procedure Find_Longest_Matching_Switch
95 Index_In_Switches
: out Integer;
96 Switch_Length
: out Integer;
97 Param
: out Switch_Parameter_Type
);
98 -- Return the Longest switch from Switches that at least partially
99 -- partially Arg. Index_In_Switches is set to 0 if none matches.
100 -- What are other parameters??? in particular Param is not always set???
102 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
103 (Argument_List
, Argument_List_Access
);
105 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
106 (Command_Line_Configuration_Record
, Command_Line_Configuration
);
108 procedure Remove
(Line
: in out Argument_List_Access
; Index
: Integer);
109 -- Remove a specific element from Line
112 (Line
: in out Argument_List_Access
;
114 Before
: Boolean := False);
115 -- Add a new element to Line. If Before is True, the item is inserted at
116 -- the beginning, else it is appended.
119 (Config
: in out Command_Line_Configuration
;
120 Switch
: Switch_Definition
);
122 (Def
: in out Alias_Definitions_List
;
123 Alias
: Alias_Definition
);
124 -- Add a new element to Def
126 procedure Initialize_Switch_Def
127 (Def
: out Switch_Definition
;
128 Switch
: String := "";
129 Long_Switch
: String := "";
131 Section
: String := "";
132 Argument
: String := "ARG");
133 -- Initialize [Def] with the contents of the other parameters.
134 -- This also checks consistency of the switch parameters, and will raise
135 -- Invalid_Switch if they do not match.
137 procedure Decompose_Switch
139 Parameter_Type
: out Switch_Parameter_Type
;
140 Switch_Last
: out Integer);
141 -- Given a switch definition ("name:" for instance), extracts the type of
142 -- parameter that is expected, and the name of the switch
144 function Can_Have_Parameter
(S
: String) return Boolean;
145 -- True if S can have a parameter
147 function Require_Parameter
(S
: String) return Boolean;
148 -- True if S requires a parameter
150 function Actual_Switch
(S
: String) return String;
151 -- Remove any possible trailing '!', ':', '?' and '='
154 with procedure Callback
155 (Simple_Switch
: String;
158 Index
: Integer); -- Index in Config.Switches, or -1
159 procedure For_Each_Simple_Switch
160 (Config
: Command_Line_Configuration
;
163 Parameter
: String := "";
164 Unalias
: Boolean := True);
165 -- Breaks Switch into as simple switches as possible (expanding aliases and
166 -- ungrouping common prefixes when possible), and call Callback for each of
169 procedure Sort_Sections
170 (Line
: GNAT
.OS_Lib
.Argument_List_Access
;
171 Sections
: GNAT
.OS_Lib
.Argument_List_Access
;
172 Params
: GNAT
.OS_Lib
.Argument_List_Access
);
173 -- Reorder the command line switches so that the switches belonging to a
174 -- section are grouped together.
176 procedure Group_Switches
178 Result
: Argument_List_Access
;
179 Sections
: Argument_List_Access
;
180 Params
: Argument_List_Access
);
181 -- Group switches with common prefixes whenever possible. Once they have
182 -- been grouped, we also check items for possible aliasing.
184 procedure Alias_Switches
186 Result
: Argument_List_Access
;
187 Params
: Argument_List_Access
);
188 -- When possible, replace one or more switches by an alias, i.e. a shorter
194 Substring
: String) return Boolean;
195 -- Return True if the characters starting at Index in Type_Str are
196 -- equivalent to Substring.
199 with function Callback
(S
: String; Index
: Integer) return Boolean;
200 procedure Foreach_Switch
201 (Config
: Command_Line_Configuration
;
203 -- Iterate over all switches defined in Config, for a specific section.
204 -- Index is set to the index in Config.Switches. Stop iterating when
205 -- Callback returns False.
211 function Argument
(Parser
: Opt_Parser
; Index
: Integer) return String is
213 if Parser
.Arguments
/= null then
214 return Parser
.Arguments
(Index
+ Parser
.Arguments
'First - 1).all;
216 return CL
.Argument
(Index
);
220 ------------------------------
221 -- Canonical_Case_File_Name --
222 ------------------------------
224 procedure Canonical_Case_File_Name
(S
: in out String) is
226 if not File_Names_Case_Sensitive
then
227 for J
in S
'Range loop
228 if S
(J
) in 'A' .. 'Z' then
229 S
(J
) := Character'Val
230 (Character'Pos (S
(J
)) +
231 (Character'Pos ('a') - Character'Pos ('A')));
235 end Canonical_Case_File_Name
;
241 function Expansion
(Iterator
: Expansion_Iterator
) return String is
242 type Pointer
is access all Expansion_Iterator
;
244 It
: constant Pointer
:= Iterator
'Unrestricted_Access;
245 S
: String (1 .. 1024);
248 Current
: Depth
:= It
.Current_Depth
;
252 -- It is assumed that a directory is opened at the current level.
253 -- Otherwise GNAT.Directory_Operations.Directory_Error will be raised
254 -- at the first call to Read.
257 Read
(It
.Levels
(Current
).Dir
, S
, Last
);
259 -- If we have exhausted the directory, close it and go back one level
262 Close
(It
.Levels
(Current
).Dir
);
264 -- If we are at level 1, we are finished; return an empty string
267 return String'(1 .. 0 => ' ');
269 -- Otherwise continue with the directory at the previous level
272 Current := Current - 1;
273 It.Current_Depth := Current;
276 -- If this is a directory, that is neither "." or "..", attempt to
277 -- go to the next level.
280 (It.Dir_Name (1 .. It.Levels (Current).Name_Last) &
282 and then S (1 .. Last) /= "."
283 and then S (1 .. Last) /= ".."
285 -- We can go to the next level only if we have not reached the
288 if Current < It.Maximum_Depth then
289 NL := It.Levels (Current).Name_Last;
291 -- And if relative path of this new directory is not too long
293 if NL + Last + 1 < Max_Path_Length then
294 Current := Current + 1;
295 It.Current_Depth := Current;
296 It.Dir_Name (NL + 1 .. NL + Last) := S (1 .. Last);
298 It.Dir_Name (NL) := Directory_Separator;
299 It.Levels (Current).Name_Last := NL;
300 Canonical_Case_File_Name (It.Dir_Name (1 .. NL));
302 -- Open the new directory, and read from it
304 GNAT.Directory_Operations.Open
305 (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
310 -- Check the relative path against the pattern
312 -- Note that we try to match also against directory names, since
313 -- clients of this function may expect to retrieve directories.
317 It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
321 Canonical_Case_File_Name (Name);
323 -- If it matches return the relative path
325 if GNAT.Regexp.Match (Name, Iterator.Regexp) then
332 ---------------------
333 -- Current_Section --
334 ---------------------
336 function Current_Section
337 (Parser : Opt_Parser := Command_Line_Parser) return String
340 if Parser.Current_Section = 1 then
344 for Index in reverse 1 .. Integer'Min (Parser.Current_Argument - 1,
347 if Parser.Section (Index) = 0 then
348 return Argument (Parser, Index);
360 (Parser : Opt_Parser := Command_Line_Parser) return String
363 if Parser.The_Switch.Extra = ASCII.NUL then
364 return Argument (Parser, Parser.The_Switch.Arg_Num)
365 (Parser.The_Switch.First .. Parser.The_Switch.Last);
367 return Parser.The_Switch.Extra
368 & Argument (Parser, Parser.The_Switch.Arg_Num)
369 (Parser.The_Switch.First .. Parser.The_Switch.Last);
377 function Get_Argument
378 (Do_Expansion : Boolean := False;
379 Parser : Opt_Parser := Command_Line_Parser) return String
382 if Parser.In_Expansion then
384 S : constant String := Expansion (Parser.Expansion_It);
386 if S'Length /= 0 then
389 Parser.In_Expansion := False;
394 if Parser.Current_Argument > Parser.Arg_Count then
396 -- If this is the first time this function is called
398 if Parser.Current_Index = 1 then
399 Parser.Current_Argument := 1;
400 while Parser.Current_Argument <= Parser.Arg_Count
401 and then Parser.Section (Parser.Current_Argument) /=
402 Parser.Current_Section
404 Parser.Current_Argument := Parser.Current_Argument + 1;
408 return String'(1 .. 0 => ' ');
411 elsif Parser
.Section
(Parser
.Current_Argument
) = 0 then
412 while Parser
.Current_Argument
<= Parser
.Arg_Count
413 and then Parser
.Section
(Parser
.Current_Argument
) /=
414 Parser
.Current_Section
416 Parser
.Current_Argument
:= Parser
.Current_Argument
+ 1;
420 Parser
.Current_Index
:= Integer'Last;
422 while Parser
.Current_Argument
<= Parser
.Arg_Count
423 and then Parser
.Is_Switch
(Parser
.Current_Argument
)
425 Parser
.Current_Argument
:= Parser
.Current_Argument
+ 1;
428 if Parser
.Current_Argument
> Parser
.Arg_Count
then
429 return String'(1 .. 0 => ' ');
430 elsif Parser.Section (Parser.Current_Argument) = 0 then
431 return Get_Argument (Do_Expansion);
434 Parser.Current_Argument := Parser.Current_Argument + 1;
436 -- Could it be a file name with wild cards to expand?
440 Arg : constant String :=
441 Argument (Parser, Parser.Current_Argument - 1);
446 while Index <= Arg'Last loop
448 or else Arg (Index) = '?
'
449 or else Arg (Index) = '['
451 Parser.In_Expansion := True;
452 Start_Expansion (Parser.Expansion_It, Arg);
453 return Get_Argument (Do_Expansion);
461 return Argument (Parser, Parser.Current_Argument - 1);
464 ----------------------
465 -- Decompose_Switch --
466 ----------------------
468 procedure Decompose_Switch
470 Parameter_Type : out Switch_Parameter_Type;
471 Switch_Last : out Integer)
475 Parameter_Type := Parameter_None;
476 Switch_Last := Switch'Last;
480 case Switch (Switch'Last) is
482 Parameter_Type := Parameter_With_Optional_Space;
483 Switch_Last := Switch'Last - 1;
485 Parameter_Type := Parameter_With_Space_Or_Equal;
486 Switch_Last := Switch'Last - 1;
488 Parameter_Type := Parameter_No_Space;
489 Switch_Last := Switch'Last - 1;
491 Parameter_Type := Parameter_Optional;
492 Switch_Last := Switch'Last - 1;
494 Parameter_Type := Parameter_None;
495 Switch_Last := Switch'Last;
497 end Decompose_Switch;
499 ----------------------------------
500 -- Find_Longest_Matching_Switch --
501 ----------------------------------
503 procedure Find_Longest_Matching_Switch
506 Index_In_Switches : out Integer;
507 Switch_Length : out Integer;
508 Param : out Switch_Parameter_Type)
511 Length : Natural := 1;
513 P : Switch_Parameter_Type;
516 Index_In_Switches := 0;
519 -- Remove all leading spaces first to make sure that Index points
520 -- at the start of the first switch.
522 Index := Switches'First;
523 while Index <= Switches'Last and then Switches (Index) = ' ' loop
527 while Index <= Switches'Last loop
529 -- Search the length of the parameter at this position in Switches
532 while Length <= Switches'Last
533 and then Switches (Length) /= ' '
535 Length := Length + 1;
538 -- Length now marks the separator after the current switch. Last will
539 -- mark the last character of the name of the switch.
541 if Length = Index + 1 then
545 Decompose_Switch (Switches (Index .. Length - 1), P, Last);
548 -- If it is the one we searched, it may be a candidate
550 if Arg'First + Last - Index <= Arg'Last
551 and then Switches (Index .. Last) =
552 Arg (Arg'First .. Arg'First + Last - Index)
553 and then Last - Index + 1 > Switch_Length
556 Index_In_Switches := Index;
557 Switch_Length := Last - Index + 1;
560 -- Look for the next switch in Switches
562 while Index <= Switches'Last
563 and then Switches (Index) /= ' '
570 end Find_Longest_Matching_Switch;
578 Concatenate : Boolean := True;
579 Parser : Opt_Parser := Command_Line_Parser) return Character
582 pragma Unreferenced (Dummy);
587 -- If we have finished parsing the current command line item (there
588 -- might be multiple switches in a single item), then go to the next
591 if Parser.Current_Argument > Parser.Arg_Count
592 or else (Parser.Current_Index >
593 Argument (Parser, Parser.Current_Argument)'Last
594 and then not Goto_Next_Argument_In_Section (Parser))
599 -- By default, the switch will not have a parameter
601 Parser.The_Parameter :=
602 (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL);
603 Parser.The_Separator := ASCII.NUL;
606 Arg : constant String :=
607 Argument (Parser, Parser.Current_Argument);
608 Index_Switches : Natural := 0;
609 Max_Length : Natural := 0;
611 Param : Switch_Parameter_Type;
613 -- If we are on a new item, test if this might be a switch
615 if Parser.Current_Index = Arg'First then
616 if Arg (Arg'First) /= Parser.Switch_Character then
618 -- If it isn't a switch, return it immediately. We also know it
619 -- isn't the parameter to a previous switch, since that has
620 -- already been handled.
622 if Switches (Switches'First) = '*' then
625 Arg_Num => Parser.Current_Argument,
628 Parser.Is_Switch (Parser.Current_Argument) := True;
629 Dummy := Goto_Next_Argument_In_Section (Parser);
633 if Parser.Stop_At_First then
634 Parser.Current_Argument := Positive'Last;
637 elsif not Goto_Next_Argument_In_Section (Parser) then
641 -- Recurse to get the next switch on the command line
647 -- We are on the first character of a new command line argument,
648 -- which starts with Switch_Character. Further analysis is needed.
650 Parser.Current_Index := Parser.Current_Index + 1;
651 Parser.Is_Switch (Parser.Current_Argument) := True;
654 Find_Longest_Matching_Switch
655 (Switches => Switches,
656 Arg => Arg (Parser.Current_Index .. Arg'Last),
657 Index_In_Switches => Index_Switches,
658 Switch_Length => Max_Length,
661 -- If switch is not accepted, it is either invalid or is returned
662 -- in the context of '*'.
664 if Index_Switches = 0 then
666 -- Depending on the value of Concatenate, the full switch is
667 -- a single character or the rest of the argument.
670 (if Concatenate then Parser.Current_Index else Arg'Last);
672 if Switches (Switches'First) = '*' then
674 -- Always prepend the switch character, so that users know that
675 -- this comes from a switch on the command line. This is
676 -- especially important when Concatenate is False, since
677 -- otherwise the current argument first character is lost.
679 if Parser.Section (Parser.Current_Argument) = 0 then
681 -- A section transition should not be returned to the user
683 Dummy := Goto_Next_Argument_In_Section (Parser);
689 Arg_Num => Parser.Current_Argument,
690 First => Parser.Current_Index,
692 Extra => Parser.Switch_Character);
693 Parser.Is_Switch (Parser.Current_Argument) := True;
694 Dummy := Goto_Next_Argument_In_Section (Parser);
701 Arg_Num => Parser.Current_Argument,
702 First => Parser.Current_Index,
704 Parser.Current_Index := End_Index + 1;
706 raise Invalid_Switch;
709 End_Index := Parser.Current_Index + Max_Length - 1;
712 Arg_Num => Parser.Current_Argument,
713 First => Parser.Current_Index,
717 when Parameter_With_Optional_Space =>
718 if End_Index < Arg'Last then
720 (Parser.The_Parameter,
721 Arg_Num => Parser.Current_Argument,
722 First => End_Index + 1,
724 Dummy := Goto_Next_Argument_In_Section (Parser);
726 elsif Parser.Current_Argument < Parser.Arg_Count
727 and then Parser.Section (Parser.Current_Argument + 1) /= 0
729 Parser.Current_Argument := Parser.Current_Argument + 1;
730 Parser.The_Separator := ' ';
732 (Parser.The_Parameter,
733 Arg_Num => Parser.Current_Argument,
734 First => Argument (Parser, Parser.Current_Argument)'First,
735 Last => Argument (Parser, Parser.Current_Argument)'Last);
736 Parser.Is_Switch (Parser.Current_Argument) := True;
737 Dummy := Goto_Next_Argument_In_Section (Parser);
740 Parser.Current_Index := End_Index + 1;
741 raise Invalid_Parameter;
744 when Parameter_With_Space_Or_Equal =>
746 -- If the switch is of the form <switch>=xxx
748 if End_Index < Arg'Last then
749 if Arg (End_Index + 1) = '='
750 and then End_Index + 1 < Arg'Last
752 Parser.The_Separator := '=';
754 (Parser.The_Parameter,
755 Arg_Num => Parser.Current_Argument,
756 First => End_Index + 2,
758 Dummy := Goto_Next_Argument_In_Section (Parser);
761 Parser.Current_Index := End_Index + 1;
762 raise Invalid_Parameter;
765 -- If the switch is of the form <switch> xxx
767 elsif Parser.Current_Argument < Parser.Arg_Count
768 and then Parser.Section (Parser.Current_Argument + 1) /= 0
770 Parser.Current_Argument := Parser.Current_Argument + 1;
771 Parser.The_Separator := ' ';
773 (Parser.The_Parameter,
774 Arg_Num => Parser.Current_Argument,
775 First => Argument (Parser, Parser.Current_Argument)'First,
776 Last => Argument (Parser, Parser.Current_Argument)'Last);
777 Parser.Is_Switch (Parser.Current_Argument) := True;
778 Dummy := Goto_Next_Argument_In_Section (Parser);
781 Parser.Current_Index := End_Index + 1;
782 raise Invalid_Parameter;
785 when Parameter_No_Space =>
786 if End_Index < Arg'Last then
788 (Parser.The_Parameter,
789 Arg_Num => Parser.Current_Argument,
790 First => End_Index + 1,
792 Dummy := Goto_Next_Argument_In_Section (Parser);
795 Parser.Current_Index := End_Index + 1;
796 raise Invalid_Parameter;
799 when Parameter_Optional =>
800 if End_Index < Arg'Last then
802 (Parser.The_Parameter,
803 Arg_Num => Parser.Current_Argument,
804 First => End_Index + 1,
808 Dummy := Goto_Next_Argument_In_Section (Parser);
810 when Parameter_None =>
811 if Concatenate or else End_Index = Arg'Last then
812 Parser.Current_Index := End_Index + 1;
815 -- If Concatenate is False and the full argument is not
816 -- recognized as a switch, this is an invalid switch.
818 if Switches (Switches'First) = '*' then
821 Arg_Num => Parser.Current_Argument,
824 Parser.Is_Switch (Parser.Current_Argument) := True;
825 Dummy := Goto_Next_Argument_In_Section (Parser);
831 Arg_Num => Parser.Current_Argument,
832 First => Parser.Current_Index,
834 Parser.Current_Index := Arg'Last + 1;
835 raise Invalid_Switch;
839 return Switches (Index_Switches);
843 -----------------------------------
844 -- Goto_Next_Argument_In_Section --
845 -----------------------------------
847 function Goto_Next_Argument_In_Section
848 (Parser : Opt_Parser) return Boolean
851 Parser.Current_Argument := Parser.Current_Argument + 1;
853 if Parser.Current_Argument > Parser.Arg_Count
854 or else Parser.Section (Parser.Current_Argument) = 0
857 Parser.Current_Argument := Parser.Current_Argument + 1;
859 if Parser.Current_Argument > Parser.Arg_Count then
860 Parser.Current_Index := 1;
864 exit when Parser.Section (Parser.Current_Argument) =
865 Parser.Current_Section;
869 Parser.Current_Index :=
870 Argument (Parser, Parser.Current_Argument)'First;
873 end Goto_Next_Argument_In_Section;
879 procedure Goto_Section
880 (Name : String := "";
881 Parser : Opt_Parser := Command_Line_Parser)
886 Parser.In_Expansion := False;
889 Parser.Current_Argument := 1;
890 Parser.Current_Index := 1;
891 Parser.Current_Section := 1;
896 while Index <= Parser.Arg_Count loop
897 if Parser.Section (Index) = 0
898 and then Argument (Parser, Index) = Parser.Switch_Character & Name
900 Parser.Current_Argument := Index + 1;
901 Parser.Current_Index := 1;
903 if Parser.Current_Argument <= Parser.Arg_Count then
904 Parser.Current_Section :=
905 Parser.Section (Parser.Current_Argument);
908 -- Exit from loop if we have the start of another section
910 if Index = Parser.Section'Last
911 or else Parser.Section (Index + 1) /= 0
920 Parser.Current_Argument := Positive'Last;
921 Parser.Current_Index := 2; -- so that Get_Argument returns nothing
924 ----------------------------
925 -- Initialize_Option_Scan --
926 ----------------------------
928 procedure Initialize_Option_Scan
929 (Switch_Char : Character := '-';
930 Stop_At_First_Non_Switch : Boolean := False;
931 Section_Delimiters : String := "")
934 Internal_Initialize_Option_Scan
935 (Parser => Command_Line_Parser,
936 Switch_Char => Switch_Char,
937 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
938 Section_Delimiters => Section_Delimiters);
939 end Initialize_Option_Scan;
941 ----------------------------
942 -- Initialize_Option_Scan --
943 ----------------------------
945 procedure Initialize_Option_Scan
946 (Parser : out Opt_Parser;
947 Command_Line : GNAT.OS_Lib.Argument_List_Access;
948 Switch_Char : Character := '-';
949 Stop_At_First_Non_Switch : Boolean := False;
950 Section_Delimiters : String := "")
955 if Command_Line = null then
956 Parser := new Opt_Parser_Data (CL.Argument_Count);
957 Internal_Initialize_Option_Scan
959 Switch_Char => Switch_Char,
960 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
961 Section_Delimiters => Section_Delimiters);
963 Parser := new Opt_Parser_Data (Command_Line'Length);
964 Parser.Arguments := Command_Line;
965 Internal_Initialize_Option_Scan
967 Switch_Char => Switch_Char,
968 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
969 Section_Delimiters => Section_Delimiters);
971 end Initialize_Option_Scan;
973 -------------------------------------
974 -- Internal_Initialize_Option_Scan --
975 -------------------------------------
977 procedure Internal_Initialize_Option_Scan
978 (Parser : Opt_Parser;
979 Switch_Char : Character;
980 Stop_At_First_Non_Switch : Boolean;
981 Section_Delimiters : String)
983 Section_Num : Section_Number;
984 Section_Index : Integer;
986 Delimiter_Found : Boolean;
989 pragma Warnings (Off, Discard);
992 Parser.Current_Argument := 0;
993 Parser.Current_Index := 0;
994 Parser.In_Expansion := False;
995 Parser.Switch_Character := Switch_Char;
996 Parser.Stop_At_First := Stop_At_First_Non_Switch;
997 Parser.Section := (others => 1);
999 -- If we are using sections, we have to preprocess the command line to
1000 -- delimit them. A section can be repeated, so we just give each item
1001 -- on the command line a section number
1004 Section_Index := Section_Delimiters'First;
1005 while Section_Index <= Section_Delimiters'Last loop
1006 Last := Section_Index;
1007 while Last <= Section_Delimiters'Last
1008 and then Section_Delimiters (Last) /= ' '
1013 Delimiter_Found := False;
1014 Section_Num := Section_Num + 1;
1016 for Index in 1 .. Parser.Arg_Count loop
1017 if Argument (Parser, Index)(1) = Parser.Switch_Character
1019 Argument (Parser, Index) = Parser.Switch_Character &
1021 (Section_Index .. Last - 1)
1023 Parser.Section (Index) := 0;
1024 Delimiter_Found := True;
1026 elsif Parser.Section (Index) = 0 then
1028 -- A previous section delimiter
1030 Delimiter_Found := False;
1032 elsif Delimiter_Found then
1033 Parser.Section (Index) := Section_Num;
1037 Section_Index := Last + 1;
1038 while Section_Index <= Section_Delimiters'Last
1039 and then Section_Delimiters (Section_Index) = ' '
1041 Section_Index := Section_Index + 1;
1045 Discard := Goto_Next_Argument_In_Section (Parser);
1046 end Internal_Initialize_Option_Scan;
1053 (Parser : Opt_Parser := Command_Line_Parser) return String
1056 if Parser.The_Parameter.First > Parser.The_Parameter.Last then
1057 return String'(1 .. 0 => ' ');
1059 return Argument
(Parser
, Parser
.The_Parameter
.Arg_Num
)
1060 (Parser
.The_Parameter
.First
.. Parser
.The_Parameter
.Last
);
1069 (Parser
: Opt_Parser
:= Command_Line_Parser
) return Character
1072 return Parser
.The_Separator
;
1079 procedure Set_Parameter
1080 (Variable
: out Parameter_Type
;
1084 Extra
: Character := ASCII
.NUL
)
1087 Variable
.Arg_Num
:= Arg_Num
;
1088 Variable
.First
:= First
;
1089 Variable
.Last
:= Last
;
1090 Variable
.Extra
:= Extra
;
1093 ---------------------
1094 -- Start_Expansion --
1095 ---------------------
1097 procedure Start_Expansion
1098 (Iterator
: out Expansion_Iterator
;
1100 Directory
: String := "";
1101 Basic_Regexp
: Boolean := True)
1103 Directory_Separator
: Character;
1104 pragma Import
(C
, Directory_Separator
, "__gnat_dir_separator");
1106 First
: Positive := Pattern
'First;
1107 Pat
: String := Pattern
;
1110 Canonical_Case_File_Name
(Pat
);
1111 Iterator
.Current_Depth
:= 1;
1113 -- If Directory is unspecified, use the current directory ("./" or ".\")
1115 if Directory
= "" then
1116 Iterator
.Dir_Name
(1 .. 2) := "." & Directory_Separator
;
1117 Iterator
.Start
:= 3;
1120 Iterator
.Dir_Name
(1 .. Directory
'Length) := Directory
;
1121 Iterator
.Start
:= Directory
'Length + 1;
1122 Canonical_Case_File_Name
(Iterator
.Dir_Name
(1 .. Directory
'Length));
1124 -- Make sure that the last character is a directory separator
1126 if Directory
(Directory
'Last) /= Directory_Separator
then
1127 Iterator
.Dir_Name
(Iterator
.Start
) := Directory_Separator
;
1128 Iterator
.Start
:= Iterator
.Start
+ 1;
1132 Iterator
.Levels
(1).Name_Last
:= Iterator
.Start
- 1;
1134 -- Open the initial Directory, at depth 1
1136 GNAT
.Directory_Operations
.Open
1137 (Iterator
.Levels
(1).Dir
, Iterator
.Dir_Name
(1 .. Iterator
.Start
- 1));
1139 -- If in the current directory and the pattern starts with "./" or ".\",
1140 -- drop the "./" or ".\" from the pattern.
1142 if Directory
= "" and then Pat
'Length > 2
1143 and then Pat
(Pat
'First) = '.'
1144 and then Pat
(Pat
'First + 1) = Directory_Separator
1146 First
:= Pat
'First + 2;
1150 GNAT
.Regexp
.Compile
(Pat
(First
.. Pat
'Last), Basic_Regexp
, True);
1152 Iterator
.Maximum_Depth
:= 1;
1154 -- Maximum_Depth is equal to 1 plus the number of directory separators
1157 for Index
in First
.. Pat
'Last loop
1158 if Pat
(Index
) = Directory_Separator
then
1159 Iterator
.Maximum_Depth
:= Iterator
.Maximum_Depth
+ 1;
1160 exit when Iterator
.Maximum_Depth
= Max_Depth
;
1163 end Start_Expansion
;
1169 procedure Free
(Parser
: in out Opt_Parser
) is
1170 procedure Unchecked_Free
is new
1171 Ada
.Unchecked_Deallocation
(Opt_Parser_Data
, Opt_Parser
);
1174 and then Parser
/= Command_Line_Parser
1176 Free
(Parser
.Arguments
);
1177 Unchecked_Free
(Parser
);
1185 procedure Define_Alias
1186 (Config
: in out Command_Line_Configuration
;
1189 Section
: String := "")
1191 Def
: Alias_Definition
;
1193 if Config
= null then
1194 Config
:= new Command_Line_Configuration_Record
;
1197 Def
.Alias
:= new String'(Switch);
1198 Def.Expansion := new String'(Expanded
);
1199 Def
.Section
:= new String'(Section);
1200 Add (Config.Aliases, Def);
1207 procedure Define_Prefix
1208 (Config : in out Command_Line_Configuration;
1212 if Config = null then
1213 Config := new Command_Line_Configuration_Record;
1216 Add (Config.Prefixes, new String'(Prefix
));
1224 (Config
: in out Command_Line_Configuration
;
1225 Switch
: Switch_Definition
)
1227 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
1228 (Switch_Definitions
, Switch_Definitions_List
);
1230 Tmp
: Switch_Definitions_List
;
1233 if Config
= null then
1234 Config
:= new Command_Line_Configuration_Record
;
1237 Tmp
:= Config
.Switches
;
1240 Config
.Switches
:= new Switch_Definitions
(1 .. 1);
1242 Config
.Switches
:= new Switch_Definitions
(1 .. Tmp
'Length + 1);
1243 Config
.Switches
(1 .. Tmp
'Length) := Tmp
.all;
1244 Unchecked_Free
(Tmp
);
1247 if Switch
.Switch
/= null and then Switch
.Switch
.all = "*" then
1248 Config
.Star_Switch
:= True;
1251 Config
.Switches
(Config
.Switches
'Last) := Switch
;
1258 procedure Add
(Def
: in out Alias_Definitions_List
;
1259 Alias
: Alias_Definition
)
1261 procedure Unchecked_Free
is new
1262 Ada
.Unchecked_Deallocation
1263 (Alias_Definitions
, Alias_Definitions_List
);
1265 Tmp
: Alias_Definitions_List
:= Def
;
1269 Def
:= new Alias_Definitions
(1 .. 1);
1271 Def
:= new Alias_Definitions
(1 .. Tmp
'Length + 1);
1272 Def
(1 .. Tmp
'Length) := Tmp
.all;
1273 Unchecked_Free
(Tmp
);
1276 Def
(Def
'Last) := Alias
;
1279 ---------------------------
1280 -- Initialize_Switch_Def --
1281 ---------------------------
1283 procedure Initialize_Switch_Def
1284 (Def
: out Switch_Definition
;
1285 Switch
: String := "";
1286 Long_Switch
: String := "";
1287 Help
: String := "";
1288 Section
: String := "";
1289 Argument
: String := "ARG")
1291 P1
, P2
: Switch_Parameter_Type
:= Parameter_None
;
1292 Last1
, Last2
: Integer;
1295 if Switch
/= "" then
1296 Def
.Switch
:= new String'(Switch);
1297 Decompose_Switch (Switch, P1, Last1);
1300 if Long_Switch /= "" then
1301 Def.Long_Switch := new String'(Long_Switch
);
1302 Decompose_Switch
(Long_Switch
, P2
, Last2
);
1305 if Switch
/= "" and then Long_Switch
/= "" then
1306 if (P1
= Parameter_None
and then P2
/= P1
)
1307 or else (P2
= Parameter_None
and then P1
/= P2
)
1308 or else (P1
= Parameter_Optional
and then P2
/= P1
)
1309 or else (P2
= Parameter_Optional
and then P2
/= P1
)
1311 raise Invalid_Switch
1312 with "Inconsistent parameter types for "
1313 & Switch
& " and " & Long_Switch
;
1317 if Section
/= "" then
1318 Def
.Section
:= new String'(Section);
1321 if Argument /= "ARG" then
1322 Def.Argument := new String'(Argument
);
1326 Def
.Help
:= new String'(Help);
1328 end Initialize_Switch_Def;
1334 procedure Define_Switch
1335 (Config : in out Command_Line_Configuration;
1336 Switch : String := "";
1337 Long_Switch : String := "";
1338 Help : String := "";
1339 Section : String := "";
1340 Argument : String := "ARG")
1342 Def : Switch_Definition;
1344 if Switch /= "" or else Long_Switch /= "" then
1345 Initialize_Switch_Def
1346 (Def, Switch, Long_Switch, Help, Section, Argument);
1355 procedure Define_Switch
1356 (Config : in out Command_Line_Configuration;
1357 Output : access Boolean;
1358 Switch : String := "";
1359 Long_Switch : String := "";
1360 Help : String := "";
1361 Section : String := "";
1362 Value : Boolean := True)
1364 Def : Switch_Definition (Switch_Boolean);
1366 if Switch /= "" or else Long_Switch /= "" then
1367 Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
1368 Def.Boolean_Output := Output.all'Unchecked_Access;
1369 Def.Boolean_Value := Value;
1378 procedure Define_Switch
1379 (Config : in out Command_Line_Configuration;
1380 Output : access Integer;
1381 Switch : String := "";
1382 Long_Switch : String := "";
1383 Help : String := "";
1384 Section : String := "";
1385 Initial : Integer := 0;
1386 Default : Integer := 1;
1387 Argument : String := "ARG")
1389 Def : Switch_Definition (Switch_Integer);
1391 if Switch /= "" or else Long_Switch /= "" then
1392 Initialize_Switch_Def
1393 (Def, Switch, Long_Switch, Help, Section, Argument);
1394 Def.Integer_Output := Output.all'Unchecked_Access;
1395 Def.Integer_Default := Default;
1396 Def.Integer_Initial := Initial;
1405 procedure Define_Switch
1406 (Config : in out Command_Line_Configuration;
1407 Output : access GNAT.Strings.String_Access;
1408 Switch : String := "";
1409 Long_Switch : String := "";
1410 Help : String := "";
1411 Section : String := "";
1412 Argument : String := "ARG")
1414 Def : Switch_Definition (Switch_String);
1416 if Switch /= "" or else Long_Switch /= "" then
1417 Initialize_Switch_Def
1418 (Def, Switch, Long_Switch, Help, Section, Argument);
1419 Def.String_Output := Output.all'Unchecked_Access;
1424 --------------------
1425 -- Define_Section --
1426 --------------------
1428 procedure Define_Section
1429 (Config : in out Command_Line_Configuration;
1433 if Config = null then
1434 Config := new Command_Line_Configuration_Record;
1437 Add (Config.Sections, new String'(Section
));
1440 --------------------
1441 -- Foreach_Switch --
1442 --------------------
1444 procedure Foreach_Switch
1445 (Config
: Command_Line_Configuration
;
1449 if Config
/= null and then Config
.Switches
/= null then
1450 for J
in Config
.Switches
'Range loop
1451 if (Section
= "" and then Config
.Switches
(J
).Section
= null)
1453 (Config
.Switches
(J
).Section
/= null
1454 and then Config
.Switches
(J
).Section
.all = Section
)
1456 exit when Config
.Switches
(J
).Switch
/= null
1457 and then not Callback
(Config
.Switches
(J
).Switch
.all, J
);
1459 exit when Config
.Switches
(J
).Long_Switch
/= null
1461 not Callback
(Config
.Switches
(J
).Long_Switch
.all, J
);
1471 function Get_Switches
1472 (Config
: Command_Line_Configuration
;
1473 Switch_Char
: Character := '-';
1474 Section
: String := "") return String
1476 Ret
: Ada
.Strings
.Unbounded
.Unbounded_String
;
1477 use Ada
.Strings
.Unbounded
;
1479 function Add_Switch
(S
: String; Index
: Integer) return Boolean;
1480 -- Add a switch to Ret
1486 function Add_Switch
(S
: String; Index
: Integer) return Boolean is
1487 pragma Unreferenced
(Index
);
1490 Ret
:= "*" & Ret
; -- Always first
1491 elsif S
(S
'First) = Switch_Char
then
1492 Append
(Ret
, " " & S
(S
'First + 1 .. S
'Last));
1494 Append
(Ret
, " " & S
);
1501 pragma Unreferenced
(Tmp
);
1503 procedure Foreach
is new Foreach_Switch
(Add_Switch
);
1505 -- Start of processing for Get_Switches
1508 if Config
= null then
1512 Foreach
(Config
, Section
=> Section
);
1514 -- Adding relevant aliases
1516 if Config
.Aliases
/= null then
1517 for A
in Config
.Aliases
'Range loop
1518 if Config
.Aliases
(A
).Section
.all = Section
then
1519 Tmp
:= Add_Switch
(Config
.Aliases
(A
).Alias
.all, -1);
1524 return To_String
(Ret
);
1527 ------------------------
1528 -- Section_Delimiters --
1529 ------------------------
1531 function Section_Delimiters
1532 (Config
: Command_Line_Configuration
) return String
1534 use Ada
.Strings
.Unbounded
;
1535 Result
: Unbounded_String
;
1538 if Config
/= null and then Config
.Sections
/= null then
1539 for S
in Config
.Sections
'Range loop
1540 Append
(Result
, " " & Config
.Sections
(S
).all);
1544 return To_String
(Result
);
1545 end Section_Delimiters
;
1547 -----------------------
1548 -- Set_Configuration --
1549 -----------------------
1551 procedure Set_Configuration
1552 (Cmd
: in out Command_Line
;
1553 Config
: Command_Line_Configuration
)
1556 Cmd
.Config
:= Config
;
1557 end Set_Configuration
;
1559 -----------------------
1560 -- Get_Configuration --
1561 -----------------------
1563 function Get_Configuration
1564 (Cmd
: Command_Line
) return Command_Line_Configuration
1568 end Get_Configuration
;
1570 ----------------------
1571 -- Set_Command_Line --
1572 ----------------------
1574 procedure Set_Command_Line
1575 (Cmd
: in out Command_Line
;
1577 Getopt_Description
: String := "";
1578 Switch_Char
: Character := '-')
1580 Tmp
: Argument_List_Access
;
1581 Parser
: Opt_Parser
;
1583 Section
: String_Access
:= null;
1585 function Real_Full_Switch
1587 Parser
: Opt_Parser
) return String;
1588 -- Ensure that the returned switch value contains the
1589 -- Switch_Char prefix if needed.
1591 ----------------------
1592 -- Real_Full_Switch --
1593 ----------------------
1595 function Real_Full_Switch
1597 Parser
: Opt_Parser
) return String
1601 return Full_Switch
(Parser
);
1603 return Switch_Char
& Full_Switch
(Parser
);
1605 end Real_Full_Switch
;
1607 -- Start of processing for Set_Command_Line
1610 Free
(Cmd
.Expanded
);
1613 if Switches
/= "" then
1614 Tmp
:= Argument_String_To_List
(Switches
);
1615 Initialize_Option_Scan
(Parser
, Tmp
, Switch_Char
);
1619 if Cmd
.Config
/= null then
1621 -- Do not use Getopt_Description in this case. Otherwise,
1622 -- if we have defined a prefix -gnaty, and two switches
1623 -- -gnatya and -gnatyL!, we would have a different behavior
1624 -- depending on the order of switches:
1626 -- -gnatyL1a => -gnatyL with argument "1a"
1627 -- -gnatyaL1 => -gnatya and -gnatyL with argument "1"
1629 -- This is because the call to Getopt below knows nothing
1630 -- about prefixes, and in the first case finds a valid
1631 -- switch with arguments, so returns it without analyzing
1632 -- the argument. In the second case, the switch matches "*",
1633 -- and is then decomposed below.
1635 S
:= Getopt
(Switches
=> "*",
1636 Concatenate
=> False,
1640 S
:= Getopt
(Switches
=> "* " & Getopt_Description
,
1641 Concatenate
=> False,
1645 exit when S
= ASCII
.NUL
;
1648 Sw
: constant String := Real_Full_Switch
(S
, Parser
);
1649 Is_Section
: Boolean := False;
1652 if Cmd
.Config
/= null
1653 and then Cmd
.Config
.Sections
/= null
1656 for S
in Cmd
.Config
.Sections
'Range loop
1657 if Sw
= Cmd
.Config
.Sections
(S
).all then
1658 Section
:= Cmd
.Config
.Sections
(S
);
1661 exit Section_Search
;
1663 end loop Section_Search
;
1666 if not Is_Section
then
1667 if Section
= null then
1668 Add_Switch
(Cmd
, Sw
, Parameter
(Parser
));
1671 (Cmd
, Sw
, Parameter
(Parser
),
1672 Section
=> Section
.all);
1678 when Invalid_Parameter
=>
1680 -- Add it with no parameter, if that's the way the user
1683 -- Specify the separator in all cases, as the switch might
1684 -- need to be unaliased, and the alias might contain
1685 -- switches with parameters.
1687 if Section
= null then
1689 (Cmd
, Switch_Char
& Full_Switch
(Parser
));
1692 (Cmd
, Switch_Char
& Full_Switch
(Parser
),
1693 Section
=> Section
.all);
1700 end Set_Command_Line
;
1709 Substring
: String) return Boolean
1712 return Index
+ Substring
'Length - 1 <= Type_Str
'Last
1713 and then Type_Str
(Index
.. Index
+ Substring
'Length - 1) = Substring
;
1716 ------------------------
1717 -- Can_Have_Parameter --
1718 ------------------------
1720 function Can_Have_Parameter
(S
: String) return Boolean is
1722 if S
'Length <= 1 then
1727 when '!' |
':' |
'?' |
'=' =>
1732 end Can_Have_Parameter
;
1734 -----------------------
1735 -- Require_Parameter --
1736 -----------------------
1738 function Require_Parameter
(S
: String) return Boolean is
1740 if S
'Length <= 1 then
1745 when '!' |
':' |
'=' =>
1750 end Require_Parameter
;
1756 function Actual_Switch
(S
: String) return String is
1758 if S
'Length <= 1 then
1763 when '!' |
':' |
'?' |
'=' =>
1764 return S
(S
'First .. S
'Last - 1);
1770 ----------------------------
1771 -- For_Each_Simple_Switch --
1772 ----------------------------
1774 procedure For_Each_Simple_Switch
1775 (Config
: Command_Line_Configuration
;
1778 Parameter
: String := "";
1779 Unalias
: Boolean := True)
1781 function Group_Analysis
1783 Group
: String) return Boolean;
1784 -- Perform the analysis of a group of switches
1786 Found_In_Config
: Boolean := False;
1787 function Is_In_Config
1788 (Config_Switch
: String; Index
: Integer) return Boolean;
1789 -- If Switch is the same as Config_Switch, run the callback and sets
1790 -- Found_In_Config to True.
1792 function Starts_With
1793 (Config_Switch
: String; Index
: Integer) return Boolean;
1794 -- if Switch starts with Config_Switch, sets Found_In_Config to True.
1795 -- The return value is for the Foreach_Switch iterator.
1797 --------------------
1798 -- Group_Analysis --
1799 --------------------
1801 function Group_Analysis
1803 Group
: String) return Boolean
1808 function Analyze_Simple_Switch
1809 (Switch
: String; Index
: Integer) return Boolean;
1810 -- "Switches" is one of the switch definitions passed to the
1811 -- configuration, not one of the switches found on the command line.
1813 ---------------------------
1814 -- Analyze_Simple_Switch --
1815 ---------------------------
1817 function Analyze_Simple_Switch
1818 (Switch
: String; Index
: Integer) return Boolean
1820 pragma Unreferenced
(Index
);
1822 Full
: constant String := Prefix
& Group
(Idx
.. Group
'Last);
1824 Sw
: constant String := Actual_Switch
(Switch
);
1825 -- Switches definition minus argument definition
1831 -- Verify that sw starts with Prefix
1833 if Looking_At
(Sw
, Sw
'First, Prefix
)
1835 -- Verify that the group starts with sw
1837 and then Looking_At
(Full
, Full
'First, Sw
)
1839 Last
:= Idx
+ Sw
'Length - Prefix
'Length - 1;
1842 if Can_Have_Parameter
(Switch
) then
1844 -- Include potential parameter to the recursive call. Only
1845 -- numbers are allowed.
1847 while Last
< Group
'Last
1848 and then Group
(Last
+ 1) in '0' .. '9'
1854 if not Require_Parameter
(Switch
) or else Last
>= Param
then
1855 if Idx
= Group
'First
1856 and then Last
= Group
'Last
1857 and then Last
< Param
1859 -- The group only concerns a single switch. Do not
1860 -- perform recursive call.
1862 -- Note that we still perform a recursive call if
1863 -- a parameter is detected in the switch, as this
1864 -- is a way to correctly identify such a parameter
1872 -- Recursive call, using the detected parameter if any
1874 if Last
>= Param
then
1875 For_Each_Simple_Switch
1878 Prefix
& Group
(Idx
.. Param
- 1),
1879 Group
(Param
.. Last
));
1882 For_Each_Simple_Switch
1883 (Config
, Section
, Prefix
& Group
(Idx
.. Last
), "");
1892 end Analyze_Simple_Switch
;
1894 procedure Foreach
is new Foreach_Switch
(Analyze_Simple_Switch
);
1896 -- Start of processing for Group_Analysis
1900 while Idx
<= Group
'Last loop
1902 Foreach
(Config
, Section
);
1905 For_Each_Simple_Switch
1906 (Config
, Section
, Prefix
& Group
(Idx
), "");
1918 function Is_In_Config
1919 (Config_Switch
: String; Index
: Integer) return Boolean
1922 P
: Switch_Parameter_Type
;
1925 Decompose_Switch
(Config_Switch
, P
, Last
);
1927 if Config_Switch
(Config_Switch
'First .. Last
) = Switch
then
1929 when Parameter_None
=>
1930 if Parameter
= "" then
1931 Callback
(Switch
, "", "", Index
=> Index
);
1932 Found_In_Config
:= True;
1936 when Parameter_With_Optional_Space
=>
1937 Callback
(Switch
, " ", Parameter
, Index
=> Index
);
1938 Found_In_Config
:= True;
1941 when Parameter_With_Space_Or_Equal
=>
1942 Callback
(Switch
, "=", Parameter
, Index
=> Index
);
1943 Found_In_Config
:= True;
1946 when Parameter_No_Space
=>
1947 Callback
(Switch
, "", Parameter
, Index
);
1948 Found_In_Config
:= True;
1951 when Parameter_Optional
=>
1952 Callback
(Switch
, "", Parameter
, Index
);
1953 Found_In_Config
:= True;
1965 function Starts_With
1966 (Config_Switch
: String; Index
: Integer) return Boolean
1970 P
: Switch_Parameter_Type
;
1973 -- This function is called when we believe the parameter was
1974 -- specified as part of the switch, instead of separately. Thus we
1975 -- look in the config to find all possible switches.
1977 Decompose_Switch
(Config_Switch
, P
, Last
);
1980 (Switch
, Switch
'First,
1981 Config_Switch
(Config_Switch
'First .. Last
))
1983 -- Set first char of Param, and last char of Switch
1985 Param
:= Switch
'First + Last
;
1986 Last
:= Switch
'First + Last
- Config_Switch
'First;
1990 -- None is already handled in Is_In_Config
1992 when Parameter_None
=>
1995 when Parameter_With_Space_Or_Equal
=>
1996 if Param
<= Switch
'Last
1998 (Switch
(Param
) = ' ' or else Switch
(Param
) = '=')
2000 Callback
(Switch
(Switch
'First .. Last
),
2001 "=", Switch
(Param
+ 1 .. Switch
'Last), Index
);
2002 Found_In_Config
:= True;
2006 when Parameter_With_Optional_Space
=>
2007 if Param
<= Switch
'Last and then Switch
(Param
) = ' ' then
2011 Callback
(Switch
(Switch
'First .. Last
),
2012 " ", Switch
(Param
.. Switch
'Last), Index
);
2013 Found_In_Config
:= True;
2016 when Parameter_No_Space | Parameter_Optional
=>
2017 Callback
(Switch
(Switch
'First .. Last
),
2018 "", Switch
(Param
.. Switch
'Last), Index
);
2019 Found_In_Config
:= True;
2026 procedure Foreach_In_Config
is new Foreach_Switch
(Is_In_Config
);
2027 procedure Foreach_Starts_With
is new Foreach_Switch
(Starts_With
);
2029 -- Start of processing for For_Each_Simple_Switch
2032 -- First determine if the switch corresponds to one belonging to the
2033 -- configuration. If so, run callback and exit.
2035 -- ??? Is this necessary. On simple tests, we seem to have the same
2036 -- results with or without this call.
2038 Foreach_In_Config
(Config
, Section
);
2040 if Found_In_Config
then
2044 -- If adding a switch that can in fact be expanded through aliases,
2045 -- add separately each of its expansions.
2047 -- This takes care of expansions like "-T" -> "-gnatwrs", where the
2048 -- alias and its expansion do not have the same prefix. Given the order
2049 -- in which we do things here, the expansion of the alias will itself
2050 -- be checked for a common prefix and split into simple switches.
2053 and then Config
/= null
2054 and then Config
.Aliases
/= null
2056 for A
in Config
.Aliases
'Range loop
2057 if Config
.Aliases
(A
).Section
.all = Section
2058 and then Config
.Aliases
(A
).Alias
.all = Switch
2059 and then Parameter
= ""
2061 For_Each_Simple_Switch
2062 (Config
, Section
, Config
.Aliases
(A
).Expansion
.all, "");
2068 -- If adding a switch grouping several switches, add each of the simple
2069 -- switches instead.
2071 if Config
/= null and then Config
.Prefixes
/= null then
2072 for P
in Config
.Prefixes
'Range loop
2073 if Switch
'Length > Config
.Prefixes
(P
)'Length + 1
2075 Looking_At
(Switch
, Switch
'First, Config
.Prefixes
(P
).all)
2077 -- Alias expansion will be done recursively
2079 if Config
.Switches
= null then
2080 for S
in Switch
'First + Config
.Prefixes
(P
)'Length
2083 For_Each_Simple_Switch
2085 Config
.Prefixes
(P
).all & Switch
(S
), "");
2090 elsif Group_Analysis
2091 (Config
.Prefixes
(P
).all,
2093 (Switch
'First + Config
.Prefixes
(P
)'Length .. Switch
'Last))
2095 -- Recursive calls already done on each switch of the group:
2096 -- Return without executing Callback.
2104 -- Test if added switch is a known switch with parameter attached
2105 -- instead of being specified separately
2108 and then Config
/= null
2109 and then Config
.Switches
/= null
2111 Found_In_Config
:= False;
2112 Foreach_Starts_With
(Config
, Section
);
2114 if Found_In_Config
then
2119 -- The switch is invalid in the config, but we still want to report it.
2120 -- The config could, for instance, include "*" to specify it accepts
2123 Callback
(Switch
, " ", Parameter
, Index
=> -1);
2124 end For_Each_Simple_Switch
;
2130 procedure Add_Switch
2131 (Cmd
: in out Command_Line
;
2133 Parameter
: String := "";
2134 Separator
: Character := ASCII
.NUL
;
2135 Section
: String := "";
2136 Add_Before
: Boolean := False)
2139 pragma Unreferenced
(Success
);
2141 Add_Switch
(Cmd
, Switch
, Parameter
, Separator
,
2142 Section
, Add_Before
, Success
);
2149 procedure Add_Switch
2150 (Cmd
: in out Command_Line
;
2152 Parameter
: String := "";
2153 Separator
: Character := ASCII
.NUL
;
2154 Section
: String := "";
2155 Add_Before
: Boolean := False;
2156 Success
: out Boolean)
2158 procedure Add_Simple_Switch
2163 -- Add a new switch that has had all its aliases expanded, and switches
2164 -- ungrouped. We know there are no more aliases in Switches.
2166 -----------------------
2167 -- Add_Simple_Switch --
2168 -----------------------
2170 procedure Add_Simple_Switch
2180 and then Cmd
.Config
/= null
2181 and then not Cmd
.Config
.Star_Switch
2183 raise Invalid_Switch
2184 with "Invalid switch " & Simple
;
2187 if Separator
/= ASCII
.NUL
then
2190 elsif Sepa
= "" then
2193 Sep
:= Sepa
(Sepa
'First);
2196 if Cmd
.Expanded
= null then
2197 Cmd
.Expanded
:= new Argument_List
'(1 .. 1 => new String'(Simple
));
2201 new Argument_List
'(1 .. 1 => new String'(Sep
& Param
));
2203 Cmd
.Params
:= new Argument_List
'(1 .. 1 => null);
2206 if Section = "" then
2207 Cmd.Sections := new Argument_List'(1 .. 1 => null);
2210 new Argument_List
'(1 .. 1 => new String'(Section
));
2214 -- Do we already have this switch?
2216 for C
in Cmd
.Expanded
'Range loop
2217 if Cmd
.Expanded
(C
).all = Simple
2219 ((Cmd
.Params
(C
) = null and then Param
= "")
2221 (Cmd
.Params
(C
) /= null
2222 and then Cmd
.Params
(C
).all = Sep
& Param
))
2224 ((Cmd
.Sections
(C
) = null and then Section
= "")
2226 (Cmd
.Sections
(C
) /= null
2227 and then Cmd
.Sections
(C
).all = Section
))
2233 -- Inserting at least one switch
2236 Add
(Cmd
.Expanded
, new String'(Simple), Add_Before);
2241 new String'(Sep
& Param
),
2250 if Section
= "" then
2258 new String'(Section),
2262 end Add_Simple_Switch;
2264 procedure Add_Simple_Switches is
2265 new For_Each_Simple_Switch (Add_Simple_Switch);
2269 Section_Valid : Boolean := False;
2271 -- Start of processing for Add_Switch
2274 if Section /= "" and then Cmd.Config /= null then
2275 for S in Cmd.Config.Sections'Range loop
2276 if Section = Cmd.Config.Sections (S).all then
2277 Section_Valid := True;
2282 if not Section_Valid then
2283 raise Invalid_Section;
2288 Add_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
2289 Free (Cmd.Coalesce);
2296 procedure Remove (Line : in out Argument_List_Access; Index : Integer) is
2297 Tmp : Argument_List_Access := Line;
2300 Line := new Argument_List (Tmp'First .. Tmp'Last - 1);
2302 if Index /= Tmp'First then
2303 Line (Tmp'First .. Index - 1) := Tmp (Tmp'First .. Index - 1);
2308 if Index /= Tmp'Last then
2309 Line (Index .. Tmp'Last - 1) := Tmp (Index + 1 .. Tmp'Last);
2312 Unchecked_Free (Tmp);
2320 (Line : in out Argument_List_Access;
2321 Str : String_Access;
2322 Before : Boolean := False)
2324 Tmp : Argument_List_Access := Line;
2328 Line := new Argument_List (Tmp'First .. Tmp'Last + 1);
2331 Line (Tmp'First) := Str;
2332 Line (Tmp'First + 1 .. Tmp'Last + 1) := Tmp.all;
2334 Line (Tmp'Range) := Tmp.all;
2335 Line (Tmp'Last + 1) := Str;
2338 Unchecked_Free (Tmp);
2341 Line := new Argument_List'(1 .. 1 => Str
);
2349 procedure Remove_Switch
2350 (Cmd
: in out Command_Line
;
2352 Remove_All
: Boolean := False;
2353 Has_Parameter
: Boolean := False;
2354 Section
: String := "")
2357 pragma Unreferenced
(Success
);
2359 Remove_Switch
(Cmd
, Switch
, Remove_All
, Has_Parameter
, Section
, Success
);
2366 procedure Remove_Switch
2367 (Cmd
: in out Command_Line
;
2369 Remove_All
: Boolean := False;
2370 Has_Parameter
: Boolean := False;
2371 Section
: String := "";
2372 Success
: out Boolean)
2374 procedure Remove_Simple_Switch
2375 (Simple
, Separator
, Param
: String; Index
: Integer);
2376 -- Removes a simple switch, with no aliasing or grouping
2378 --------------------------
2379 -- Remove_Simple_Switch --
2380 --------------------------
2382 procedure Remove_Simple_Switch
2383 (Simple
, Separator
, Param
: String; Index
: Integer)
2386 pragma Unreferenced
(Param
, Separator
, Index
);
2389 if Cmd
.Expanded
/= null then
2390 C
:= Cmd
.Expanded
'First;
2391 while C
<= Cmd
.Expanded
'Last loop
2392 if Cmd
.Expanded
(C
).all = Simple
2395 or else (Cmd
.Sections
(C
) = null
2396 and then Section
= "")
2397 or else (Cmd
.Sections
(C
) /= null
2398 and then Section
= Cmd
.Sections
(C
).all))
2399 and then (not Has_Parameter
or else Cmd
.Params
(C
) /= null)
2401 Remove
(Cmd
.Expanded
, C
);
2402 Remove
(Cmd
.Params
, C
);
2403 Remove
(Cmd
.Sections
, C
);
2406 if not Remove_All
then
2415 end Remove_Simple_Switch
;
2417 procedure Remove_Simple_Switches
is
2418 new For_Each_Simple_Switch
(Remove_Simple_Switch
);
2420 -- Start of processing for Remove_Switch
2424 Remove_Simple_Switches
2425 (Cmd
.Config
, Section
, Switch
, "", Unalias
=> not Has_Parameter
);
2426 Free
(Cmd
.Coalesce
);
2433 procedure Remove_Switch
2434 (Cmd
: in out Command_Line
;
2437 Section
: String := "")
2439 procedure Remove_Simple_Switch
2440 (Simple
, Separator
, Param
: String; Index
: Integer);
2441 -- Removes a simple switch, with no aliasing or grouping
2443 --------------------------
2444 -- Remove_Simple_Switch --
2445 --------------------------
2447 procedure Remove_Simple_Switch
2448 (Simple
, Separator
, Param
: String; Index
: Integer)
2450 pragma Unreferenced
(Separator
, Index
);
2454 if Cmd
.Expanded
/= null then
2455 C
:= Cmd
.Expanded
'First;
2456 while C
<= Cmd
.Expanded
'Last loop
2457 if Cmd
.Expanded
(C
).all = Simple
2459 ((Cmd
.Sections
(C
) = null
2460 and then Section
= "")
2462 (Cmd
.Sections
(C
) /= null
2463 and then Section
= Cmd
.Sections
(C
).all))
2465 ((Cmd
.Params
(C
) = null and then Param
= "")
2467 (Cmd
.Params
(C
) /= null
2470 -- Ignore the separator stored in Parameter
2472 Cmd
.Params
(C
) (Cmd
.Params
(C
)'First + 1
2473 .. Cmd
.Params
(C
)'Last) =
2476 Remove
(Cmd
.Expanded
, C
);
2477 Remove
(Cmd
.Params
, C
);
2478 Remove
(Cmd
.Sections
, C
);
2480 -- The switch is necessarily unique by construction of
2490 end Remove_Simple_Switch
;
2492 procedure Remove_Simple_Switches
is
2493 new For_Each_Simple_Switch
(Remove_Simple_Switch
);
2495 -- Start of processing for Remove_Switch
2498 Remove_Simple_Switches
(Cmd
.Config
, Section
, Switch
, Parameter
);
2499 Free
(Cmd
.Coalesce
);
2502 --------------------
2503 -- Group_Switches --
2504 --------------------
2506 procedure Group_Switches
2507 (Cmd
: Command_Line
;
2508 Result
: Argument_List_Access
;
2509 Sections
: Argument_List_Access
;
2510 Params
: Argument_List_Access
)
2512 function Compatible_Parameter
(Param
: String_Access
) return Boolean;
2513 -- True when the parameter can be part of a group
2515 --------------------------
2516 -- Compatible_Parameter --
2517 --------------------------
2519 function Compatible_Parameter
(Param
: String_Access
) return Boolean is
2523 if Param
= null then
2526 -- We need parameters without separators
2528 elsif Param
(Param
'First) /= ASCII
.NUL
then
2531 -- Parameters must be all digits
2534 for J
in Param
'First + 1 .. Param
'Last loop
2535 if Param
(J
) not in '0' .. '9' then
2542 end Compatible_Parameter
;
2544 -- Local declarations
2546 Group
: Ada
.Strings
.Unbounded
.Unbounded_String
;
2548 use type Ada
.Strings
.Unbounded
.Unbounded_String
;
2550 -- Start of processing for Group_Switches
2553 if Cmd
.Config
= null
2554 or else Cmd
.Config
.Prefixes
= null
2559 for P
in Cmd
.Config
.Prefixes
'Range loop
2560 Group
:= Ada
.Strings
.Unbounded
.Null_Unbounded_String
;
2563 for C
in Result
'Range loop
2564 if Result
(C
) /= null
2565 and then Compatible_Parameter
(Params
(C
))
2569 Cmd
.Config
.Prefixes
(P
).all)
2571 -- If we are still in the same section, group the switches
2575 (Sections
(C
) = null
2576 and then Sections
(First
) = null)
2578 (Sections
(C
) /= null
2579 and then Sections
(First
) /= null
2580 and then Sections
(C
).all = Sections
(First
).all)
2585 (Result
(C
)'First + Cmd
.Config
.Prefixes
(P
)'Length ..
2588 if Params
(C
) /= null then
2591 Params
(C
) (Params
(C
)'First + 1 .. Params
(C
)'Last);
2601 -- We changed section: we put the grouped switches to the first
2602 -- place, on continue with the new section.
2607 (Cmd.Config.Prefixes (P).all &
2608 Ada.Strings.Unbounded.To_String (Group));
2610 Ada.Strings.Unbounded.To_Unbounded_String
2612 (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2622 (Cmd
.Config
.Prefixes
(P
).all &
2623 Ada
.Strings
.Unbounded
.To_String
(Group
));
2628 --------------------
2629 -- Alias_Switches --
2630 --------------------
2632 procedure Alias_Switches
2633 (Cmd
: Command_Line
;
2634 Result
: Argument_List_Access
;
2635 Params
: Argument_List_Access
)
2640 procedure Check_Cb
(Switch
, Separator
, Param
: String; Index
: Integer);
2641 -- Checks whether the command line contains [Switch].
2642 -- Sets the global variable [Found] appropriately.
2643 -- This will be called for each simple switch that make up an alias, to
2644 -- know whether the alias should be applied.
2646 procedure Remove_Cb
(Switch
, Separator
, Param
: String; Index
: Integer);
2647 -- Remove the simple switch [Switch] from the command line, since it is
2648 -- part of a simpler alias
2655 (Switch
, Separator
, Param
: String; Index
: Integer)
2657 pragma Unreferenced
(Separator
, Index
);
2661 for E
in Result
'Range loop
2662 if Result
(E
) /= null
2665 or else Params
(E
) (Params
(E
)'First + 1 ..
2666 Params
(E
)'Last) = Param
)
2667 and then Result
(E
).all = Switch
2681 procedure Remove_Cb
(Switch
, Separator
, Param
: String; Index
: Integer)
2683 pragma Unreferenced
(Separator
, Index
);
2686 for E
in Result
'Range loop
2687 if Result
(E
) /= null
2690 or else Params
(E
) (Params
(E
)'First + 1
2691 .. Params
(E
)'Last) = Param
)
2692 and then Result
(E
).all = Switch
2705 procedure Check_All
is new For_Each_Simple_Switch
(Check_Cb
);
2706 procedure Remove_All
is new For_Each_Simple_Switch
(Remove_Cb
);
2708 -- Start of processing for Alias_Switches
2711 if Cmd
.Config
= null
2712 or else Cmd
.Config
.Aliases
= null
2717 for A
in Cmd
.Config
.Aliases
'Range loop
2719 -- Compute the various simple switches that make up the alias. We
2720 -- split the expansion into as many simple switches as possible, and
2721 -- then check whether the expanded command line has all of them.
2724 Check_All
(Cmd
.Config
,
2725 Switch
=> Cmd
.Config
.Aliases
(A
).Expansion
.all,
2726 Section
=> Cmd
.Config
.Aliases
(A
).Section
.all);
2729 First
:= Integer'Last;
2730 Remove_All
(Cmd
.Config
,
2731 Switch
=> Cmd
.Config
.Aliases
(A
).Expansion
.all,
2732 Section
=> Cmd
.Config
.Aliases
(A
).Section
.all);
2733 Result
(First
) := new String'(Cmd.Config.Aliases (A).Alias.all);
2742 procedure Sort_Sections
2743 (Line : GNAT.OS_Lib.Argument_List_Access;
2744 Sections : GNAT.OS_Lib.Argument_List_Access;
2745 Params : GNAT.OS_Lib.Argument_List_Access)
2747 Sections_List : Argument_List_Access :=
2748 new Argument_List'(1 .. 1 => null);
2750 Old_Line
: constant Argument_List
:= Line
.all;
2751 Old_Sections
: constant Argument_List
:= Sections
.all;
2752 Old_Params
: constant Argument_List
:= Params
.all;
2760 -- First construct a list of all sections
2762 for E
in Line
'Range loop
2763 if Sections
(E
) /= null then
2765 for S
in Sections_List
'Range loop
2766 if (Sections_List
(S
) = null and then Sections
(E
) = null)
2768 (Sections_List
(S
) /= null
2769 and then Sections
(E
) /= null
2770 and then Sections_List
(S
).all = Sections
(E
).all)
2778 Add
(Sections_List
, Sections
(E
));
2783 Index
:= Line
'First;
2785 for S
in Sections_List
'Range loop
2786 for E
in Old_Line
'Range loop
2787 if (Sections_List
(S
) = null and then Old_Sections
(E
) = null)
2789 (Sections_List
(S
) /= null
2790 and then Old_Sections
(E
) /= null
2791 and then Sections_List
(S
).all = Old_Sections
(E
).all)
2793 Line
(Index
) := Old_Line
(E
);
2794 Sections
(Index
) := Old_Sections
(E
);
2795 Params
(Index
) := Old_Params
(E
);
2801 Unchecked_Free
(Sections_List
);
2809 (Cmd
: in out Command_Line
;
2810 Iter
: in out Command_Line_Iterator
;
2811 Expanded
: Boolean := False)
2814 if Cmd
.Expanded
= null then
2819 -- Reorder the expanded line so that sections are grouped
2821 Sort_Sections
(Cmd
.Expanded
, Cmd
.Sections
, Cmd
.Params
);
2823 -- Coalesce the switches as much as possible
2826 and then Cmd
.Coalesce
= null
2828 Cmd
.Coalesce
:= new Argument_List
(Cmd
.Expanded
'Range);
2829 for E
in Cmd
.Expanded
'Range loop
2830 Cmd
.Coalesce
(E
) := new String'(Cmd.Expanded (E).all);
2833 Free (Cmd.Coalesce_Sections);
2834 Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range);
2835 for E in Cmd.Sections'Range loop
2836 Cmd.Coalesce_Sections (E) :=
2837 (if Cmd.Sections (E) = null then null
2838 else new String'(Cmd
.Sections
(E
).all));
2841 Free
(Cmd
.Coalesce_Params
);
2842 Cmd
.Coalesce_Params
:= new Argument_List
(Cmd
.Params
'Range);
2843 for E
in Cmd
.Params
'Range loop
2844 Cmd
.Coalesce_Params
(E
) :=
2845 (if Cmd
.Params
(E
) = null then null
2846 else new String'(Cmd.Params (E).all));
2849 -- Not a clone, since we will not modify the parameters anyway
2851 Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Params);
2853 (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Coalesce_Params);
2857 Iter.List := Cmd.Expanded;
2858 Iter.Params := Cmd.Params;
2859 Iter.Sections := Cmd.Sections;
2861 Iter.List := Cmd.Coalesce;
2862 Iter.Params := Cmd.Coalesce_Params;
2863 Iter.Sections := Cmd.Coalesce_Sections;
2866 if Iter.List = null then
2867 Iter.Current := Integer'Last;
2869 Iter.Current := Iter.List'First - 1;
2874 --------------------
2875 -- Current_Switch --
2876 --------------------
2878 function Current_Switch (Iter : Command_Line_Iterator) return String is
2880 return Iter.List (Iter.Current).all;
2883 --------------------
2884 -- Is_New_Section --
2885 --------------------
2887 function Is_New_Section (Iter : Command_Line_Iterator) return Boolean is
2888 Section : constant String := Current_Section (Iter);
2891 if Iter.Sections = null then
2894 elsif Iter.Current = Iter.Sections'First
2895 or else Iter.Sections (Iter.Current - 1) = null
2897 return Section /= "";
2900 return Section /= Iter.Sections (Iter.Current - 1).all;
2904 ---------------------
2905 -- Current_Section --
2906 ---------------------
2908 function Current_Section (Iter : Command_Line_Iterator) return String is
2910 if Iter.Sections = null
2911 or else Iter.Current > Iter.Sections'Last
2912 or else Iter.Sections (Iter.Current) = null
2917 return Iter.Sections (Iter.Current).all;
2918 end Current_Section;
2920 -----------------------
2921 -- Current_Separator --
2922 -----------------------
2924 function Current_Separator (Iter : Command_Line_Iterator) return String is
2926 if Iter.Params = null
2927 or else Iter.Current > Iter.Params'Last
2928 or else Iter.Params (Iter.Current) = null
2934 Sep : constant Character :=
2935 Iter.Params (Iter.Current) (Iter.Params (Iter.Current)'First);
2937 if Sep = ASCII.NUL then
2944 end Current_Separator;
2946 -----------------------
2947 -- Current_Parameter --
2948 -----------------------
2950 function Current_Parameter (Iter : Command_Line_Iterator) return String is
2952 if Iter.Params = null
2953 or else Iter.Current > Iter.Params'Last
2954 or else Iter.Params (Iter.Current) = null
2959 -- Return result, skipping separator
2962 P : constant String := Iter.Params (Iter.Current).all;
2964 return P (P'First + 1 .. P'Last);
2967 end Current_Parameter;
2973 function Has_More (Iter : Command_Line_Iterator) return Boolean is
2975 return Iter.List /= null and then Iter.Current <= Iter.List'Last;
2982 procedure Next (Iter : in out Command_Line_Iterator) is
2984 Iter.Current := Iter.Current + 1;
2985 while Iter.Current <= Iter.List'Last
2986 and then Iter.List (Iter.Current) = null
2988 Iter.Current := Iter.Current + 1;
2996 procedure Free (Config : in out Command_Line_Configuration) is
2997 procedure Unchecked_Free is new
2998 Ada.Unchecked_Deallocation
2999 (Switch_Definitions, Switch_Definitions_List);
3001 procedure Unchecked_Free is new
3002 Ada.Unchecked_Deallocation
3003 (Alias_Definitions, Alias_Definitions_List);
3006 if Config /= null then
3007 Free (Config.Prefixes);
3008 Free (Config.Sections);
3009 Free (Config.Usage);
3011 Free (Config.Help_Msg);
3013 if Config.Aliases /= null then
3014 for A in Config.Aliases'Range loop
3015 Free (Config.Aliases (A).Alias);
3016 Free (Config.Aliases (A).Expansion);
3017 Free (Config.Aliases (A).Section);
3020 Unchecked_Free (Config.Aliases);
3023 if Config.Switches /= null then
3024 for S in Config.Switches'Range loop
3025 Free (Config.Switches (S).Switch);
3026 Free (Config.Switches (S).Long_Switch);
3027 Free (Config.Switches (S).Help);
3028 Free (Config.Switches (S).Section);
3031 Unchecked_Free (Config.Switches);
3034 Unchecked_Free (Config);
3042 procedure Free (Cmd : in out Command_Line) is
3044 Free (Cmd.Expanded);
3045 Free (Cmd.Coalesce);
3046 Free (Cmd.Coalesce_Sections);
3047 Free (Cmd.Coalesce_Params);
3049 Free (Cmd.Sections);
3057 (Config : in out Command_Line_Configuration;
3058 Usage : String := "[switches] [arguments]";
3059 Help : String := "";
3060 Help_Msg : String := "")
3063 if Config = null then
3064 Config := new Command_Line_Configuration_Record;
3067 Free (Config.Usage);
3069 Free (Config.Help_Msg);
3071 Config.Usage := new String'(Usage
);
3072 Config
.Help
:= new String'(Help);
3073 Config.Help_Msg := new String'(Help_Msg
);
3080 procedure Display_Help
(Config
: Command_Line_Configuration
) is
3081 function Switch_Name
3082 (Def
: Switch_Definition
;
3083 Section
: String) return String;
3084 -- Return the "-short, --long=ARG" string for Def.
3085 -- Returns "" if the switch is not in the section.
3088 (P
: Switch_Parameter_Type
;
3089 Name
: String := "ARG") return String;
3090 -- Return the display for a switch parameter
3092 procedure Display_Section_Help
(Section
: String);
3093 -- Display the help for a specific section ("" is the default section)
3095 --------------------------
3096 -- Display_Section_Help --
3097 --------------------------
3099 procedure Display_Section_Help
(Section
: String) is
3100 Max_Len
: Natural := 0;
3103 -- ??? Special display for "*"
3107 if Section
/= "" then
3108 Put_Line
("Switches after " & Section
);
3111 -- Compute size of the switches column
3113 for S
in Config
.Switches
'Range loop
3114 Max_Len
:= Natural'Max
3115 (Max_Len
, Switch_Name
(Config
.Switches
(S
), Section
)'Length);
3118 if Config
.Aliases
/= null then
3119 for A
in Config
.Aliases
'Range loop
3120 if Config
.Aliases
(A
).Section
.all = Section
then
3121 Max_Len
:= Natural'Max
3122 (Max_Len
, Config
.Aliases
(A
).Alias
'Length);
3127 -- Display the switches
3129 for S
in Config
.Switches
'Range loop
3131 N
: constant String :=
3132 Switch_Name
(Config
.Switches
(S
), Section
);
3138 Put
((1 .. Max_Len
- N
'Length + 1 => ' '));
3140 if Config
.Switches
(S
).Help
/= null then
3141 Put
(Config
.Switches
(S
).Help
.all);
3149 -- Display the aliases
3151 if Config
.Aliases
/= null then
3152 for A
in Config
.Aliases
'Range loop
3153 if Config
.Aliases
(A
).Section
.all = Section
then
3155 Put
(Config
.Aliases
(A
).Alias
.all);
3156 Put
((1 .. Max_Len
- Config
.Aliases
(A
).Alias
'Length + 1
3158 Put
("Equivalent to " & Config
.Aliases
(A
).Expansion
.all);
3163 end Display_Section_Help
;
3170 (P
: Switch_Parameter_Type
;
3171 Name
: String := "ARG") return String
3175 when Parameter_None
=>
3178 when Parameter_With_Optional_Space
=>
3179 return " " & To_Upper
(Name
);
3181 when Parameter_With_Space_Or_Equal
=>
3182 return "=" & To_Upper
(Name
);
3184 when Parameter_No_Space
=>
3185 return To_Upper
(Name
);
3187 when Parameter_Optional
=>
3188 return '[' & To_Upper
(Name
) & ']';
3196 function Switch_Name
3197 (Def
: Switch_Definition
;
3198 Section
: String) return String
3200 use Ada
.Strings
.Unbounded
;
3201 Result
: Unbounded_String
;
3202 P1
, P2
: Switch_Parameter_Type
;
3203 Last1
, Last2
: Integer := 0;
3206 if (Section
= "" and then Def
.Section
= null)
3207 or else (Def
.Section
/= null and then Def
.Section
.all = Section
)
3209 if Def
.Switch
/= null and then Def
.Switch
.all = "*" then
3210 return "[any switch]";
3213 if Def
.Switch
/= null then
3214 Decompose_Switch
(Def
.Switch
.all, P1
, Last1
);
3215 Append
(Result
, Def
.Switch
(Def
.Switch
'First .. Last1
));
3217 if Def
.Long_Switch
/= null then
3218 Decompose_Switch
(Def
.Long_Switch
.all, P2
, Last2
);
3219 Append
(Result
, ", "
3220 & Def
.Long_Switch
(Def
.Long_Switch
'First .. Last2
));
3222 if Def
.Argument
= null then
3223 Append
(Result
, Param_Name
(P2
, "ARG"));
3225 Append
(Result
, Param_Name
(P2
, Def
.Argument
.all));
3229 if Def
.Argument
= null then
3230 Append
(Result
, Param_Name
(P1
, "ARG"));
3232 Append
(Result
, Param_Name
(P1
, Def
.Argument
.all));
3236 -- Def.Switch is null (Long_Switch must be non-null)
3239 Decompose_Switch
(Def
.Long_Switch
.all, P2
, Last2
);
3241 Def
.Long_Switch
(Def
.Long_Switch
'First .. Last2
));
3243 if Def
.Argument
= null then
3244 Append
(Result
, Param_Name
(P2
, "ARG"));
3246 Append
(Result
, Param_Name
(P2
, Def
.Argument
.all));
3251 return To_String
(Result
);
3254 -- Start of processing for Display_Help
3257 if Config
= null then
3261 if Config
.Help
/= null and then Config
.Help
.all /= "" then
3262 Put_Line
(Config
.Help
.all);
3265 if Config
.Usage
/= null then
3268 (Ada
.Command_Line
.Command_Name
) & " " & Config
.Usage
.all);
3270 Put_Line
("Usage: " & Base_Name
(Ada
.Command_Line
.Command_Name
)
3271 & " [switches] [arguments]");
3274 if Config
.Help_Msg
/= null and then Config
.Help_Msg
.all /= "" then
3275 Put_Line
(Config
.Help_Msg
.all);
3278 Display_Section_Help
("");
3280 if Config
.Sections
/= null and then Config
.Switches
/= null then
3281 for S
in Config
.Sections
'Range loop
3282 Display_Section_Help
(Config
.Sections
(S
).all);
3293 (Config
: Command_Line_Configuration
;
3294 Callback
: Switch_Handler
:= null;
3295 Parser
: Opt_Parser
:= Command_Line_Parser
;
3296 Concatenate
: Boolean := True)
3298 Getopt_Switches
: String_Access
;
3299 C
: Character := ASCII
.NUL
;
3301 Empty_Name
: aliased constant String := "";
3302 Current_Section
: Integer := -1;
3303 Section_Name
: not null access constant String := Empty_Name
'Access;
3305 procedure Simple_Callback
3306 (Simple_Switch
: String;
3310 -- Needs comments ???
3312 procedure Do_Callback
(Switch
, Parameter
: String; Index
: Integer);
3318 procedure Do_Callback
(Switch
, Parameter
: String; Index
: Integer) is
3320 -- Do automatic handling when possible
3323 case Config
.Switches
(Index
).Typ
is
3324 when Switch_Untyped
=>
3325 null; -- no automatic handling
3327 when Switch_Boolean
=>
3328 Config
.Switches
(Index
).Boolean_Output
.all :=
3329 Config
.Switches
(Index
).Boolean_Value
;
3332 when Switch_Integer
=>
3334 if Parameter
= "" then
3335 Config
.Switches
(Index
).Integer_Output
.all :=
3336 Config
.Switches
(Index
).Integer_Default
;
3338 Config
.Switches
(Index
).Integer_Output
.all :=
3339 Integer'Value (Parameter
);
3343 when Constraint_Error
=>
3344 raise Invalid_Parameter
3345 with "Expected integer parameter for '"
3351 when Switch_String
=>
3352 Free
(Config
.Switches
(Index
).String_Output
.all);
3353 Config
.Switches
(Index
).String_Output
.all :=
3354 new String'(Parameter);
3360 -- Otherwise calls the user callback if one was defined
3362 if Callback /= null then
3363 Callback (Switch => Switch,
3364 Parameter => Parameter,
3365 Section => Section_Name.all);
3369 procedure For_Each_Simple
3370 is new For_Each_Simple_Switch (Simple_Callback);
3372 ---------------------
3373 -- Simple_Callback --
3374 ---------------------
3376 procedure Simple_Callback
3377 (Simple_Switch : String;
3382 pragma Unreferenced (Separator);
3384 Do_Callback (Switch => Simple_Switch,
3385 Parameter => Parameter,
3387 end Simple_Callback;
3389 -- Start of processing for Getopt
3392 -- Initialize sections
3394 if Config.Sections = null then
3395 Config.Sections := new Argument_List'(1 .. 0 => null);
3398 Internal_Initialize_Option_Scan
3400 Switch_Char
=> Parser
.Switch_Character
,
3401 Stop_At_First_Non_Switch
=> Parser
.Stop_At_First
,
3402 Section_Delimiters
=> Section_Delimiters
(Config
));
3404 Getopt_Switches
:= new String'
3405 (Get_Switches (Config, Parser.Switch_Character, Section_Name.all)
3408 -- Initialize output values for automatically handled switches
3410 for S in Config.Switches'Range loop
3411 case Config.Switches (S).Typ is
3412 when Switch_Untyped =>
3413 null; -- Nothing to do
3415 when Switch_Boolean =>
3416 Config.Switches (S).Boolean_Output.all :=
3417 not Config.Switches (S).Boolean_Value;
3419 when Switch_Integer =>
3420 Config.Switches (S).Integer_Output.all :=
3421 Config.Switches (S).Integer_Initial;
3423 when Switch_String =>
3424 if Config.Switches (S).String_Output.all = null then
3425 Config.Switches (S).String_Output.all := new String'("");
3430 -- For all sections, and all switches within those sections
3433 C
:= Getopt
(Switches
=> Getopt_Switches
.all,
3434 Concatenate
=> Concatenate
,
3438 -- Full_Switch already includes the leading '-'
3440 Do_Callback
(Switch
=> Full_Switch
(Parser
),
3441 Parameter
=> Parameter
(Parser
),
3444 elsif C
/= ASCII
.NUL
then
3445 if Full_Switch
(Parser
) = "h"
3447 Full_Switch
(Parser
) = "-help"
3449 Display_Help
(Config
);
3450 raise Exit_From_Command_Line
;
3453 -- Do switch expansion if needed
3457 Section
=> Section_Name
.all,
3458 Switch
=> Parser
.Switch_Character
& Full_Switch
(Parser
),
3459 Parameter
=> Parameter
(Parser
));
3462 if Current_Section
= -1 then
3463 Current_Section
:= Config
.Sections
'First;
3465 Current_Section
:= Current_Section
+ 1;
3468 exit when Current_Section
> Config
.Sections
'Last;
3470 Section_Name
:= Config
.Sections
(Current_Section
);
3471 Goto_Section
(Section_Name
.all, Parser
);
3473 Free
(Getopt_Switches
);
3474 Getopt_Switches
:= new String'
3476 (Config, Parser.Switch_Character, Section_Name.all));
3480 Free (Getopt_Switches);
3483 when Invalid_Switch =>
3484 Free (Getopt_Switches);
3486 -- Message inspired by "ls" on Unix
3488 Put_Line (Standard_Error,
3489 Base_Name (Ada.Command_Line.Command_Name)
3490 & ": unrecognized option '"
3491 & Parser.Switch_Character & Full_Switch (Parser)
3493 Put_Line (Standard_Error,
3495 & Base_Name (Ada.Command_Line.Command_Name)
3496 & " --help` for more information.");
3501 Free (Getopt_Switches);
3510 (Line : in out Command_Line;
3511 Args : out GNAT.OS_Lib.Argument_List_Access;
3512 Expanded : Boolean := False;
3513 Switch_Char : Character := '-')
3515 Iter : Command_Line_Iterator;
3516 Count : Natural := 0;
3519 Start (Line, Iter, Expanded => Expanded);
3520 while Has_More (Iter) loop
3521 if Is_New_Section (Iter) then
3529 Args := new Argument_List (1 .. Count);
3530 Count := Args'First;
3532 Start (Line, Iter, Expanded => Expanded);
3533 while Has_More (Iter) loop
3534 if Is_New_Section (Iter) then
3535 Args (Count) := new String'(Switch_Char
& Current_Section
(Iter
));
3539 Args
(Count
) := new String'(Current_Switch (Iter)
3540 & Current_Separator (Iter)
3541 & Current_Parameter (Iter));
3547 end GNAT.Command_Line;