04a6fa188f36b4de536ca4e5c4b3c05ba6fd32fc
[gcc.git] / gcc / ada / switch-c.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S W I T C H - C --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2014, 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 ------------------------------------------------------------------------------
25
26 -- This package is for switch processing and should not depend on higher level
27 -- packages such as those for the scanner, parser, etc. Doing so may cause
28 -- circularities, especially for back ends using Adabkend.
29
30 with Debug; use Debug;
31 with Lib; use Lib;
32 with Osint; use Osint;
33 with Opt; use Opt;
34 with Stylesw; use Stylesw;
35 with Ttypes; use Ttypes;
36 with Validsw; use Validsw;
37 with Warnsw; use Warnsw;
38
39 with Ada.Unchecked_Deallocation;
40 with System.WCh_Con; use System.WCh_Con;
41
42 package body Switch.C is
43
44 RTS_Specified : String_Access := null;
45 -- Used to detect multiple use of --RTS= flag
46
47 procedure Add_Symbol_Definition (Def : String);
48 -- Add a symbol definition from the command line
49
50 procedure Free is
51 new Ada.Unchecked_Deallocation (String_List, String_List_Access);
52 -- Avoid using System.Strings.Free, which also frees the designated strings
53
54 function Get_Overflow_Mode (C : Character) return Overflow_Mode_Type;
55 -- Given a digit in the range 0 .. 3, returns the corresponding value of
56 -- Overflow_Mode_Type. Raises Program_Error if C is outside this range.
57
58 function Switch_Subsequently_Cancelled
59 (C : String;
60 Args : String_List;
61 Arg_Rank : Positive) return Boolean;
62 -- This function is called from Scan_Front_End_Switches. It determines if
63 -- the switch currently being scanned is followed by a switch of the form
64 -- "-gnat-" & C, where C is the argument. If so, then True is returned,
65 -- and Scan_Front_End_Switches will cancel the effect of the switch. If
66 -- no such switch is found, False is returned.
67
68 ---------------------------
69 -- Add_Symbol_Definition --
70 ---------------------------
71
72 procedure Add_Symbol_Definition (Def : String) is
73 begin
74 -- If Preprocessor_Symbol_Defs is not large enough, double its size
75
76 if Preprocessing_Symbol_Last = Preprocessing_Symbol_Defs'Last then
77 declare
78 New_Symbol_Definitions : constant String_List_Access :=
79 new String_List (1 .. 2 * Preprocessing_Symbol_Last);
80 begin
81 New_Symbol_Definitions (Preprocessing_Symbol_Defs'Range) :=
82 Preprocessing_Symbol_Defs.all;
83 Free (Preprocessing_Symbol_Defs);
84 Preprocessing_Symbol_Defs := New_Symbol_Definitions;
85 end;
86 end if;
87
88 Preprocessing_Symbol_Last := Preprocessing_Symbol_Last + 1;
89 Preprocessing_Symbol_Defs (Preprocessing_Symbol_Last) :=
90 new String'(Def);
91 end Add_Symbol_Definition;
92
93 -----------------------
94 -- Get_Overflow_Mode --
95 -----------------------
96
97 function Get_Overflow_Mode (C : Character) return Overflow_Mode_Type is
98 begin
99 case C is
100 when '1' =>
101 return Strict;
102
103 when '2' =>
104 return Minimized;
105
106 -- Eliminated allowed only if Long_Long_Integer is 64 bits (since
107 -- the current implementation of System.Bignums assumes this).
108
109 when '3' =>
110 if Standard_Long_Long_Integer_Size /= 64 then
111 Bad_Switch ("-gnato3 not implemented for this configuration");
112 else
113 return Eliminated;
114 end if;
115
116 when others =>
117 raise Program_Error;
118 end case;
119 end Get_Overflow_Mode;
120
121 -----------------------------
122 -- Scan_Front_End_Switches --
123 -----------------------------
124
125 procedure Scan_Front_End_Switches
126 (Switch_Chars : String;
127 Args : String_List;
128 Arg_Rank : Positive)
129 is
130 First_Switch : Boolean := True;
131 -- False for all but first switch
132
133 Max : constant Natural := Switch_Chars'Last;
134 Ptr : Natural;
135 C : Character := ' ';
136 Dot : Boolean;
137
138 Store_Switch : Boolean;
139 -- For -gnatxx switches, the normal processing, signalled by this flag
140 -- being set to True, is to store the switch on exit from the case
141 -- statement, the switch stored is -gnat followed by the characters
142 -- from First_Char to Ptr-1. For cases like -gnaty, where the switch
143 -- is stored in separate pieces, this flag is set to False, and the
144 -- appropriate calls to Store_Compilation_Switch are made from within
145 -- the case branch.
146
147 First_Char : Positive;
148 -- Marks start of switch to be stored
149
150 First_Ptr : Positive;
151 -- Save position of first character after -gnatd (for checking that
152 -- debug flags that must come first are first, in particular -gnatd.b),
153
154 begin
155 Ptr := Switch_Chars'First;
156
157 -- Skip past the initial character (must be the switch character)
158
159 if Ptr = Max then
160 Bad_Switch (C);
161 else
162 Ptr := Ptr + 1;
163 end if;
164
165 -- Handle switches that do not start with -gnat
166
167 if Ptr + 3 > Max or else Switch_Chars (Ptr .. Ptr + 3) /= "gnat" then
168
169 -- There are two front-end switches that do not start with -gnat:
170 -- -I, --RTS
171
172 if Switch_Chars (Ptr) = 'I' then
173
174 -- Set flag Search_Directory_Present if switch is "-I" only:
175 -- the directory will be the next argument.
176
177 if Ptr = Max then
178 Search_Directory_Present := True;
179 return;
180 end if;
181
182 Ptr := Ptr + 1;
183
184 -- Find out whether this is a -I- or regular -Ixxx switch
185
186 -- Note: -I switches are not recorded in the ALI file, since the
187 -- meaning of the program depends on the source files compiled,
188 -- not where they came from.
189
190 if Ptr = Max and then Switch_Chars (Ptr) = '-' then
191 Look_In_Primary_Dir := False;
192 else
193 Add_Src_Search_Dir (Switch_Chars (Ptr .. Max));
194 end if;
195
196 -- Processing of the --RTS switch. --RTS may have been modified by
197 -- gcc into -fRTS (for GCC targets).
198
199 elsif Ptr + 3 <= Max
200 and then (Switch_Chars (Ptr .. Ptr + 3) = "fRTS"
201 or else
202 Switch_Chars (Ptr .. Ptr + 3) = "-RTS")
203 then
204 Ptr := Ptr + 1;
205
206 if Ptr + 4 > Max
207 or else Switch_Chars (Ptr + 3) /= '='
208 then
209 Osint.Fail ("missing path for --RTS");
210 else
211 -- Check that this is the first time --RTS is specified or if
212 -- it is not the first time, the same path has been specified.
213
214 if RTS_Specified = null then
215 RTS_Specified := new String'(Switch_Chars (Ptr + 4 .. Max));
216
217 elsif
218 RTS_Specified.all /= Switch_Chars (Ptr + 4 .. Max)
219 then
220 Osint.Fail ("--RTS cannot be specified multiple times");
221 end if;
222
223 -- Valid --RTS switch
224
225 Opt.No_Stdinc := True;
226 Opt.RTS_Switch := True;
227
228 RTS_Src_Path_Name :=
229 Get_RTS_Search_Dir
230 (Switch_Chars (Ptr + 4 .. Max), Include);
231
232 RTS_Lib_Path_Name :=
233 Get_RTS_Search_Dir
234 (Switch_Chars (Ptr + 4 .. Max), Objects);
235
236 if RTS_Src_Path_Name /= null
237 and then RTS_Lib_Path_Name /= null
238 then
239 -- Store the -fRTS switch (Note: Store_Compilation_Switch
240 -- changes -fRTS back into --RTS for the actual output).
241
242 Store_Compilation_Switch (Switch_Chars);
243
244 elsif RTS_Src_Path_Name = null
245 and then RTS_Lib_Path_Name = null
246 then
247 Osint.Fail ("RTS path not valid: missing " &
248 "adainclude and adalib directories");
249
250 elsif RTS_Src_Path_Name = null then
251 Osint.Fail ("RTS path not valid: missing " &
252 "adainclude directory");
253
254 elsif RTS_Lib_Path_Name = null then
255 Osint.Fail ("RTS path not valid: missing " &
256 "adalib directory");
257 end if;
258 end if;
259
260 -- There are no other switches not starting with -gnat
261
262 else
263 Bad_Switch (Switch_Chars);
264 end if;
265
266 -- Case of switch starting with -gnat
267
268 else
269 Ptr := Ptr + 4;
270
271 -- Loop to scan through switches given in switch string
272
273 while Ptr <= Max loop
274 First_Char := Ptr;
275 Store_Switch := True;
276
277 C := Switch_Chars (Ptr);
278
279 case C is
280
281 -- -gnata (assertions enabled)
282
283 when 'a' =>
284 Ptr := Ptr + 1;
285 Assertions_Enabled := True;
286
287 -- -gnatA (disregard gnat.adc)
288
289 when 'A' =>
290 Ptr := Ptr + 1;
291 Config_File := False;
292
293 -- -gnatb (brief messages to stderr)
294
295 when 'b' =>
296 Ptr := Ptr + 1;
297 Brief_Output := True;
298
299 -- -gnatB (assume no invalid values)
300
301 when 'B' =>
302 Ptr := Ptr + 1;
303 Assume_No_Invalid_Values := True;
304
305 -- -gnatc (check syntax and semantics only)
306
307 when 'c' =>
308 if not First_Switch then
309 Osint.Fail
310 ("-gnatc must be first if combined with other switches");
311 end if;
312
313 Ptr := Ptr + 1;
314 Operating_Mode := Check_Semantics;
315
316 -- -gnatC (Generate CodePeer information)
317
318 when 'C' =>
319 Ptr := Ptr + 1;
320
321 if not CodePeer_Mode then
322 CodePeer_Mode := True;
323
324 -- Suppress compiler warnings by default, since what we are
325 -- interested in here is what CodePeer can find out. Note
326 -- that if -gnatwxxx is specified after -gnatC on the
327 -- command line, we do not want to override this setting in
328 -- Adjust_Global_Switches, and assume that the user wants to
329 -- get both warnings from GNAT and CodePeer messages.
330
331 Warning_Mode := Suppress;
332 end if;
333
334 -- -gnatd (compiler debug options)
335
336 when 'd' =>
337 Store_Switch := False;
338 Dot := False;
339 First_Ptr := Ptr + 1;
340
341 -- Note: for the debug switch, the remaining characters in this
342 -- switch field must all be debug flags, since all valid switch
343 -- characters are also valid debug characters.
344
345 -- Loop to scan out debug flags
346
347 while Ptr < Max loop
348 Ptr := Ptr + 1;
349 C := Switch_Chars (Ptr);
350 exit when C = ASCII.NUL or else C = '/' or else C = '-';
351
352 if C in '1' .. '9' or else
353 C in 'a' .. 'z' or else
354 C in 'A' .. 'Z'
355 then
356 -- Case of dotted flag
357
358 if Dot then
359 Set_Dotted_Debug_Flag (C);
360 Store_Compilation_Switch ("-gnatd." & C);
361
362 -- Special check, -gnatd.b must come first
363
364 if C = 'b'
365 and then (Ptr /= First_Ptr + 1
366 or else not First_Switch)
367 then
368 Osint.Fail
369 ("-gnatd.b must be first if combined "
370 & "with other switches");
371 end if;
372
373 -- Not a dotted flag
374
375 else
376 Set_Debug_Flag (C);
377 Store_Compilation_Switch ("-gnatd" & C);
378 end if;
379
380 elsif C = '.' then
381 Dot := True;
382
383 elsif Dot then
384 Bad_Switch ("-gnatd." & Switch_Chars (Ptr .. Max));
385 else
386 Bad_Switch ("-gnatd" & Switch_Chars (Ptr .. Max));
387 end if;
388 end loop;
389
390 return;
391
392 -- -gnatD (debug expanded code)
393
394 when 'D' =>
395 Ptr := Ptr + 1;
396
397 -- Not allowed if previous -gnatR given
398
399 -- The reason for this prohibition is that the rewriting of
400 -- Sloc values causes strange malfunctions in the tests of
401 -- whether units belong to the main source. This is really a
402 -- bug, but too hard to fix for a marginal capability ???
403
404 -- The proper fix is to completely redo -gnatD processing so
405 -- that the tree is not messed with, and instead a separate
406 -- table is built on the side for debug information generation.
407
408 if List_Representation_Info /= 0 then
409 Osint.Fail
410 ("-gnatD not permitted since -gnatR given previously");
411 end if;
412
413 -- Scan optional integer line limit value
414
415 if Nat_Present (Switch_Chars, Max, Ptr) then
416 Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'D');
417 Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
418 end if;
419
420 -- Note: -gnatD also sets -gnatx (to turn off cross-reference
421 -- generation in the ali file) since otherwise this generation
422 -- gets confused by the "wrong" Sloc values put in the tree.
423
424 Debug_Generated_Code := True;
425 Xref_Active := False;
426 Set_Debug_Flag ('g');
427
428 -- -gnate? (extended switches)
429
430 when 'e' =>
431 Ptr := Ptr + 1;
432
433 -- The -gnate? switches are all double character switches
434 -- so we must always have a character after the e.
435
436 if Ptr > Max then
437 Bad_Switch ("-gnate");
438 end if;
439
440 case Switch_Chars (Ptr) is
441
442 -- -gnatea (initial delimiter of explicit switches)
443
444 -- This is an internal switch
445
446 -- All switches that come before -gnatea have been added by
447 -- the GCC driver and are not stored in the ALI file.
448 -- See also -gnatez below.
449
450 when 'a' =>
451 Store_Switch := False;
452 Enable_Switch_Storing;
453 Ptr := Ptr + 1;
454
455 -- -gnateA (aliasing checks on parameters)
456
457 when 'A' =>
458 Ptr := Ptr + 1;
459 Check_Aliasing_Of_Parameters := True;
460
461 -- -gnatec (configuration pragmas)
462
463 when 'c' =>
464 Store_Switch := False;
465 Ptr := Ptr + 1;
466
467 -- There may be an equal sign between -gnatec and
468 -- the path name of the config file.
469
470 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
471 Ptr := Ptr + 1;
472 end if;
473
474 if Ptr > Max then
475 Bad_Switch ("-gnatec");
476 end if;
477
478 declare
479 Config_File_Name : constant String_Access :=
480 new String'
481 (Switch_Chars (Ptr .. Max));
482
483 begin
484 if Config_File_Names = null then
485 Config_File_Names :=
486 new String_List'(1 => Config_File_Name);
487
488 else
489 declare
490 New_Names : constant String_List_Access :=
491 new String_List
492 (1 ..
493 Config_File_Names'Length + 1);
494
495 begin
496 for Index in Config_File_Names'Range loop
497 New_Names (Index) :=
498 Config_File_Names (Index);
499 Config_File_Names (Index) := null;
500 end loop;
501
502 New_Names (New_Names'Last) := Config_File_Name;
503 Free (Config_File_Names);
504 Config_File_Names := New_Names;
505 end;
506 end if;
507 end;
508
509 return;
510
511 -- -gnateC switch (generate CodePeer messages)
512
513 when 'C' =>
514 Ptr := Ptr + 1;
515 Generate_CodePeer_Messages := True;
516
517 -- -gnated switch (disable atomic synchronization)
518
519 when 'd' =>
520 Suppress_Options.Suppress (Atomic_Synchronization) :=
521 True;
522
523 -- -gnateD switch (preprocessing symbol definition)
524
525 when 'D' =>
526 Store_Switch := False;
527 Ptr := Ptr + 1;
528
529 if Ptr > Max then
530 Bad_Switch ("-gnateD");
531 end if;
532
533 Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
534
535 -- Store the switch
536
537 Store_Compilation_Switch
538 ("-gnateD" & Switch_Chars (Ptr .. Max));
539 Ptr := Max + 1;
540
541 -- -gnateE (extra exception information)
542
543 when 'E' =>
544 Exception_Extra_Info := True;
545 Ptr := Ptr + 1;
546
547 -- -gnatef (full source path for brief error messages)
548
549 when 'f' =>
550 Store_Switch := False;
551 Ptr := Ptr + 1;
552 Full_Path_Name_For_Brief_Errors := True;
553
554 -- -gnateF (Check_Float_Overflow)
555
556 when 'F' =>
557 Ptr := Ptr + 1;
558 Check_Float_Overflow := True;
559
560 -- -gnateG (save preprocessor output)
561
562 when 'G' =>
563 Generate_Processed_File := True;
564 Ptr := Ptr + 1;
565
566 -- -gnatei (max number of instantiations)
567
568 when 'i' =>
569 Ptr := Ptr + 1;
570 Scan_Pos
571 (Switch_Chars, Max, Ptr, Maximum_Instantiations, C);
572
573 -- -gnateI (index of unit in multi-unit source)
574
575 when 'I' =>
576 Ptr := Ptr + 1;
577 Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index, C);
578
579 -- -gnatel
580
581 when 'l' =>
582 Ptr := Ptr + 1;
583 Elab_Info_Messages := True;
584
585 -- -gnateL
586
587 when 'L' =>
588 Ptr := Ptr + 1;
589 Elab_Info_Messages := False;
590
591 -- -gnatem (mapping file)
592
593 when 'm' =>
594 Store_Switch := False;
595 Ptr := Ptr + 1;
596
597 -- There may be an equal sign between -gnatem and
598 -- the path name of the mapping file.
599
600 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
601 Ptr := Ptr + 1;
602 end if;
603
604 if Ptr > Max then
605 Bad_Switch ("-gnatem");
606 end if;
607
608 Mapping_File_Name :=
609 new String'(Switch_Chars (Ptr .. Max));
610 return;
611
612 -- -gnateO= (object path file)
613
614 -- This is an internal switch
615
616 when 'O' =>
617 Store_Switch := False;
618 Ptr := Ptr + 1;
619
620 -- Check for '='
621
622 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
623 Bad_Switch ("-gnateO");
624 else
625 Object_Path_File_Name :=
626 new String'(Switch_Chars (Ptr + 1 .. Max));
627 end if;
628
629 return;
630
631 -- -gnatep (preprocessing data file)
632
633 when 'p' =>
634 Store_Switch := False;
635 Ptr := Ptr + 1;
636
637 -- There may be an equal sign between -gnatep and
638 -- the path name of the mapping file.
639
640 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
641 Ptr := Ptr + 1;
642 end if;
643
644 if Ptr > Max then
645 Bad_Switch ("-gnatep");
646 end if;
647
648 Preprocessing_Data_File :=
649 new String'(Switch_Chars (Ptr .. Max));
650
651 -- Store the switch, normalizing to -gnatep=
652
653 Store_Compilation_Switch
654 ("-gnatep=" & Preprocessing_Data_File.all);
655
656 Ptr := Max + 1;
657
658 -- -gnateP (Treat pragma Pure/Preelaborate errs as warnings)
659
660 when 'P' =>
661 Treat_Categorization_Errors_As_Warnings := True;
662
663 -- -gnates=file (specify extra file switches for gnat2why)
664
665 -- This is an internal switch
666
667 when 's' =>
668 if not First_Switch then
669 Osint.Fail
670 ("-gnates must not be combined with other switches");
671 end if;
672
673 -- Check for '='
674
675 Ptr := Ptr + 1;
676
677 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
678 Bad_Switch ("-gnates");
679 else
680 SPARK_Switches_File_Name :=
681 new String'(Switch_Chars (Ptr + 1 .. Max));
682 end if;
683
684 return;
685
686 -- -gnateS (generate SCO information)
687
688 -- Include Source Coverage Obligation information in ALI
689 -- files for use by source coverage analysis tools
690 -- (gnatcov) (equivalent to -fdump-scos, provided for
691 -- backwards compatibility).
692
693 when 'S' =>
694 Generate_SCO := True;
695 Generate_SCO_Instance_Table := True;
696 Ptr := Ptr + 1;
697
698 -- -gnatet (write target dependent information)
699
700 when 't' =>
701 if not First_Switch then
702 Osint.Fail
703 ("-gnatet must not be combined with other switches");
704 end if;
705
706 -- Check for '='
707
708 Ptr := Ptr + 1;
709
710 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
711 Bad_Switch ("-gnatet");
712 else
713 Target_Dependent_Info_Write_Name :=
714 new String'(Switch_Chars (Ptr + 1 .. Max));
715 end if;
716
717 return;
718
719 -- -gnateT (read target dependent information)
720
721 when 'T' =>
722 if not First_Switch then
723 Osint.Fail
724 ("-gnateT must not be combined with other switches");
725 end if;
726
727 -- Check for '='
728
729 Ptr := Ptr + 1;
730
731 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
732 Bad_Switch ("-gnateT");
733 else
734 -- This parameter was stored by Set_Targ earlier
735
736 pragma Assert
737 (Target_Dependent_Info_Read_Name.all =
738 Switch_Chars (Ptr + 1 .. Max));
739 null;
740 end if;
741
742 return;
743
744 -- -gnateu (unrecognized y,V,w switches)
745
746 when 'u' =>
747 Ptr := Ptr + 1;
748 Ignore_Unrecognized_VWY_Switches := True;
749
750 -- -gnateV (validity checks on parameters)
751
752 when 'V' =>
753 Ptr := Ptr + 1;
754 Check_Validity_Of_Parameters := True;
755
756 -- -gnateY (ignore Style_Checks pragmas)
757
758 when 'Y' =>
759 Ignore_Style_Checks_Pragmas := True;
760 Ptr := Ptr + 1;
761
762 -- -gnatez (final delimiter of explicit switches)
763
764 -- This is an internal switch
765
766 -- All switches that come after -gnatez have been added by
767 -- the GCC driver and are not stored in the ALI file. See
768 -- also -gnatea above.
769
770 when 'z' =>
771 Store_Switch := False;
772 Disable_Switch_Storing;
773 Ptr := Ptr + 1;
774
775 -- All other -gnate? switches are unassigned
776
777 when others =>
778 Bad_Switch ("-gnate" & Switch_Chars (Ptr .. Max));
779 end case;
780
781 -- -gnatE (dynamic elaboration checks)
782
783 when 'E' =>
784 Ptr := Ptr + 1;
785 Dynamic_Elaboration_Checks := True;
786
787 -- -gnatf (full error messages)
788
789 when 'f' =>
790 Ptr := Ptr + 1;
791 All_Errors_Mode := True;
792
793 -- -gnatF (overflow of predefined float types)
794
795 when 'F' =>
796 Ptr := Ptr + 1;
797 External_Name_Exp_Casing := Uppercase;
798 External_Name_Imp_Casing := Uppercase;
799
800 -- -gnatg (GNAT implementation mode)
801
802 when 'g' =>
803 Ptr := Ptr + 1;
804 GNAT_Mode := True;
805 Identifier_Character_Set := 'n';
806 System_Extend_Unit := Empty;
807 Warning_Mode := Treat_As_Error;
808 Style_Check_Main := True;
809 Ada_Version := Ada_2012;
810 Ada_Version_Explicit := Ada_2012;
811 Ada_Version_Pragma := Empty;
812
813 -- Set default warnings and style checks for -gnatg
814
815 Set_GNAT_Mode_Warnings;
816 Set_GNAT_Style_Check_Options;
817
818 -- -gnatG (output generated code)
819
820 when 'G' =>
821 Ptr := Ptr + 1;
822 Print_Generated_Code := True;
823
824 -- Scan optional integer line limit value
825
826 if Nat_Present (Switch_Chars, Max, Ptr) then
827 Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'G');
828 Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
829 end if;
830
831 -- -gnath (help information)
832
833 when 'h' =>
834 Ptr := Ptr + 1;
835 Usage_Requested := True;
836
837 -- -gnati (character set)
838
839 when 'i' =>
840 if Ptr = Max then
841 Bad_Switch ("-gnati");
842 end if;
843
844 Ptr := Ptr + 1;
845 C := Switch_Chars (Ptr);
846
847 if C in '1' .. '5'
848 or else C = '8'
849 or else C = '9'
850 or else C = 'p'
851 or else C = 'f'
852 or else C = 'n'
853 or else C = 'w'
854 then
855 Identifier_Character_Set := C;
856 Ptr := Ptr + 1;
857
858 else
859 Bad_Switch ("-gnati" & Switch_Chars (Ptr .. Max));
860 end if;
861
862 -- -gnatI (ignore representation clauses)
863
864 when 'I' =>
865 Ptr := Ptr + 1;
866 Ignore_Rep_Clauses := True;
867
868 -- -gnatj (messages in limited length lines)
869
870 when 'j' =>
871 Ptr := Ptr + 1;
872 Scan_Nat (Switch_Chars, Max, Ptr, Error_Msg_Line_Length, C);
873
874 -- -gnatk (limit file name length)
875
876 when 'k' =>
877 Ptr := Ptr + 1;
878 Scan_Pos
879 (Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C);
880
881 -- -gnatl (output full source)
882
883 when 'l' =>
884 Ptr := Ptr + 1;
885 Full_List := True;
886
887 -- There may be an equal sign between -gnatl and a file name
888
889 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
890 if Ptr = Max then
891 Osint.Fail ("file name for -gnatl= is null");
892 else
893 Opt.Full_List_File_Name :=
894 new String'(Switch_Chars (Ptr + 1 .. Max));
895 Ptr := Max + 1;
896 end if;
897 end if;
898
899 -- -gnatL (corresponding source text)
900
901 when 'L' =>
902 Ptr := Ptr + 1;
903 Dump_Source_Text := True;
904
905 -- -gnatm (max number or errors/warnings)
906
907 when 'm' =>
908 Ptr := Ptr + 1;
909 Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Messages, C);
910
911 -- -gnatn (enable pragma Inline)
912
913 when 'n' =>
914 Ptr := Ptr + 1;
915 Inline_Active := True;
916
917 -- There may be a digit (1 or 2) appended to the switch
918
919 if Ptr <= Max then
920 C := Switch_Chars (Ptr);
921
922 if C in '1' .. '2' then
923 Ptr := Ptr + 1;
924 Inline_Level := Character'Pos (C) - Character'Pos ('0');
925 end if;
926 end if;
927
928 -- -gnatN (obsolescent)
929
930 when 'N' =>
931 Ptr := Ptr + 1;
932 Inline_Active := True;
933 Front_End_Inlining := True;
934
935 -- -gnato (overflow checks)
936
937 when 'o' =>
938 Ptr := Ptr + 1;
939 Suppress_Options.Suppress (Overflow_Check) := False;
940
941 -- Case of no digits after the -gnato
942
943 if Ptr > Max or else Switch_Chars (Ptr) not in '1' .. '3' then
944 Suppress_Options.Overflow_Mode_General := Strict;
945 Suppress_Options.Overflow_Mode_Assertions := Strict;
946
947 -- At least one digit after the -gnato
948
949 else
950 -- Handle first digit after -gnato
951
952 Suppress_Options.Overflow_Mode_General :=
953 Get_Overflow_Mode (Switch_Chars (Ptr));
954 Ptr := Ptr + 1;
955
956 -- Only one digit after -gnato, set assertions mode to
957 -- be the same as general mode.
958
959 if Ptr > Max
960 or else Switch_Chars (Ptr) not in '1' .. '3'
961 then
962 Suppress_Options.Overflow_Mode_Assertions :=
963 Suppress_Options.Overflow_Mode_General;
964
965 -- Process second digit after -gnato
966
967 else
968 Suppress_Options.Overflow_Mode_Assertions :=
969 Get_Overflow_Mode (Switch_Chars (Ptr));
970 Ptr := Ptr + 1;
971 end if;
972 end if;
973
974 -- -gnatO (specify name of the object file)
975
976 -- This is an internal switch
977
978 when 'O' =>
979 Store_Switch := False;
980 Ptr := Ptr + 1;
981 Output_File_Name_Present := True;
982
983 -- -gnatp (suppress all checks)
984
985 when 'p' =>
986 Ptr := Ptr + 1;
987
988 -- Skip processing if cancelled by subsequent -gnat-p
989
990 if Switch_Subsequently_Cancelled ("p", Args, Arg_Rank) then
991 Store_Switch := False;
992
993 else
994 -- Set all specific options as well as All_Checks in the
995 -- Suppress_Options array, excluding Elaboration_Check,
996 -- since this is treated specially because we do not want
997 -- -gnatp to disable static elaboration processing. Also
998 -- exclude Atomic_Synchronization, since this is not a real
999 -- check.
1000
1001 for J in Suppress_Options.Suppress'Range loop
1002 if J /= Elaboration_Check
1003 and then
1004 J /= Atomic_Synchronization
1005 then
1006 Suppress_Options.Suppress (J) := True;
1007 end if;
1008 end loop;
1009
1010 Validity_Checks_On := False;
1011 Opt.Suppress_Checks := True;
1012 end if;
1013
1014 -- -gnatP (periodic poll)
1015
1016 when 'P' =>
1017 Ptr := Ptr + 1;
1018 Polling_Required := True;
1019
1020 -- -gnatq (don't quit)
1021
1022 when 'q' =>
1023 Ptr := Ptr + 1;
1024 Try_Semantics := True;
1025
1026 -- -gnatQ (always write ALI file)
1027
1028 when 'Q' =>
1029 Ptr := Ptr + 1;
1030 Force_ALI_Tree_File := True;
1031 Try_Semantics := True;
1032
1033 -- -gnatr (restrictions as warnings)
1034
1035 when 'r' =>
1036 Ptr := Ptr + 1;
1037 Treat_Restrictions_As_Warnings := True;
1038
1039 -- -gnatR (list rep. info)
1040
1041 when 'R' =>
1042
1043 -- Not allowed if previous -gnatD given. See more extensive
1044 -- comments in the 'D' section for the inverse test.
1045
1046 if Debug_Generated_Code then
1047 Osint.Fail
1048 ("-gnatR not permitted since -gnatD given previously");
1049 end if;
1050
1051 -- Set to annotate rep info, and set default -gnatR mode
1052
1053 Back_Annotate_Rep_Info := True;
1054 List_Representation_Info := 1;
1055
1056 -- Scan possible parameter
1057
1058 Ptr := Ptr + 1;
1059 while Ptr <= Max loop
1060 C := Switch_Chars (Ptr);
1061
1062 if C in '1' .. '3' then
1063 List_Representation_Info :=
1064 Character'Pos (C) - Character'Pos ('0');
1065
1066 elsif Switch_Chars (Ptr) = 's' then
1067 List_Representation_Info_To_File := True;
1068
1069 elsif Switch_Chars (Ptr) = 'm' then
1070 List_Representation_Info_Mechanisms := True;
1071
1072 else
1073 Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max));
1074 end if;
1075
1076 Ptr := Ptr + 1;
1077 end loop;
1078
1079 -- -gnats (syntax check only)
1080
1081 when 's' =>
1082 if not First_Switch then
1083 Osint.Fail
1084 ("-gnats must be first if combined with other switches");
1085 end if;
1086
1087 Ptr := Ptr + 1;
1088 Operating_Mode := Check_Syntax;
1089
1090 -- -gnatS (print package Standard)
1091
1092 when 'S' =>
1093 Print_Standard := True;
1094 Ptr := Ptr + 1;
1095
1096 -- -gnatt (output tree)
1097
1098 when 't' =>
1099 Ptr := Ptr + 1;
1100 Tree_Output := True;
1101 Back_Annotate_Rep_Info := True;
1102
1103 -- -gnatT (change start of internal table sizes)
1104
1105 when 'T' =>
1106 Ptr := Ptr + 1;
1107 Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C);
1108
1109 -- -gnatu (list units for compilation)
1110
1111 when 'u' =>
1112 Ptr := Ptr + 1;
1113 List_Units := True;
1114
1115 -- -gnatU (unique tags)
1116
1117 when 'U' =>
1118 Ptr := Ptr + 1;
1119 Unique_Error_Tag := True;
1120
1121 -- -gnatv (verbose mode)
1122
1123 when 'v' =>
1124 Ptr := Ptr + 1;
1125 Verbose_Mode := True;
1126
1127 -- -gnatV (validity checks)
1128
1129 when 'V' =>
1130 Store_Switch := False;
1131 Ptr := Ptr + 1;
1132
1133 if Ptr > Max then
1134 Bad_Switch ("-gnatV");
1135
1136 else
1137 declare
1138 OK : Boolean;
1139
1140 begin
1141 Set_Validity_Check_Options
1142 (Switch_Chars (Ptr .. Max), OK, Ptr);
1143
1144 if not OK then
1145 Bad_Switch ("-gnatV" & Switch_Chars (Ptr .. Max));
1146 end if;
1147
1148 for Index in First_Char + 1 .. Max loop
1149 Store_Compilation_Switch
1150 ("-gnatV" & Switch_Chars (Index));
1151 end loop;
1152 end;
1153 end if;
1154
1155 Ptr := Max + 1;
1156
1157 -- -gnatw (warning modes)
1158
1159 when 'w' =>
1160 Store_Switch := False;
1161 Ptr := Ptr + 1;
1162
1163 if Ptr > Max then
1164 Bad_Switch ("-gnatw");
1165 end if;
1166
1167 while Ptr <= Max loop
1168 C := Switch_Chars (Ptr);
1169
1170 -- Case of dot switch
1171
1172 if C = '.' and then Ptr < Max then
1173 Ptr := Ptr + 1;
1174 C := Switch_Chars (Ptr);
1175
1176 if Set_Dot_Warning_Switch (C) then
1177 Store_Compilation_Switch ("-gnatw." & C);
1178 else
1179 Bad_Switch ("-gnatw." & Switch_Chars (Ptr .. Max));
1180 end if;
1181
1182 -- Normal case, no dot
1183
1184 else
1185 if Set_Warning_Switch (C) then
1186 Store_Compilation_Switch ("-gnatw" & C);
1187 else
1188 Bad_Switch ("-gnatw" & Switch_Chars (Ptr .. Max));
1189 end if;
1190 end if;
1191
1192 Ptr := Ptr + 1;
1193 end loop;
1194
1195 return;
1196
1197 -- -gnatW (wide character encoding method)
1198
1199 when 'W' =>
1200 Ptr := Ptr + 1;
1201
1202 if Ptr > Max then
1203 Bad_Switch ("-gnatW");
1204 end if;
1205
1206 begin
1207 Wide_Character_Encoding_Method :=
1208 Get_WC_Encoding_Method (Switch_Chars (Ptr));
1209 exception
1210 when Constraint_Error =>
1211 Bad_Switch ("-gnatW" & Switch_Chars (Ptr .. Max));
1212 end;
1213
1214 Wide_Character_Encoding_Method_Specified := True;
1215
1216 Upper_Half_Encoding :=
1217 Wide_Character_Encoding_Method in
1218 WC_Upper_Half_Encoding_Method;
1219
1220 Ptr := Ptr + 1;
1221
1222 -- -gnatx (suppress cross-ref information)
1223
1224 when 'x' =>
1225 Ptr := Ptr + 1;
1226 Xref_Active := False;
1227
1228 -- -gnatX (language extensions)
1229
1230 when 'X' =>
1231 Ptr := Ptr + 1;
1232 Extensions_Allowed := True;
1233 Ada_Version := Ada_Version_Type'Last;
1234 Ada_Version_Explicit := Ada_Version_Type'Last;
1235 Ada_Version_Pragma := Empty;
1236
1237 -- -gnaty (style checks)
1238
1239 when 'y' =>
1240 Ptr := Ptr + 1;
1241 Style_Check_Main := True;
1242
1243 if Ptr > Max then
1244 Set_Default_Style_Check_Options;
1245
1246 else
1247 Store_Switch := False;
1248
1249 declare
1250 OK : Boolean;
1251
1252 begin
1253 Set_Style_Check_Options
1254 (Switch_Chars (Ptr .. Max), OK, Ptr);
1255
1256 if not OK then
1257 Osint.Fail
1258 ("bad -gnaty switch (" &
1259 Style_Msg_Buf (1 .. Style_Msg_Len) & ')');
1260 end if;
1261
1262 Ptr := First_Char + 1;
1263 while Ptr <= Max loop
1264 if Switch_Chars (Ptr) = 'M' then
1265 First_Char := Ptr;
1266 loop
1267 Ptr := Ptr + 1;
1268 exit when Ptr > Max
1269 or else Switch_Chars (Ptr) not in '0' .. '9';
1270 end loop;
1271
1272 Store_Compilation_Switch
1273 ("-gnaty" & Switch_Chars (First_Char .. Ptr - 1));
1274
1275 else
1276 Store_Compilation_Switch
1277 ("-gnaty" & Switch_Chars (Ptr));
1278 Ptr := Ptr + 1;
1279 end if;
1280 end loop;
1281 end;
1282 end if;
1283
1284 -- -gnatz (stub generation)
1285
1286 when 'z' =>
1287
1288 -- -gnatz must be the first and only switch in Switch_Chars,
1289 -- and is a two-letter switch.
1290
1291 if Ptr /= Switch_Chars'First + 5
1292 or else (Max - Ptr + 1) > 2
1293 then
1294 Osint.Fail
1295 ("-gnatz* may not be combined with other switches");
1296 end if;
1297
1298 if Ptr = Max then
1299 Bad_Switch ("-gnatz");
1300 end if;
1301
1302 Ptr := Ptr + 1;
1303
1304 -- Only one occurrence of -gnat* is permitted
1305
1306 if Distribution_Stub_Mode = No_Stubs then
1307 case Switch_Chars (Ptr) is
1308 when 'r' =>
1309 Distribution_Stub_Mode := Generate_Receiver_Stub_Body;
1310
1311 when 'c' =>
1312 Distribution_Stub_Mode := Generate_Caller_Stub_Body;
1313
1314 when others =>
1315 Bad_Switch ("-gnatz" & Switch_Chars (Ptr .. Max));
1316 end case;
1317
1318 Ptr := Ptr + 1;
1319
1320 else
1321 Osint.Fail ("only one -gnatz* switch allowed");
1322 end if;
1323
1324 -- -gnatZ (obsolescent)
1325
1326 when 'Z' =>
1327 Ptr := Ptr + 1;
1328 Osint.Fail
1329 ("-gnatZ is no longer supported: consider using --RTS=zcx");
1330
1331 -- Note on language version switches: whenever a new language
1332 -- version switch is added, Switch.M.Normalize_Compiler_Switches
1333 -- must be updated.
1334
1335 -- -gnat83
1336
1337 when '8' =>
1338 if Ptr = Max then
1339 Bad_Switch ("-gnat8");
1340 end if;
1341
1342 Ptr := Ptr + 1;
1343
1344 if Switch_Chars (Ptr) /= '3' then
1345 Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max));
1346 else
1347 Ptr := Ptr + 1;
1348 Ada_Version := Ada_83;
1349 Ada_Version_Explicit := Ada_83;
1350 Ada_Version_Pragma := Empty;
1351 end if;
1352
1353 -- -gnat95
1354
1355 when '9' =>
1356 if Ptr = Max then
1357 Bad_Switch ("-gnat9");
1358 end if;
1359
1360 Ptr := Ptr + 1;
1361
1362 if Switch_Chars (Ptr) /= '5' then
1363 Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max));
1364 else
1365 Ptr := Ptr + 1;
1366 Ada_Version := Ada_95;
1367 Ada_Version_Explicit := Ada_95;
1368 Ada_Version_Pragma := Empty;
1369 end if;
1370
1371 -- -gnat05
1372
1373 when '0' =>
1374 if Ptr = Max then
1375 Bad_Switch ("-gnat0");
1376 end if;
1377
1378 Ptr := Ptr + 1;
1379
1380 if Switch_Chars (Ptr) /= '5' then
1381 Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max));
1382 else
1383 Ptr := Ptr + 1;
1384 Ada_Version := Ada_2005;
1385 Ada_Version_Explicit := Ada_2005;
1386 Ada_Version_Pragma := Empty;
1387 end if;
1388
1389 -- -gnat12
1390
1391 when '1' =>
1392 if Ptr = Max then
1393 Bad_Switch ("-gnat1");
1394 end if;
1395
1396 Ptr := Ptr + 1;
1397
1398 if Switch_Chars (Ptr) /= '2' then
1399 Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max));
1400 else
1401 Ptr := Ptr + 1;
1402 Ada_Version := Ada_2012;
1403 Ada_Version_Explicit := Ada_2012;
1404 Ada_Version_Pragma := Empty;
1405 end if;
1406
1407 -- -gnat2005 and -gnat2012
1408
1409 when '2' =>
1410 if Ptr > Max - 3 then
1411 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
1412
1413 elsif Switch_Chars (Ptr .. Ptr + 3) = "2005" then
1414 Ada_Version := Ada_2005;
1415
1416 elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then
1417 Ada_Version := Ada_2012;
1418
1419 else
1420 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3));
1421 end if;
1422
1423 Ada_Version_Explicit := Ada_Version;
1424 Ada_Version_Pragma := Empty;
1425 Ptr := Ptr + 4;
1426
1427 -- Switch cancellation, currently only -gnat-p is allowed.
1428 -- All we do here is the error checking, since the actual
1429 -- processing for switch cancellation is done by calls to
1430 -- Switch_Subsequently_Cancelled at the appropriate point.
1431
1432 when '-' =>
1433
1434 -- Simple ignore -gnat-p
1435
1436 if Switch_Chars = "-gnat-p" then
1437 return;
1438
1439 -- Any other occurrence of minus is ignored. This is for
1440 -- maximum compatibility with previous version which ignored
1441 -- all occurrences of minus.
1442
1443 else
1444 Store_Switch := False;
1445 Ptr := Ptr + 1;
1446 end if;
1447
1448 -- We ignore '/' in switches, this is historical, still needed???
1449
1450 when '/' =>
1451 Store_Switch := False;
1452
1453 -- Anything else is an error (illegal switch character)
1454
1455 when others =>
1456 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
1457 end case;
1458
1459 if Store_Switch then
1460 Store_Compilation_Switch
1461 ("-gnat" & Switch_Chars (First_Char .. Ptr - 1));
1462 end if;
1463
1464 First_Switch := False;
1465 end loop;
1466 end if;
1467 end Scan_Front_End_Switches;
1468
1469 -----------------------------------
1470 -- Switch_Subsequently_Cancelled --
1471 -----------------------------------
1472
1473 function Switch_Subsequently_Cancelled
1474 (C : String;
1475 Args : String_List;
1476 Arg_Rank : Positive) return Boolean
1477 is
1478 begin
1479 -- Loop through arguments following the current one
1480
1481 for Arg in Arg_Rank + 1 .. Args'Last loop
1482 if Args (Arg).all = "-gnat-" & C then
1483 return True;
1484 end if;
1485 end loop;
1486
1487 -- No match found, not cancelled
1488
1489 return False;
1490 end Switch_Subsequently_Cancelled;
1491
1492 end Switch.C;