[multiple changes]
[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-2013, 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 -- Not allowed if previous -gnatR given
314
315 if List_Representation_Info /= 0
316 or else List_Representation_Info_Mechanisms
317 then
318 Osint.Fail
319 ("-gnatc not allowed since -gnatR given previously");
320 end if;
321
322 Ptr := Ptr + 1;
323 Operating_Mode := Check_Semantics;
324
325 -- -gnatC (Generate CodePeer information)
326
327 when 'C' =>
328 Ptr := Ptr + 1;
329
330 if not CodePeer_Mode then
331 CodePeer_Mode := True;
332
333 -- Suppress compiler warnings by default, since what we are
334 -- interested in here is what CodePeer can find out. Note
335 -- that if -gnatwxxx is specified after -gnatC on the
336 -- command line, we do not want to override this setting in
337 -- Adjust_Global_Switches, and assume that the user wants to
338 -- get both warnings from GNAT and CodePeer messages.
339
340 Warning_Mode := Suppress;
341 end if;
342
343 -- -gnatd (compiler debug options)
344
345 when 'd' =>
346 Store_Switch := False;
347 Dot := False;
348 First_Ptr := Ptr + 1;
349
350 -- Note: for the debug switch, the remaining characters in this
351 -- switch field must all be debug flags, since all valid switch
352 -- characters are also valid debug characters.
353
354 -- Loop to scan out debug flags
355
356 while Ptr < Max loop
357 Ptr := Ptr + 1;
358 C := Switch_Chars (Ptr);
359 exit when C = ASCII.NUL or else C = '/' or else C = '-';
360
361 if C in '1' .. '9' or else
362 C in 'a' .. 'z' or else
363 C in 'A' .. 'Z'
364 then
365 -- Case of dotted flag
366
367 if Dot then
368 Set_Dotted_Debug_Flag (C);
369 Store_Compilation_Switch ("-gnatd." & C);
370
371 -- Special check, -gnatd.b must come first
372
373 if C = 'b'
374 and then (Ptr /= First_Ptr + 1
375 or else not First_Switch)
376 then
377 Osint.Fail
378 ("-gnatd.b must be first if combined "
379 & "with other switches");
380 end if;
381
382 -- Not a dotted flag
383
384 else
385 Set_Debug_Flag (C);
386 Store_Compilation_Switch ("-gnatd" & C);
387 end if;
388
389 elsif C = '.' then
390 Dot := True;
391
392 elsif Dot then
393 Bad_Switch ("-gnatd." & Switch_Chars (Ptr .. Max));
394 else
395 Bad_Switch ("-gnatd" & Switch_Chars (Ptr .. Max));
396 end if;
397 end loop;
398
399 return;
400
401 -- -gnatD (debug expanded code)
402
403 when 'D' =>
404 Ptr := Ptr + 1;
405
406 -- Not allowed if previous -gnatR given
407
408 -- The reason for this prohibition is that the rewriting of
409 -- Sloc values causes strange malfunctions in the tests of
410 -- whether units belong to the main source. This is really a
411 -- bug, but too hard to fix for a marginal capability ???
412
413 -- The proper fix is to completely redo -gnatD processing so
414 -- that the tree is not messed with, and instead a separate
415 -- table is built on the side for debug information generation.
416
417 if List_Representation_Info /= 0 then
418 Osint.Fail
419 ("-gnatD not permitted since -gnatR given previously");
420 end if;
421
422 -- Scan optional integer line limit value
423
424 if Nat_Present (Switch_Chars, Max, Ptr) then
425 Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'D');
426 Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
427 end if;
428
429 -- Note: -gnatD also sets -gnatx (to turn off cross-reference
430 -- generation in the ali file) since otherwise this generation
431 -- gets confused by the "wrong" Sloc values put in the tree.
432
433 Debug_Generated_Code := True;
434 Xref_Active := False;
435 Set_Debug_Flag ('g');
436
437 -- -gnate? (extended switches)
438
439 when 'e' =>
440 Ptr := Ptr + 1;
441
442 -- The -gnate? switches are all double character switches
443 -- so we must always have a character after the e.
444
445 if Ptr > Max then
446 Bad_Switch ("-gnate");
447 end if;
448
449 case Switch_Chars (Ptr) is
450
451 -- -gnatea (initial delimiter of explicit switches)
452
453 -- This is an internal switch
454
455 -- All switches that come before -gnatea have been added by
456 -- the GCC driver and are not stored in the ALI file.
457 -- See also -gnatez below.
458
459 when 'a' =>
460 Store_Switch := False;
461 Enable_Switch_Storing;
462 Ptr := Ptr + 1;
463
464 -- -gnateA (aliasing checks on parameters)
465
466 when 'A' =>
467 Ptr := Ptr + 1;
468 Check_Aliasing_Of_Parameters := True;
469
470 -- -gnatec (configuration pragmas)
471
472 when 'c' =>
473 Store_Switch := False;
474 Ptr := Ptr + 1;
475
476 -- There may be an equal sign between -gnatec and
477 -- the path name of the config file.
478
479 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
480 Ptr := Ptr + 1;
481 end if;
482
483 if Ptr > Max then
484 Bad_Switch ("-gnatec");
485 end if;
486
487 declare
488 Config_File_Name : constant String_Access :=
489 new String'
490 (Switch_Chars (Ptr .. Max));
491
492 begin
493 if Config_File_Names = null then
494 Config_File_Names :=
495 new String_List'(1 => Config_File_Name);
496
497 else
498 declare
499 New_Names : constant String_List_Access :=
500 new String_List
501 (1 ..
502 Config_File_Names'Length + 1);
503
504 begin
505 for Index in Config_File_Names'Range loop
506 New_Names (Index) :=
507 Config_File_Names (Index);
508 Config_File_Names (Index) := null;
509 end loop;
510
511 New_Names (New_Names'Last) := Config_File_Name;
512 Free (Config_File_Names);
513 Config_File_Names := New_Names;
514 end;
515 end if;
516 end;
517
518 return;
519
520 -- -gnateC switch (CodePeer SCIL generation)
521
522 -- Not enabled for now, keep it for later???
523 -- use -gnatd.I only for now
524
525 -- when 'C' =>
526 -- Ptr := Ptr + 1;
527 -- Generate_SCIL := True;
528
529 -- -gnated switch (disable atomic synchronization)
530
531 when 'd' =>
532 Suppress_Options.Suppress (Atomic_Synchronization) :=
533 True;
534
535 -- -gnateD switch (preprocessing symbol definition)
536
537 when 'D' =>
538 Store_Switch := False;
539 Ptr := Ptr + 1;
540
541 if Ptr > Max then
542 Bad_Switch ("-gnateD");
543 end if;
544
545 Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
546
547 -- Store the switch
548
549 Store_Compilation_Switch
550 ("-gnateD" & Switch_Chars (Ptr .. Max));
551 Ptr := Max + 1;
552
553 -- -gnateE (extra exception information)
554
555 when 'E' =>
556 Exception_Extra_Info := True;
557 Ptr := Ptr + 1;
558
559 -- -gnatef (full source path for brief error messages)
560
561 when 'f' =>
562 Store_Switch := False;
563 Ptr := Ptr + 1;
564 Full_Path_Name_For_Brief_Errors := True;
565
566 -- -gnateF (Check_Float_Overflow)
567
568 when 'F' =>
569 Ptr := Ptr + 1;
570 Check_Float_Overflow := True;
571
572 -- -gnateG (save preprocessor output)
573
574 when 'G' =>
575 Generate_Processed_File := True;
576 Ptr := Ptr + 1;
577
578 -- -gnatei (max number of instantiations)
579
580 when 'i' =>
581 Ptr := Ptr + 1;
582 Scan_Pos
583 (Switch_Chars, Max, Ptr, Maximum_Instantiations, C);
584
585 -- -gnateI (index of unit in multi-unit source)
586
587 when 'I' =>
588 Ptr := Ptr + 1;
589 Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index, C);
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
810 -- Set Ada 2012 mode explicitly. We don't want to rely on the
811 -- implicit setting here, since for example, we want
812 -- Preelaborate_05 treated as Preelaborate
813
814 Ada_Version := Ada_2012;
815 Ada_Version_Explicit := Ada_2012;
816 Ada_Version_Pragma := Empty;
817
818 -- Set default warnings and style checks for -gnatg
819
820 Set_GNAT_Mode_Warnings;
821 Set_GNAT_Style_Check_Options;
822
823 -- -gnatG (output generated code)
824
825 when 'G' =>
826 Ptr := Ptr + 1;
827 Print_Generated_Code := True;
828
829 -- Scan optional integer line limit value
830
831 if Nat_Present (Switch_Chars, Max, Ptr) then
832 Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'G');
833 Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
834 end if;
835
836 -- -gnath (help information)
837
838 when 'h' =>
839 Ptr := Ptr + 1;
840 Usage_Requested := True;
841
842 -- -gnati (character set)
843
844 when 'i' =>
845 if Ptr = Max then
846 Bad_Switch ("-gnati");
847 end if;
848
849 Ptr := Ptr + 1;
850 C := Switch_Chars (Ptr);
851
852 if C in '1' .. '5'
853 or else C = '8'
854 or else C = '9'
855 or else C = 'p'
856 or else C = 'f'
857 or else C = 'n'
858 or else C = 'w'
859 then
860 Identifier_Character_Set := C;
861 Ptr := Ptr + 1;
862
863 else
864 Bad_Switch ("-gnati" & Switch_Chars (Ptr .. Max));
865 end if;
866
867 -- -gnatI (ignore representation clauses)
868
869 when 'I' =>
870 Ptr := Ptr + 1;
871 Ignore_Rep_Clauses := True;
872
873 -- -gnatj (messages in limited length lines)
874
875 when 'j' =>
876 Ptr := Ptr + 1;
877 Scan_Nat (Switch_Chars, Max, Ptr, Error_Msg_Line_Length, C);
878
879 -- -gnatk (limit file name length)
880
881 when 'k' =>
882 Ptr := Ptr + 1;
883 Scan_Pos
884 (Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C);
885
886 -- -gnatl (output full source)
887
888 when 'l' =>
889 Ptr := Ptr + 1;
890 Full_List := True;
891
892 -- There may be an equal sign between -gnatl and a file name
893
894 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
895 if Ptr = Max then
896 Osint.Fail ("file name for -gnatl= is null");
897 else
898 Opt.Full_List_File_Name :=
899 new String'(Switch_Chars (Ptr + 1 .. Max));
900 Ptr := Max + 1;
901 end if;
902 end if;
903
904 -- -gnatL (corresponding source text)
905
906 when 'L' =>
907 Ptr := Ptr + 1;
908 Dump_Source_Text := True;
909
910 -- -gnatm (max number or errors/warnings)
911
912 when 'm' =>
913 Ptr := Ptr + 1;
914 Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Messages, C);
915
916 -- -gnatn (enable pragma Inline)
917
918 when 'n' =>
919 Ptr := Ptr + 1;
920 Inline_Active := True;
921
922 -- There may be a digit (1 or 2) appended to the switch
923
924 if Ptr <= Max then
925 C := Switch_Chars (Ptr);
926
927 if C in '1' .. '2' then
928 Ptr := Ptr + 1;
929 Inline_Level := Character'Pos (C) - Character'Pos ('0');
930 end if;
931 end if;
932
933 -- -gnatN (obsolescent)
934
935 when 'N' =>
936 Ptr := Ptr + 1;
937 Inline_Active := True;
938 Front_End_Inlining := True;
939
940 -- -gnato (overflow checks)
941
942 when 'o' =>
943 Ptr := Ptr + 1;
944 Suppress_Options.Suppress (Overflow_Check) := False;
945
946 -- Case of no digits after the -gnato
947
948 if Ptr > Max or else Switch_Chars (Ptr) not in '1' .. '3' then
949 Suppress_Options.Overflow_Mode_General := Strict;
950 Suppress_Options.Overflow_Mode_Assertions := Strict;
951
952 -- At least one digit after the -gnato
953
954 else
955 -- Handle first digit after -gnato
956
957 Suppress_Options.Overflow_Mode_General :=
958 Get_Overflow_Mode (Switch_Chars (Ptr));
959 Ptr := Ptr + 1;
960
961 -- Only one digit after -gnato, set assertions mode to
962 -- be the same as general mode.
963
964 if Ptr > Max
965 or else Switch_Chars (Ptr) not in '1' .. '3'
966 then
967 Suppress_Options.Overflow_Mode_Assertions :=
968 Suppress_Options.Overflow_Mode_General;
969
970 -- Process second digit after -gnato
971
972 else
973 Suppress_Options.Overflow_Mode_Assertions :=
974 Get_Overflow_Mode (Switch_Chars (Ptr));
975 Ptr := Ptr + 1;
976 end if;
977 end if;
978
979 -- -gnatO (specify name of the object file)
980
981 -- This is an internal switch
982
983 when 'O' =>
984 Store_Switch := False;
985 Ptr := Ptr + 1;
986 Output_File_Name_Present := True;
987
988 -- -gnatp (suppress all checks)
989
990 when 'p' =>
991 Ptr := Ptr + 1;
992
993 -- Skip processing if cancelled by subsequent -gnat-p
994
995 if Switch_Subsequently_Cancelled ("p", Args, Arg_Rank) then
996 Store_Switch := False;
997
998 else
999 -- Set all specific options as well as All_Checks in the
1000 -- Suppress_Options array, excluding Elaboration_Check,
1001 -- since this is treated specially because we do not want
1002 -- -gnatp to disable static elaboration processing. Also
1003 -- exclude Atomic_Synchronization, since this is not a real
1004 -- check.
1005
1006 for J in Suppress_Options.Suppress'Range loop
1007 if J /= Elaboration_Check
1008 and then
1009 J /= Atomic_Synchronization
1010 then
1011 Suppress_Options.Suppress (J) := True;
1012 end if;
1013 end loop;
1014
1015 Validity_Checks_On := False;
1016 Opt.Suppress_Checks := True;
1017 end if;
1018
1019 -- -gnatP (periodic poll)
1020
1021 when 'P' =>
1022 Ptr := Ptr + 1;
1023 Polling_Required := True;
1024
1025 -- -gnatq (don't quit)
1026
1027 when 'q' =>
1028 Ptr := Ptr + 1;
1029 Try_Semantics := True;
1030
1031 -- -gnatQ (always write ALI file)
1032
1033 when 'Q' =>
1034 Ptr := Ptr + 1;
1035 Force_ALI_Tree_File := True;
1036 Try_Semantics := True;
1037
1038 -- -gnatr (restrictions as warnings)
1039
1040 when 'r' =>
1041 Ptr := Ptr + 1;
1042 Treat_Restrictions_As_Warnings := True;
1043
1044 -- -gnatR (list rep. info)
1045
1046 when 'R' =>
1047
1048 -- Not allowed if previous -gnatD given. See more extensive
1049 -- comments in the 'D' section for the inverse test.
1050
1051 if Debug_Generated_Code then
1052 Osint.Fail
1053 ("-gnatR not permitted since -gnatD given previously");
1054 end if;
1055
1056 -- Not allowed if previous -gnatc was given, since we must
1057 -- call the code generator to determine rep information.
1058
1059 if Operating_Mode = Check_Semantics then
1060 Osint.Fail
1061 ("-gnatR not permitted since -gnatc given previously");
1062 end if;
1063
1064 -- Set to annotate rep info, and set default -gnatR mode
1065
1066 Back_Annotate_Rep_Info := True;
1067 List_Representation_Info := 1;
1068
1069 -- Scan possible parameter
1070
1071 Ptr := Ptr + 1;
1072 while Ptr <= Max loop
1073 C := Switch_Chars (Ptr);
1074
1075 if C in '1' .. '3' then
1076 List_Representation_Info :=
1077 Character'Pos (C) - Character'Pos ('0');
1078
1079 elsif Switch_Chars (Ptr) = 's' then
1080 List_Representation_Info_To_File := True;
1081
1082 elsif Switch_Chars (Ptr) = 'm' then
1083 List_Representation_Info_Mechanisms := True;
1084
1085 else
1086 Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max));
1087 end if;
1088
1089 Ptr := Ptr + 1;
1090 end loop;
1091
1092 -- -gnats (syntax check only)
1093
1094 when 's' =>
1095 if not First_Switch then
1096 Osint.Fail
1097 ("-gnats must be first if combined with other switches");
1098 end if;
1099
1100 Ptr := Ptr + 1;
1101 Operating_Mode := Check_Syntax;
1102
1103 -- -gnatS (print package Standard)
1104
1105 when 'S' =>
1106 Print_Standard := True;
1107 Ptr := Ptr + 1;
1108
1109 -- -gnatt (output tree)
1110
1111 when 't' =>
1112 Ptr := Ptr + 1;
1113 Tree_Output := True;
1114 Back_Annotate_Rep_Info := True;
1115
1116 -- -gnatT (change start of internal table sizes)
1117
1118 when 'T' =>
1119 Ptr := Ptr + 1;
1120 Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C);
1121
1122 -- -gnatu (list units for compilation)
1123
1124 when 'u' =>
1125 Ptr := Ptr + 1;
1126 List_Units := True;
1127
1128 -- -gnatU (unique tags)
1129
1130 when 'U' =>
1131 Ptr := Ptr + 1;
1132 Unique_Error_Tag := True;
1133
1134 -- -gnatv (verbose mode)
1135
1136 when 'v' =>
1137 Ptr := Ptr + 1;
1138 Verbose_Mode := True;
1139
1140 -- -gnatV (validity checks)
1141
1142 when 'V' =>
1143 Store_Switch := False;
1144 Ptr := Ptr + 1;
1145
1146 if Ptr > Max then
1147 Bad_Switch ("-gnatV");
1148
1149 else
1150 declare
1151 OK : Boolean;
1152
1153 begin
1154 Set_Validity_Check_Options
1155 (Switch_Chars (Ptr .. Max), OK, Ptr);
1156
1157 if not OK then
1158 Bad_Switch ("-gnatV" & Switch_Chars (Ptr .. Max));
1159 end if;
1160
1161 for Index in First_Char + 1 .. Max loop
1162 Store_Compilation_Switch
1163 ("-gnatV" & Switch_Chars (Index));
1164 end loop;
1165 end;
1166 end if;
1167
1168 Ptr := Max + 1;
1169
1170 -- -gnatw (warning modes)
1171
1172 when 'w' =>
1173 Store_Switch := False;
1174 Ptr := Ptr + 1;
1175
1176 if Ptr > Max then
1177 Bad_Switch ("-gnatw");
1178 end if;
1179
1180 while Ptr <= Max loop
1181 C := Switch_Chars (Ptr);
1182
1183 -- Case of dot switch
1184
1185 if C = '.' and then Ptr < Max then
1186 Ptr := Ptr + 1;
1187 C := Switch_Chars (Ptr);
1188
1189 if Set_Dot_Warning_Switch (C) then
1190 Store_Compilation_Switch ("-gnatw." & C);
1191 else
1192 Bad_Switch ("-gnatw." & Switch_Chars (Ptr .. Max));
1193 end if;
1194
1195 -- Normal case, no dot
1196
1197 else
1198 if Set_Warning_Switch (C) then
1199 Store_Compilation_Switch ("-gnatw" & C);
1200 else
1201 Bad_Switch ("-gnatw" & Switch_Chars (Ptr .. Max));
1202 end if;
1203 end if;
1204
1205 Ptr := Ptr + 1;
1206 end loop;
1207
1208 return;
1209
1210 -- -gnatW (wide character encoding method)
1211
1212 when 'W' =>
1213 Ptr := Ptr + 1;
1214
1215 if Ptr > Max then
1216 Bad_Switch ("-gnatW");
1217 end if;
1218
1219 begin
1220 Wide_Character_Encoding_Method :=
1221 Get_WC_Encoding_Method (Switch_Chars (Ptr));
1222 exception
1223 when Constraint_Error =>
1224 Bad_Switch ("-gnatW" & Switch_Chars (Ptr .. Max));
1225 end;
1226
1227 Wide_Character_Encoding_Method_Specified := True;
1228
1229 Upper_Half_Encoding :=
1230 Wide_Character_Encoding_Method in
1231 WC_Upper_Half_Encoding_Method;
1232
1233 Ptr := Ptr + 1;
1234
1235 -- -gnatx (suppress cross-ref information)
1236
1237 when 'x' =>
1238 Ptr := Ptr + 1;
1239 Xref_Active := False;
1240
1241 -- -gnatX (language extensions)
1242
1243 when 'X' =>
1244 Ptr := Ptr + 1;
1245 Extensions_Allowed := True;
1246 Ada_Version := Ada_Version_Type'Last;
1247 Ada_Version_Explicit := Ada_Version_Type'Last;
1248 Ada_Version_Pragma := Empty;
1249
1250 -- -gnaty (style checks)
1251
1252 when 'y' =>
1253 Ptr := Ptr + 1;
1254 Style_Check_Main := True;
1255
1256 if Ptr > Max then
1257 Set_Default_Style_Check_Options;
1258
1259 else
1260 Store_Switch := False;
1261
1262 declare
1263 OK : Boolean;
1264
1265 begin
1266 Set_Style_Check_Options
1267 (Switch_Chars (Ptr .. Max), OK, Ptr);
1268
1269 if not OK then
1270 Osint.Fail
1271 ("bad -gnaty switch (" &
1272 Style_Msg_Buf (1 .. Style_Msg_Len) & ')');
1273 end if;
1274
1275 Ptr := First_Char + 1;
1276 while Ptr <= Max loop
1277 if Switch_Chars (Ptr) = 'M' then
1278 First_Char := Ptr;
1279 loop
1280 Ptr := Ptr + 1;
1281 exit when Ptr > Max
1282 or else Switch_Chars (Ptr) not in '0' .. '9';
1283 end loop;
1284
1285 Store_Compilation_Switch
1286 ("-gnaty" & Switch_Chars (First_Char .. Ptr - 1));
1287
1288 else
1289 Store_Compilation_Switch
1290 ("-gnaty" & Switch_Chars (Ptr));
1291 Ptr := Ptr + 1;
1292 end if;
1293 end loop;
1294 end;
1295 end if;
1296
1297 -- -gnatz (stub generation)
1298
1299 when 'z' =>
1300
1301 -- -gnatz must be the first and only switch in Switch_Chars,
1302 -- and is a two-letter switch.
1303
1304 if Ptr /= Switch_Chars'First + 5
1305 or else (Max - Ptr + 1) > 2
1306 then
1307 Osint.Fail
1308 ("-gnatz* may not be combined with other switches");
1309 end if;
1310
1311 if Ptr = Max then
1312 Bad_Switch ("-gnatz");
1313 end if;
1314
1315 Ptr := Ptr + 1;
1316
1317 -- Only one occurrence of -gnat* is permitted
1318
1319 if Distribution_Stub_Mode = No_Stubs then
1320 case Switch_Chars (Ptr) is
1321 when 'r' =>
1322 Distribution_Stub_Mode := Generate_Receiver_Stub_Body;
1323
1324 when 'c' =>
1325 Distribution_Stub_Mode := Generate_Caller_Stub_Body;
1326
1327 when others =>
1328 Bad_Switch ("-gnatz" & Switch_Chars (Ptr .. Max));
1329 end case;
1330
1331 Ptr := Ptr + 1;
1332
1333 else
1334 Osint.Fail ("only one -gnatz* switch allowed");
1335 end if;
1336
1337 -- -gnatZ (obsolescent)
1338
1339 when 'Z' =>
1340 Ptr := Ptr + 1;
1341 Osint.Fail
1342 ("-gnatZ is no longer supported: consider using --RTS=zcx");
1343
1344 -- Note on language version switches: whenever a new language
1345 -- version switch is added, Switch.M.Normalize_Compiler_Switches
1346 -- must be updated.
1347
1348 -- -gnat83
1349
1350 when '8' =>
1351 if Ptr = Max then
1352 Bad_Switch ("-gnat8");
1353 end if;
1354
1355 Ptr := Ptr + 1;
1356
1357 if Switch_Chars (Ptr) /= '3' then
1358 Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max));
1359 else
1360 Ptr := Ptr + 1;
1361 Ada_Version := Ada_83;
1362 Ada_Version_Explicit := Ada_83;
1363 Ada_Version_Pragma := Empty;
1364 end if;
1365
1366 -- -gnat95
1367
1368 when '9' =>
1369 if Ptr = Max then
1370 Bad_Switch ("-gnat9");
1371 end if;
1372
1373 Ptr := Ptr + 1;
1374
1375 if Switch_Chars (Ptr) /= '5' then
1376 Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max));
1377 else
1378 Ptr := Ptr + 1;
1379 Ada_Version := Ada_95;
1380 Ada_Version_Explicit := Ada_95;
1381 Ada_Version_Pragma := Empty;
1382 end if;
1383
1384 -- -gnat05
1385
1386 when '0' =>
1387 if Ptr = Max then
1388 Bad_Switch ("-gnat0");
1389 end if;
1390
1391 Ptr := Ptr + 1;
1392
1393 if Switch_Chars (Ptr) /= '5' then
1394 Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max));
1395 else
1396 Ptr := Ptr + 1;
1397 Ada_Version := Ada_2005;
1398 Ada_Version_Explicit := Ada_2005;
1399 Ada_Version_Pragma := Empty;
1400 end if;
1401
1402 -- -gnat12
1403
1404 when '1' =>
1405 if Ptr = Max then
1406 Bad_Switch ("-gnat1");
1407 end if;
1408
1409 Ptr := Ptr + 1;
1410
1411 if Switch_Chars (Ptr) /= '2' then
1412 Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max));
1413 else
1414 Ptr := Ptr + 1;
1415 Ada_Version := Ada_2012;
1416 Ada_Version_Explicit := Ada_2012;
1417 Ada_Version_Pragma := Empty;
1418 end if;
1419
1420 -- -gnat2005 and -gnat2012
1421
1422 when '2' =>
1423 if Ptr > Max - 3 then
1424 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
1425
1426 elsif Switch_Chars (Ptr .. Ptr + 3) = "2005" then
1427 Ada_Version := Ada_2005;
1428
1429 elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then
1430 Ada_Version := Ada_2012;
1431
1432 else
1433 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3));
1434 end if;
1435
1436 Ada_Version_Explicit := Ada_Version;
1437 Ada_Version_Pragma := Empty;
1438 Ptr := Ptr + 4;
1439
1440 -- Switch cancellation, currently only -gnat-p is allowed.
1441 -- All we do here is the error checking, since the actual
1442 -- processing for switch cancellation is done by calls to
1443 -- Switch_Subsequently_Cancelled at the appropriate point.
1444
1445 when '-' =>
1446
1447 -- Simple ignore -gnat-p
1448
1449 if Switch_Chars = "-gnat-p" then
1450 return;
1451
1452 -- Any other occurrence of minus is ignored. This is for
1453 -- maximum compatibility with previous version which ignored
1454 -- all occurrences of minus.
1455
1456 else
1457 Store_Switch := False;
1458 Ptr := Ptr + 1;
1459 end if;
1460
1461 -- We ignore '/' in switches, this is historical, still needed???
1462
1463 when '/' =>
1464 Store_Switch := False;
1465
1466 -- Anything else is an error (illegal switch character)
1467
1468 when others =>
1469 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
1470 end case;
1471
1472 if Store_Switch then
1473 Store_Compilation_Switch
1474 ("-gnat" & Switch_Chars (First_Char .. Ptr - 1));
1475 end if;
1476
1477 First_Switch := False;
1478 end loop;
1479 end if;
1480 end Scan_Front_End_Switches;
1481
1482 -----------------------------------
1483 -- Switch_Subsequently_Cancelled --
1484 -----------------------------------
1485
1486 function Switch_Subsequently_Cancelled
1487 (C : String;
1488 Args : String_List;
1489 Arg_Rank : Positive) return Boolean
1490 is
1491 begin
1492 -- Loop through arguments following the current one
1493
1494 for Arg in Arg_Rank + 1 .. Args'Last loop
1495 if Args (Arg).all = "-gnat-" & C then
1496 return True;
1497 end if;
1498 end loop;
1499
1500 -- No match found, not cancelled
1501
1502 return False;
1503 end Switch_Subsequently_Cancelled;
1504
1505 end Switch.C;