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-2004 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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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
.Command_Line
;
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 Section_Number
is new Natural range 0 .. 65534;
42 for Section_Number
'Size use 16;
44 type Parameter_Type
is record
49 The_Parameter
: Parameter_Type
;
50 The_Switch
: Parameter_Type
;
51 -- This type and this variable are provided to store the current switch
54 type Is_Switch_Type
is array (1 .. CL
.Argument_Count
) of Boolean;
55 pragma Pack
(Is_Switch_Type
);
57 Is_Switch
: Is_Switch_Type
:= (others => False);
58 -- Indicates wich arguments on the command line are considered not be
59 -- switches or parameters to switches (this leaves e.g. the filenames...)
61 type Section_Type
is array (1 .. CL
.Argument_Count
+ 1) of Section_Number
;
62 pragma Pack
(Section_Type
);
63 Section
: Section_Type
:= (others => 1);
64 -- Contains the number of the section associated with the current
65 -- switch. If this number is 0, then it is a section delimiter, which
66 -- is never returns by GetOpt.
67 -- The last element of this array is set to 0 to avoid the need to test for
68 -- if we have reached the end of the command line in loops.
70 Current_Argument
: Natural := 1;
71 -- Number of the current argument parsed on the command line
73 Current_Index
: Natural := 1;
74 -- Index in the current argument of the character to be processed
76 Current_Section
: Section_Number
:= 1;
78 Expansion_It
: aliased Expansion_Iterator
;
79 -- When Get_Argument is expanding a file name, this is the iterator used
81 In_Expansion
: Boolean := False;
82 -- True if we are expanding a file
84 Switch_Character
: Character := '-';
85 -- The character at the beginning of the command line arguments,
86 -- indicating the beginning of a switch
88 Stop_At_First
: Boolean := False;
89 -- If it is True then Getopt stops at the first non-switch argument
91 procedure Set_Parameter
92 (Variable
: out Parameter_Type
;
96 pragma Inline
(Set_Parameter
);
97 -- Set the parameter that will be returned by Parameter below
99 function Goto_Next_Argument_In_Section
return Boolean;
100 -- Go to the next argument on the command line. If we are at the end
101 -- of the current section, we want to make sure there is no other
102 -- identical section on the command line (there might be multiple
103 -- instances of -largs). Returns True iff there is another argument.
105 function Get_File_Names_Case_Sensitive
return Integer;
106 pragma Import
(C
, Get_File_Names_Case_Sensitive
,
107 "__gnat_get_file_names_case_sensitive");
108 File_Names_Case_Sensitive
: constant Boolean :=
109 Get_File_Names_Case_Sensitive
/= 0;
111 procedure Canonical_Case_File_Name
(S
: in out String);
112 -- Given a file name, converts it to canonical case form. For systems
113 -- where file names are case sensitive, this procedure has no effect.
114 -- If file names are not case sensitive (i.e. for example if you have
115 -- the file "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then
116 -- this call converts the given string to canonical all lower case form,
117 -- so that two file names compare equal if they refer to the same file.
119 ------------------------------
120 -- Canonical_Case_File_Name --
121 ------------------------------
123 procedure Canonical_Case_File_Name
(S
: in out String) is
125 if not File_Names_Case_Sensitive
then
126 for J
in S
'Range loop
127 if S
(J
) in 'A' .. 'Z' then
128 S
(J
) := Character'Val (
129 Character'Pos (S
(J
)) +
130 Character'Pos ('a') -
131 Character'Pos ('A'));
135 end Canonical_Case_File_Name
;
141 function Expansion
(Iterator
: Expansion_Iterator
) return String is
142 use GNAT
.Directory_Operations
;
143 type Pointer
is access all Expansion_Iterator
;
145 S
: String (1 .. 1024);
147 It
: constant Pointer
:= Iterator
'Unrestricted_Access;
149 Current
: Depth
:= It
.Current_Depth
;
153 -- It is assumed that a directory is opened at the current level;
154 -- otherwise, GNAT.Directory_Operations.Directory_Error will be raised
155 -- at the first call to Read.
158 Read
(It
.Levels
(Current
).Dir
, S
, Last
);
160 -- If we have exhausted the directory, close it and go back one level
163 Close
(It
.Levels
(Current
).Dir
);
165 -- If we are at level 1, we are finished; return an empty string.
168 return String'(1 .. 0 => ' ');
170 -- Otherwise, continue with the directory at the previous level
172 Current := Current - 1;
173 It.Current_Depth := Current;
176 -- If this is a directory, that is neither "." or "..", attempt to
177 -- go to the next level.
180 (It.Dir_Name (1 .. It.Levels (Current).Name_Last) & S (1 .. Last))
181 and then S (1 .. Last) /= "."
182 and then S (1 .. Last) /= ".."
184 -- We can go to the next level only if we have not reached the
187 if Current < It.Maximum_Depth then
188 NL := It.Levels (Current).Name_Last;
190 -- And if relative path of this new directory is not too long
192 if NL + Last + 1 < Max_Path_Length then
193 Current := Current + 1;
194 It.Current_Depth := Current;
195 It.Dir_Name (NL + 1 .. NL + Last) := S (1 .. Last);
197 It.Dir_Name (NL) := Directory_Separator;
198 It.Levels (Current).Name_Last := NL;
199 Canonical_Case_File_Name (It.Dir_Name (1 .. NL));
201 -- Open the new directory, and read from it
203 GNAT.Directory_Operations.Open
204 (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
208 -- If not a directory, check the relative path against the pattern
213 It.Dir_Name (It.Start .. It.Levels (Current).Name_Last) &
216 Canonical_Case_File_Name (Name);
218 -- If it matches, return the relative path
220 if GNAT.Regexp.Match (Name, Iterator.Regexp) then
228 return String'(1 .. 0 => ' ');
235 function Full_Switch
return String is
237 return CL
.Argument
(The_Switch
.Arg_Num
)
238 (The_Switch
.First
.. The_Switch
.Last
);
245 function Get_Argument
(Do_Expansion
: Boolean := False) return String is
246 Total
: constant Natural := CL
.Argument_Count
;
251 S
: constant String := Expansion
(Expansion_It
);
254 if S
'Length /= 0 then
257 In_Expansion
:= False;
262 if Current_Argument
> Total
then
264 -- If this is the first time this function is called
266 if Current_Index
= 1 then
267 Current_Argument
:= 1;
268 while Current_Argument
<= CL
.Argument_Count
269 and then Section
(Current_Argument
) /= Current_Section
271 Current_Argument
:= Current_Argument
+ 1;
274 return String'(1 .. 0 => ' ');
277 elsif Section (Current_Argument) = 0 then
278 while Current_Argument <= CL.Argument_Count
279 and then Section (Current_Argument) /= Current_Section
281 Current_Argument := Current_Argument + 1;
287 while Current_Argument <= Total
288 and then Is_Switch (Current_Argument)
290 Current_Argument := Current_Argument + 1;
293 if Current_Argument > Total then
294 return String'(1 .. 0 => ' ');
297 if Section
(Current_Argument
) = 0 then
298 return Get_Argument
(Do_Expansion
);
301 Current_Argument
:= Current_Argument
+ 1;
303 -- Could it be a file name with wild cards to expand?
307 Arg
: String renames CL
.Argument
(Current_Argument
- 1);
308 Index
: Positive := Arg
'First;
311 while Index
<= Arg
'Last loop
314 or else Arg
(Index
) = '?'
315 or else Arg
(Index
) = '['
317 In_Expansion
:= True;
318 Start_Expansion
(Expansion_It
, Arg
);
319 return Get_Argument
(Do_Expansion
);
327 return CL
.Argument
(Current_Argument
- 1);
336 Concatenate
: Boolean := True) return Character
339 pragma Unreferenced
(Dummy
);
342 -- If we have finished parsing the current command line item (there
343 -- might be multiple switches in a single item), then go to the next
346 if Current_Argument
> CL
.Argument_Count
347 or else (Current_Index
> CL
.Argument
(Current_Argument
)'Last
348 and then not Goto_Next_Argument_In_Section
)
353 -- If we are on a new item, test if this might be a switch
355 if Current_Index
= 1 then
356 if CL
.Argument
(Current_Argument
)(1) /= Switch_Character
then
357 if Switches
(Switches
'First) = '*' then
358 Set_Parameter
(The_Switch
,
359 Arg_Num
=> Current_Argument
,
361 Last
=> CL
.Argument
(Current_Argument
)'Last);
362 Is_Switch
(Current_Argument
) := True;
363 Dummy
:= Goto_Next_Argument_In_Section
;
367 if Stop_At_First
then
368 Current_Argument
:= Positive'Last;
371 elsif not Goto_Next_Argument_In_Section
then
375 return Getopt
(Switches
);
380 Is_Switch
(Current_Argument
) := True;
384 Arg
: String renames CL
.Argument
(Current_Argument
);
385 Index_Switches
: Natural := 0;
386 Max_Length
: Natural := 0;
387 Index
: Natural := Switches
'First;
388 Length
: Natural := 1;
392 while Index
<= Switches
'Last loop
394 -- Search the length of the parameter at this position in Switches
397 while Length
<= Switches
'Last
398 and then Switches
(Length
) /= ' '
400 Length
:= Length
+ 1;
403 if (Switches
(Length
- 1) = ':' or else
404 Switches
(Length
- 1) = '=' or else
405 Switches
(Length
- 1) = '?' or else
406 Switches
(Length
- 1) = '!')
407 and then Length
> Index
+ 1
409 Length
:= Length
- 1;
412 -- If it is the one we searched, it may be a candidate
414 if Current_Index
+ Length
- 1 - Index
<= Arg
'Last
416 Switches
(Index
.. Length
- 1) =
417 Arg
(Current_Index
.. Current_Index
+ Length
- 1 - Index
)
418 and then Length
- Index
> Max_Length
420 Index_Switches
:= Index
;
421 Max_Length
:= Length
- Index
;
424 -- Look for the next switch in Switches
426 while Index
<= Switches
'Last
427 and then Switches
(Index
) /= ' ' loop
434 End_Index
:= Current_Index
+ Max_Length
- 1;
436 -- If switch is not accepted, skip it, unless we had '*' in Switches
438 if Index_Switches
= 0 then
439 if Switches
(Switches
'First) = '*' then
440 Set_Parameter
(The_Switch
,
441 Arg_Num
=> Current_Argument
,
443 Last
=> CL
.Argument
(Current_Argument
)'Last);
444 Is_Switch
(Current_Argument
) := True;
445 Dummy
:= Goto_Next_Argument_In_Section
;
449 -- Depending on the value of Concatenate, the full switch is
450 -- a single character (True) or the rest of the argument (False).
453 End_Index
:= Current_Index
;
455 End_Index
:= Arg
'Last;
458 Set_Parameter
(The_Switch
,
459 Arg_Num
=> Current_Argument
,
460 First
=> Current_Index
,
462 Current_Index
:= End_Index
+ 1;
463 raise Invalid_Switch
;
466 Set_Parameter
(The_Switch
,
467 Arg_Num
=> Current_Argument
,
468 First
=> Current_Index
,
471 -- Case of switch needs an argument
473 if Index_Switches
+ Max_Length
<= Switches
'Last then
475 case Switches
(Index_Switches
+ Max_Length
) is
479 if End_Index
< Arg
'Last then
480 Set_Parameter
(The_Parameter
,
481 Arg_Num
=> Current_Argument
,
482 First
=> End_Index
+ 1,
484 Dummy
:= Goto_Next_Argument_In_Section
;
486 elsif Section
(Current_Argument
+ 1) /= 0 then
489 Arg_Num
=> Current_Argument
+ 1,
491 Last
=> CL
.Argument
(Current_Argument
+ 1)'Last);
492 Current_Argument
:= Current_Argument
+ 1;
493 Is_Switch
(Current_Argument
) := True;
494 Dummy
:= Goto_Next_Argument_In_Section
;
497 Current_Index
:= End_Index
+ 1;
498 raise Invalid_Parameter
;
503 -- If the switch is of the form <switch>=xxx
505 if End_Index
< Arg
'Last then
507 if Arg
(End_Index
+ 1) = '='
508 and then End_Index
+ 1 < Arg
'Last
510 Set_Parameter
(The_Parameter
,
511 Arg_Num
=> Current_Argument
,
512 First
=> End_Index
+ 2,
514 Dummy
:= Goto_Next_Argument_In_Section
;
517 Current_Index
:= End_Index
+ 1;
518 raise Invalid_Parameter
;
521 -- If the switch is of the form <switch> xxx
523 elsif Section
(Current_Argument
+ 1) /= 0 then
526 Arg_Num
=> Current_Argument
+ 1,
528 Last
=> CL
.Argument
(Current_Argument
+ 1)'Last);
529 Current_Argument
:= Current_Argument
+ 1;
530 Is_Switch
(Current_Argument
) := True;
531 Dummy
:= Goto_Next_Argument_In_Section
;
534 Current_Index
:= End_Index
+ 1;
535 raise Invalid_Parameter
;
540 if End_Index
< Arg
'Last then
541 Set_Parameter
(The_Parameter
,
542 Arg_Num
=> Current_Argument
,
543 First
=> End_Index
+ 1,
545 Dummy
:= Goto_Next_Argument_In_Section
;
548 Current_Index
:= End_Index
+ 1;
549 raise Invalid_Parameter
;
554 if End_Index
< Arg
'Last then
555 Set_Parameter
(The_Parameter
,
556 Arg_Num
=> Current_Argument
,
557 First
=> End_Index
+ 1,
561 Set_Parameter
(The_Parameter
,
562 Arg_Num
=> Current_Argument
,
566 Dummy
:= Goto_Next_Argument_In_Section
;
569 if Concatenate
or else End_Index
= Arg
'Last then
570 Current_Index
:= End_Index
+ 1;
573 -- If Concatenate is False and the full argument is not
574 -- recognized as a switch, this is an invalid switch.
576 Set_Parameter
(The_Switch
,
577 Arg_Num
=> Current_Argument
,
578 First
=> Current_Index
,
580 Current_Index
:= Arg
'Last + 1;
581 raise Invalid_Switch
;
585 elsif Concatenate
or else End_Index
= Arg
'Last then
586 Current_Index
:= End_Index
+ 1;
589 -- If Concatenate is False and the full argument is not
590 -- recognized as a switch, this is an invalid switch.
592 Set_Parameter
(The_Switch
,
593 Arg_Num
=> Current_Argument
,
594 First
=> Current_Index
,
596 Current_Index
:= Arg
'Last + 1;
597 raise Invalid_Switch
;
600 return Switches
(Index_Switches
);
604 -----------------------------------
605 -- Goto_Next_Argument_In_Section --
606 -----------------------------------
608 function Goto_Next_Argument_In_Section
return Boolean is
611 Current_Argument
:= Current_Argument
+ 1;
613 if Section
(Current_Argument
) = 0 then
615 if Current_Argument
> CL
.Argument_Count
then
619 Current_Argument
:= Current_Argument
+ 1;
620 exit when Section
(Current_Argument
) = Current_Section
;
624 end Goto_Next_Argument_In_Section
;
630 procedure Goto_Section
(Name
: String := "") is
631 Index
: Integer := 1;
634 In_Expansion
:= False;
637 Current_Argument
:= 1;
639 Current_Section
:= 1;
643 while Index
<= CL
.Argument_Count
loop
645 if Section
(Index
) = 0
646 and then CL
.Argument
(Index
) = Switch_Character
& Name
648 Current_Argument
:= Index
+ 1;
651 if Current_Argument
<= CL
.Argument_Count
then
652 Current_Section
:= Section
(Current_Argument
);
660 Current_Argument
:= Positive'Last;
661 Current_Index
:= 2; -- so that Get_Argument returns nothing
664 ----------------------------
665 -- Initialize_Option_Scan --
666 ----------------------------
668 procedure Initialize_Option_Scan
669 (Switch_Char
: Character := '-';
670 Stop_At_First_Non_Switch
: Boolean := False;
671 Section_Delimiters
: String := "")
673 Section_Num
: Section_Number
:= 1;
674 Section_Index
: Integer := Section_Delimiters
'First;
676 Delimiter_Found
: Boolean;
679 Current_Argument
:= 0;
681 In_Expansion
:= False;
682 Switch_Character
:= Switch_Char
;
683 Stop_At_First
:= Stop_At_First_Non_Switch
;
685 -- If we are using sections, we have to preprocess the command line
686 -- to delimit them. A section can be repeated, so we just give each
687 -- item on the command line a section number
689 while Section_Index
<= Section_Delimiters
'Last loop
691 Last
:= Section_Index
;
692 while Last
<= Section_Delimiters
'Last
693 and then Section_Delimiters
(Last
) /= ' '
698 Delimiter_Found
:= False;
699 Section_Num
:= Section_Num
+ 1;
701 for Index
in 1 .. CL
.Argument_Count
loop
702 if CL
.Argument
(Index
)(1) = Switch_Character
704 CL
.Argument
(Index
) = Switch_Character
&
706 (Section_Index
.. Last
- 1)
708 Section
(Index
) := 0;
709 Delimiter_Found
:= True;
711 elsif Section
(Index
) = 0 then
712 Delimiter_Found
:= False;
714 elsif Delimiter_Found
then
715 Section
(Index
) := Section_Num
;
719 Section_Index
:= Last
+ 1;
720 while Section_Index
<= Section_Delimiters
'Last
721 and then Section_Delimiters
(Section_Index
) = ' '
723 Section_Index
:= Section_Index
+ 1;
727 Delimiter_Found
:= Goto_Next_Argument_In_Section
;
728 end Initialize_Option_Scan
;
734 function Parameter
return String is
736 if The_Parameter
.First
> The_Parameter
.Last
then
737 return String'(1 .. 0 => ' ');
739 return CL.Argument (The_Parameter.Arg_Num)
740 (The_Parameter.First .. The_Parameter.Last);
748 procedure Set_Parameter
749 (Variable : out Parameter_Type;
755 Variable.Arg_Num := Arg_Num;
756 Variable.First := First;
757 Variable.Last := Last;
760 ---------------------
761 -- Start_Expansion --
762 ---------------------
764 procedure Start_Expansion
765 (Iterator : out Expansion_Iterator;
767 Directory : String := "";
768 Basic_Regexp : Boolean := True)
770 Directory_Separator : Character;
771 pragma Import (C, Directory_Separator, "__gnat_dir_separator");
772 First : Positive := Pattern'First;
774 Pat : String := Pattern;
777 Canonical_Case_File_Name (Pat);
778 Iterator.Current_Depth := 1;
780 -- If Directory is unspecified, use the current directory ("./" or ".\")
782 if Directory = "" then
783 Iterator.Dir_Name (1 .. 2) := "." & Directory_Separator;
787 Iterator.Dir_Name (1 .. Directory'Length) := Directory;
788 Iterator.Start := Directory'Length + 1;
789 Canonical_Case_File_Name (Iterator.Dir_Name (1 .. Directory'Length));
791 -- Make sure that the last character is a directory separator
793 if Directory (Directory'Last) /= Directory_Separator then
794 Iterator.Dir_Name (Iterator.Start) := Directory_Separator;
795 Iterator.Start := Iterator.Start + 1;
799 Iterator.Levels (1).Name_Last := Iterator.Start - 1;
801 -- Open the initial Directory, at depth 1
803 GNAT.Directory_Operations.Open
804 (Iterator.Levels (1).Dir, Iterator.Dir_Name (1 .. Iterator.Start - 1));
806 -- If in the current directory and the pattern starts with "./" or ".\",
807 -- drop the "./" or ".\" from the pattern.
809 if Directory = "" and then Pat'Length > 2
810 and then Pat (Pat'First) = '.'
811 and then Pat (Pat'First + 1) = Directory_Separator
813 First := Pat'First + 2;
817 GNAT.Regexp.Compile (Pat (First .. Pat'Last), Basic_Regexp, True);
819 Iterator.Maximum_Depth := 1;
821 -- Maximum_Depth is equal to 1 plus the number of directory separators
824 for Index in First .. Pat'Last loop
825 if Pat (Index) = Directory_Separator then
826 Iterator.Maximum_Depth := Iterator.Maximum_Depth + 1;
827 exit when Iterator.Maximum_Depth = Max_Depth;
834 Section (CL.Argument_Count + 1) := 0;
835 end GNAT.Command_Line;