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-2008, 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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Ada.Unchecked_Deallocation;
35 with Ada.Strings.Unbounded;
37 with GNAT.OS_Lib; use GNAT.OS_Lib;
39 package body GNAT.Command_Line is
41 package CL renames Ada.Command_Line;
43 type Switch_Parameter_Type is
45 Parameter_With_Optional_Space, -- ':' in getopt
46 Parameter_With_Space_Or_Equal, -- '=' in getopt
47 Parameter_No_Space, -- '!' in getopt
48 Parameter_Optional); -- '?' in getopt
50 procedure Set_Parameter
51 (Variable : out Parameter_Type;
55 Extra : Character := ASCII.NUL);
56 pragma Inline (Set_Parameter);
57 -- Set the parameter that will be returned by Parameter below
58 -- Parameters need to be defined ???
60 function Goto_Next_Argument_In_Section (Parser : Opt_Parser) return Boolean;
61 -- Go to the next argument on the command line. If we are at the end of
62 -- the current section, we want to make sure there is no other identical
63 -- section on the command line (there might be multiple instances of
64 -- -largs). Returns True iff there is another argument.
66 function Get_File_Names_Case_Sensitive return Integer;
67 pragma Import (C, Get_File_Names_Case_Sensitive,
68 "__gnat_get_file_names_case_sensitive");
70 File_Names_Case_Sensitive : constant Boolean :=
71 Get_File_Names_Case_Sensitive /= 0;
73 procedure Canonical_Case_File_Name (S : in out String);
74 -- Given a file name, converts it to canonical case form. For systems where
75 -- file names are case sensitive, this procedure has no effect. If file
76 -- names are not case sensitive (i.e. for example if you have the file
77 -- "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then this call
78 -- converts the given string to canonical all lower case form, so that two
79 -- file names compare equal if they refer to the same file.
81 procedure Internal_Initialize_Option_Scan
83 Switch_Char : Character;
84 Stop_At_First_Non_Switch : Boolean;
85 Section_Delimiters : String);
86 -- Initialize Parser, which must have been allocated already
88 function Argument (Parser : Opt_Parser; Index : Integer) return String;
89 -- Return the index-th command line argument
91 procedure Find_Longest_Matching_Switch
94 Index_In_Switches : out Integer;
95 Switch_Length : out Integer;
96 Param : out Switch_Parameter_Type);
97 -- return the Longest switch from Switches that matches at least
98 -- partially Arg. Index_In_Switches is set to 0 if none matches
100 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
101 (Argument_List, Argument_List_Access);
103 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
104 (Command_Line_Configuration_Record, Command_Line_Configuration);
106 procedure Remove (Line : in out Argument_List_Access; Index : Integer);
107 -- Remove a specific element from Line
110 (Line : in out Argument_List_Access;
112 Before : Boolean := False);
113 -- Add a new element to Line. If Before is True, the item is inserted at
114 -- the beginning, else it is appended.
116 function Can_Have_Parameter (S : String) return Boolean;
117 -- True if S can have a parameter.
119 function Require_Parameter (S : String) return Boolean;
120 -- True if S requires a parameter.
122 function Actual_Switch (S : String) return String;
123 -- Remove any possible trailing '!', ':', '?' and '='
126 with procedure Callback (Simple_Switch : String; Parameter : String);
127 procedure For_Each_Simple_Switch
130 Parameter : String := "";
131 Unalias : Boolean := True);
132 -- Breaks Switch into as simple switches as possible (expanding aliases and
133 -- ungrouping common prefixes when possible), and call Callback for each of
136 procedure Sort_Sections
137 (Line : GNAT.OS_Lib.Argument_List_Access;
138 Sections : GNAT.OS_Lib.Argument_List_Access;
139 Params : GNAT.OS_Lib.Argument_List_Access);
140 -- Reorder the command line switches so that the switches belonging to a
141 -- section are grouped together.
143 procedure Group_Switches
145 Result : Argument_List_Access;
146 Sections : Argument_List_Access;
147 Params : Argument_List_Access);
148 -- Group switches with common prefixes whenever possible. Once they have
149 -- been grouped, we also check items for possible aliasing.
151 procedure Alias_Switches
153 Result : Argument_List_Access;
154 Params : Argument_List_Access);
155 -- When possible, replace one or more switches by an alias, i.e. a shorter
161 Substring : String) return Boolean;
162 -- Return True if the characters starting at Index in Type_Str are
163 -- equivalent to Substring.
169 function Argument (Parser : Opt_Parser; Index : Integer) return String is
171 if Parser.Arguments /= null then
172 return Parser.Arguments (Index + Parser.Arguments'First - 1).all;
174 return CL.Argument (Index);
178 ------------------------------
179 -- Canonical_Case_File_Name --
180 ------------------------------
182 procedure Canonical_Case_File_Name (S : in out String) is
184 if not File_Names_Case_Sensitive then
185 for J in S'Range loop
186 if S (J) in 'A' .. 'Z' then
187 S (J) := Character'Val
188 (Character'Pos (S (J)) +
189 Character'Pos ('a') -
190 Character'Pos ('A'));
194 end Canonical_Case_File_Name;
200 function Expansion (Iterator : Expansion_Iterator) return String is
201 use GNAT.Directory_Operations;
202 type Pointer is access all Expansion_Iterator;
204 It : constant Pointer := Iterator'Unrestricted_Access;
205 S : String (1 .. 1024);
208 Current : Depth := It.Current_Depth;
212 -- It is assumed that a directory is opened at the current level.
213 -- Otherwise GNAT.Directory_Operations.Directory_Error will be raised
214 -- at the first call to Read.
217 Read (It.Levels (Current).Dir, S, Last);
219 -- If we have exhausted the directory, close it and go back one level
222 Close (It.Levels (Current).Dir);
224 -- If we are at level 1, we are finished; return an empty string
227 return String'(1 .. 0 => ' ');
229 -- Otherwise continue with the directory at the previous level
231 Current := Current - 1;
232 It.Current_Depth := Current;
235 -- If this is a directory, that is neither "." or "..", attempt to
236 -- go to the next level.
239 (It.Dir_Name (1 .. It.Levels (Current).Name_Last) & S (1 .. Last))
240 and then S (1 .. Last) /= "."
241 and then S (1 .. Last) /= ".."
243 -- We can go to the next level only if we have not reached the
246 if Current < It.Maximum_Depth then
247 NL := It.Levels (Current).Name_Last;
249 -- And if relative path of this new directory is not too long
251 if NL + Last + 1 < Max_Path_Length then
252 Current := Current + 1;
253 It.Current_Depth := Current;
254 It.Dir_Name (NL + 1 .. NL + Last) := S (1 .. Last);
256 It.Dir_Name (NL) := Directory_Separator;
257 It.Levels (Current).Name_Last := NL;
258 Canonical_Case_File_Name (It.Dir_Name (1 .. NL));
260 -- Open the new directory, and read from it
262 GNAT.Directory_Operations.Open
263 (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
268 -- 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)
277 Canonical_Case_File_Name (Name);
279 -- If it matches return the relative path
281 if GNAT.Regexp.Match (Name, Iterator.Regexp) then
293 (Parser : Opt_Parser := Command_Line_Parser) return String
296 if Parser.The_Switch.Extra = ASCII.NUL then
297 return Argument (Parser, Parser.The_Switch.Arg_Num)
298 (Parser.The_Switch.First .. Parser.The_Switch.Last);
300 return Parser.The_Switch.Extra
301 & Argument (Parser, Parser.The_Switch.Arg_Num)
302 (Parser.The_Switch.First .. Parser.The_Switch.Last);
310 function Get_Argument
311 (Do_Expansion : Boolean := False;
312 Parser : Opt_Parser := Command_Line_Parser) return String
315 if Parser.In_Expansion then
317 S : constant String := Expansion (Parser.Expansion_It);
319 if S'Length /= 0 then
322 Parser.In_Expansion := False;
327 if Parser.Current_Argument > Parser.Arg_Count then
329 -- If this is the first time this function is called
331 if Parser.Current_Index = 1 then
332 Parser.Current_Argument := 1;
333 while Parser.Current_Argument <= Parser.Arg_Count
334 and then Parser.Section (Parser.Current_Argument) /=
335 Parser.Current_Section
337 Parser.Current_Argument := Parser.Current_Argument + 1;
340 return String'(1 .. 0 => ' ');
343 elsif Parser.Section (Parser.Current_Argument) = 0 then
344 while Parser.Current_Argument <= Parser.Arg_Count
345 and then Parser.Section (Parser.Current_Argument) /=
346 Parser.Current_Section
348 Parser.Current_Argument := Parser.Current_Argument + 1;
352 Parser.Current_Index := Integer'Last;
354 while Parser.Current_Argument <= Parser.Arg_Count
355 and then Parser.Is_Switch (Parser.Current_Argument)
357 Parser.Current_Argument := Parser.Current_Argument + 1;
360 if Parser.Current_Argument > Parser.Arg_Count then
361 return String'(1 .. 0 => ' ');
362 elsif Parser.Section (Parser.Current_Argument) = 0 then
363 return Get_Argument (Do_Expansion);
366 Parser.Current_Argument := Parser.Current_Argument + 1;
368 -- Could it be a file name with wild cards to expand?
372 Arg : constant String :=
373 Argument (Parser, Parser.Current_Argument - 1);
378 while Index <= Arg'Last loop
380 or else Arg (Index) = '?'
381 or else Arg (Index) = '['
383 Parser.In_Expansion := True;
384 Start_Expansion (Parser.Expansion_It, Arg);
385 return Get_Argument (Do_Expansion);
393 return Argument (Parser, Parser.Current_Argument - 1);
396 ----------------------------------
397 -- Find_Longest_Matching_Switch --
398 ----------------------------------
400 procedure Find_Longest_Matching_Switch
403 Index_In_Switches : out Integer;
404 Switch_Length : out Integer;
405 Param : out Switch_Parameter_Type)
408 Length : Natural := 1;
409 P : Switch_Parameter_Type;
412 Index_In_Switches := 0;
415 -- Remove all leading spaces first to make sure that Index points
416 -- at the start of the first switch.
418 Index := Switches'First;
419 while Index <= Switches'Last and then Switches (Index) = ' ' loop
423 while Index <= Switches'Last loop
425 -- Search the length of the parameter at this position in Switches
428 while Length <= Switches'Last
429 and then Switches (Length) /= ' '
431 Length := Length + 1;
434 if Length = Index + 1 then
437 case Switches (Length - 1) is
439 P := Parameter_With_Optional_Space;
440 Length := Length - 1;
442 P := Parameter_With_Space_Or_Equal;
443 Length := Length - 1;
445 P := Parameter_No_Space;
446 Length := Length - 1;
448 P := Parameter_Optional;
449 Length := Length - 1;
455 -- If it is the one we searched, it may be a candidate
457 if Arg'First + Length - 1 - Index <= Arg'Last
458 and then Switches (Index .. Length - 1) =
459 Arg (Arg'First .. Arg'First + Length - 1 - Index)
460 and then Length - Index > Switch_Length
463 Index_In_Switches := Index;
464 Switch_Length := Length - Index;
467 -- Look for the next switch in Switches
469 while Index <= Switches'Last
470 and then Switches (Index) /= ' '
477 end Find_Longest_Matching_Switch;
485 Concatenate : Boolean := True;
486 Parser : Opt_Parser := Command_Line_Parser) return Character
489 pragma Unreferenced (Dummy);
494 -- If we have finished parsing the current command line item (there
495 -- might be multiple switches in a single item), then go to the next
498 if Parser.Current_Argument > Parser.Arg_Count
499 or else (Parser.Current_Index >
500 Argument (Parser, Parser.Current_Argument)'Last
501 and then not Goto_Next_Argument_In_Section (Parser))
506 -- By default, the switch will not have a parameter
508 Parser.The_Parameter :=
509 (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL);
510 Parser.The_Separator := ASCII.NUL;
513 Arg : constant String :=
514 Argument (Parser, Parser.Current_Argument);
515 Index_Switches : Natural := 0;
516 Max_Length : Natural := 0;
518 Param : Switch_Parameter_Type;
520 -- If we are on a new item, test if this might be a switch
522 if Parser.Current_Index = Arg'First then
523 if Arg (Arg'First) /= Parser.Switch_Character then
525 -- If it isn't a switch, return it immediately. We also know it
526 -- isn't the parameter to a previous switch, since that has
527 -- already been handled
529 if Switches (Switches'First) = '*' then
532 Arg_Num => Parser.Current_Argument,
535 Parser.Is_Switch (Parser.Current_Argument) := True;
536 Dummy := Goto_Next_Argument_In_Section (Parser);
540 if Parser.Stop_At_First then
541 Parser.Current_Argument := Positive'Last;
544 elsif not Goto_Next_Argument_In_Section (Parser) then
548 -- Recurse to get the next switch on the command line
554 -- We are on the first character of a new command line argument,
555 -- which starts with Switch_Character. Further analysis is needed.
557 Parser.Current_Index := Parser.Current_Index + 1;
558 Parser.Is_Switch (Parser.Current_Argument) := True;
561 Find_Longest_Matching_Switch
562 (Switches => Switches,
563 Arg => Arg (Parser.Current_Index .. Arg'Last),
564 Index_In_Switches => Index_Switches,
565 Switch_Length => Max_Length,
568 -- If switch is not accepted, it is either invalid or is returned
569 -- in the context of '*'.
571 if Index_Switches = 0 then
573 -- Depending on the value of Concatenate, the full switch is
574 -- a single character or the rest of the argument.
577 End_Index := Parser.Current_Index;
579 End_Index := Arg'Last;
582 if Switches (Switches'First) = '*' then
584 -- Always prepend the switch character, so that users know that
585 -- this comes from a switch on the command line. This is
586 -- especially important when Concatenate is False, since
587 -- otherwise the current argument first character is lost.
591 Arg_Num => Parser.Current_Argument,
592 First => Parser.Current_Index,
594 Extra => Parser.Switch_Character);
595 Parser.Is_Switch (Parser.Current_Argument) := True;
596 Dummy := Goto_Next_Argument_In_Section (Parser);
602 Arg_Num => Parser.Current_Argument,
603 First => Parser.Current_Index,
605 Parser.Current_Index := End_Index + 1;
606 raise Invalid_Switch;
609 End_Index := Parser.Current_Index + Max_Length - 1;
612 Arg_Num => Parser.Current_Argument,
613 First => Parser.Current_Index,
617 when Parameter_With_Optional_Space =>
618 if End_Index < Arg'Last then
620 (Parser.The_Parameter,
621 Arg_Num => Parser.Current_Argument,
622 First => End_Index + 1,
624 Dummy := Goto_Next_Argument_In_Section (Parser);
626 elsif Parser.Current_Argument < Parser.Arg_Count
627 and then Parser.Section (Parser.Current_Argument + 1) /= 0
629 Parser.Current_Argument := Parser.Current_Argument + 1;
630 Parser.The_Separator := ' ';
632 (Parser.The_Parameter,
633 Arg_Num => Parser.Current_Argument,
634 First => Argument (Parser, Parser.Current_Argument)'First,
635 Last => Argument (Parser, Parser.Current_Argument)'Last);
636 Parser.Is_Switch (Parser.Current_Argument) := True;
637 Dummy := Goto_Next_Argument_In_Section (Parser);
640 Parser.Current_Index := End_Index + 1;
641 raise Invalid_Parameter;
644 when Parameter_With_Space_Or_Equal =>
646 -- If the switch is of the form <switch>=xxx
648 if End_Index < Arg'Last then
650 if Arg (End_Index + 1) = '='
651 and then End_Index + 1 < Arg'Last
653 Parser.The_Separator := '=';
655 (Parser.The_Parameter,
656 Arg_Num => Parser.Current_Argument,
657 First => End_Index + 2,
659 Dummy := Goto_Next_Argument_In_Section (Parser);
661 Parser.Current_Index := End_Index + 1;
662 raise Invalid_Parameter;
665 -- If the switch is of the form <switch> xxx
667 elsif Parser.Current_Argument < Parser.Arg_Count
668 and then Parser.Section (Parser.Current_Argument + 1) /= 0
670 Parser.Current_Argument := Parser.Current_Argument + 1;
671 Parser.The_Separator := ' ';
673 (Parser.The_Parameter,
674 Arg_Num => Parser.Current_Argument,
675 First => Argument (Parser, Parser.Current_Argument)'First,
676 Last => Argument (Parser, Parser.Current_Argument)'Last);
677 Parser.Is_Switch (Parser.Current_Argument) := True;
678 Dummy := Goto_Next_Argument_In_Section (Parser);
681 Parser.Current_Index := End_Index + 1;
682 raise Invalid_Parameter;
685 when Parameter_No_Space =>
687 if End_Index < Arg'Last then
689 (Parser.The_Parameter,
690 Arg_Num => Parser.Current_Argument,
691 First => End_Index + 1,
693 Dummy := Goto_Next_Argument_In_Section (Parser);
696 Parser.Current_Index := End_Index + 1;
697 raise Invalid_Parameter;
700 when Parameter_Optional =>
702 if End_Index < Arg'Last then
704 (Parser.The_Parameter,
705 Arg_Num => Parser.Current_Argument,
706 First => End_Index + 1,
710 Dummy := Goto_Next_Argument_In_Section (Parser);
712 when Parameter_None =>
714 if Concatenate or else End_Index = Arg'Last then
715 Parser.Current_Index := End_Index + 1;
718 -- If Concatenate is False and the full argument is not
719 -- recognized as a switch, this is an invalid switch.
721 if Switches (Switches'First) = '*' then
724 Arg_Num => Parser.Current_Argument,
727 Parser.Is_Switch (Parser.Current_Argument) := True;
728 Dummy := Goto_Next_Argument_In_Section (Parser);
734 Arg_Num => Parser.Current_Argument,
735 First => Parser.Current_Index,
737 Parser.Current_Index := Arg'Last + 1;
738 raise Invalid_Switch;
742 return Switches (Index_Switches);
746 -----------------------------------
747 -- Goto_Next_Argument_In_Section --
748 -----------------------------------
750 function Goto_Next_Argument_In_Section
751 (Parser : Opt_Parser) return Boolean
754 Parser.Current_Argument := Parser.Current_Argument + 1;
756 if Parser.Current_Argument > Parser.Arg_Count
757 or else Parser.Section (Parser.Current_Argument) = 0
760 Parser.Current_Argument := Parser.Current_Argument + 1;
762 if Parser.Current_Argument > Parser.Arg_Count then
763 Parser.Current_Index := 1;
767 exit when Parser.Section (Parser.Current_Argument) =
768 Parser.Current_Section;
772 Parser.Current_Index :=
773 Argument (Parser, Parser.Current_Argument)'First;
776 end Goto_Next_Argument_In_Section;
782 procedure Goto_Section
783 (Name : String := "";
784 Parser : Opt_Parser := Command_Line_Parser)
789 Parser.In_Expansion := False;
792 Parser.Current_Argument := 1;
793 Parser.Current_Index := 1;
794 Parser.Current_Section := 1;
799 while Index <= Parser.Arg_Count loop
800 if Parser.Section (Index) = 0
801 and then Argument (Parser, Index) = Parser.Switch_Character & Name
803 Parser.Current_Argument := Index + 1;
804 Parser.Current_Index := 1;
806 if Parser.Current_Argument <= Parser.Arg_Count then
807 Parser.Current_Section :=
808 Parser.Section (Parser.Current_Argument);
816 Parser.Current_Argument := Positive'Last;
817 Parser.Current_Index := 2; -- so that Get_Argument returns nothing
820 ----------------------------
821 -- Initialize_Option_Scan --
822 ----------------------------
824 procedure Initialize_Option_Scan
825 (Switch_Char : Character := '-';
826 Stop_At_First_Non_Switch : Boolean := False;
827 Section_Delimiters : String := "")
830 Internal_Initialize_Option_Scan
831 (Parser => Command_Line_Parser,
832 Switch_Char => Switch_Char,
833 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
834 Section_Delimiters => Section_Delimiters);
835 end Initialize_Option_Scan;
837 ----------------------------
838 -- Initialize_Option_Scan --
839 ----------------------------
841 procedure Initialize_Option_Scan
842 (Parser : out Opt_Parser;
843 Command_Line : GNAT.OS_Lib.Argument_List_Access;
844 Switch_Char : Character := '-';
845 Stop_At_First_Non_Switch : Boolean := False;
846 Section_Delimiters : String := "")
851 if Command_Line = null then
852 Parser := new Opt_Parser_Data (CL.Argument_Count);
853 Initialize_Option_Scan
854 (Switch_Char => Switch_Char,
855 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
856 Section_Delimiters => Section_Delimiters);
858 Parser := new Opt_Parser_Data (Command_Line'Length);
859 Parser.Arguments := Command_Line;
860 Internal_Initialize_Option_Scan
862 Switch_Char => Switch_Char,
863 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
864 Section_Delimiters => Section_Delimiters);
866 end Initialize_Option_Scan;
868 -------------------------------------
869 -- Internal_Initialize_Option_Scan --
870 -------------------------------------
872 procedure Internal_Initialize_Option_Scan
873 (Parser : Opt_Parser;
874 Switch_Char : Character;
875 Stop_At_First_Non_Switch : Boolean;
876 Section_Delimiters : String)
878 Section_Num : Section_Number;
879 Section_Index : Integer;
881 Delimiter_Found : Boolean;
884 pragma Warnings (Off, Discard);
887 Parser.Current_Argument := 0;
888 Parser.Current_Index := 0;
889 Parser.In_Expansion := False;
890 Parser.Switch_Character := Switch_Char;
891 Parser.Stop_At_First := Stop_At_First_Non_Switch;
893 -- If we are using sections, we have to preprocess the command line
894 -- to delimit them. A section can be repeated, so we just give each
895 -- item on the command line a section number
898 Section_Index := Section_Delimiters'First;
899 while Section_Index <= Section_Delimiters'Last loop
900 Last := Section_Index;
901 while Last <= Section_Delimiters'Last
902 and then Section_Delimiters (Last) /= ' '
907 Delimiter_Found := False;
908 Section_Num := Section_Num + 1;
910 for Index in 1 .. Parser.Arg_Count loop
911 if Argument (Parser, Index)(1) = Parser.Switch_Character
913 Argument (Parser, Index) = Parser.Switch_Character &
915 (Section_Index .. Last - 1)
917 Parser.Section (Index) := 0;
918 Delimiter_Found := True;
920 elsif Parser.Section (Index) = 0 then
921 Delimiter_Found := False;
923 elsif Delimiter_Found then
924 Parser.Section (Index) := Section_Num;
928 Section_Index := Last + 1;
929 while Section_Index <= Section_Delimiters'Last
930 and then Section_Delimiters (Section_Index) = ' '
932 Section_Index := Section_Index + 1;
936 Discard := Goto_Next_Argument_In_Section (Parser);
937 end Internal_Initialize_Option_Scan;
944 (Parser : Opt_Parser := Command_Line_Parser) return String
947 if Parser.The_Parameter.First > Parser.The_Parameter.Last then
948 return String'(1 .. 0 => ' ');
950 return Argument (Parser, Parser.The_Parameter.Arg_Num)
951 (Parser.The_Parameter.First .. Parser.The_Parameter.Last);
960 (Parser : Opt_Parser := Command_Line_Parser) return Character
963 return Parser.The_Separator;
970 procedure Set_Parameter
971 (Variable : out Parameter_Type;
975 Extra : Character := ASCII.NUL)
978 Variable.Arg_Num := Arg_Num;
979 Variable.First := First;
980 Variable.Last := Last;
981 Variable.Extra := Extra;
984 ---------------------
985 -- Start_Expansion --
986 ---------------------
988 procedure Start_Expansion
989 (Iterator : out Expansion_Iterator;
991 Directory : String := "";
992 Basic_Regexp : Boolean := True)
994 Directory_Separator : Character;
995 pragma Import (C, Directory_Separator, "__gnat_dir_separator");
997 First : Positive := Pattern'First;
998 Pat : String := Pattern;
1001 Canonical_Case_File_Name (Pat);
1002 Iterator.Current_Depth := 1;
1004 -- If Directory is unspecified, use the current directory ("./" or ".\")
1006 if Directory = "" then
1007 Iterator.Dir_Name (1 .. 2) := "." & Directory_Separator;
1008 Iterator.Start := 3;
1011 Iterator.Dir_Name (1 .. Directory'Length) := Directory;
1012 Iterator.Start := Directory'Length + 1;
1013 Canonical_Case_File_Name (Iterator.Dir_Name (1 .. Directory'Length));
1015 -- Make sure that the last character is a directory separator
1017 if Directory (Directory'Last) /= Directory_Separator then
1018 Iterator.Dir_Name (Iterator.Start) := Directory_Separator;
1019 Iterator.Start := Iterator.Start + 1;
1023 Iterator.Levels (1).Name_Last := Iterator.Start - 1;
1025 -- Open the initial Directory, at depth 1
1027 GNAT.Directory_Operations.Open
1028 (Iterator.Levels (1).Dir, Iterator.Dir_Name (1 .. Iterator.Start - 1));
1030 -- If in the current directory and the pattern starts with "./" or ".\",
1031 -- drop the "./" or ".\" from the pattern.
1033 if Directory = "" and then Pat'Length > 2
1034 and then Pat (Pat'First) = '.'
1035 and then Pat (Pat'First + 1) = Directory_Separator
1037 First := Pat'First + 2;
1041 GNAT.Regexp.Compile (Pat (First .. Pat'Last), Basic_Regexp, True);
1043 Iterator.Maximum_Depth := 1;
1045 -- Maximum_Depth is equal to 1 plus the number of directory separators
1048 for Index in First .. Pat'Last loop
1049 if Pat (Index) = Directory_Separator then
1050 Iterator.Maximum_Depth := Iterator.Maximum_Depth + 1;
1051 exit when Iterator.Maximum_Depth = Max_Depth;
1054 end Start_Expansion;
1060 procedure Free (Parser : in out Opt_Parser) is
1061 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1062 (Opt_Parser_Data, Opt_Parser);
1065 and then Parser /= Command_Line_Parser
1067 Free (Parser.Arguments);
1068 Unchecked_Free (Parser);
1076 procedure Define_Alias
1077 (Config : in out Command_Line_Configuration;
1082 if Config = null then
1083 Config := new Command_Line_Configuration_Record;
1086 Add (Config.Aliases, new String'(Switch));
1087 Add (Config.Expansions, new String'(Expanded));
1094 procedure Define_Prefix
1095 (Config : in out Command_Line_Configuration;
1099 if Config = null then
1100 Config := new Command_Line_Configuration_Record;
1103 Add (Config.Prefixes, new String'(Prefix));
1110 procedure Define_Switch
1111 (Config : in out Command_Line_Configuration;
1115 if Config = null then
1116 Config := new Command_Line_Configuration_Record;
1119 Add (Config.Switches, new String'(Switch));
1122 --------------------
1123 -- Define_Section --
1124 --------------------
1126 procedure Define_Section
1127 (Config : in out Command_Line_Configuration;
1131 if Config = null then
1132 Config := new Command_Line_Configuration_Record;
1135 Add (Config.Sections, new String'(Section));
1142 function Get_Switches
1143 (Config : Command_Line_Configuration;
1144 Switch_Char : Character)
1147 Ret : Ada.Strings.Unbounded.Unbounded_String;
1148 use type Ada.Strings.Unbounded.Unbounded_String;
1151 if Config = null or else Config.Switches = null then
1155 for J in Config.Switches'Range loop
1156 if Config.Switches (J) (Config.Switches (J)'First) = Switch_Char then
1160 (Config.Switches (J)'First + 1 .. Config.Switches (J)'Last);
1162 Ret := Ret & " " & Config.Switches (J).all;
1166 return Ada.Strings.Unbounded.To_String (Ret);
1169 -----------------------
1170 -- Set_Configuration --
1171 -----------------------
1173 procedure Set_Configuration
1174 (Cmd : in out Command_Line;
1175 Config : Command_Line_Configuration)
1178 Cmd.Config := Config;
1179 end Set_Configuration;
1181 -----------------------
1182 -- Get_Configuration --
1183 -----------------------
1185 function Get_Configuration
1186 (Cmd : Command_Line) return Command_Line_Configuration is
1189 end Get_Configuration;
1191 ----------------------
1192 -- Set_Command_Line --
1193 ----------------------
1195 procedure Set_Command_Line
1196 (Cmd : in out Command_Line;
1198 Getopt_Description : String := "";
1199 Switch_Char : Character := '-')
1201 Tmp : Argument_List_Access;
1202 Parser : Opt_Parser;
1204 Section : String_Access := null;
1206 function Real_Full_Switch
1208 Parser : Opt_Parser) return String;
1209 -- Ensure that the returned switch value contains the
1210 -- Switch_Char prefix if needed.
1212 ----------------------
1213 -- Real_Full_Switch --
1214 ----------------------
1216 function Real_Full_Switch
1218 Parser : Opt_Parser) return String
1222 return Full_Switch (Parser);
1224 return Switch_Char & Full_Switch (Parser);
1226 end Real_Full_Switch;
1228 -- Start of processing for Set_Command_Line
1231 Free (Cmd.Expanded);
1234 if Switches /= "" then
1235 Tmp := Argument_String_To_List (Switches);
1236 Initialize_Option_Scan (Parser, Tmp, Switch_Char);
1240 S := Getopt (Switches => "* " & Getopt_Description,
1241 Concatenate => False,
1243 exit when S = ASCII.NUL;
1246 Sw : constant String :=
1247 Real_Full_Switch (S, Parser);
1248 Is_Section : Boolean := False;
1251 if Cmd.Config /= null
1252 and then Cmd.Config.Sections /= null
1255 for S in Cmd.Config.Sections'Range loop
1256 if Sw = Cmd.Config.Sections (S).all then
1257 Section := Cmd.Config.Sections (S);
1260 exit Section_Search;
1262 end loop Section_Search;
1265 if not Is_Section then
1266 if Section = null then
1268 -- Work around some weird cases: some switches may
1269 -- expect parameters, but have the same value as
1270 -- longer switches: -gnaty3 (-gnaty, parameter=3) and
1271 -- -gnatya (-gnatya, no parameter).
1273 -- So we are calling add_switch here with parameter
1274 -- attached. This will be anyway correctly handled by
1275 -- Add_Switch if -gnaty3 is actually provided.
1277 if Separator (Parser) = ASCII.NUL then
1279 (Cmd, Sw & Parameter (Parser), "");
1282 (Cmd, Sw, Parameter (Parser), Separator (Parser));
1285 if Separator (Parser) = ASCII.NUL then
1287 (Cmd, Sw & Parameter (Parser), "",
1302 when Invalid_Parameter =>
1304 -- Add it with no parameter, if that's the way the user
1307 -- Specify the separator in all cases, as the switch might
1308 -- need to be unaliased, and the alias might contain
1309 -- switches with parameters.
1311 if Section = null then
1313 (Cmd, Switch_Char & Full_Switch (Parser),
1314 Separator => Separator (Parser));
1317 (Cmd, Switch_Char & Full_Switch (Parser),
1318 Separator => Separator (Parser),
1319 Section => Section.all);
1326 end Set_Command_Line;
1335 Substring : String) return Boolean is
1337 return Index + Substring'Length - 1 <= Type_Str'Last
1338 and then Type_Str (Index .. Index + Substring'Length - 1) = Substring;
1341 ------------------------
1342 -- Can_Have_Parameter --
1343 ------------------------
1345 function Can_Have_Parameter (S : String) return Boolean is
1347 if S'Length <= 1 then
1352 when '!' | ':' | '?' | '=' =>
1357 end Can_Have_Parameter;
1359 -----------------------
1360 -- Require_Parameter --
1361 -----------------------
1363 function Require_Parameter (S : String) return Boolean is
1365 if S'Length <= 1 then
1370 when '!' | ':' | '=' =>
1375 end Require_Parameter;
1381 function Actual_Switch (S : String) return String is
1383 if S'Length <= 1 then
1388 when '!' | ':' | '?' | '=' =>
1389 return S (S'First .. S'Last - 1);
1395 ----------------------------
1396 -- For_Each_Simple_Switch --
1397 ----------------------------
1399 procedure For_Each_Simple_Switch
1400 (Cmd : Command_Line;
1402 Parameter : String := "";
1403 Unalias : Boolean := True)
1405 function Group_Analysis
1407 Group : String) return Boolean;
1408 -- Perform the analysis of a group of switches
1410 --------------------
1411 -- Group_Analysis --
1412 --------------------
1414 function Group_Analysis
1416 Group : String) return Boolean
1423 while Idx <= Group'Last loop
1426 for S in Cmd.Config.Switches'Range loop
1428 Sw : constant String :=
1430 (Cmd.Config.Switches (S).all);
1431 Full : constant String :=
1432 Prefix & Group (Idx .. Group'Last);
1437 if Sw'Length >= Prefix'Length
1439 -- Verify that sw starts with Prefix
1441 and then Looking_At (Sw, Sw'First, Prefix)
1443 -- Verify that the group starts with sw
1445 and then Looking_At (Full, Full'First, Sw)
1447 Last := Idx + Sw'Length - Prefix'Length - 1;
1450 if Can_Have_Parameter (Cmd.Config.Switches (S).all) then
1452 -- Include potential parameter to the recursive call.
1453 -- Only numbers are allowed.
1455 while Last < Group'Last
1456 and then Group (Last + 1) in '0' .. '9'
1462 if not Require_Parameter (Cmd.Config.Switches (S).all)
1463 or else Last >= Param
1465 if Idx = Group'First
1466 and then Last = Group'Last
1467 and then Last < Param
1469 -- The group only concerns a single switch. Do not
1470 -- perform recursive call.
1472 -- Note that we still perform a recursive call if
1473 -- a parameter is detected in the switch, as this
1474 -- is a way to correctly identify such a parameter
1482 -- Recursive call, using the detected parameter if any
1484 if Last >= Param then
1485 For_Each_Simple_Switch
1487 Prefix & Group (Idx .. Param - 1),
1488 Group (Param .. Last));
1490 For_Each_Simple_Switch
1491 (Cmd, Prefix & Group (Idx .. Last), "");
1502 For_Each_Simple_Switch (Cmd, Prefix & Group (Idx), "");
1511 -- Are we adding a switch that can in fact be expanded through aliases ?
1512 -- If yes, we add separately each of its expansion.
1514 -- This takes care of expansions like "-T" -> "-gnatwrs", where the
1515 -- alias and its expansion do not have the same prefix. Given the order
1516 -- in which we do things here, the expansion of the alias will itself
1517 -- be checked for a common prefix and further split into simple switches
1520 and then Cmd.Config /= null
1521 and then Cmd.Config.Aliases /= null
1523 for A in Cmd.Config.Aliases'Range loop
1524 if Cmd.Config.Aliases (A).all = Switch
1525 and then Parameter = ""
1527 For_Each_Simple_Switch
1528 (Cmd, Cmd.Config.Expansions (A).all, "");
1534 -- Are we adding a switch grouping several switches ? If yes, add each
1535 -- of the simple switches instead.
1537 if Cmd.Config /= null
1538 and then Cmd.Config.Prefixes /= null
1540 for P in Cmd.Config.Prefixes'Range loop
1541 if Switch'Length > Cmd.Config.Prefixes (P)'Length + 1
1543 (Switch, Switch'First, Cmd.Config.Prefixes (P).all)
1545 -- Alias expansion will be done recursively
1546 if Cmd.Config.Switches = null then
1547 for S in Switch'First + Cmd.Config.Prefixes (P)'Length
1550 For_Each_Simple_Switch
1551 (Cmd, Cmd.Config.Prefixes (P).all & Switch (S), "");
1556 elsif Group_Analysis
1557 (Cmd.Config.Prefixes (P).all,
1559 (Switch'First + Cmd.Config.Prefixes (P)'Length
1562 -- Recursive calls already done on each switch of the
1563 -- group. Let's return to not call Callback.
1570 -- Test if added switch is a known switch with parameter attached
1573 and then Cmd.Config /= null
1574 and then Cmd.Config.Switches /= null
1576 for S in Cmd.Config.Switches'Range loop
1578 Sw : constant String :=
1579 Actual_Switch (Cmd.Config.Switches (S).all);
1584 -- Verify that switch starts with Sw
1585 -- What if the "verification" fails???
1587 if Switch'Length >= Sw'Length
1588 and then Looking_At (Switch, Switch'First, Sw)
1590 Param := Switch'First + Sw'Length - 1;
1593 if Can_Have_Parameter (Cmd.Config.Switches (S).all) then
1594 while Last < Switch'Last
1595 and then Switch (Last + 1) in '0' .. '9'
1601 -- If full Switch is a known switch with attached parameter
1602 -- then we use this parameter in the callback.
1604 if Last = Switch'Last then
1606 (Switch (Switch'First .. Param),
1607 Switch (Param + 1 .. Last));
1616 Callback (Switch, Parameter);
1617 end For_Each_Simple_Switch;
1623 procedure Add_Switch
1624 (Cmd : in out Command_Line;
1626 Parameter : String := "";
1627 Separator : Character := ' ';
1628 Section : String := "";
1629 Add_Before : Boolean := False)
1632 pragma Unreferenced (Success);
1635 (Cmd, Switch, Parameter, Separator, Section, Add_Before, Success);
1642 procedure Add_Switch
1643 (Cmd : in out Command_Line;
1645 Parameter : String := "";
1646 Separator : Character := ' ';
1647 Section : String := "";
1648 Add_Before : Boolean := False;
1649 Success : out Boolean)
1651 procedure Add_Simple_Switch (Simple : String; Param : String);
1652 -- Add a new switch that has had all its aliases expanded, and switches
1653 -- ungrouped. We know there are no more aliases in Switches.
1655 -----------------------
1656 -- Add_Simple_Switch --
1657 -----------------------
1659 procedure Add_Simple_Switch (Simple : String; Param : String) is
1661 if Cmd.Expanded = null then
1662 Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
1665 Cmd.Params := new Argument_List'
1666 (1 .. 1 => new String'(Separator & Param));
1669 Cmd.Params := new Argument_List'(1 .. 1 => null);
1672 if Section = "" then
1673 Cmd.Sections := new Argument_List'(1 .. 1 => null);
1676 Cmd.Sections := new Argument_List'
1677 (1 .. 1 => new String'(Section));
1681 -- Do we already have this switch?
1683 for C in Cmd.Expanded'Range loop
1684 if Cmd.Expanded (C).all = Simple
1686 ((Cmd.Params (C) = null and then Param = "")
1688 (Cmd.Params (C) /= null
1689 and then Cmd.Params (C).all = Separator & Param))
1691 ((Cmd.Sections (C) = null and then Section = "")
1693 (Cmd.Sections (C) /= null
1694 and then Cmd.Sections (C).all = Section))
1700 -- Inserting at least one switch
1703 Add (Cmd.Expanded, new String'(Simple), Add_Before);
1708 new String'(Separator & Param),
1718 if Section = "" then
1726 new String'(Section),
1730 end Add_Simple_Switch;
1732 procedure Add_Simple_Switches is
1733 new For_Each_Simple_Switch (Add_Simple_Switch);
1735 -- Start of processing for Add_Switch
1739 Add_Simple_Switches (Cmd, Switch, Parameter);
1740 Free (Cmd.Coalesce);
1747 procedure Remove (Line : in out Argument_List_Access; Index : Integer) is
1748 Tmp : Argument_List_Access := Line;
1751 Line := new Argument_List (Tmp'First .. Tmp'Last - 1);
1753 if Index /= Tmp'First then
1754 Line (Tmp'First .. Index - 1) := Tmp (Tmp'First .. Index - 1);
1759 if Index /= Tmp'Last then
1760 Line (Index .. Tmp'Last - 1) := Tmp (Index + 1 .. Tmp'Last);
1763 Unchecked_Free (Tmp);
1771 (Line : in out Argument_List_Access;
1772 Str : String_Access;
1773 Before : Boolean := False)
1775 Tmp : Argument_List_Access := Line;
1779 Line := new Argument_List (Tmp'First .. Tmp'Last + 1);
1782 Line (Tmp'First) := Str;
1783 Line (Tmp'First + 1 .. Tmp'Last + 1) := Tmp.all;
1785 Line (Tmp'Range) := Tmp.all;
1786 Line (Tmp'Last + 1) := Str;
1789 Unchecked_Free (Tmp);
1792 Line := new Argument_List'(1 .. 1 => Str);
1800 procedure Remove_Switch
1801 (Cmd : in out Command_Line;
1803 Remove_All : Boolean := False;
1804 Has_Parameter : Boolean := False;
1805 Section : String := "")
1808 pragma Unreferenced (Success);
1810 Remove_Switch (Cmd, Switch, Remove_All, Has_Parameter, Section, Success);
1817 procedure Remove_Switch
1818 (Cmd : in out Command_Line;
1820 Remove_All : Boolean := False;
1821 Has_Parameter : Boolean := False;
1822 Section : String := "";
1823 Success : out Boolean)
1825 procedure Remove_Simple_Switch (Simple : String; Param : String);
1826 -- Removes a simple switch, with no aliasing or grouping
1828 --------------------------
1829 -- Remove_Simple_Switch --
1830 --------------------------
1832 procedure Remove_Simple_Switch (Simple : String; Param : String) is
1834 pragma Unreferenced (Param);
1837 if Cmd.Expanded /= null then
1838 C := Cmd.Expanded'First;
1839 while C <= Cmd.Expanded'Last loop
1840 if Cmd.Expanded (C).all = Simple
1843 or else (Cmd.Sections (C) = null
1844 and then Section = "")
1845 or else (Cmd.Sections (C) /= null
1846 and then Section = Cmd.Sections (C).all))
1847 and then (not Has_Parameter or else Cmd.Params (C) /= null)
1849 Remove (Cmd.Expanded, C);
1850 Remove (Cmd.Params, C);
1851 Remove (Cmd.Sections, C);
1854 if not Remove_All then
1863 end Remove_Simple_Switch;
1865 procedure Remove_Simple_Switches is
1866 new For_Each_Simple_Switch (Remove_Simple_Switch);
1868 -- Start of processing for Remove_Switch
1872 Remove_Simple_Switches (Cmd, Switch, "", Unalias => not Has_Parameter);
1873 Free (Cmd.Coalesce);
1880 procedure Remove_Switch
1881 (Cmd : in out Command_Line;
1884 Section : String := "")
1886 procedure Remove_Simple_Switch (Simple : String; Param : String);
1887 -- Removes a simple switch, with no aliasing or grouping
1889 --------------------------
1890 -- Remove_Simple_Switch --
1891 --------------------------
1893 procedure Remove_Simple_Switch (Simple : String; Param : String) is
1897 if Cmd.Expanded /= null then
1898 C := Cmd.Expanded'First;
1899 while C <= Cmd.Expanded'Last loop
1900 if Cmd.Expanded (C).all = Simple
1902 ((Cmd.Sections (C) = null
1903 and then Section = "")
1905 (Cmd.Sections (C) /= null
1906 and then Section = Cmd.Sections (C).all))
1908 ((Cmd.Params (C) = null and then Param = "")
1910 (Cmd.Params (C) /= null
1913 -- Ignore the separator stored in Parameter
1915 Cmd.Params (C) (Cmd.Params (C)'First + 1
1916 .. Cmd.Params (C)'Last) =
1919 Remove (Cmd.Expanded, C);
1920 Remove (Cmd.Params, C);
1921 Remove (Cmd.Sections, C);
1923 -- The switch is necessarily unique by construction of
1933 end Remove_Simple_Switch;
1935 procedure Remove_Simple_Switches is
1936 new For_Each_Simple_Switch (Remove_Simple_Switch);
1938 -- Start of processing for Remove_Switch
1941 Remove_Simple_Switches (Cmd, Switch, Parameter);
1942 Free (Cmd.Coalesce);
1945 --------------------
1946 -- Group_Switches --
1947 --------------------
1949 procedure Group_Switches
1950 (Cmd : Command_Line;
1951 Result : Argument_List_Access;
1952 Sections : Argument_List_Access;
1953 Params : Argument_List_Access)
1955 function Compatible_Parameter (Param : String_Access) return Boolean;
1956 -- True when the parameter can be part of a group
1958 --------------------------
1959 -- Compatible_Parameter --
1960 --------------------------
1962 function Compatible_Parameter (Param : String_Access) return Boolean is
1966 if Param = null then
1969 -- We need parameters without separators
1971 elsif Param (Param'First) /= ASCII.NUL then
1974 -- Parameters must be all digits
1977 for J in Param'First + 1 .. Param'Last loop
1978 if Param (J) not in '0' .. '9' then
1985 end Compatible_Parameter;
1987 -- Local declarations
1989 Group : Ada.Strings.Unbounded.Unbounded_String;
1991 use type Ada.Strings.Unbounded.Unbounded_String;
1993 -- Start of processing for Group_Switches
1996 if Cmd.Config = null
1997 or else Cmd.Config.Prefixes = null
2002 for P in Cmd.Config.Prefixes'Range loop
2003 Group := Ada.Strings.Unbounded.Null_Unbounded_String;
2006 for C in Result'Range loop
2007 if Result (C) /= null
2008 and then Compatible_Parameter (Params (C))
2010 (Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all)
2012 -- If we are still in the same section, group the switches
2016 (Sections (C) = null
2017 and then Sections (First) = null)
2019 (Sections (C) /= null
2020 and then Sections (First) /= null
2021 and then Sections (C).all = Sections (First).all)
2026 (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2029 if Params (C) /= null then
2032 Params (C) (Params (C)'First + 1 .. Params (C)'Last);
2043 -- We changed section: we put the grouped switches to the
2044 -- first place, on continue with the new section.
2048 (Cmd.Config.Prefixes (P).all &
2049 Ada.Strings.Unbounded.To_String (Group));
2051 Ada.Strings.Unbounded.To_Unbounded_String
2053 (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2063 (Cmd.Config.Prefixes (P).all &
2064 Ada.Strings.Unbounded.To_String (Group));
2069 --------------------
2070 -- Alias_Switches --
2071 --------------------
2073 procedure Alias_Switches
2074 (Cmd : Command_Line;
2075 Result : Argument_List_Access;
2076 Params : Argument_List_Access)
2081 procedure Check_Cb (Switch : String; Param : String);
2082 -- Comment required ???
2084 procedure Remove_Cb (Switch : String; Param : String);
2085 -- Comment required ???
2091 procedure Check_Cb (Switch : String; Param : String) is
2094 for E in Result'Range loop
2095 if Result (E) /= null
2098 or else Params (E) (Params (E)'First + 1
2099 .. Params (E)'Last) = Param)
2100 and then Result (E).all = Switch
2114 procedure Remove_Cb (Switch : String; Param : String) is
2116 for E in Result'Range loop
2117 if Result (E) /= null
2120 or else Params (E) (Params (E)'First + 1
2121 .. Params (E)'Last) = Param)
2122 and then Result (E).all = Switch
2134 procedure Check_All is new For_Each_Simple_Switch (Check_Cb);
2135 procedure Remove_All is new For_Each_Simple_Switch (Remove_Cb);
2137 -- Start of processing for Alias_Switches
2140 if Cmd.Config = null
2141 or else Cmd.Config.Aliases = null
2146 for A in Cmd.Config.Aliases'Range loop
2148 -- Compute the various simple switches that make up the alias. We
2149 -- split the expansion into as many simple switches as possible, and
2150 -- then check whether the expanded command line has all of them.
2153 Check_All (Cmd, Cmd.Config.Expansions (A).all);
2156 First := Integer'Last;
2157 Remove_All (Cmd, Cmd.Config.Expansions (A).all);
2158 Result (First) := new String'(Cmd.Config.Aliases (A).all);
2167 procedure Sort_Sections
2168 (Line : GNAT.OS_Lib.Argument_List_Access;
2169 Sections : GNAT.OS_Lib.Argument_List_Access;
2170 Params : GNAT.OS_Lib.Argument_List_Access)
2172 Sections_List : Argument_List_Access :=
2173 new Argument_List'(1 .. 1 => null);
2175 Old_Line : constant Argument_List := Line.all;
2176 Old_Sections : constant Argument_List := Sections.all;
2177 Old_Params : constant Argument_List := Params.all;
2185 -- First construct a list of all sections
2187 for E in Line'Range loop
2188 if Sections (E) /= null then
2190 for S in Sections_List'Range loop
2191 if (Sections_List (S) = null and then Sections (E) = null)
2193 (Sections_List (S) /= null
2194 and then Sections (E) /= null
2195 and then Sections_List (S).all = Sections (E).all)
2203 Add (Sections_List, Sections (E));
2208 Index := Line'First;
2210 for S in Sections_List'Range loop
2211 for E in Old_Line'Range loop
2212 if (Sections_List (S) = null and then Old_Sections (E) = null)
2214 (Sections_List (S) /= null
2215 and then Old_Sections (E) /= null
2216 and then Sections_List (S).all = Old_Sections (E).all)
2218 Line (Index) := Old_Line (E);
2219 Sections (Index) := Old_Sections (E);
2220 Params (Index) := Old_Params (E);
2232 (Cmd : in out Command_Line;
2233 Iter : in out Command_Line_Iterator;
2237 if Cmd.Expanded = null then
2242 -- Reorder the expanded line so that sections are grouped
2244 Sort_Sections (Cmd.Expanded, Cmd.Sections, Cmd.Params);
2246 -- Coalesce the switches as much as possible
2249 and then Cmd.Coalesce = null
2251 Cmd.Coalesce := new Argument_List (Cmd.Expanded'Range);
2252 for E in Cmd.Expanded'Range loop
2253 Cmd.Coalesce (E) := new String'(Cmd.Expanded (E).all);
2256 Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range);
2257 for E in Cmd.Sections'Range loop
2258 if Cmd.Sections (E) = null then
2259 Cmd.Coalesce_Sections (E) := null;
2261 Cmd.Coalesce_Sections (E) := new String'(Cmd.Sections (E).all);
2265 Cmd.Coalesce_Params := new Argument_List (Cmd.Params'Range);
2266 for E in Cmd.Params'Range loop
2267 if Cmd.Params (E) = null then
2268 Cmd.Coalesce_Params (E) := null;
2270 Cmd.Coalesce_Params (E) := new String'(Cmd.Params (E).all);
2274 -- Not a clone, since we will not modify the parameters anyway
2276 Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Params);
2278 (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Coalesce_Params);
2282 Iter.List := Cmd.Expanded;
2283 Iter.Params := Cmd.Params;
2284 Iter.Sections := Cmd.Sections;
2286 Iter.List := Cmd.Coalesce;
2287 Iter.Params := Cmd.Coalesce_Params;
2288 Iter.Sections := Cmd.Coalesce_Sections;
2291 if Iter.List = null then
2292 Iter.Current := Integer'Last;
2294 Iter.Current := Iter.List'First;
2296 while Iter.Current <= Iter.List'Last
2297 and then Iter.List (Iter.Current) = null
2299 Iter.Current := Iter.Current + 1;
2304 --------------------
2305 -- Current_Switch --
2306 --------------------
2308 function Current_Switch (Iter : Command_Line_Iterator) return String is
2310 return Iter.List (Iter.Current).all;
2313 --------------------
2314 -- Is_New_Section --
2315 --------------------
2317 function Is_New_Section (Iter : Command_Line_Iterator) return Boolean is
2318 Section : constant String := Current_Section (Iter);
2320 if Iter.Sections = null then
2322 elsif Iter.Current = Iter.Sections'First
2323 or else Iter.Sections (Iter.Current - 1) = null
2325 return Section /= "";
2328 return Section /= Iter.Sections (Iter.Current - 1).all;
2331 ---------------------
2332 -- Current_Section --
2333 ---------------------
2335 function Current_Section (Iter : Command_Line_Iterator) return String is
2337 if Iter.Sections = null
2338 or else Iter.Current > Iter.Sections'Last
2339 or else Iter.Sections (Iter.Current) = null
2344 return Iter.Sections (Iter.Current).all;
2345 end Current_Section;
2347 -----------------------
2348 -- Current_Separator --
2349 -----------------------
2351 function Current_Separator (Iter : Command_Line_Iterator) return String is
2353 if Iter.Params = null
2354 or else Iter.Current > Iter.Params'Last
2355 or else Iter.Params (Iter.Current) = null
2361 Sep : constant Character :=
2362 Iter.Params (Iter.Current) (Iter.Params (Iter.Current)'First);
2364 if Sep = ASCII.NUL then
2371 end Current_Separator;
2373 -----------------------
2374 -- Current_Parameter --
2375 -----------------------
2377 function Current_Parameter (Iter : Command_Line_Iterator) return String is
2379 if Iter.Params = null
2380 or else Iter.Current > Iter.Params'Last
2381 or else Iter.Params (Iter.Current) = null
2387 P : constant String := Iter.Params (Iter.Current).all;
2392 return P (P'First + 1 .. P'Last);
2395 end Current_Parameter;
2401 function Has_More (Iter : Command_Line_Iterator) return Boolean is
2403 return Iter.List /= null and then Iter.Current <= Iter.List'Last;
2410 procedure Next (Iter : in out Command_Line_Iterator) is
2412 Iter.Current := Iter.Current + 1;
2413 while Iter.Current <= Iter.List'Last
2414 and then Iter.List (Iter.Current) = null
2416 Iter.Current := Iter.Current + 1;
2424 procedure Free (Config : in out Command_Line_Configuration) is
2426 if Config /= null then
2427 Free (Config.Aliases);
2428 Free (Config.Expansions);
2429 Free (Config.Prefixes);
2430 Unchecked_Free (Config);
2438 procedure Free (Cmd : in out Command_Line) is
2440 Free (Cmd.Expanded);
2441 Free (Cmd.Coalesce);
2445 end GNAT.Command_Line;