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-2009, 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
.Unchecked_Deallocation
;
33 with Ada
.Strings
.Unbounded
;
35 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
37 package body GNAT
.Command_Line
is
39 package CL
renames Ada
.Command_Line
;
41 type Switch_Parameter_Type
is
43 Parameter_With_Optional_Space
, -- ':' in getopt
44 Parameter_With_Space_Or_Equal
, -- '=' in getopt
45 Parameter_No_Space
, -- '!' in getopt
46 Parameter_Optional
); -- '?' in getopt
48 procedure Set_Parameter
49 (Variable
: out Parameter_Type
;
53 Extra
: Character := ASCII
.NUL
);
54 pragma Inline
(Set_Parameter
);
55 -- Set the parameter that will be returned by Parameter below
56 -- Parameters need to be defined ???
58 function Goto_Next_Argument_In_Section
(Parser
: Opt_Parser
) return Boolean;
59 -- Go to the next argument on the command line. If we are at the end of
60 -- the current section, we want to make sure there is no other identical
61 -- section on the command line (there might be multiple instances of
62 -- -largs). Returns True iff there is another argument.
64 function Get_File_Names_Case_Sensitive
return Integer;
65 pragma Import
(C
, Get_File_Names_Case_Sensitive
,
66 "__gnat_get_file_names_case_sensitive");
68 File_Names_Case_Sensitive
: constant Boolean :=
69 Get_File_Names_Case_Sensitive
/= 0;
71 procedure Canonical_Case_File_Name
(S
: in out String);
72 -- Given a file name, converts it to canonical case form. For systems where
73 -- file names are case sensitive, this procedure has no effect. If file
74 -- names are not case sensitive (i.e. for example if you have the file
75 -- "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then this call
76 -- converts the given string to canonical all lower case form, so that two
77 -- file names compare equal if they refer to the same file.
79 procedure Internal_Initialize_Option_Scan
81 Switch_Char
: Character;
82 Stop_At_First_Non_Switch
: Boolean;
83 Section_Delimiters
: String);
84 -- Initialize Parser, which must have been allocated already
86 function Argument
(Parser
: Opt_Parser
; Index
: Integer) return String;
87 -- Return the index-th command line argument
89 procedure Find_Longest_Matching_Switch
92 Index_In_Switches
: out Integer;
93 Switch_Length
: out Integer;
94 Param
: out Switch_Parameter_Type
);
95 -- Return the Longest switch from Switches that at least partially
96 -- partially Arg. Index_In_Switches is set to 0 if none matches.
97 -- What are other parameters??? in particular Param is not always set???
99 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
100 (Argument_List
, Argument_List_Access
);
102 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
103 (Command_Line_Configuration_Record
, Command_Line_Configuration
);
105 procedure Remove
(Line
: in out Argument_List_Access
; Index
: Integer);
106 -- Remove a specific element from Line
109 (Line
: in out Argument_List_Access
;
111 Before
: Boolean := False);
112 -- Add a new element to Line. If Before is True, the item is inserted at
113 -- the beginning, else it is appended.
115 function Can_Have_Parameter
(S
: String) return Boolean;
116 -- True if S can have a parameter
118 function Require_Parameter
(S
: String) return Boolean;
119 -- True if S requires a parameter
121 function Actual_Switch
(S
: String) return String;
122 -- Remove any possible trailing '!', ':', '?' and '='
125 with procedure Callback
(Simple_Switch
: String; Parameter
: String);
126 procedure For_Each_Simple_Switch
129 Parameter
: String := "";
130 Unalias
: Boolean := True);
131 -- Breaks Switch into as simple switches as possible (expanding aliases and
132 -- ungrouping common prefixes when possible), and call Callback for each of
135 procedure Sort_Sections
136 (Line
: GNAT
.OS_Lib
.Argument_List_Access
;
137 Sections
: GNAT
.OS_Lib
.Argument_List_Access
;
138 Params
: GNAT
.OS_Lib
.Argument_List_Access
);
139 -- Reorder the command line switches so that the switches belonging to a
140 -- section are grouped together.
142 procedure Group_Switches
144 Result
: Argument_List_Access
;
145 Sections
: Argument_List_Access
;
146 Params
: Argument_List_Access
);
147 -- Group switches with common prefixes whenever possible. Once they have
148 -- been grouped, we also check items for possible aliasing.
150 procedure Alias_Switches
152 Result
: Argument_List_Access
;
153 Params
: Argument_List_Access
);
154 -- When possible, replace one or more switches by an alias, i.e. a shorter
160 Substring
: String) return Boolean;
161 -- Return True if the characters starting at Index in Type_Str are
162 -- equivalent to Substring.
168 function Argument
(Parser
: Opt_Parser
; Index
: Integer) return String is
170 if Parser
.Arguments
/= null then
171 return Parser
.Arguments
(Index
+ Parser
.Arguments
'First - 1).all;
173 return CL
.Argument
(Index
);
177 ------------------------------
178 -- Canonical_Case_File_Name --
179 ------------------------------
181 procedure Canonical_Case_File_Name
(S
: in out String) is
183 if not File_Names_Case_Sensitive
then
184 for J
in S
'Range loop
185 if S
(J
) in 'A' .. 'Z' then
186 S
(J
) := Character'Val
187 (Character'Pos (S
(J
)) +
188 Character'Pos ('a') -
189 Character'Pos ('A'));
193 end Canonical_Case_File_Name
;
199 function Expansion
(Iterator
: Expansion_Iterator
) return String is
200 use GNAT
.Directory_Operations
;
201 type Pointer
is access all Expansion_Iterator
;
203 It
: constant Pointer
:= Iterator
'Unrestricted_Access;
204 S
: String (1 .. 1024);
207 Current
: Depth
:= It
.Current_Depth
;
211 -- It is assumed that a directory is opened at the current level.
212 -- Otherwise GNAT.Directory_Operations.Directory_Error will be raised
213 -- at the first call to Read.
216 Read
(It
.Levels
(Current
).Dir
, S
, Last
);
218 -- If we have exhausted the directory, close it and go back one level
221 Close
(It
.Levels
(Current
).Dir
);
223 -- If we are at level 1, we are finished; return an empty string
226 return String'(1 .. 0 => ' ');
228 -- Otherwise continue with the directory at the previous level
230 Current := Current - 1;
231 It.Current_Depth := Current;
234 -- If this is a directory, that is neither "." or "..", attempt to
235 -- go to the next level.
238 (It.Dir_Name (1 .. It.Levels (Current).Name_Last) & S (1 .. Last))
239 and then S (1 .. Last) /= "."
240 and then S (1 .. Last) /= ".."
242 -- We can go to the next level only if we have not reached the
245 if Current < It.Maximum_Depth then
246 NL := It.Levels (Current).Name_Last;
248 -- And if relative path of this new directory is not too long
250 if NL + Last + 1 < Max_Path_Length then
251 Current := Current + 1;
252 It.Current_Depth := Current;
253 It.Dir_Name (NL + 1 .. NL + Last) := S (1 .. Last);
255 It.Dir_Name (NL) := Directory_Separator;
256 It.Levels (Current).Name_Last := NL;
257 Canonical_Case_File_Name (It.Dir_Name (1 .. NL));
259 -- Open the new directory, and read from it
261 GNAT.Directory_Operations.Open
262 (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
267 -- Check the relative path against the pattern
269 -- Note that we try to match also against directory names, since
270 -- clients of this function may expect to retrieve directories.
274 It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
278 Canonical_Case_File_Name (Name);
280 -- If it matches return the relative path
282 if GNAT.Regexp.Match (Name, Iterator.Regexp) then
294 (Parser : Opt_Parser := Command_Line_Parser) return String
297 if Parser.The_Switch.Extra = ASCII.NUL then
298 return Argument (Parser, Parser.The_Switch.Arg_Num)
299 (Parser.The_Switch.First .. Parser.The_Switch.Last);
301 return Parser.The_Switch.Extra
302 & Argument (Parser, Parser.The_Switch.Arg_Num)
303 (Parser.The_Switch.First .. Parser.The_Switch.Last);
311 function Get_Argument
312 (Do_Expansion : Boolean := False;
313 Parser : Opt_Parser := Command_Line_Parser) return String
316 if Parser.In_Expansion then
318 S : constant String := Expansion (Parser.Expansion_It);
320 if S'Length /= 0 then
323 Parser.In_Expansion := False;
328 if Parser.Current_Argument > Parser.Arg_Count then
330 -- If this is the first time this function is called
332 if Parser.Current_Index = 1 then
333 Parser.Current_Argument := 1;
334 while Parser.Current_Argument <= Parser.Arg_Count
335 and then Parser.Section (Parser.Current_Argument) /=
336 Parser.Current_Section
338 Parser.Current_Argument := Parser.Current_Argument + 1;
341 return String'(1 .. 0 => ' ');
344 elsif Parser
.Section
(Parser
.Current_Argument
) = 0 then
345 while Parser
.Current_Argument
<= Parser
.Arg_Count
346 and then Parser
.Section
(Parser
.Current_Argument
) /=
347 Parser
.Current_Section
349 Parser
.Current_Argument
:= Parser
.Current_Argument
+ 1;
353 Parser
.Current_Index
:= Integer'Last;
355 while Parser
.Current_Argument
<= Parser
.Arg_Count
356 and then Parser
.Is_Switch
(Parser
.Current_Argument
)
358 Parser
.Current_Argument
:= Parser
.Current_Argument
+ 1;
361 if Parser
.Current_Argument
> Parser
.Arg_Count
then
362 return String'(1 .. 0 => ' ');
363 elsif Parser.Section (Parser.Current_Argument) = 0 then
364 return Get_Argument (Do_Expansion);
367 Parser.Current_Argument := Parser.Current_Argument + 1;
369 -- Could it be a file name with wild cards to expand?
373 Arg : constant String :=
374 Argument (Parser, Parser.Current_Argument - 1);
379 while Index <= Arg'Last loop
381 or else Arg (Index) = '?
'
382 or else Arg (Index) = '['
384 Parser.In_Expansion := True;
385 Start_Expansion (Parser.Expansion_It, Arg);
386 return Get_Argument (Do_Expansion);
394 return Argument (Parser, Parser.Current_Argument - 1);
397 ----------------------------------
398 -- Find_Longest_Matching_Switch --
399 ----------------------------------
401 procedure Find_Longest_Matching_Switch
404 Index_In_Switches : out Integer;
405 Switch_Length : out Integer;
406 Param : out Switch_Parameter_Type)
409 Length : Natural := 1;
410 P : Switch_Parameter_Type;
413 Index_In_Switches := 0;
416 -- Remove all leading spaces first to make sure that Index points
417 -- at the start of the first switch.
419 Index := Switches'First;
420 while Index <= Switches'Last and then Switches (Index) = ' ' loop
424 while Index <= Switches'Last loop
426 -- Search the length of the parameter at this position in Switches
429 while Length <= Switches'Last
430 and then Switches (Length) /= ' '
432 Length := Length + 1;
435 if Length = Index + 1 then
438 case Switches (Length - 1) is
440 P := Parameter_With_Optional_Space;
441 Length := Length - 1;
443 P := Parameter_With_Space_Or_Equal;
444 Length := Length - 1;
446 P := Parameter_No_Space;
447 Length := Length - 1;
449 P := Parameter_Optional;
450 Length := Length - 1;
456 -- If it is the one we searched, it may be a candidate
458 if Arg'First + Length - 1 - Index <= Arg'Last
459 and then Switches (Index .. Length - 1) =
460 Arg (Arg'First .. Arg'First + Length - 1 - Index)
461 and then Length - Index > Switch_Length
464 Index_In_Switches := Index;
465 Switch_Length := Length - Index;
468 -- Look for the next switch in Switches
470 while Index <= Switches'Last
471 and then Switches (Index) /= ' '
478 end Find_Longest_Matching_Switch;
486 Concatenate : Boolean := True;
487 Parser : Opt_Parser := Command_Line_Parser) return Character
490 pragma Unreferenced (Dummy);
495 -- If we have finished parsing the current command line item (there
496 -- might be multiple switches in a single item), then go to the next
499 if Parser.Current_Argument > Parser.Arg_Count
500 or else (Parser.Current_Index >
501 Argument (Parser, Parser.Current_Argument)'Last
502 and then not Goto_Next_Argument_In_Section (Parser))
507 -- By default, the switch will not have a parameter
509 Parser.The_Parameter :=
510 (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL);
511 Parser.The_Separator := ASCII.NUL;
514 Arg : constant String :=
515 Argument (Parser, Parser.Current_Argument);
516 Index_Switches : Natural := 0;
517 Max_Length : Natural := 0;
519 Param : Switch_Parameter_Type;
521 -- If we are on a new item, test if this might be a switch
523 if Parser.Current_Index = Arg'First then
524 if Arg (Arg'First) /= Parser.Switch_Character then
526 -- If it isn't a switch, return it immediately. We also know it
527 -- isn't the parameter to a previous switch, since that has
528 -- already been handled
530 if Switches (Switches'First) = '*' then
533 Arg_Num => Parser.Current_Argument,
536 Parser.Is_Switch (Parser.Current_Argument) := True;
537 Dummy := Goto_Next_Argument_In_Section (Parser);
541 if Parser.Stop_At_First then
542 Parser.Current_Argument := Positive'Last;
545 elsif not Goto_Next_Argument_In_Section (Parser) then
549 -- Recurse to get the next switch on the command line
555 -- We are on the first character of a new command line argument,
556 -- which starts with Switch_Character. Further analysis is needed.
558 Parser.Current_Index := Parser.Current_Index + 1;
559 Parser.Is_Switch (Parser.Current_Argument) := True;
562 Find_Longest_Matching_Switch
563 (Switches => Switches,
564 Arg => Arg (Parser.Current_Index .. Arg'Last),
565 Index_In_Switches => Index_Switches,
566 Switch_Length => Max_Length,
569 -- If switch is not accepted, it is either invalid or is returned
570 -- in the context of '*'.
572 if Index_Switches = 0 then
574 -- Depending on the value of Concatenate, the full switch is
575 -- a single character or the rest of the argument.
578 End_Index := Parser.Current_Index;
580 End_Index := Arg'Last;
583 if Switches (Switches'First) = '*' then
585 -- Always prepend the switch character, so that users know that
586 -- this comes from a switch on the command line. This is
587 -- especially important when Concatenate is False, since
588 -- otherwise the current argument first character is lost.
592 Arg_Num => Parser.Current_Argument,
593 First => Parser.Current_Index,
595 Extra => Parser.Switch_Character);
596 Parser.Is_Switch (Parser.Current_Argument) := True;
597 Dummy := Goto_Next_Argument_In_Section (Parser);
603 Arg_Num => Parser.Current_Argument,
604 First => Parser.Current_Index,
606 Parser.Current_Index := End_Index + 1;
607 raise Invalid_Switch;
610 End_Index := Parser.Current_Index + Max_Length - 1;
613 Arg_Num => Parser.Current_Argument,
614 First => Parser.Current_Index,
618 when Parameter_With_Optional_Space =>
619 if End_Index < Arg'Last then
621 (Parser.The_Parameter,
622 Arg_Num => Parser.Current_Argument,
623 First => End_Index + 1,
625 Dummy := Goto_Next_Argument_In_Section (Parser);
627 elsif Parser.Current_Argument < Parser.Arg_Count
628 and then Parser.Section (Parser.Current_Argument + 1) /= 0
630 Parser.Current_Argument := Parser.Current_Argument + 1;
631 Parser.The_Separator := ' ';
633 (Parser.The_Parameter,
634 Arg_Num => Parser.Current_Argument,
635 First => Argument (Parser, Parser.Current_Argument)'First,
636 Last => Argument (Parser, Parser.Current_Argument)'Last);
637 Parser.Is_Switch (Parser.Current_Argument) := True;
638 Dummy := Goto_Next_Argument_In_Section (Parser);
641 Parser.Current_Index := End_Index + 1;
642 raise Invalid_Parameter;
645 when Parameter_With_Space_Or_Equal =>
647 -- If the switch is of the form <switch>=xxx
649 if End_Index < Arg'Last then
651 if Arg (End_Index + 1) = '='
652 and then End_Index + 1 < Arg'Last
654 Parser.The_Separator := '=';
656 (Parser.The_Parameter,
657 Arg_Num => Parser.Current_Argument,
658 First => End_Index + 2,
660 Dummy := Goto_Next_Argument_In_Section (Parser);
662 Parser.Current_Index := End_Index + 1;
663 raise Invalid_Parameter;
666 -- If the switch is of the form <switch> xxx
668 elsif Parser.Current_Argument < Parser.Arg_Count
669 and then Parser.Section (Parser.Current_Argument + 1) /= 0
671 Parser.Current_Argument := Parser.Current_Argument + 1;
672 Parser.The_Separator := ' ';
674 (Parser.The_Parameter,
675 Arg_Num => Parser.Current_Argument,
676 First => Argument (Parser, Parser.Current_Argument)'First,
677 Last => Argument (Parser, Parser.Current_Argument)'Last);
678 Parser.Is_Switch (Parser.Current_Argument) := True;
679 Dummy := Goto_Next_Argument_In_Section (Parser);
682 Parser.Current_Index := End_Index + 1;
683 raise Invalid_Parameter;
686 when Parameter_No_Space =>
688 if End_Index < Arg'Last then
690 (Parser.The_Parameter,
691 Arg_Num => Parser.Current_Argument,
692 First => End_Index + 1,
694 Dummy := Goto_Next_Argument_In_Section (Parser);
697 Parser.Current_Index := End_Index + 1;
698 raise Invalid_Parameter;
701 when Parameter_Optional =>
703 if End_Index < Arg'Last then
705 (Parser.The_Parameter,
706 Arg_Num => Parser.Current_Argument,
707 First => End_Index + 1,
711 Dummy := Goto_Next_Argument_In_Section (Parser);
713 when Parameter_None =>
715 if Concatenate or else End_Index = Arg'Last then
716 Parser.Current_Index := End_Index + 1;
719 -- If Concatenate is False and the full argument is not
720 -- recognized as a switch, this is an invalid switch.
722 if Switches (Switches'First) = '*' then
725 Arg_Num => Parser.Current_Argument,
728 Parser.Is_Switch (Parser.Current_Argument) := True;
729 Dummy := Goto_Next_Argument_In_Section (Parser);
735 Arg_Num => Parser.Current_Argument,
736 First => Parser.Current_Index,
738 Parser.Current_Index := Arg'Last + 1;
739 raise Invalid_Switch;
743 return Switches (Index_Switches);
747 -----------------------------------
748 -- Goto_Next_Argument_In_Section --
749 -----------------------------------
751 function Goto_Next_Argument_In_Section
752 (Parser : Opt_Parser) return Boolean
755 Parser.Current_Argument := Parser.Current_Argument + 1;
757 if Parser.Current_Argument > Parser.Arg_Count
758 or else Parser.Section (Parser.Current_Argument) = 0
761 Parser.Current_Argument := Parser.Current_Argument + 1;
763 if Parser.Current_Argument > Parser.Arg_Count then
764 Parser.Current_Index := 1;
768 exit when Parser.Section (Parser.Current_Argument) =
769 Parser.Current_Section;
773 Parser.Current_Index :=
774 Argument (Parser, Parser.Current_Argument)'First;
777 end Goto_Next_Argument_In_Section;
783 procedure Goto_Section
784 (Name : String := "";
785 Parser : Opt_Parser := Command_Line_Parser)
790 Parser.In_Expansion := False;
793 Parser.Current_Argument := 1;
794 Parser.Current_Index := 1;
795 Parser.Current_Section := 1;
800 while Index <= Parser.Arg_Count loop
801 if Parser.Section (Index) = 0
802 and then Argument (Parser, Index) = Parser.Switch_Character & Name
804 Parser.Current_Argument := Index + 1;
805 Parser.Current_Index := 1;
807 if Parser.Current_Argument <= Parser.Arg_Count then
808 Parser.Current_Section :=
809 Parser.Section (Parser.Current_Argument);
817 Parser.Current_Argument := Positive'Last;
818 Parser.Current_Index := 2; -- so that Get_Argument returns nothing
821 ----------------------------
822 -- Initialize_Option_Scan --
823 ----------------------------
825 procedure Initialize_Option_Scan
826 (Switch_Char : Character := '-';
827 Stop_At_First_Non_Switch : Boolean := False;
828 Section_Delimiters : String := "")
831 Internal_Initialize_Option_Scan
832 (Parser => Command_Line_Parser,
833 Switch_Char => Switch_Char,
834 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
835 Section_Delimiters => Section_Delimiters);
836 end Initialize_Option_Scan;
838 ----------------------------
839 -- Initialize_Option_Scan --
840 ----------------------------
842 procedure Initialize_Option_Scan
843 (Parser : out Opt_Parser;
844 Command_Line : GNAT.OS_Lib.Argument_List_Access;
845 Switch_Char : Character := '-';
846 Stop_At_First_Non_Switch : Boolean := False;
847 Section_Delimiters : String := "")
852 if Command_Line = null then
853 Parser := new Opt_Parser_Data (CL.Argument_Count);
854 Internal_Initialize_Option_Scan
856 Switch_Char => Switch_Char,
857 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
858 Section_Delimiters => Section_Delimiters);
860 Parser := new Opt_Parser_Data (Command_Line'Length);
861 Parser.Arguments := Command_Line;
862 Internal_Initialize_Option_Scan
864 Switch_Char => Switch_Char,
865 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
866 Section_Delimiters => Section_Delimiters);
868 end Initialize_Option_Scan;
870 -------------------------------------
871 -- Internal_Initialize_Option_Scan --
872 -------------------------------------
874 procedure Internal_Initialize_Option_Scan
875 (Parser : Opt_Parser;
876 Switch_Char : Character;
877 Stop_At_First_Non_Switch : Boolean;
878 Section_Delimiters : String)
880 Section_Num : Section_Number;
881 Section_Index : Integer;
883 Delimiter_Found : Boolean;
886 pragma Warnings (Off, Discard);
889 Parser.Current_Argument := 0;
890 Parser.Current_Index := 0;
891 Parser.In_Expansion := False;
892 Parser.Switch_Character := Switch_Char;
893 Parser.Stop_At_First := Stop_At_First_Non_Switch;
894 Parser.Section := (others => 1);
896 -- If we are using sections, we have to preprocess the command line
897 -- to delimit them. A section can be repeated, so we just give each
898 -- item on the command line a section number
901 Section_Index := Section_Delimiters'First;
902 while Section_Index <= Section_Delimiters'Last loop
903 Last := Section_Index;
904 while Last <= Section_Delimiters'Last
905 and then Section_Delimiters (Last) /= ' '
910 Delimiter_Found := False;
911 Section_Num := Section_Num + 1;
913 for Index in 1 .. Parser.Arg_Count loop
914 if Argument (Parser, Index)(1) = Parser.Switch_Character
916 Argument (Parser, Index) = Parser.Switch_Character &
918 (Section_Index .. Last - 1)
920 Parser.Section (Index) := 0;
921 Delimiter_Found := True;
923 elsif Parser.Section (Index) = 0 then
924 Delimiter_Found := False;
926 elsif Delimiter_Found then
927 Parser.Section (Index) := Section_Num;
931 Section_Index := Last + 1;
932 while Section_Index <= Section_Delimiters'Last
933 and then Section_Delimiters (Section_Index) = ' '
935 Section_Index := Section_Index + 1;
939 Discard := Goto_Next_Argument_In_Section (Parser);
940 end Internal_Initialize_Option_Scan;
947 (Parser : Opt_Parser := Command_Line_Parser) return String
950 if Parser.The_Parameter.First > Parser.The_Parameter.Last then
951 return String'(1 .. 0 => ' ');
953 return Argument
(Parser
, Parser
.The_Parameter
.Arg_Num
)
954 (Parser
.The_Parameter
.First
.. Parser
.The_Parameter
.Last
);
963 (Parser
: Opt_Parser
:= Command_Line_Parser
) return Character
966 return Parser
.The_Separator
;
973 procedure Set_Parameter
974 (Variable
: out Parameter_Type
;
978 Extra
: Character := ASCII
.NUL
)
981 Variable
.Arg_Num
:= Arg_Num
;
982 Variable
.First
:= First
;
983 Variable
.Last
:= Last
;
984 Variable
.Extra
:= Extra
;
987 ---------------------
988 -- Start_Expansion --
989 ---------------------
991 procedure Start_Expansion
992 (Iterator
: out Expansion_Iterator
;
994 Directory
: String := "";
995 Basic_Regexp
: Boolean := True)
997 Directory_Separator
: Character;
998 pragma Import
(C
, Directory_Separator
, "__gnat_dir_separator");
1000 First
: Positive := Pattern
'First;
1001 Pat
: String := Pattern
;
1004 Canonical_Case_File_Name
(Pat
);
1005 Iterator
.Current_Depth
:= 1;
1007 -- If Directory is unspecified, use the current directory ("./" or ".\")
1009 if Directory
= "" then
1010 Iterator
.Dir_Name
(1 .. 2) := "." & Directory_Separator
;
1011 Iterator
.Start
:= 3;
1014 Iterator
.Dir_Name
(1 .. Directory
'Length) := Directory
;
1015 Iterator
.Start
:= Directory
'Length + 1;
1016 Canonical_Case_File_Name
(Iterator
.Dir_Name
(1 .. Directory
'Length));
1018 -- Make sure that the last character is a directory separator
1020 if Directory
(Directory
'Last) /= Directory_Separator
then
1021 Iterator
.Dir_Name
(Iterator
.Start
) := Directory_Separator
;
1022 Iterator
.Start
:= Iterator
.Start
+ 1;
1026 Iterator
.Levels
(1).Name_Last
:= Iterator
.Start
- 1;
1028 -- Open the initial Directory, at depth 1
1030 GNAT
.Directory_Operations
.Open
1031 (Iterator
.Levels
(1).Dir
, Iterator
.Dir_Name
(1 .. Iterator
.Start
- 1));
1033 -- If in the current directory and the pattern starts with "./" or ".\",
1034 -- drop the "./" or ".\" from the pattern.
1036 if Directory
= "" and then Pat
'Length > 2
1037 and then Pat
(Pat
'First) = '.'
1038 and then Pat
(Pat
'First + 1) = Directory_Separator
1040 First
:= Pat
'First + 2;
1044 GNAT
.Regexp
.Compile
(Pat
(First
.. Pat
'Last), Basic_Regexp
, True);
1046 Iterator
.Maximum_Depth
:= 1;
1048 -- Maximum_Depth is equal to 1 plus the number of directory separators
1051 for Index
in First
.. Pat
'Last loop
1052 if Pat
(Index
) = Directory_Separator
then
1053 Iterator
.Maximum_Depth
:= Iterator
.Maximum_Depth
+ 1;
1054 exit when Iterator
.Maximum_Depth
= Max_Depth
;
1057 end Start_Expansion
;
1063 procedure Free
(Parser
: in out Opt_Parser
) is
1064 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
1065 (Opt_Parser_Data
, Opt_Parser
);
1068 and then Parser
/= Command_Line_Parser
1070 Free
(Parser
.Arguments
);
1071 Unchecked_Free
(Parser
);
1079 procedure Define_Alias
1080 (Config
: in out Command_Line_Configuration
;
1085 if Config
= null then
1086 Config
:= new Command_Line_Configuration_Record
;
1089 Add
(Config
.Aliases
, new String'(Switch));
1090 Add (Config.Expansions, new String'(Expanded
));
1097 procedure Define_Prefix
1098 (Config
: in out Command_Line_Configuration
;
1102 if Config
= null then
1103 Config
:= new Command_Line_Configuration_Record
;
1106 Add
(Config
.Prefixes
, new String'(Prefix));
1113 procedure Define_Switch
1114 (Config : in out Command_Line_Configuration;
1118 if Config = null then
1119 Config := new Command_Line_Configuration_Record;
1122 Add (Config.Switches, new String'(Switch
));
1125 --------------------
1126 -- Define_Section --
1127 --------------------
1129 procedure Define_Section
1130 (Config
: in out Command_Line_Configuration
;
1134 if Config
= null then
1135 Config
:= new Command_Line_Configuration_Record
;
1138 Add
(Config
.Sections
, new String'(Section));
1145 function Get_Switches
1146 (Config : Command_Line_Configuration;
1147 Switch_Char : Character)
1150 Ret : Ada.Strings.Unbounded.Unbounded_String;
1151 use type Ada.Strings.Unbounded.Unbounded_String;
1154 if Config = null or else Config.Switches = null then
1158 for J in Config.Switches'Range loop
1159 if Config.Switches (J) (Config.Switches (J)'First) = Switch_Char then
1163 (Config.Switches (J)'First + 1 .. Config.Switches (J)'Last);
1165 Ret := Ret & " " & Config.Switches (J).all;
1169 return Ada.Strings.Unbounded.To_String (Ret);
1172 -----------------------
1173 -- Set_Configuration --
1174 -----------------------
1176 procedure Set_Configuration
1177 (Cmd : in out Command_Line;
1178 Config : Command_Line_Configuration)
1181 Cmd.Config := Config;
1182 end Set_Configuration;
1184 -----------------------
1185 -- Get_Configuration --
1186 -----------------------
1188 function Get_Configuration
1189 (Cmd : Command_Line) return Command_Line_Configuration is
1192 end Get_Configuration;
1194 ----------------------
1195 -- Set_Command_Line --
1196 ----------------------
1198 procedure Set_Command_Line
1199 (Cmd : in out Command_Line;
1201 Getopt_Description : String := "";
1202 Switch_Char : Character := '-')
1204 Tmp : Argument_List_Access;
1205 Parser : Opt_Parser;
1207 Section : String_Access := null;
1209 function Real_Full_Switch
1211 Parser : Opt_Parser) return String;
1212 -- Ensure that the returned switch value contains the
1213 -- Switch_Char prefix if needed.
1215 ----------------------
1216 -- Real_Full_Switch --
1217 ----------------------
1219 function Real_Full_Switch
1221 Parser : Opt_Parser) return String
1225 return Full_Switch (Parser);
1227 return Switch_Char & Full_Switch (Parser);
1229 end Real_Full_Switch;
1231 -- Start of processing for Set_Command_Line
1234 Free (Cmd.Expanded);
1237 if Switches /= "" then
1238 Tmp := Argument_String_To_List (Switches);
1239 Initialize_Option_Scan (Parser, Tmp, Switch_Char);
1243 S := Getopt (Switches => "* " & Getopt_Description,
1244 Concatenate => False,
1246 exit when S = ASCII.NUL;
1249 Sw : constant String :=
1250 Real_Full_Switch (S, Parser);
1251 Is_Section : Boolean := False;
1254 if Cmd.Config /= null
1255 and then Cmd.Config.Sections /= null
1258 for S in Cmd.Config.Sections'Range loop
1259 if Sw = Cmd.Config.Sections (S).all then
1260 Section := Cmd.Config.Sections (S);
1263 exit Section_Search;
1265 end loop Section_Search;
1268 if not Is_Section then
1269 if Section = null then
1271 -- Work around some weird cases: some switches may
1272 -- expect parameters, but have the same value as
1273 -- longer switches: -gnaty3 (-gnaty, parameter=3) and
1274 -- -gnatya (-gnatya, no parameter).
1276 -- So we are calling add_switch here with parameter
1277 -- attached. This will be anyway correctly handled by
1278 -- Add_Switch if -gnaty3 is actually provided.
1280 if Separator (Parser) = ASCII.NUL then
1282 (Cmd, Sw & Parameter (Parser), "", ASCII.NUL);
1285 (Cmd, Sw, Parameter (Parser), Separator (Parser));
1288 if Separator (Parser) = ASCII.NUL then
1290 (Cmd, Sw & Parameter (Parser), "",
1305 when Invalid_Parameter =>
1307 -- Add it with no parameter, if that's the way the user
1310 -- Specify the separator in all cases, as the switch might
1311 -- need to be unaliased, and the alias might contain
1312 -- switches with parameters.
1314 if Section = null then
1316 (Cmd, Switch_Char & Full_Switch (Parser),
1317 Separator => Separator (Parser));
1320 (Cmd, Switch_Char & Full_Switch (Parser),
1321 Separator => Separator (Parser),
1322 Section => Section.all);
1329 end Set_Command_Line;
1338 Substring : String) return Boolean is
1340 return Index + Substring'Length - 1 <= Type_Str'Last
1341 and then Type_Str (Index .. Index + Substring'Length - 1) = Substring;
1344 ------------------------
1345 -- Can_Have_Parameter --
1346 ------------------------
1348 function Can_Have_Parameter (S : String) return Boolean is
1350 if S'Length <= 1 then
1355 when '!' | ':' | '?
' | '=' =>
1360 end Can_Have_Parameter;
1362 -----------------------
1363 -- Require_Parameter --
1364 -----------------------
1366 function Require_Parameter (S : String) return Boolean is
1368 if S'Length <= 1 then
1373 when '!' | ':' | '=' =>
1378 end Require_Parameter;
1384 function Actual_Switch (S : String) return String is
1386 if S'Length <= 1 then
1391 when '!' | ':' | '?
' | '=' =>
1392 return S (S'First .. S'Last - 1);
1398 ----------------------------
1399 -- For_Each_Simple_Switch --
1400 ----------------------------
1402 procedure For_Each_Simple_Switch
1403 (Cmd : Command_Line;
1405 Parameter : String := "";
1406 Unalias : Boolean := True)
1408 function Group_Analysis
1410 Group : String) return Boolean;
1411 -- Perform the analysis of a group of switches
1413 --------------------
1414 -- Group_Analysis --
1415 --------------------
1417 function Group_Analysis
1419 Group : String) return Boolean
1426 while Idx <= Group'Last loop
1429 for S in Cmd.Config.Switches'Range loop
1431 Sw : constant String :=
1433 (Cmd.Config.Switches (S).all);
1434 Full : constant String :=
1435 Prefix & Group (Idx .. Group'Last);
1440 if Sw'Length >= Prefix'Length
1442 -- Verify that sw starts with Prefix
1444 and then Looking_At (Sw, Sw'First, Prefix)
1446 -- Verify that the group starts with sw
1448 and then Looking_At (Full, Full'First, Sw)
1450 Last := Idx + Sw'Length - Prefix'Length - 1;
1453 if Can_Have_Parameter (Cmd.Config.Switches (S).all) then
1455 -- Include potential parameter to the recursive call.
1456 -- Only numbers are allowed.
1458 while Last < Group'Last
1459 and then Group (Last + 1) in '0' .. '9'
1465 if not Require_Parameter (Cmd.Config.Switches (S).all)
1466 or else Last >= Param
1468 if Idx = Group'First
1469 and then Last = Group'Last
1470 and then Last < Param
1472 -- The group only concerns a single switch. Do not
1473 -- perform recursive call.
1475 -- Note that we still perform a recursive call if
1476 -- a parameter is detected in the switch, as this
1477 -- is a way to correctly identify such a parameter
1485 -- Recursive call, using the detected parameter if any
1487 if Last >= Param then
1488 For_Each_Simple_Switch
1490 Prefix & Group (Idx .. Param - 1),
1491 Group (Param .. Last));
1493 For_Each_Simple_Switch
1494 (Cmd, Prefix & Group (Idx .. Last), "");
1505 For_Each_Simple_Switch (Cmd, Prefix & Group (Idx), "");
1514 -- First determine if the switch corresponds to one belonging to the
1515 -- configuration. If so, run callback and exit.
1517 if Cmd.Config /= null and then Cmd.Config.Switches /= null then
1518 for S in Cmd.Config.Switches'Range loop
1520 Config_Switch : String renames Cmd.Config.Switches (S).all;
1522 if Actual_Switch (Config_Switch) = Switch
1524 ((Can_Have_Parameter (Config_Switch)
1525 and then Parameter /= "")
1527 (not Require_Parameter (Config_Switch)
1528 and then Parameter = ""))
1530 Callback (Switch, Parameter);
1537 -- If adding a switch that can in fact be expanded through aliases,
1538 -- add separately each of its expansions.
1540 -- This takes care of expansions like "-T" -> "-gnatwrs", where the
1541 -- alias and its expansion do not have the same prefix. Given the order
1542 -- in which we do things here, the expansion of the alias will itself
1543 -- be checked for a common prefix and split into simple switches.
1546 and then Cmd.Config /= null
1547 and then Cmd.Config.Aliases /= null
1549 for A in Cmd.Config.Aliases'Range loop
1550 if Cmd.Config.Aliases (A).all = Switch and then Parameter = "" then
1551 For_Each_Simple_Switch
1552 (Cmd, Cmd.Config.Expansions (A).all, "");
1558 -- If adding a switch grouping several switches, add each of the simple
1559 -- switches instead.
1561 if Cmd.Config /= null and then Cmd.Config.Prefixes /= null then
1562 for P in Cmd.Config.Prefixes'Range loop
1563 if Switch'Length > Cmd.Config.Prefixes (P)'Length + 1
1565 (Switch, Switch'First, Cmd.Config.Prefixes (P).all)
1567 -- Alias expansion will be done recursively
1569 if Cmd.Config.Switches = null then
1570 for S in Switch'First + Cmd.Config.Prefixes (P)'Length
1573 For_Each_Simple_Switch
1574 (Cmd, Cmd.Config.Prefixes (P).all & Switch (S), "");
1579 elsif Group_Analysis
1580 (Cmd.Config.Prefixes (P).all,
1582 (Switch'First + Cmd.Config.Prefixes (P)'Length
1585 -- Recursive calls already done on each switch of the group:
1586 -- Return without executing Callback.
1594 -- Test if added switch is a known switch with parameter attached
1597 and then Cmd.Config /= null
1598 and then Cmd.Config.Switches /= null
1600 for S in Cmd.Config.Switches'Range loop
1602 Sw : constant String :=
1603 Actual_Switch (Cmd.Config.Switches (S).all);
1608 -- Verify that switch starts with Sw
1609 -- What if the "verification" fails???
1611 if Switch'Length >= Sw'Length
1612 and then Looking_At (Switch, Switch'First, Sw)
1614 Param := Switch'First + Sw'Length - 1;
1617 if Can_Have_Parameter (Cmd.Config.Switches (S).all) then
1618 while Last < Switch'Last
1619 and then Switch (Last + 1) in '0' .. '9'
1625 -- If full Switch is a known switch with attached parameter
1626 -- then we use this parameter in the callback.
1628 if Last = Switch'Last then
1630 (Switch (Switch'First .. Param),
1631 Switch (Param + 1 .. Last));
1640 Callback (Switch, Parameter);
1641 end For_Each_Simple_Switch;
1647 procedure Add_Switch
1648 (Cmd : in out Command_Line;
1650 Parameter : String := "";
1651 Separator : Character := ' ';
1652 Section : String := "";
1653 Add_Before : Boolean := False)
1656 pragma Unreferenced (Success);
1659 (Cmd, Switch, Parameter, Separator, Section, Add_Before, Success);
1666 procedure Add_Switch
1667 (Cmd : in out Command_Line;
1669 Parameter : String := "";
1670 Separator : Character := ' ';
1671 Section : String := "";
1672 Add_Before : Boolean := False;
1673 Success : out Boolean)
1675 procedure Add_Simple_Switch (Simple : String; Param : String);
1676 -- Add a new switch that has had all its aliases expanded, and switches
1677 -- ungrouped. We know there are no more aliases in Switches.
1679 -----------------------
1680 -- Add_Simple_Switch --
1681 -----------------------
1683 procedure Add_Simple_Switch (Simple : String; Param : String) is
1685 if Cmd.Expanded = null then
1686 Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
1689 Cmd.Params := new Argument_List'
1690 (1 .. 1 => new String'(Separator & Param));
1693 Cmd.Params := new Argument_List'(1 .. 1 => null);
1696 if Section
= "" then
1697 Cmd
.Sections
:= new Argument_List
'(1 .. 1 => null);
1700 Cmd.Sections := new Argument_List'
1701 (1 .. 1 => new String'(Section));
1705 -- Do we already have this switch?
1707 for C in Cmd.Expanded'Range loop
1708 if Cmd.Expanded (C).all = Simple
1710 ((Cmd.Params (C) = null and then Param = "")
1712 (Cmd.Params (C) /= null
1713 and then Cmd.Params (C).all = Separator & Param))
1715 ((Cmd.Sections (C) = null and then Section = "")
1717 (Cmd.Sections (C) /= null
1718 and then Cmd.Sections (C).all = Section))
1724 -- Inserting at least one switch
1727 Add (Cmd.Expanded, new String'(Simple
), Add_Before
);
1732 new String'(Separator & Param),
1742 if Section = "" then
1750 new String'(Section
),
1754 end Add_Simple_Switch
;
1756 procedure Add_Simple_Switches
is
1757 new For_Each_Simple_Switch
(Add_Simple_Switch
);
1759 -- Start of processing for Add_Switch
1763 Add_Simple_Switches
(Cmd
, Switch
, Parameter
);
1764 Free
(Cmd
.Coalesce
);
1771 procedure Remove
(Line
: in out Argument_List_Access
; Index
: Integer) is
1772 Tmp
: Argument_List_Access
:= Line
;
1775 Line
:= new Argument_List
(Tmp
'First .. Tmp
'Last - 1);
1777 if Index
/= Tmp
'First then
1778 Line
(Tmp
'First .. Index
- 1) := Tmp
(Tmp
'First .. Index
- 1);
1783 if Index
/= Tmp
'Last then
1784 Line
(Index
.. Tmp
'Last - 1) := Tmp
(Index
+ 1 .. Tmp
'Last);
1787 Unchecked_Free
(Tmp
);
1795 (Line
: in out Argument_List_Access
;
1796 Str
: String_Access
;
1797 Before
: Boolean := False)
1799 Tmp
: Argument_List_Access
:= Line
;
1803 Line
:= new Argument_List
(Tmp
'First .. Tmp
'Last + 1);
1806 Line
(Tmp
'First) := Str
;
1807 Line
(Tmp
'First + 1 .. Tmp
'Last + 1) := Tmp
.all;
1809 Line
(Tmp
'Range) := Tmp
.all;
1810 Line
(Tmp
'Last + 1) := Str
;
1813 Unchecked_Free
(Tmp
);
1816 Line
:= new Argument_List
'(1 .. 1 => Str);
1824 procedure Remove_Switch
1825 (Cmd : in out Command_Line;
1827 Remove_All : Boolean := False;
1828 Has_Parameter : Boolean := False;
1829 Section : String := "")
1832 pragma Unreferenced (Success);
1834 Remove_Switch (Cmd, Switch, Remove_All, Has_Parameter, Section, Success);
1841 procedure Remove_Switch
1842 (Cmd : in out Command_Line;
1844 Remove_All : Boolean := False;
1845 Has_Parameter : Boolean := False;
1846 Section : String := "";
1847 Success : out Boolean)
1849 procedure Remove_Simple_Switch (Simple : String; Param : String);
1850 -- Removes a simple switch, with no aliasing or grouping
1852 --------------------------
1853 -- Remove_Simple_Switch --
1854 --------------------------
1856 procedure Remove_Simple_Switch (Simple : String; Param : String) is
1858 pragma Unreferenced (Param);
1861 if Cmd.Expanded /= null then
1862 C := Cmd.Expanded'First;
1863 while C <= Cmd.Expanded'Last loop
1864 if Cmd.Expanded (C).all = Simple
1867 or else (Cmd.Sections (C) = null
1868 and then Section = "")
1869 or else (Cmd.Sections (C) /= null
1870 and then Section = Cmd.Sections (C).all))
1871 and then (not Has_Parameter or else Cmd.Params (C) /= null)
1873 Remove (Cmd.Expanded, C);
1874 Remove (Cmd.Params, C);
1875 Remove (Cmd.Sections, C);
1878 if not Remove_All then
1887 end Remove_Simple_Switch;
1889 procedure Remove_Simple_Switches is
1890 new For_Each_Simple_Switch (Remove_Simple_Switch);
1892 -- Start of processing for Remove_Switch
1896 Remove_Simple_Switches (Cmd, Switch, "", Unalias => not Has_Parameter);
1897 Free (Cmd.Coalesce);
1904 procedure Remove_Switch
1905 (Cmd : in out Command_Line;
1908 Section : String := "")
1910 procedure Remove_Simple_Switch (Simple : String; Param : String);
1911 -- Removes a simple switch, with no aliasing or grouping
1913 --------------------------
1914 -- Remove_Simple_Switch --
1915 --------------------------
1917 procedure Remove_Simple_Switch (Simple : String; Param : String) is
1921 if Cmd.Expanded /= null then
1922 C := Cmd.Expanded'First;
1923 while C <= Cmd.Expanded'Last loop
1924 if Cmd.Expanded (C).all = Simple
1926 ((Cmd.Sections (C) = null
1927 and then Section = "")
1929 (Cmd.Sections (C) /= null
1930 and then Section = Cmd.Sections (C).all))
1932 ((Cmd.Params (C) = null and then Param = "")
1934 (Cmd.Params (C) /= null
1937 -- Ignore the separator stored in Parameter
1939 Cmd.Params (C) (Cmd.Params (C)'First + 1
1940 .. Cmd.Params (C)'Last) =
1943 Remove (Cmd.Expanded, C);
1944 Remove (Cmd.Params, C);
1945 Remove (Cmd.Sections, C);
1947 -- The switch is necessarily unique by construction of
1957 end Remove_Simple_Switch;
1959 procedure Remove_Simple_Switches is
1960 new For_Each_Simple_Switch (Remove_Simple_Switch);
1962 -- Start of processing for Remove_Switch
1965 Remove_Simple_Switches (Cmd, Switch, Parameter);
1966 Free (Cmd.Coalesce);
1969 --------------------
1970 -- Group_Switches --
1971 --------------------
1973 procedure Group_Switches
1974 (Cmd : Command_Line;
1975 Result : Argument_List_Access;
1976 Sections : Argument_List_Access;
1977 Params : Argument_List_Access)
1979 function Compatible_Parameter (Param : String_Access) return Boolean;
1980 -- True when the parameter can be part of a group
1982 --------------------------
1983 -- Compatible_Parameter --
1984 --------------------------
1986 function Compatible_Parameter (Param : String_Access) return Boolean is
1990 if Param = null then
1993 -- We need parameters without separators
1995 elsif Param (Param'First) /= ASCII.NUL then
1998 -- Parameters must be all digits
2001 for J in Param'First + 1 .. Param'Last loop
2002 if Param (J) not in '0' .. '9' then
2009 end Compatible_Parameter;
2011 -- Local declarations
2013 Group : Ada.Strings.Unbounded.Unbounded_String;
2015 use type Ada.Strings.Unbounded.Unbounded_String;
2017 -- Start of processing for Group_Switches
2020 if Cmd.Config = null
2021 or else Cmd.Config.Prefixes = null
2026 for P in Cmd.Config.Prefixes'Range loop
2027 Group := Ada.Strings.Unbounded.Null_Unbounded_String;
2030 for C in Result'Range loop
2031 if Result (C) /= null
2032 and then Compatible_Parameter (Params (C))
2034 (Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all)
2036 -- If we are still in the same section, group the switches
2040 (Sections (C) = null
2041 and then Sections (First) = null)
2043 (Sections (C) /= null
2044 and then Sections (First) /= null
2045 and then Sections (C).all = Sections (First).all)
2050 (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2053 if Params (C) /= null then
2056 Params (C) (Params (C)'First + 1 .. Params (C)'Last);
2067 -- We changed section: we put the grouped switches to the
2068 -- first place, on continue with the new section.
2072 (Cmd
.Config
.Prefixes
(P
).all &
2073 Ada
.Strings
.Unbounded
.To_String
(Group
));
2075 Ada
.Strings
.Unbounded
.To_Unbounded_String
2077 (Result
(C
)'First + Cmd
.Config
.Prefixes
(P
)'Length ..
2087 (Cmd.Config.Prefixes (P).all &
2088 Ada.Strings.Unbounded.To_String (Group));
2093 --------------------
2094 -- Alias_Switches --
2095 --------------------
2097 procedure Alias_Switches
2098 (Cmd : Command_Line;
2099 Result : Argument_List_Access;
2100 Params : Argument_List_Access)
2105 procedure Check_Cb (Switch : String; Param : String);
2106 -- Comment required ???
2108 procedure Remove_Cb (Switch : String; Param : String);
2109 -- Comment required ???
2115 procedure Check_Cb (Switch : String; Param : String) is
2118 for E in Result'Range loop
2119 if Result (E) /= null
2122 or else Params (E) (Params (E)'First + 1
2123 .. Params (E)'Last) = Param)
2124 and then Result (E).all = Switch
2138 procedure Remove_Cb (Switch : String; Param : String) is
2140 for E in Result'Range loop
2141 if Result (E) /= null
2144 or else Params (E) (Params (E)'First + 1
2145 .. Params (E)'Last) = Param)
2146 and then Result (E).all = Switch
2158 procedure Check_All is new For_Each_Simple_Switch (Check_Cb);
2159 procedure Remove_All is new For_Each_Simple_Switch (Remove_Cb);
2161 -- Start of processing for Alias_Switches
2164 if Cmd.Config = null
2165 or else Cmd.Config.Aliases = null
2170 for A in Cmd.Config.Aliases'Range loop
2172 -- Compute the various simple switches that make up the alias. We
2173 -- split the expansion into as many simple switches as possible, and
2174 -- then check whether the expanded command line has all of them.
2177 Check_All (Cmd, Cmd.Config.Expansions (A).all);
2180 First := Integer'Last;
2181 Remove_All (Cmd, Cmd.Config.Expansions (A).all);
2182 Result (First) := new String'(Cmd
.Config
.Aliases
(A
).all);
2191 procedure Sort_Sections
2192 (Line
: GNAT
.OS_Lib
.Argument_List_Access
;
2193 Sections
: GNAT
.OS_Lib
.Argument_List_Access
;
2194 Params
: GNAT
.OS_Lib
.Argument_List_Access
)
2196 Sections_List
: Argument_List_Access
:=
2197 new Argument_List
'(1 .. 1 => null);
2199 Old_Line : constant Argument_List := Line.all;
2200 Old_Sections : constant Argument_List := Sections.all;
2201 Old_Params : constant Argument_List := Params.all;
2209 -- First construct a list of all sections
2211 for E in Line'Range loop
2212 if Sections (E) /= null then
2214 for S in Sections_List'Range loop
2215 if (Sections_List (S) = null and then Sections (E) = null)
2217 (Sections_List (S) /= null
2218 and then Sections (E) /= null
2219 and then Sections_List (S).all = Sections (E).all)
2227 Add (Sections_List, Sections (E));
2232 Index := Line'First;
2234 for S in Sections_List'Range loop
2235 for E in Old_Line'Range loop
2236 if (Sections_List (S) = null and then Old_Sections (E) = null)
2238 (Sections_List (S) /= null
2239 and then Old_Sections (E) /= null
2240 and then Sections_List (S).all = Old_Sections (E).all)
2242 Line (Index) := Old_Line (E);
2243 Sections (Index) := Old_Sections (E);
2244 Params (Index) := Old_Params (E);
2256 (Cmd : in out Command_Line;
2257 Iter : in out Command_Line_Iterator;
2261 if Cmd.Expanded = null then
2266 -- Reorder the expanded line so that sections are grouped
2268 Sort_Sections (Cmd.Expanded, Cmd.Sections, Cmd.Params);
2270 -- Coalesce the switches as much as possible
2273 and then Cmd.Coalesce = null
2275 Cmd.Coalesce := new Argument_List (Cmd.Expanded'Range);
2276 for E in Cmd.Expanded'Range loop
2277 Cmd.Coalesce (E) := new String'(Cmd
.Expanded
(E
).all);
2280 Cmd
.Coalesce_Sections
:= new Argument_List
(Cmd
.Sections
'Range);
2281 for E
in Cmd
.Sections
'Range loop
2282 if Cmd
.Sections
(E
) = null then
2283 Cmd
.Coalesce_Sections
(E
) := null;
2285 Cmd
.Coalesce_Sections
(E
) := new String'(Cmd.Sections (E).all);
2289 Cmd.Coalesce_Params := new Argument_List (Cmd.Params'Range);
2290 for E in Cmd.Params'Range loop
2291 if Cmd.Params (E) = null then
2292 Cmd.Coalesce_Params (E) := null;
2294 Cmd.Coalesce_Params (E) := new String'(Cmd
.Params
(E
).all);
2298 -- Not a clone, since we will not modify the parameters anyway
2300 Alias_Switches
(Cmd
, Cmd
.Coalesce
, Cmd
.Coalesce_Params
);
2302 (Cmd
, Cmd
.Coalesce
, Cmd
.Coalesce_Sections
, Cmd
.Coalesce_Params
);
2306 Iter
.List
:= Cmd
.Expanded
;
2307 Iter
.Params
:= Cmd
.Params
;
2308 Iter
.Sections
:= Cmd
.Sections
;
2310 Iter
.List
:= Cmd
.Coalesce
;
2311 Iter
.Params
:= Cmd
.Coalesce_Params
;
2312 Iter
.Sections
:= Cmd
.Coalesce_Sections
;
2315 if Iter
.List
= null then
2316 Iter
.Current
:= Integer'Last;
2318 Iter
.Current
:= Iter
.List
'First;
2320 while Iter
.Current
<= Iter
.List
'Last
2321 and then Iter
.List
(Iter
.Current
) = null
2323 Iter
.Current
:= Iter
.Current
+ 1;
2328 --------------------
2329 -- Current_Switch --
2330 --------------------
2332 function Current_Switch
(Iter
: Command_Line_Iterator
) return String is
2334 return Iter
.List
(Iter
.Current
).all;
2337 --------------------
2338 -- Is_New_Section --
2339 --------------------
2341 function Is_New_Section
(Iter
: Command_Line_Iterator
) return Boolean is
2342 Section
: constant String := Current_Section
(Iter
);
2344 if Iter
.Sections
= null then
2346 elsif Iter
.Current
= Iter
.Sections
'First
2347 or else Iter
.Sections
(Iter
.Current
- 1) = null
2349 return Section
/= "";
2352 return Section
/= Iter
.Sections
(Iter
.Current
- 1).all;
2355 ---------------------
2356 -- Current_Section --
2357 ---------------------
2359 function Current_Section
(Iter
: Command_Line_Iterator
) return String is
2361 if Iter
.Sections
= null
2362 or else Iter
.Current
> Iter
.Sections
'Last
2363 or else Iter
.Sections
(Iter
.Current
) = null
2368 return Iter
.Sections
(Iter
.Current
).all;
2369 end Current_Section
;
2371 -----------------------
2372 -- Current_Separator --
2373 -----------------------
2375 function Current_Separator
(Iter
: Command_Line_Iterator
) return String is
2377 if Iter
.Params
= null
2378 or else Iter
.Current
> Iter
.Params
'Last
2379 or else Iter
.Params
(Iter
.Current
) = null
2385 Sep
: constant Character :=
2386 Iter
.Params
(Iter
.Current
) (Iter
.Params
(Iter
.Current
)'First);
2388 if Sep
= ASCII
.NUL
then
2395 end Current_Separator
;
2397 -----------------------
2398 -- Current_Parameter --
2399 -----------------------
2401 function Current_Parameter
(Iter
: Command_Line_Iterator
) return String is
2403 if Iter
.Params
= null
2404 or else Iter
.Current
> Iter
.Params
'Last
2405 or else Iter
.Params
(Iter
.Current
) = null
2411 P
: constant String := Iter
.Params
(Iter
.Current
).all;
2416 return P
(P
'First + 1 .. P
'Last);
2419 end Current_Parameter
;
2425 function Has_More
(Iter
: Command_Line_Iterator
) return Boolean is
2427 return Iter
.List
/= null and then Iter
.Current
<= Iter
.List
'Last;
2434 procedure Next
(Iter
: in out Command_Line_Iterator
) is
2436 Iter
.Current
:= Iter
.Current
+ 1;
2437 while Iter
.Current
<= Iter
.List
'Last
2438 and then Iter
.List
(Iter
.Current
) = null
2440 Iter
.Current
:= Iter
.Current
+ 1;
2448 procedure Free
(Config
: in out Command_Line_Configuration
) is
2450 if Config
/= null then
2451 Free
(Config
.Aliases
);
2452 Free
(Config
.Expansions
);
2453 Free
(Config
.Prefixes
);
2454 Free
(Config
.Sections
);
2455 Free
(Config
.Switches
);
2456 Unchecked_Free
(Config
);
2464 procedure Free
(Cmd
: in out Command_Line
) is
2466 Free
(Cmd
.Expanded
);
2467 Free
(Cmd
.Coalesce
);
2471 end GNAT
.Command_Line
;