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-2002 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 is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
31 ------------------------------------------------------------------------------
33 with Ada
.Command_Line
;
34 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
36 package body GNAT
.Command_Line
is
38 package CL
renames Ada
.Command_Line
;
40 type Section_Number
is new Natural range 0 .. 65534;
41 for Section_Number
'Size use 16;
43 type Parameter_Type
is record
48 The_Parameter
: Parameter_Type
;
49 The_Switch
: Parameter_Type
;
50 -- This type and this variable are provided to store the current switch
53 type Is_Switch_Type
is array (1 .. CL
.Argument_Count
) of Boolean;
54 pragma Pack
(Is_Switch_Type
);
56 Is_Switch
: Is_Switch_Type
:= (others => False);
57 -- Indicates wich arguments on the command line are considered not be
58 -- switches or parameters to switches (this leaves e.g. the filenames...)
60 type Section_Type
is array (1 .. CL
.Argument_Count
+ 1) of Section_Number
;
61 pragma Pack
(Section_Type
);
62 Section
: Section_Type
:= (others => 1);
63 -- Contains the number of the section associated with the current
64 -- switch. If this number is 0, then it is a section delimiter, which
65 -- is never returns by GetOpt.
66 -- The last element of this array is set to 0 to avoid the need to test for
67 -- if we have reached the end of the command line in loops.
69 Current_Argument
: Natural := 1;
70 -- Number of the current argument parsed on the command line
72 Current_Index
: Natural := 1;
73 -- Index in the current argument of the character to be processed
75 Current_Section
: Section_Number
:= 1;
77 Expansion_It
: aliased Expansion_Iterator
;
78 -- When Get_Argument is expanding a file name, this is the iterator used
80 In_Expansion
: Boolean := False;
81 -- True if we are expanding a file
83 Switch_Character
: Character := '-';
84 -- The character at the beginning of the command line arguments,
85 -- indicating the beginning of a switch
87 Stop_At_First
: Boolean := False;
88 -- If it is True then Getopt stops at the first non-switch argument
90 procedure Set_Parameter
91 (Variable
: out Parameter_Type
;
95 pragma Inline
(Set_Parameter
);
96 -- Set the parameter that will be returned by Parameter below
98 function Goto_Next_Argument_In_Section
return Boolean;
99 -- Go to the next argument on the command line. If we are at the end
100 -- of the current section, we want to make sure there is no other
101 -- identical section on the command line (there might be multiple
102 -- instances of -largs). Returns True iff there is another argument.
104 function Get_File_Names_Case_Sensitive
return Integer;
105 pragma Import
(C
, Get_File_Names_Case_Sensitive
,
106 "__gnat_get_file_names_case_sensitive");
107 File_Names_Case_Sensitive
: constant Boolean :=
108 Get_File_Names_Case_Sensitive
/= 0;
110 procedure Canonical_Case_File_Name
(S
: in out String);
111 -- Given a file name, converts it to canonical case form. For systems
112 -- where file names are case sensitive, this procedure has no effect.
113 -- If file names are not case sensitive (i.e. for example if you have
114 -- the file "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then
115 -- this call converts the given string to canonical all lower case form,
116 -- so that two file names compare equal if they refer to the same file.
118 ------------------------------
119 -- Canonical_Case_File_Name --
120 ------------------------------
122 procedure Canonical_Case_File_Name
(S
: in out String) is
124 if not File_Names_Case_Sensitive
then
125 for J
in S
'Range loop
126 if S
(J
) in 'A' .. 'Z' then
127 S
(J
) := Character'Val (
128 Character'Pos (S
(J
)) +
129 Character'Pos ('a') -
130 Character'Pos ('A'));
134 end Canonical_Case_File_Name
;
140 function Expansion
(Iterator
: Expansion_Iterator
) return String is
141 use GNAT
.Directory_Operations
;
142 type Pointer
is access all Expansion_Iterator
;
144 S
: String (1 .. 1024);
146 It
: Pointer
:= Iterator
'Unrestricted_Access;
148 Current
: Depth
:= It
.Current_Depth
;
152 -- It is assumed that a directory is opened at the current level;
153 -- otherwise, GNAT.Directory_Operations.Directory_Error will be raised
154 -- at the first call to Read.
157 Read
(It
.Levels
(Current
).Dir
, S
, Last
);
159 -- If we have exhausted the directory, close it and go back one level
162 Close
(It
.Levels
(Current
).Dir
);
164 -- If we are at level 1, we are finished; return an empty string.
167 return String'(1 .. 0 => ' ');
169 -- Otherwise, continue with the directory at the previous level
171 Current := Current - 1;
172 It.Current_Depth := Current;
175 -- If this is a directory, that is neither "." or "..", attempt to
176 -- go to the next level.
179 (It.Dir_Name (1 .. It.Levels (Current).Name_Last) & S (1 .. Last))
180 and then S (1 .. Last) /= "."
181 and then S (1 .. Last) /= ".."
183 -- We can go to the next level only if we have not reached the
186 if Current < It.Maximum_Depth then
187 NL := It.Levels (Current).Name_Last;
189 -- And if relative path of this new directory is not too long
191 if NL + Last + 1 < Max_Path_Length then
192 Current := Current + 1;
193 It.Current_Depth := Current;
194 It.Dir_Name (NL + 1 .. NL + Last) := S (1 .. Last);
196 It.Dir_Name (NL) := Directory_Separator;
197 It.Levels (Current).Name_Last := NL;
198 Canonical_Case_File_Name (It.Dir_Name (1 .. NL));
200 -- Open the new directory, and read from it
202 GNAT.Directory_Operations.Open
203 (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
207 -- If not a directory, check the relative path against the pattern
212 It.Dir_Name (It.Start .. It.Levels (Current).Name_Last) &
215 Canonical_Case_File_Name (Name);
217 -- If it matches, return the relative path
219 if GNAT.Regexp.Match (Name, Iterator.Regexp) then
227 return String'(1 .. 0 => ' ');
234 function Full_Switch
return String is
236 return CL
.Argument
(The_Switch
.Arg_Num
)
237 (The_Switch
.First
.. The_Switch
.Last
);
244 function Get_Argument
(Do_Expansion
: Boolean := False) return String is
245 Total
: constant Natural := CL
.Argument_Count
;
250 S
: constant String := Expansion
(Expansion_It
);
253 if S
'Length /= 0 then
256 In_Expansion
:= False;
261 if Current_Argument
> Total
then
263 -- If this is the first time this function is called
265 if Current_Index
= 1 then
266 Current_Argument
:= 1;
267 while Current_Argument
<= CL
.Argument_Count
268 and then Section
(Current_Argument
) /= Current_Section
270 Current_Argument
:= Current_Argument
+ 1;
273 return String'(1 .. 0 => ' ');
276 elsif Section (Current_Argument) = 0 then
277 while Current_Argument <= CL.Argument_Count
278 and then Section (Current_Argument) /= Current_Section
280 Current_Argument := Current_Argument + 1;
286 while Current_Argument <= Total
287 and then Is_Switch (Current_Argument)
289 Current_Argument := Current_Argument + 1;
292 if Current_Argument > Total then
293 return String'(1 .. 0 => ' ');
296 if Section
(Current_Argument
) = 0 then
297 return Get_Argument
(Do_Expansion
);
300 Current_Argument
:= Current_Argument
+ 1;
302 -- Could it be a file name with wild cards to expand?
306 Arg
: String renames CL
.Argument
(Current_Argument
- 1);
307 Index
: Positive := Arg
'First;
310 while Index
<= Arg
'Last loop
313 or else Arg
(Index
) = '?'
314 or else Arg
(Index
) = '['
316 In_Expansion
:= True;
317 Start_Expansion
(Expansion_It
, Arg
);
318 return Get_Argument
(Do_Expansion
);
326 return CL
.Argument
(Current_Argument
- 1);
333 function Getopt
(Switches
: String) return Character is
337 -- If we have finished parsing the current command line item (there
338 -- might be multiple switches in a single item), then go to the next
341 if Current_Argument
> CL
.Argument_Count
342 or else (Current_Index
> CL
.Argument
(Current_Argument
)'Last
343 and then not Goto_Next_Argument_In_Section
)
348 -- If we are on a new item, test if this might be a switch
350 if Current_Index
= 1 then
351 if CL
.Argument
(Current_Argument
)(1) /= Switch_Character
then
352 if Switches
(Switches
'First) = '*' then
353 Set_Parameter
(The_Switch
,
354 Arg_Num
=> Current_Argument
,
356 Last
=> CL
.Argument
(Current_Argument
)'Last);
357 Is_Switch
(Current_Argument
) := True;
358 Dummy
:= Goto_Next_Argument_In_Section
;
362 if Stop_At_First
then
363 Current_Argument
:= Positive'Last;
366 elsif not Goto_Next_Argument_In_Section
then
370 return Getopt
(Switches
);
375 Is_Switch
(Current_Argument
) := True;
379 Arg
: String renames CL
.Argument
(Current_Argument
);
380 Index_Switches
: Natural := 0;
381 Max_Length
: Natural := 0;
382 Index
: Natural := Switches
'First;
383 Length
: Natural := 1;
387 while Index
<= Switches
'Last loop
389 -- Search the length of the parameter at this position in Switches
392 while Length
<= Switches
'Last
393 and then Switches
(Length
) /= ' '
395 Length
:= Length
+ 1;
398 if (Switches
(Length
- 1) = ':' or else
399 Switches
(Length
- 1) = '=' or else
400 Switches
(Length
- 1) = '?' or else
401 Switches
(Length
- 1) = '!')
402 and then Length
> Index
+ 1
404 Length
:= Length
- 1;
407 -- If it is the one we searched, it may be a candidate
409 if Current_Index
+ Length
- 1 - Index
<= Arg
'Last
411 Switches
(Index
.. Length
- 1) =
412 Arg
(Current_Index
.. Current_Index
+ Length
- 1 - Index
)
413 and then Length
- Index
> Max_Length
415 Index_Switches
:= Index
;
416 Max_Length
:= Length
- Index
;
419 -- Look for the next switch in Switches
421 while Index
<= Switches
'Last
422 and then Switches
(Index
) /= ' ' loop
429 End_Index
:= Current_Index
+ Max_Length
- 1;
431 -- If switch is not accepted, skip it, unless we had '*' in Switches
433 if Index_Switches
= 0 then
434 if Switches
(Switches
'First) = '*' then
435 Set_Parameter
(The_Switch
,
436 Arg_Num
=> Current_Argument
,
438 Last
=> CL
.Argument
(Current_Argument
)'Last);
439 Is_Switch
(Current_Argument
) := True;
440 Dummy
:= Goto_Next_Argument_In_Section
;
444 Set_Parameter
(The_Switch
,
445 Arg_Num
=> Current_Argument
,
446 First
=> Current_Index
,
447 Last
=> Current_Index
);
448 Current_Index
:= Current_Index
+ 1;
449 raise Invalid_Switch
;
452 Set_Parameter
(The_Switch
,
453 Arg_Num
=> Current_Argument
,
454 First
=> Current_Index
,
457 -- Case of switch needs an argument
459 if Index_Switches
+ Max_Length
<= Switches
'Last then
461 case Switches
(Index_Switches
+ Max_Length
) is
465 if End_Index
< Arg
'Last then
466 Set_Parameter
(The_Parameter
,
467 Arg_Num
=> Current_Argument
,
468 First
=> End_Index
+ 1,
470 Dummy
:= Goto_Next_Argument_In_Section
;
472 elsif Section
(Current_Argument
+ 1) /= 0 then
475 Arg_Num
=> Current_Argument
+ 1,
477 Last
=> CL
.Argument
(Current_Argument
+ 1)'Last);
478 Current_Argument
:= Current_Argument
+ 1;
479 Is_Switch
(Current_Argument
) := True;
480 Dummy
:= Goto_Next_Argument_In_Section
;
483 Current_Index
:= End_Index
+ 1;
484 raise Invalid_Parameter
;
489 -- If the switch is of the form <switch>=xxx
491 if End_Index
< Arg
'Last then
493 if Arg
(End_Index
+ 1) = '='
494 and then End_Index
+ 1 < Arg
'Last
496 Set_Parameter
(The_Parameter
,
497 Arg_Num
=> Current_Argument
,
498 First
=> End_Index
+ 2,
500 Dummy
:= Goto_Next_Argument_In_Section
;
503 Current_Index
:= End_Index
+ 1;
504 raise Invalid_Parameter
;
507 -- If the switch is of the form <switch> xxx
509 elsif Section
(Current_Argument
+ 1) /= 0 then
512 Arg_Num
=> Current_Argument
+ 1,
514 Last
=> CL
.Argument
(Current_Argument
+ 1)'Last);
515 Current_Argument
:= Current_Argument
+ 1;
516 Is_Switch
(Current_Argument
) := True;
517 Dummy
:= Goto_Next_Argument_In_Section
;
520 Current_Index
:= End_Index
+ 1;
521 raise Invalid_Parameter
;
526 if End_Index
< Arg
'Last then
527 Set_Parameter
(The_Parameter
,
528 Arg_Num
=> Current_Argument
,
529 First
=> End_Index
+ 1,
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,
547 Set_Parameter
(The_Parameter
,
548 Arg_Num
=> Current_Argument
,
552 Dummy
:= Goto_Next_Argument_In_Section
;
556 Current_Index
:= End_Index
+ 1;
560 Current_Index
:= End_Index
+ 1;
563 return Switches
(Index_Switches
);
567 -----------------------------------
568 -- Goto_Next_Argument_In_Section --
569 -----------------------------------
571 function Goto_Next_Argument_In_Section
return Boolean is
574 Current_Argument
:= Current_Argument
+ 1;
576 if Section
(Current_Argument
) = 0 then
578 if Current_Argument
> CL
.Argument_Count
then
582 Current_Argument
:= Current_Argument
+ 1;
583 exit when Section
(Current_Argument
) = Current_Section
;
587 end Goto_Next_Argument_In_Section
;
593 procedure Goto_Section
(Name
: String := "") is
594 Index
: Integer := 1;
597 In_Expansion
:= False;
600 Current_Argument
:= 1;
602 Current_Section
:= 1;
606 while Index
<= CL
.Argument_Count
loop
608 if Section
(Index
) = 0
609 and then CL
.Argument
(Index
) = Switch_Character
& Name
611 Current_Argument
:= Index
+ 1;
614 if Current_Argument
<= CL
.Argument_Count
then
615 Current_Section
:= Section
(Current_Argument
);
623 Current_Argument
:= Positive'Last;
624 Current_Index
:= 2; -- so that Get_Argument returns nothing
627 ----------------------------
628 -- Initialize_Option_Scan --
629 ----------------------------
631 procedure Initialize_Option_Scan
632 (Switch_Char
: Character := '-';
633 Stop_At_First_Non_Switch
: Boolean := False;
634 Section_Delimiters
: String := "")
636 Section_Num
: Section_Number
:= 1;
637 Section_Index
: Integer := Section_Delimiters
'First;
639 Delimiter_Found
: Boolean;
642 Current_Argument
:= 0;
644 In_Expansion
:= False;
645 Switch_Character
:= Switch_Char
;
646 Stop_At_First
:= Stop_At_First_Non_Switch
;
648 -- If we are using sections, we have to preprocess the command line
649 -- to delimit them. A section can be repeated, so we just give each
650 -- item on the command line a section number
652 while Section_Index
<= Section_Delimiters
'Last loop
654 Last
:= Section_Index
;
655 while Last
<= Section_Delimiters
'Last
656 and then Section_Delimiters
(Last
) /= ' '
661 Delimiter_Found
:= False;
662 Section_Num
:= Section_Num
+ 1;
664 for Index
in 1 .. CL
.Argument_Count
loop
665 if CL
.Argument
(Index
)(1) = Switch_Character
667 CL
.Argument
(Index
) = Switch_Character
&
669 (Section_Index
.. Last
- 1)
671 Section
(Index
) := 0;
672 Delimiter_Found
:= True;
674 elsif Section
(Index
) = 0 then
675 Delimiter_Found
:= False;
677 elsif Delimiter_Found
then
678 Section
(Index
) := Section_Num
;
682 Section_Index
:= Last
+ 1;
683 while Section_Index
<= Section_Delimiters
'Last
684 and then Section_Delimiters
(Section_Index
) = ' '
686 Section_Index
:= Section_Index
+ 1;
690 Delimiter_Found
:= Goto_Next_Argument_In_Section
;
691 end Initialize_Option_Scan
;
697 function Parameter
return String is
699 if The_Parameter
.First
> The_Parameter
.Last
then
700 return String'(1 .. 0 => ' ');
702 return CL.Argument (The_Parameter.Arg_Num)
703 (The_Parameter.First .. The_Parameter.Last);
711 procedure Set_Parameter
712 (Variable : out Parameter_Type;
718 Variable.Arg_Num := Arg_Num;
719 Variable.First := First;
720 Variable.Last := Last;
723 ---------------------
724 -- Start_Expansion --
725 ---------------------
727 procedure Start_Expansion
728 (Iterator : out Expansion_Iterator;
730 Directory : String := "";
731 Basic_Regexp : Boolean := True)
733 Directory_Separator : Character;
734 pragma Import (C, Directory_Separator, "__gnat_dir_separator");
735 First : Positive := Pattern'First;
737 Pat : String := Pattern;
740 Canonical_Case_File_Name (Pat);
741 Iterator.Current_Depth := 1;
743 -- If Directory is unspecified, use the current directory ("./" or ".\")
745 if Directory = "" then
746 Iterator.Dir_Name (1 .. 2) := "." & Directory_Separator;
750 Iterator.Dir_Name (1 .. Directory'Length) := Directory;
751 Iterator.Start := Directory'Length + 1;
752 Canonical_Case_File_Name (Iterator.Dir_Name (1 .. Directory'Length));
754 -- Make sure that the last character is a directory separator
756 if Directory (Directory'Last) /= Directory_Separator then
757 Iterator.Dir_Name (Iterator.Start) := Directory_Separator;
758 Iterator.Start := Iterator.Start + 1;
762 Iterator.Levels (1).Name_Last := Iterator.Start - 1;
764 -- Open the initial Directory, at depth 1
766 GNAT.Directory_Operations.Open
767 (Iterator.Levels (1).Dir, Iterator.Dir_Name (1 .. Iterator.Start - 1));
769 -- If in the current directory and the pattern starts with "./" or ".\",
770 -- drop the "./" or ".\" from the pattern.
772 if Directory = "" and then Pat'Length > 2
773 and then Pat (Pat'First) = '.'
774 and then Pat (Pat'First + 1) = Directory_Separator
776 First := Pat'First + 2;
780 GNAT.Regexp.Compile (Pat (First .. Pat'Last), Basic_Regexp, True);
782 Iterator.Maximum_Depth := 1;
784 -- Maximum_Depth is equal to 1 plus the number of directory separators
787 for Index in First .. Pat'Last loop
788 if Pat (Index) = Directory_Separator then
789 Iterator.Maximum_Depth := Iterator.Maximum_Depth + 1;
790 exit when Iterator.Maximum_Depth = Max_Depth;
797 Section (CL.Argument_Count + 1) := 0;
798 end GNAT.Command_Line;