PR c++/11509
[official-gcc.git] / gcc / ada / g-comlin.adb
blobabaa24cd53b47c17538d1d772277f033b727b202
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G N A T . C O M M A N D _ L I N E --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1999-2002 Free Software Foundation, Inc. --
10 -- --
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. --
21 -- --
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. --
28 -- --
29 -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
30 -- --
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
44 Arg_Num : Positive;
45 First : Positive;
46 Last : Positive;
47 end record;
48 The_Parameter : Parameter_Type;
49 The_Switch : Parameter_Type;
50 -- This type and this variable are provided to store the current switch
51 -- and parameter
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;
92 Arg_Num : Positive;
93 First : Positive;
94 Last : Positive);
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
123 begin
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'));
131 end if;
132 end loop;
133 end if;
134 end Canonical_Case_File_Name;
136 ---------------
137 -- Expansion --
138 ---------------
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);
145 Last : Natural;
146 It : Pointer := Iterator'Unrestricted_Access;
148 Current : Depth := It.Current_Depth;
149 NL : Positive;
151 begin
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.
156 loop
157 Read (It.Levels (Current).Dir, S, Last);
159 -- If we have exhausted the directory, close it and go back one level
161 if Last = 0 then
162 Close (It.Levels (Current).Dir);
164 -- If we are at level 1, we are finished; return an empty string.
166 if Current = 1 then
167 return String'(1 .. 0 => ' ');
168 else
169 -- Otherwise, continue with the directory at the previous level
171 Current := Current - 1;
172 It.Current_Depth := Current;
173 end if;
175 -- If this is a directory, that is neither "." or "..", attempt to
176 -- go to the next level.
178 elsif Is_Directory
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) /= ".."
182 then
183 -- We can go to the next level only if we have not reached the
184 -- maximum depth,
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);
195 NL := NL + Last + 1;
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));
204 end if;
205 end if;
207 -- If not a directory, check the relative path against the pattern
209 else
210 declare
211 Name : String :=
212 It.Dir_Name (It.Start .. It.Levels (Current).Name_Last) &
213 S (1 .. Last);
214 begin
215 Canonical_Case_File_Name (Name);
217 -- If it matches, return the relative path
219 if GNAT.Regexp.Match (Name, Iterator.Regexp) then
220 return Name;
221 end if;
222 end;
223 end if;
225 end loop;
227 return String'(1 .. 0 => ' ');
228 end Expansion;
230 -----------------
231 -- Full_Switch --
232 -----------------
234 function Full_Switch return String is
235 begin
236 return CL.Argument (The_Switch.Arg_Num)
237 (The_Switch.First .. The_Switch.Last);
238 end Full_Switch;
240 ------------------
241 -- Get_Argument --
242 ------------------
244 function Get_Argument (Do_Expansion : Boolean := False) return String is
245 Total : constant Natural := CL.Argument_Count;
247 begin
248 if In_Expansion then
249 declare
250 S : constant String := Expansion (Expansion_It);
252 begin
253 if S'Length /= 0 then
254 return S;
255 else
256 In_Expansion := False;
257 end if;
258 end;
259 end if;
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
269 loop
270 Current_Argument := Current_Argument + 1;
271 end loop;
272 else
273 return String'(1 .. 0 => ' ');
274 end if;
276 elsif Section (Current_Argument) = 0 then
277 while Current_Argument <= CL.Argument_Count
278 and then Section (Current_Argument) /= Current_Section
279 loop
280 Current_Argument := Current_Argument + 1;
281 end loop;
282 end if;
284 Current_Index := 2;
286 while Current_Argument <= Total
287 and then Is_Switch (Current_Argument)
288 loop
289 Current_Argument := Current_Argument + 1;
290 end loop;
292 if Current_Argument > Total then
293 return String'(1 .. 0 => ' ');
294 end if;
296 if Section (Current_Argument) = 0 then
297 return Get_Argument (Do_Expansion);
298 end if;
300 Current_Argument := Current_Argument + 1;
302 -- Could it be a file name with wild cards to expand?
304 if Do_Expansion then
305 declare
306 Arg : String renames CL.Argument (Current_Argument - 1);
307 Index : Positive := Arg'First;
309 begin
310 while Index <= Arg'Last loop
312 if Arg (Index) = '*'
313 or else Arg (Index) = '?'
314 or else Arg (Index) = '['
315 then
316 In_Expansion := True;
317 Start_Expansion (Expansion_It, Arg);
318 return Get_Argument (Do_Expansion);
319 end if;
321 Index := Index + 1;
322 end loop;
323 end;
324 end if;
326 return CL.Argument (Current_Argument - 1);
327 end Get_Argument;
329 ------------
330 -- Getopt --
331 ------------
333 function Getopt (Switches : String) return Character is
334 Dummy : Boolean;
336 begin
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
339 -- element
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)
344 then
345 return ASCII.NUL;
346 end if;
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,
355 First => 1,
356 Last => CL.Argument (Current_Argument)'Last);
357 Is_Switch (Current_Argument) := True;
358 Dummy := Goto_Next_Argument_In_Section;
359 return '*';
360 end if;
362 if Stop_At_First then
363 Current_Argument := Positive'Last;
364 return ASCII.NUL;
366 elsif not Goto_Next_Argument_In_Section then
367 return ASCII.NUL;
369 else
370 return Getopt (Switches);
371 end if;
372 end if;
374 Current_Index := 2;
375 Is_Switch (Current_Argument) := True;
376 end if;
378 declare
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;
384 End_Index : Natural;
386 begin
387 while Index <= Switches'Last loop
389 -- Search the length of the parameter at this position in Switches
391 Length := Index;
392 while Length <= Switches'Last
393 and then Switches (Length) /= ' '
394 loop
395 Length := Length + 1;
396 end loop;
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
403 then
404 Length := Length - 1;
405 end if;
407 -- If it is the one we searched, it may be a candidate
409 if Current_Index + Length - 1 - Index <= Arg'Last
410 and then
411 Switches (Index .. Length - 1) =
412 Arg (Current_Index .. Current_Index + Length - 1 - Index)
413 and then Length - Index > Max_Length
414 then
415 Index_Switches := Index;
416 Max_Length := Length - Index;
417 end if;
419 -- Look for the next switch in Switches
421 while Index <= Switches'Last
422 and then Switches (Index) /= ' ' loop
423 Index := Index + 1;
424 end loop;
426 Index := Index + 1;
427 end 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,
437 First => 1,
438 Last => CL.Argument (Current_Argument)'Last);
439 Is_Switch (Current_Argument) := True;
440 Dummy := Goto_Next_Argument_In_Section;
441 return '*';
442 end if;
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;
450 end if;
452 Set_Parameter (The_Switch,
453 Arg_Num => Current_Argument,
454 First => Current_Index,
455 Last => End_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
463 when ':' =>
465 if End_Index < Arg'Last then
466 Set_Parameter (The_Parameter,
467 Arg_Num => Current_Argument,
468 First => End_Index + 1,
469 Last => Arg'Last);
470 Dummy := Goto_Next_Argument_In_Section;
472 elsif Section (Current_Argument + 1) /= 0 then
473 Set_Parameter
474 (The_Parameter,
475 Arg_Num => Current_Argument + 1,
476 First => 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;
482 else
483 Current_Index := End_Index + 1;
484 raise Invalid_Parameter;
485 end if;
487 when '=' =>
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
495 then
496 Set_Parameter (The_Parameter,
497 Arg_Num => Current_Argument,
498 First => End_Index + 2,
499 Last => Arg'Last);
500 Dummy := Goto_Next_Argument_In_Section;
502 else
503 Current_Index := End_Index + 1;
504 raise Invalid_Parameter;
505 end if;
507 -- If the switch is of the form <switch> xxx
509 elsif Section (Current_Argument + 1) /= 0 then
510 Set_Parameter
511 (The_Parameter,
512 Arg_Num => Current_Argument + 1,
513 First => 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;
519 else
520 Current_Index := End_Index + 1;
521 raise Invalid_Parameter;
522 end if;
524 when '!' =>
526 if End_Index < Arg'Last then
527 Set_Parameter (The_Parameter,
528 Arg_Num => Current_Argument,
529 First => End_Index + 1,
530 Last => Arg'Last);
531 Dummy := Goto_Next_Argument_In_Section;
533 else
534 Current_Index := End_Index + 1;
535 raise Invalid_Parameter;
536 end if;
538 when '?' =>
540 if End_Index < Arg'Last then
541 Set_Parameter (The_Parameter,
542 Arg_Num => Current_Argument,
543 First => End_Index + 1,
544 Last => Arg'Last);
546 else
547 Set_Parameter (The_Parameter,
548 Arg_Num => Current_Argument,
549 First => 2,
550 Last => 1);
551 end if;
552 Dummy := Goto_Next_Argument_In_Section;
554 when others =>
556 Current_Index := End_Index + 1;
558 end case;
559 else
560 Current_Index := End_Index + 1;
561 end if;
563 return Switches (Index_Switches);
564 end;
565 end Getopt;
567 -----------------------------------
568 -- Goto_Next_Argument_In_Section --
569 -----------------------------------
571 function Goto_Next_Argument_In_Section return Boolean is
572 begin
573 Current_Index := 1;
574 Current_Argument := Current_Argument + 1;
576 if Section (Current_Argument) = 0 then
577 loop
578 if Current_Argument > CL.Argument_Count then
579 return False;
580 end if;
582 Current_Argument := Current_Argument + 1;
583 exit when Section (Current_Argument) = Current_Section;
584 end loop;
585 end if;
586 return True;
587 end Goto_Next_Argument_In_Section;
589 ------------------
590 -- Goto_Section --
591 ------------------
593 procedure Goto_Section (Name : String := "") is
594 Index : Integer := 1;
596 begin
597 In_Expansion := False;
599 if Name = "" then
600 Current_Argument := 1;
601 Current_Index := 1;
602 Current_Section := 1;
603 return;
604 end if;
606 while Index <= CL.Argument_Count loop
608 if Section (Index) = 0
609 and then CL.Argument (Index) = Switch_Character & Name
610 then
611 Current_Argument := Index + 1;
612 Current_Index := 1;
614 if Current_Argument <= CL.Argument_Count then
615 Current_Section := Section (Current_Argument);
616 end if;
617 return;
618 end if;
620 Index := Index + 1;
621 end loop;
623 Current_Argument := Positive'Last;
624 Current_Index := 2; -- so that Get_Argument returns nothing
625 end Goto_Section;
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;
638 Last : Integer;
639 Delimiter_Found : Boolean;
641 begin
642 Current_Argument := 0;
643 Current_Index := 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) /= ' '
657 loop
658 Last := Last + 1;
659 end loop;
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
666 and then
667 CL.Argument (Index) = Switch_Character &
668 Section_Delimiters
669 (Section_Index .. Last - 1)
670 then
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;
679 end if;
680 end loop;
682 Section_Index := Last + 1;
683 while Section_Index <= Section_Delimiters'Last
684 and then Section_Delimiters (Section_Index) = ' '
685 loop
686 Section_Index := Section_Index + 1;
687 end loop;
688 end loop;
690 Delimiter_Found := Goto_Next_Argument_In_Section;
691 end Initialize_Option_Scan;
693 ---------------
694 -- Parameter --
695 ---------------
697 function Parameter return String is
698 begin
699 if The_Parameter.First > The_Parameter.Last then
700 return String'(1 .. 0 => ' ');
701 else
702 return CL.Argument (The_Parameter.Arg_Num)
703 (The_Parameter.First .. The_Parameter.Last);
704 end if;
705 end Parameter;
707 -------------------
708 -- Set_Parameter --
709 -------------------
711 procedure Set_Parameter
712 (Variable : out Parameter_Type;
713 Arg_Num : Positive;
714 First : Positive;
715 Last : Positive)
717 begin
718 Variable.Arg_Num := Arg_Num;
719 Variable.First := First;
720 Variable.Last := Last;
721 end Set_Parameter;
723 ---------------------
724 -- Start_Expansion --
725 ---------------------
727 procedure Start_Expansion
728 (Iterator : out Expansion_Iterator;
729 Pattern : String;
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;
739 begin
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;
747 Iterator.Start := 3;
749 else
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;
759 end if;
760 end if;
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
775 then
776 First := Pat'First + 2;
777 end if;
779 Iterator.Regexp :=
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
785 -- in the pattern.
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;
791 end if;
792 end loop;
794 end Start_Expansion;
796 begin
797 Section (CL.Argument_Count + 1) := 0;
798 end GNAT.Command_Line;