fixing pr42337
[official-gcc.git] / gcc / ada / switch-m.adb
bloba7a8d192626067152b7a9e4132523fa69e7eb6ea
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S W I T C H - M --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2009, 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 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. 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 COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
26 with Debug; use Debug;
27 with Makeutl; use Makeutl;
28 with Osint; use Osint;
29 with Opt; use Opt;
30 with Prj; use Prj;
31 with Prj.Ext; use Prj.Ext;
32 with Table;
34 package body Switch.M is
36 package Normalized_Switches is new Table.Table
37 (Table_Component_Type => String_Access,
38 Table_Index_Type => Integer,
39 Table_Low_Bound => 1,
40 Table_Initial => 20,
41 Table_Increment => 100,
42 Table_Name => "Switch.M.Normalized_Switches");
43 -- This table is used to keep the normalized switches, so that they may be
44 -- reused for subsequent invocations of Normalize_Compiler_Switches with
45 -- similar switches.
47 Initial_Number_Of_Switches : constant := 10;
49 Global_Switches : Argument_List_Access := null;
50 -- Used by function Normalize_Compiler_Switches
52 ---------------------------------
53 -- Normalize_Compiler_Switches --
54 ---------------------------------
56 procedure Normalize_Compiler_Switches
57 (Switch_Chars : String;
58 Switches : in out Argument_List_Access;
59 Last : out Natural)
61 Switch_Starts_With_Gnat : Boolean;
63 Ptr : Integer := Switch_Chars'First;
64 Max : constant Integer := Switch_Chars'Last;
65 C : Character := ' ';
67 Storing : String := Switch_Chars;
68 First_Stored : Positive := Ptr + 1;
69 Last_Stored : Positive := First_Stored;
71 procedure Add_Switch_Component (S : String);
72 -- Add a new String_Access component in Switches. If a string equal
73 -- to S is already stored in the table Normalized_Switches, use it.
74 -- Other wise add a new component to the table.
76 --------------------------
77 -- Add_Switch_Component --
78 --------------------------
80 procedure Add_Switch_Component (S : String) is
81 begin
82 -- If Switches is null, allocate a new array
84 if Switches = null then
85 Switches := new Argument_List (1 .. Initial_Number_Of_Switches);
87 -- Otherwise, if Switches is full, extend it
89 elsif Last = Switches'Last then
90 declare
91 New_Switches : constant Argument_List_Access :=
92 new Argument_List
93 (1 .. Switches'Length + Switches'Length);
94 begin
95 New_Switches (1 .. Switches'Length) := Switches.all;
96 Last := Switches'Length;
97 Switches := New_Switches;
98 end;
99 end if;
101 -- If this is the first switch, Last designates the first component
103 if Last = 0 then
104 Last := Switches'First;
105 else
106 Last := Last + 1;
107 end if;
109 -- Look into the table Normalized_Switches for a similar string.
110 -- If one is found, put it at the added component, and return.
112 for Index in 1 .. Normalized_Switches.Last loop
113 if S = Normalized_Switches.Table (Index).all then
114 Switches (Last) := Normalized_Switches.Table (Index);
115 return;
116 end if;
117 end loop;
119 -- No string equal to S was found in the table Normalized_Switches.
120 -- Add a new component in the table.
122 Switches (Last) := new String'(S);
123 Normalized_Switches.Append (Switches (Last));
124 end Add_Switch_Component;
126 -- Start of processing for Normalize_Compiler_Switches
128 begin
129 Last := 0;
131 if Ptr = Max or else Switch_Chars (Ptr) /= '-' then
132 return;
133 end if;
135 Ptr := Ptr + 1;
137 Switch_Starts_With_Gnat :=
138 Ptr + 3 <= Max and then Switch_Chars (Ptr .. Ptr + 3) = "gnat";
140 if Switch_Starts_With_Gnat then
141 Ptr := Ptr + 4;
142 First_Stored := Ptr;
143 end if;
145 while Ptr <= Max loop
146 C := Switch_Chars (Ptr);
148 -- Processing for a switch
150 case Switch_Starts_With_Gnat is
152 when False =>
154 -- All switches that don't start with -gnat stay as is,
155 -- except -pg, -Wall, -k8, -w
157 if Switch_Chars = "-pg" or else Switch_Chars = "-p" then
159 -- The gcc driver converts -pg to -p, so that is what
160 -- is stored in the ALI file.
162 Add_Switch_Component ("-p");
164 elsif Switch_Chars = "-Wall" then
166 -- The gcc driver adds -gnatwa when -Wall is used
168 Add_Switch_Component ("-gnatwa");
169 Add_Switch_Component ("-Wall");
171 elsif Switch_Chars = "-k8" then
173 -- The gcc driver transforms -k8 into -gnatk8
175 Add_Switch_Component ("-gnatk8");
177 elsif Switch_Chars = "-w" then
179 -- The gcc driver adds -gnatws when -w is used
181 Add_Switch_Component ("-gnatws");
182 Add_Switch_Component ("-w");
184 elsif Switch_Chars'Length > 6
185 and then
186 Switch_Chars (Switch_Chars'First .. Switch_Chars'First + 5)
187 = "--RTS="
188 then
189 Add_Switch_Component (Switch_Chars);
191 -- When --RTS=mtp is used, the gcc driver adds -mrtp
193 if Switch_Chars = "--RTS=mtp" then
194 Add_Switch_Component ("-mrtp");
195 end if;
197 -- Take only into account switches that are transmitted to
198 -- gnat1 by the gcc driver and stored by gnat1 in the ALI file.
200 else
201 case C is
202 when 'O' | 'W' | 'w' | 'f' | 'd' | 'g' | 'm' =>
203 Add_Switch_Component (Switch_Chars);
205 when others =>
206 null;
207 end case;
208 end if;
210 return;
212 when True =>
214 case C is
216 -- One-letter switches
218 when 'a' | 'A' | 'b' | 'c' | 'D' | 'E' | 'f' |
219 'F' | 'g' | 'h' | 'H' | 'k' | 'l' | 'L' | 'n' | 'N' |
220 'o' | 'O' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' | 't' |
221 'u' | 'U' | 'v' | 'x' | 'X' | 'Z' =>
222 Storing (First_Stored) := C;
223 Add_Switch_Component
224 (Storing (Storing'First .. First_Stored));
225 Ptr := Ptr + 1;
227 -- One-letter switches followed by a positive number
229 when 'm' | 'T' =>
230 Storing (First_Stored) := C;
231 Last_Stored := First_Stored;
233 loop
234 Ptr := Ptr + 1;
235 exit when Ptr > Max
236 or else Switch_Chars (Ptr) not in '0' .. '9';
237 Last_Stored := Last_Stored + 1;
238 Storing (Last_Stored) := Switch_Chars (Ptr);
239 end loop;
241 Add_Switch_Component
242 (Storing (Storing'First .. Last_Stored));
244 when 'd' =>
245 Storing (First_Stored) := 'd';
247 while Ptr < Max loop
248 Ptr := Ptr + 1;
249 C := Switch_Chars (Ptr);
250 exit when C = ASCII.NUL or else C = '/'
251 or else C = '-';
253 if C in '1' .. '9' or else
254 C in 'a' .. 'z' or else
255 C in 'A' .. 'Z'
256 then
257 Storing (First_Stored + 1) := C;
258 Add_Switch_Component
259 (Storing (Storing'First .. First_Stored + 1));
261 else
262 Last := 0;
263 return;
264 end if;
265 end loop;
267 return;
269 when 'e' =>
271 -- Store -gnateD, -gnatep= and -gnateG in the ALI file.
272 -- The other -gnate switches do not need to be stored.
274 Storing (First_Stored) := 'e';
275 Ptr := Ptr + 1;
277 if Ptr > Max
278 or else (Switch_Chars (Ptr) /= 'D'
279 and then Switch_Chars (Ptr) /= 'G'
280 and then Switch_Chars (Ptr) /= 'p')
281 then
282 Last := 0;
283 return;
284 end if;
286 -- Processing for -gnateD
288 if Switch_Chars (Ptr) = 'D' then
289 Storing (First_Stored + 1 ..
290 First_Stored + Max - Ptr + 1) :=
291 Switch_Chars (Ptr .. Max);
292 Add_Switch_Component
293 (Storing (Storing'First ..
294 First_Stored + Max - Ptr + 1));
296 -- Processing for -gnatep=
298 elsif Switch_Chars (Ptr) = 'p' then
299 Ptr := Ptr + 1;
301 if Ptr = Max then
302 Last := 0;
303 return;
304 end if;
306 if Switch_Chars (Ptr) = '=' then
307 Ptr := Ptr + 1;
308 end if;
310 -- To normalize, always put a '=' after -gnatep.
311 -- Because that could lengthen the switch string,
312 -- declare a local variable.
314 declare
315 To_Store : String (1 .. Max - Ptr + 9);
316 begin
317 To_Store (1 .. 8) := "-gnatep=";
318 To_Store (9 .. Max - Ptr + 9) :=
319 Switch_Chars (Ptr .. Max);
320 Add_Switch_Component (To_Store);
321 end;
323 elsif Switch_Chars (Ptr) = 'G' then
324 Add_Switch_Component ("-gnateG");
325 end if;
327 return;
329 when 'i' =>
330 Storing (First_Stored) := 'i';
332 Ptr := Ptr + 1;
334 if Ptr > Max then
335 Last := 0;
336 return;
337 end if;
339 C := Switch_Chars (Ptr);
341 if C in '1' .. '5'
342 or else C = '8'
343 or else C = 'p'
344 or else C = 'f'
345 or else C = 'n'
346 or else C = 'w'
347 then
348 Storing (First_Stored + 1) := C;
349 Add_Switch_Component
350 (Storing (Storing'First .. First_Stored + 1));
351 Ptr := Ptr + 1;
353 else
354 Last := 0;
355 return;
356 end if;
358 -- -gnatR may be followed by '0', '1', '2' or '3',
359 -- then by 's'
361 when 'R' =>
362 Last_Stored := First_Stored;
363 Storing (Last_Stored) := 'R';
364 Ptr := Ptr + 1;
366 if Ptr <= Max
367 and then Switch_Chars (Ptr) in '0' .. '9'
368 then
369 C := Switch_Chars (Ptr);
371 if C in '4' .. '9' then
372 Last := 0;
373 return;
375 else
376 Last_Stored := Last_Stored + 1;
377 Storing (Last_Stored) := C;
378 Ptr := Ptr + 1;
380 if Ptr <= Max
381 and then Switch_Chars (Ptr) = 's'
382 then
383 Last_Stored := Last_Stored + 1;
384 Storing (Last_Stored) := 's';
385 Ptr := Ptr + 1;
386 end if;
387 end if;
388 end if;
390 Add_Switch_Component
391 (Storing (Storing'First .. Last_Stored));
393 -- Multiple switches
395 when 'V' | 'w' | 'y' =>
396 Storing (First_Stored) := C;
397 Ptr := Ptr + 1;
399 if Ptr > Max then
400 if C = 'y' then
401 Add_Switch_Component
402 (Storing (Storing'First .. First_Stored));
404 else
405 Last := 0;
406 return;
407 end if;
408 end if;
410 -- Loop through remaining switch characters in string
412 while Ptr <= Max loop
413 C := Switch_Chars (Ptr);
414 Ptr := Ptr + 1;
416 -- -gnatyMxxx
418 if C = 'M' and then Storing (First_Stored) = 'y' then
419 Last_Stored := First_Stored + 1;
420 Storing (Last_Stored) := 'M';
421 while Ptr <= Max loop
422 C := Switch_Chars (Ptr);
423 exit when C not in '0' .. '9';
424 Last_Stored := Last_Stored + 1;
425 Storing (Last_Stored) := C;
426 Ptr := Ptr + 1;
427 end loop;
429 -- If there is no digit after -gnatyM,
430 -- the switch is invalid.
432 if Last_Stored = First_Stored + 1 then
433 Last := 0;
434 return;
436 else
437 Add_Switch_Component
438 (Storing (Storing'First .. Last_Stored));
439 end if;
441 -- --gnatx.x
443 elsif C = '.' and then Ptr <= Max then
444 Storing (First_Stored + 1) := '.';
445 Storing (First_Stored + 2) := Switch_Chars (Ptr);
446 Ptr := Ptr + 1;
447 Add_Switch_Component
448 (Storing (Storing'First .. First_Stored + 2));
450 -- All other switches are -gnatxx
452 else
453 Storing (First_Stored + 1) := C;
454 Add_Switch_Component
455 (Storing (Storing'First .. First_Stored + 1));
456 end if;
457 end loop;
459 -- -gnat95 -gnat05
461 when '0' | '9' =>
462 Last_Stored := First_Stored;
463 Storing (Last_Stored) := C;
464 Ptr := Ptr + 1;
466 if Ptr /= Max or else Switch_Chars (Ptr) /= '5' then
468 -- Invalid switch
470 Last := 0;
471 return;
473 else
474 Last_Stored := Last_Stored + 1;
475 Storing (Last_Stored) := '5';
476 Add_Switch_Component
477 (Storing (Storing'First .. Last_Stored));
478 Ptr := Ptr + 1;
479 end if;
481 -- -gnat83
483 when '8' =>
484 Last_Stored := First_Stored;
485 Storing (Last_Stored) := '8';
486 Ptr := Ptr + 1;
488 if Ptr /= Max or else Switch_Chars (Ptr) /= '3' then
490 -- Invalid switch
492 Last := 0;
493 return;
495 else
496 Last_Stored := Last_Stored + 1;
497 Storing (Last_Stored) := '3';
498 Add_Switch_Component
499 (Storing (Storing'First .. Last_Stored));
500 Ptr := Ptr + 1;
501 end if;
503 -- Not a valid switch
505 when others =>
506 Last := 0;
507 return;
509 end case;
511 end case;
512 end loop;
513 end Normalize_Compiler_Switches;
515 function Normalize_Compiler_Switches
516 (Switch_Chars : String) return Argument_List
518 Last : Natural;
520 begin
521 Normalize_Compiler_Switches (Switch_Chars, Global_Switches, Last);
523 if Last = 0 then
524 return (1 .. 0 => null);
525 else
526 return Global_Switches (Global_Switches'First .. Last);
527 end if;
528 end Normalize_Compiler_Switches;
530 ------------------------
531 -- Scan_Make_Switches --
532 ------------------------
534 procedure Scan_Make_Switches
535 (Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
536 Switch_Chars : String;
537 Success : out Boolean)
539 Ptr : Integer := Switch_Chars'First;
540 Max : constant Integer := Switch_Chars'Last;
541 C : Character := ' ';
543 begin
544 -- Assume a good switch
546 Success := True;
548 -- Skip past the initial character (must be the switch character)
550 if Ptr = Max then
551 Bad_Switch (Switch_Chars);
553 else
554 Ptr := Ptr + 1;
555 end if;
557 -- A little check, "gnat" at the start of a switch is for the compiler
559 if Switch_Chars'Length >= Ptr + 3
560 and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
561 then
562 Success := False;
563 return;
564 end if;
566 C := Switch_Chars (Ptr);
568 -- Multiple character switches
570 if Switch_Chars'Length > 2 then
571 if Switch_Chars = "--create-missing-dirs" then
572 Setup_Projects := True;
574 elsif Switch_Chars'Length > Subdirs_Option'Length
575 and then
576 Switch_Chars
577 (Switch_Chars'First ..
578 Switch_Chars'First + Subdirs_Option'Length - 1) =
579 Subdirs_Option
580 then
581 Subdirs :=
582 new String'
583 (Switch_Chars
584 (Switch_Chars'First + Subdirs_Option'Length ..
585 Switch_Chars'Last));
587 elsif Switch_Chars (Ptr) = '-' then
588 Bad_Switch (Switch_Chars);
590 elsif Switch_Chars'Length > 3
591 and then Switch_Chars (Ptr .. Ptr + 1) = "aP"
592 then
593 Add_Search_Project_Directory
594 (Project_Node_Tree,
595 Switch_Chars (Ptr + 2 .. Switch_Chars'Last));
597 elsif C = 'v' and then Switch_Chars'Length = 3 then
598 Ptr := Ptr + 1;
599 Verbose_Mode := True;
601 case Switch_Chars (Ptr) is
602 when 'l' =>
603 Verbosity_Level := Opt.Low;
605 when 'm' =>
606 Verbosity_Level := Opt.Medium;
608 when 'h' =>
609 Verbosity_Level := Opt.High;
611 when others =>
612 Success := False;
613 end case;
615 elsif C = 'd' then
617 -- Note: for the debug switch, the remaining characters in this
618 -- switch field must all be debug flags, since all valid switch
619 -- characters are also valid debug characters. This switch is not
620 -- documented on purpose because it is only used by the
621 -- implementors.
623 -- Loop to scan out debug flags
625 while Ptr < Max loop
626 Ptr := Ptr + 1;
627 C := Switch_Chars (Ptr);
629 if C in 'a' .. 'z' or else C in 'A' .. 'Z' then
630 Set_Debug_Flag (C);
631 else
632 Bad_Switch (Switch_Chars);
633 end if;
634 end loop;
636 elsif C = 'e' then
637 Ptr := Ptr + 1;
639 case Switch_Chars (Ptr) is
641 -- Processing for eI switch
643 when 'I' =>
644 Ptr := Ptr + 1;
645 Scan_Pos (Switch_Chars, Max, Ptr, Main_Index, C);
647 if Ptr <= Max then
648 Bad_Switch (Switch_Chars);
649 end if;
651 -- Processing for eL switch
653 when 'L' =>
654 if Ptr /= Max then
655 Bad_Switch (Switch_Chars);
657 else
658 Follow_Links_For_Files := True;
659 Follow_Links_For_Dirs := True;
660 end if;
662 -- Processing for eS switch
664 when 'S' =>
665 if Ptr /= Max then
666 Bad_Switch (Switch_Chars);
668 else
669 Commands_To_Stdout := True;
670 end if;
672 when others =>
673 Bad_Switch (Switch_Chars);
674 end case;
676 elsif C = 'j' then
677 Ptr := Ptr + 1;
679 declare
680 Max_Proc : Pos;
681 begin
682 Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc, C);
684 if Ptr <= Max then
685 Bad_Switch (Switch_Chars);
687 else
688 Maximum_Processes := Positive (Max_Proc);
689 end if;
690 end;
692 elsif C = 'w' and then Switch_Chars'Length = 3 then
693 Ptr := Ptr + 1;
695 if Switch_Chars = "-we" then
696 Warning_Mode := Treat_As_Error;
698 elsif Switch_Chars = "-wn" then
699 Warning_Mode := Normal;
701 elsif Switch_Chars = "-ws" then
702 Warning_Mode := Suppress;
704 else
705 Success := False;
706 end if;
708 else
709 Success := False;
710 end if;
712 -- Single-character switches
714 else
715 Check_Switch : begin
717 case C is
719 when 'a' =>
720 Check_Readonly_Files := True;
722 -- Processing for b switch
724 when 'b' =>
725 Bind_Only := True;
726 Make_Steps := True;
728 -- Processing for B switch
730 when 'B' =>
731 Build_Bind_And_Link_Full_Project := True;
733 -- Processing for c switch
735 when 'c' =>
736 Compile_Only := True;
737 Make_Steps := True;
739 -- Processing for C switch
741 when 'C' =>
742 Create_Mapping_File := True;
744 -- Processing for D switch
746 when 'D' =>
747 if Object_Directory_Present then
748 Osint.Fail ("duplicate -D switch");
750 else
751 Object_Directory_Present := True;
752 end if;
754 -- Processing for f switch
756 when 'f' =>
757 Force_Compilations := True;
759 -- Processing for F switch
761 when 'F' =>
762 Full_Path_Name_For_Brief_Errors := True;
764 -- Processing for h switch
766 when 'h' =>
767 Usage_Requested := True;
769 -- Processing for i switch
771 when 'i' =>
772 In_Place_Mode := True;
774 -- Processing for j switch
776 when 'j' =>
777 -- -j not followed by a number is an error
779 Bad_Switch (Switch_Chars);
781 -- Processing for k switch
783 when 'k' =>
784 Keep_Going := True;
786 -- Processing for l switch
788 when 'l' =>
789 Link_Only := True;
790 Make_Steps := True;
792 -- Processing for M switch
794 when 'M' =>
795 List_Dependencies := True;
797 -- Processing for n switch
799 when 'n' =>
800 Do_Not_Execute := True;
802 -- Processing for o switch
804 when 'o' =>
805 if Output_File_Name_Present then
806 Osint.Fail ("duplicate -o switch");
807 else
808 Output_File_Name_Present := True;
809 end if;
811 -- Processing for p switch
813 when 'p' =>
814 Setup_Projects := True;
816 -- Processing for q switch
818 when 'q' =>
819 Quiet_Output := True;
821 -- Processing for R switch
823 when 'R' =>
824 Run_Path_Option := False;
826 -- Processing for s switch
828 when 's' =>
829 Ptr := Ptr + 1;
830 Check_Switches := True;
832 -- Processing for v switch
834 when 'v' =>
835 Verbose_Mode := True;
836 Verbosity_Level := Opt.High;
838 -- Processing for x switch
840 when 'x' =>
841 External_Unit_Compilation_Allowed := True;
843 -- Processing for z switch
845 when 'z' =>
846 No_Main_Subprogram := True;
848 -- Any other small letter is an illegal switch
850 when others =>
851 if C in 'a' .. 'z' then
852 Bad_Switch (Switch_Chars);
854 else
855 Success := False;
856 end if;
858 end case;
859 end Check_Switch;
860 end if;
861 end Scan_Make_Switches;
863 end Switch.M;