4ecc031cdb
2006-10-31 Robert Dewar <dewar@adacore.com> * errout.ads, errout.adb (Finalize): Implement switch -gnatd.m Avoid abbreviation Creat (Finalize): List all sources in extended mail source if -gnatl switch is active. Suppress copyright notice to file in -gnatl=f mode if -gnatd7 set (Finalize): Implement new -gnatl=xxx switch to output listing to file (Set_Specific_Warning_On): New procedure (Set_Specific_Warning_Off): New procedure Add implementation of new insertion \\ (Error_Msg_Internal): Add handling for Error_Msg_Line_Length (Unwind_Internal_Type): Improve report on anonymous access_to_subprogram types. (Error_Msg_Internal): Make sure that we set Last_Killed to True when a message from another package is suppressed. Implement insertion character ~ (insert string) (First_Node): Minor adjustments to get better placement. * frontend.adb: Implement new -gnatl=xxx switch to output listing to file * gnat1drv.adb: Implement new -gnatl=xxx switch to output listing to file * opt.ads: (Warn_On_Questionable_Missing_Paren): New switch (Commands_To_Stdout): New flag Implement new -gnatl=xxx switch to output listing to file New switch Dump_Source_Text (Warn_On_Deleted_Code): New warning flag for -gnatwt Define Error_Msg_Line_Length (Warn_On_Assumed_Low_Bound): New switch * osint.ads, osint.adb (Normalize_Directory_Name): Fix bug. Implement new -gnatl=xxx switch to output listing to file (Concat): Removed, replaced by real concatenation Make use of concatenation now allowed in compiler (Executable_Prefix.Get_Install_Dir): First get the full path, so that we find the 'lib' or 'bin' directory even when the tool has been invoked with a relative path. (Executable_Name): New function taking string parameters. * osint-c.ads, osint-c.adb: Implement new -gnatl=xxx switch to output listing to file * sinput-d.adb: Change name Creat_Debug_File to Create_Debug_File * switch-c.adb: Implement new -gnatl=xxx switch to output listing to file Recognize new -gnatL switch (no longer keep in old warning about old style usage) Use concatenation to simplify code Recognize -gnatjnn switch (Scan_Front_End_Switches): Clean up handling of -gnatW (Scan_Front_End_Switches): Include Warn_On_Assumed_Low_Bound for -gnatg From-SVN: r118251
1017 lines
32 KiB
Ada
1017 lines
32 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- S W I T C H - C --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 2001-2006, Free Software Foundation, Inc. --
|
|
-- --
|
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
|
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
|
-- for more details. You should have received a copy of the GNU General --
|
|
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
|
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
|
|
-- Boston, MA 02110-1301, USA. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
|
|
|
with Debug; use Debug;
|
|
with Lib; use Lib;
|
|
with Osint; use Osint;
|
|
with Opt; use Opt;
|
|
with Prepcomp; use Prepcomp;
|
|
with Validsw; use Validsw;
|
|
with Sem_Warn; use Sem_Warn;
|
|
with Stylesw; use Stylesw;
|
|
|
|
with System.WCh_Con; use System.WCh_Con;
|
|
|
|
package body Switch.C is
|
|
|
|
RTS_Specified : String_Access := null;
|
|
-- Used to detect multiple use of --RTS= flag
|
|
|
|
-----------------------------
|
|
-- Scan_Front_End_Switches --
|
|
-----------------------------
|
|
|
|
procedure Scan_Front_End_Switches (Switch_Chars : String) is
|
|
Switch_Starts_With_Gnat : Boolean;
|
|
-- True if first four switch characters are "gnat"
|
|
|
|
First_Switch : Boolean := True;
|
|
-- False for all but first switch
|
|
|
|
Ptr : Integer := Switch_Chars'First;
|
|
Max : constant Integer := Switch_Chars'Last;
|
|
C : Character := ' ';
|
|
Dot : Boolean;
|
|
|
|
Store_Switch : Boolean := True;
|
|
First_Char : Integer := Ptr;
|
|
Storing : String := Switch_Chars;
|
|
First_Stored : Positive := Ptr + 1;
|
|
-- The above need comments ???
|
|
|
|
begin
|
|
-- Skip past the initial character (must be the switch character)
|
|
|
|
if Ptr = Max then
|
|
Bad_Switch (C);
|
|
else
|
|
Ptr := Ptr + 1;
|
|
end if;
|
|
|
|
-- Remove "gnat" from the switch, if present
|
|
|
|
Switch_Starts_With_Gnat :=
|
|
Ptr + 3 <= Max and then Switch_Chars (Ptr .. Ptr + 3) = "gnat";
|
|
|
|
if Switch_Starts_With_Gnat then
|
|
Ptr := Ptr + 4;
|
|
First_Stored := Ptr;
|
|
end if;
|
|
|
|
-- Loop to scan through switches given in switch string
|
|
|
|
while Ptr <= Max loop
|
|
Store_Switch := True;
|
|
First_Char := Ptr;
|
|
C := Switch_Chars (Ptr);
|
|
|
|
-- Processing for a switch
|
|
|
|
case Switch_Starts_With_Gnat is
|
|
|
|
when False =>
|
|
|
|
-- There are few front-end switches that
|
|
-- do not start with -gnat: -I, --RTS
|
|
|
|
if Switch_Chars (Ptr) = 'I' then
|
|
Store_Switch := False;
|
|
|
|
-- Set flag Search_Directory_Present if switch is "-I" only:
|
|
-- the directory will be the next argument.
|
|
|
|
if Ptr = Max then
|
|
Search_Directory_Present := True;
|
|
return;
|
|
end if;
|
|
|
|
Ptr := Ptr + 1;
|
|
|
|
-- Find out whether this is a -I- or regular -Ixxx switch
|
|
|
|
if Ptr = Max and then Switch_Chars (Ptr) = '-' then
|
|
Look_In_Primary_Dir := False;
|
|
|
|
else
|
|
Add_Src_Search_Dir (Switch_Chars (Ptr .. Max));
|
|
end if;
|
|
|
|
Ptr := Max + 1;
|
|
|
|
-- Processing of the --RTS switch. --RTS has been modified by
|
|
-- gcc and is now of the form -fRTS
|
|
|
|
elsif Ptr + 3 <= Max
|
|
and then Switch_Chars (Ptr .. Ptr + 3) = "fRTS"
|
|
then
|
|
Ptr := Ptr + 1;
|
|
|
|
if Ptr + 4 > Max
|
|
or else Switch_Chars (Ptr + 3) /= '='
|
|
then
|
|
Osint.Fail ("missing path for --RTS");
|
|
else
|
|
-- Check that this is the first time --RTS is specified
|
|
-- or if it is not the first time, the same path has
|
|
-- been specified.
|
|
|
|
if RTS_Specified = null then
|
|
RTS_Specified :=
|
|
new String'(Switch_Chars (Ptr + 4 .. Max));
|
|
|
|
elsif
|
|
RTS_Specified.all /= Switch_Chars (Ptr + 4 .. Max)
|
|
then
|
|
Osint.Fail
|
|
("--RTS cannot be specified multiple times");
|
|
end if;
|
|
|
|
-- Valid --RTS switch
|
|
|
|
Opt.No_Stdinc := True;
|
|
Opt.RTS_Switch := True;
|
|
|
|
RTS_Src_Path_Name := Get_RTS_Search_Dir
|
|
(Switch_Chars (Ptr + 4 .. Max),
|
|
Include);
|
|
RTS_Lib_Path_Name := Get_RTS_Search_Dir
|
|
(Switch_Chars (Ptr + 4 .. Max),
|
|
Objects);
|
|
|
|
if RTS_Src_Path_Name /= null and then
|
|
RTS_Lib_Path_Name /= null
|
|
then
|
|
Ptr := Max + 1;
|
|
|
|
elsif RTS_Src_Path_Name = null and then
|
|
RTS_Lib_Path_Name = null
|
|
then
|
|
Osint.Fail ("RTS path not valid: missing " &
|
|
"adainclude and adalib directories");
|
|
|
|
elsif RTS_Src_Path_Name = null then
|
|
Osint.Fail ("RTS path not valid: missing " &
|
|
"adainclude directory");
|
|
|
|
elsif RTS_Lib_Path_Name = null then
|
|
Osint.Fail ("RTS path not valid: missing " &
|
|
"adalib directory");
|
|
end if;
|
|
end if;
|
|
else
|
|
Bad_Switch (C);
|
|
end if;
|
|
|
|
when True =>
|
|
|
|
-- Process -gnat* options
|
|
|
|
case C is
|
|
|
|
when 'a' =>
|
|
Ptr := Ptr + 1;
|
|
Assertions_Enabled := True;
|
|
Debug_Pragmas_Enabled := True;
|
|
|
|
-- Processing for A switch
|
|
|
|
when 'A' =>
|
|
Ptr := Ptr + 1;
|
|
Config_File := False;
|
|
|
|
-- Processing for b switch
|
|
|
|
when 'b' =>
|
|
Ptr := Ptr + 1;
|
|
Brief_Output := True;
|
|
|
|
-- Processing for c switch
|
|
|
|
when 'c' =>
|
|
if not First_Switch then
|
|
Osint.Fail
|
|
("-gnatc must be first if combined with other switches");
|
|
end if;
|
|
|
|
Ptr := Ptr + 1;
|
|
Operating_Mode := Check_Semantics;
|
|
|
|
if Tree_Output then
|
|
ASIS_Mode := True;
|
|
end if;
|
|
|
|
-- Processing for d switch
|
|
|
|
when 'd' =>
|
|
Store_Switch := False;
|
|
Storing (First_Stored) := 'd';
|
|
Dot := False;
|
|
|
|
-- Note: for the debug switch, the remaining characters in this
|
|
-- switch field must all be debug flags, since all valid switch
|
|
-- characters are also valid debug characters.
|
|
|
|
-- Loop to scan out debug flags
|
|
|
|
while Ptr < Max loop
|
|
Ptr := Ptr + 1;
|
|
C := Switch_Chars (Ptr);
|
|
exit when C = ASCII.NUL or else C = '/' or else C = '-';
|
|
|
|
if C in '1' .. '9' or else
|
|
C in 'a' .. 'z' or else
|
|
C in 'A' .. 'Z'
|
|
then
|
|
if Dot then
|
|
Set_Dotted_Debug_Flag (C);
|
|
Storing (First_Stored + 1) := '.';
|
|
Storing (First_Stored + 2) := C;
|
|
Store_Compilation_Switch
|
|
(Storing (Storing'First .. First_Stored + 2));
|
|
Dot := False;
|
|
|
|
else
|
|
Set_Debug_Flag (C);
|
|
Storing (First_Stored + 1) := C;
|
|
Store_Compilation_Switch
|
|
(Storing (Storing'First .. First_Stored + 1));
|
|
end if;
|
|
|
|
elsif C = '.' then
|
|
Dot := True;
|
|
|
|
else
|
|
Bad_Switch (C);
|
|
end if;
|
|
end loop;
|
|
|
|
return;
|
|
|
|
-- Processing for D switch
|
|
|
|
when 'D' =>
|
|
Ptr := Ptr + 1;
|
|
|
|
-- Note: -gnatD also sets -gnatx (to turn off cross-reference
|
|
-- generation in the ali file) since otherwise this generation
|
|
-- gets confused by the "wrong" Sloc values put in the tree.
|
|
|
|
Debug_Generated_Code := True;
|
|
Xref_Active := False;
|
|
Set_Debug_Flag ('g');
|
|
|
|
-- -gnate? (extended switches)
|
|
|
|
when 'e' =>
|
|
Ptr := Ptr + 1;
|
|
|
|
-- The -gnate? switches are all double character switches
|
|
-- so we must always have a character after the e.
|
|
|
|
if Ptr > Max then
|
|
Bad_Switch (C);
|
|
end if;
|
|
|
|
case Switch_Chars (Ptr) is
|
|
|
|
-- -gnatec (configuration pragmas)
|
|
|
|
when 'c' =>
|
|
Store_Switch := False;
|
|
Ptr := Ptr + 1;
|
|
|
|
-- There may be an equal sign between -gnatec and
|
|
-- the path name of the config file.
|
|
|
|
if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
|
|
Ptr := Ptr + 1;
|
|
end if;
|
|
|
|
if Ptr > Max then
|
|
Bad_Switch (C);
|
|
end if;
|
|
|
|
declare
|
|
Config_File_Name : constant String_Access :=
|
|
new String'
|
|
(Switch_Chars (Ptr .. Max));
|
|
|
|
begin
|
|
if Config_File_Names = null then
|
|
Config_File_Names :=
|
|
new String_List'(1 => Config_File_Name);
|
|
|
|
else
|
|
declare
|
|
New_Names : constant String_List_Access :=
|
|
new String_List
|
|
(1 ..
|
|
Config_File_Names'Length + 1);
|
|
|
|
begin
|
|
for Index in Config_File_Names'Range loop
|
|
New_Names (Index) :=
|
|
Config_File_Names (Index);
|
|
Config_File_Names (Index) := null;
|
|
end loop;
|
|
|
|
New_Names (New_Names'Last) := Config_File_Name;
|
|
Free (Config_File_Names);
|
|
Config_File_Names := New_Names;
|
|
end;
|
|
end if;
|
|
end;
|
|
|
|
return;
|
|
|
|
-- -gnateD switch (symbol definition)
|
|
|
|
when 'D' =>
|
|
Store_Switch := False;
|
|
Ptr := Ptr + 1;
|
|
|
|
if Ptr > Max then
|
|
Bad_Switch (C);
|
|
end if;
|
|
|
|
Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
|
|
|
|
-- Store the switch
|
|
|
|
Storing (First_Stored .. First_Stored + 1) := "eD";
|
|
Storing
|
|
(First_Stored + 2 .. First_Stored + Max - Ptr + 2) :=
|
|
Switch_Chars (Ptr .. Max);
|
|
Store_Compilation_Switch (Storing
|
|
(Storing'First .. First_Stored + Max - Ptr + 2));
|
|
return;
|
|
|
|
-- -gnatef (full source path for brief error messages)
|
|
|
|
when 'f' =>
|
|
Store_Switch := False;
|
|
Ptr := Ptr + 1;
|
|
Full_Path_Name_For_Brief_Errors := True;
|
|
return;
|
|
|
|
-- -gnateI (index of unit in multi-unit source)
|
|
|
|
when 'I' =>
|
|
Ptr := Ptr + 1;
|
|
Scan_Pos
|
|
(Switch_Chars, Max, Ptr, Multiple_Unit_Index, C);
|
|
|
|
-- -gnatem (mapping file)
|
|
|
|
when 'm' =>
|
|
Store_Switch := False;
|
|
Ptr := Ptr + 1;
|
|
|
|
-- There may be an equal sign between -gnatem and
|
|
-- the path name of the mapping file.
|
|
|
|
if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
|
|
Ptr := Ptr + 1;
|
|
end if;
|
|
|
|
if Ptr > Max then
|
|
Bad_Switch (C);
|
|
end if;
|
|
|
|
Mapping_File_Name :=
|
|
new String'(Switch_Chars (Ptr .. Max));
|
|
return;
|
|
|
|
-- -gnatep (preprocessing data file)
|
|
|
|
when 'p' =>
|
|
Store_Switch := False;
|
|
Ptr := Ptr + 1;
|
|
|
|
-- There may be an equal sign between -gnatep and
|
|
-- the path name of the mapping file.
|
|
|
|
if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
|
|
Ptr := Ptr + 1;
|
|
end if;
|
|
|
|
if Ptr > Max then
|
|
Bad_Switch (C);
|
|
end if;
|
|
|
|
Preprocessing_Data_File :=
|
|
new String'(Switch_Chars (Ptr .. Max));
|
|
|
|
-- Store the switch.
|
|
-- Because we may store a longer switch (we normalize
|
|
-- to -gnatep=), use a local variable.
|
|
|
|
declare
|
|
To_Store : String
|
|
(1 .. Preprocessing_Data_File'Length + 8);
|
|
|
|
begin
|
|
To_Store (1 .. 8) := "-gnatep=";
|
|
To_Store (9 .. Preprocessing_Data_File'Length + 8) :=
|
|
Preprocessing_Data_File.all;
|
|
Store_Compilation_Switch (To_Store);
|
|
end;
|
|
|
|
return;
|
|
|
|
when 'z' =>
|
|
Store_Switch := False;
|
|
Disable_Switch_Storing;
|
|
Ptr := Ptr + 1;
|
|
|
|
-- All other -gnate? switches are unassigned
|
|
|
|
when others =>
|
|
Bad_Switch (C);
|
|
end case;
|
|
|
|
-- -gnatE (dynamic elaboration checks)
|
|
|
|
when 'E' =>
|
|
Ptr := Ptr + 1;
|
|
Dynamic_Elaboration_Checks := True;
|
|
|
|
-- -gnatf (full error messages)
|
|
|
|
when 'f' =>
|
|
Ptr := Ptr + 1;
|
|
All_Errors_Mode := True;
|
|
|
|
-- Processing for F switch
|
|
|
|
when 'F' =>
|
|
Ptr := Ptr + 1;
|
|
External_Name_Exp_Casing := Uppercase;
|
|
External_Name_Imp_Casing := Uppercase;
|
|
|
|
-- Processing for g switch
|
|
|
|
when 'g' =>
|
|
Ptr := Ptr + 1;
|
|
GNAT_Mode := True;
|
|
Identifier_Character_Set := 'n';
|
|
System_Extend_Unit := Empty;
|
|
Warning_Mode := Treat_As_Error;
|
|
|
|
-- Set Ada 2005 mode explicitly. We don't want to rely on the
|
|
-- implicit setting here, since for example, we want
|
|
-- Preelaborate_05 treated as Preelaborate
|
|
|
|
Ada_Version := Ada_05;
|
|
Ada_Version_Explicit := Ada_Version;
|
|
|
|
-- Set default warnings for -gnatg (same set as -gnatwa)
|
|
|
|
Check_Unreferenced := True;
|
|
Check_Unreferenced_Formals := True;
|
|
Check_Withs := True;
|
|
Constant_Condition_Warnings := True;
|
|
Implementation_Unit_Warnings := True;
|
|
Ineffective_Inline_Warnings := True;
|
|
Warn_On_Assumed_Low_Bound := True;
|
|
Warn_On_Bad_Fixed_Value := True;
|
|
Warn_On_Constant := True;
|
|
Warn_On_Export_Import := True;
|
|
Warn_On_Modified_Unread := True;
|
|
Warn_On_No_Value_Assigned := True;
|
|
Warn_On_Obsolescent_Feature := True;
|
|
Warn_On_Redundant_Constructs := True;
|
|
Warn_On_Unchecked_Conversion := True;
|
|
Warn_On_Unrecognized_Pragma := True;
|
|
|
|
Set_Style_Check_Options ("3abcdefhiklmnprstux");
|
|
|
|
-- Processing for G switch
|
|
|
|
when 'G' =>
|
|
Ptr := Ptr + 1;
|
|
Print_Generated_Code := True;
|
|
|
|
-- Processing for h switch
|
|
|
|
when 'h' =>
|
|
Ptr := Ptr + 1;
|
|
Usage_Requested := True;
|
|
|
|
-- Processing for H switch
|
|
|
|
when 'H' =>
|
|
Ptr := Ptr + 1;
|
|
HLO_Active := True;
|
|
|
|
-- Processing for i switch
|
|
|
|
when 'i' =>
|
|
if Ptr = Max then
|
|
Bad_Switch (C);
|
|
end if;
|
|
|
|
Ptr := Ptr + 1;
|
|
C := Switch_Chars (Ptr);
|
|
|
|
if C in '1' .. '5'
|
|
or else C = '8'
|
|
or else C = '9'
|
|
or else C = 'p'
|
|
or else C = 'f'
|
|
or else C = 'n'
|
|
or else C = 'w'
|
|
then
|
|
Identifier_Character_Set := C;
|
|
Ptr := Ptr + 1;
|
|
|
|
else
|
|
Bad_Switch (C);
|
|
end if;
|
|
|
|
-- Processing for j switch
|
|
|
|
when 'j' =>
|
|
Ptr := Ptr + 1;
|
|
|
|
-- There may be an equal sign between -gnatj and the value
|
|
|
|
if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
|
|
Ptr := Ptr + 1;
|
|
end if;
|
|
|
|
Scan_Nat (Switch_Chars, Max, Ptr, Error_Msg_Line_Length, C);
|
|
|
|
-- Processing for k switch
|
|
|
|
when 'k' =>
|
|
Ptr := Ptr + 1;
|
|
Scan_Pos
|
|
(Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C);
|
|
|
|
-- Processing for l switch
|
|
|
|
when 'l' =>
|
|
Ptr := Ptr + 1;
|
|
Full_List := True;
|
|
|
|
-- There may be an equal sign between -gnatl and a file name
|
|
|
|
if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
|
|
if Ptr = Max then
|
|
Osint.Fail ("file name for -gnatl= is null");
|
|
else
|
|
Opt.Full_List_File_Name :=
|
|
new String'(Switch_Chars (Ptr + 1 .. Max));
|
|
Ptr := Max + 1;
|
|
end if;
|
|
end if;
|
|
|
|
-- Processing for L switch
|
|
|
|
when 'L' =>
|
|
Ptr := Ptr + 1;
|
|
Dump_Source_Text := True;
|
|
|
|
-- Processing for m switch
|
|
|
|
when 'm' =>
|
|
Ptr := Ptr + 1;
|
|
|
|
-- There may be an equal sign between -gnatm and the value
|
|
|
|
if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
|
|
Ptr := Ptr + 1;
|
|
end if;
|
|
|
|
Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Errors, C);
|
|
|
|
-- Processing for n switch
|
|
|
|
when 'n' =>
|
|
Ptr := Ptr + 1;
|
|
Inline_Active := True;
|
|
|
|
-- Processing for N switch
|
|
|
|
when 'N' =>
|
|
Ptr := Ptr + 1;
|
|
Inline_Active := True;
|
|
Front_End_Inlining := True;
|
|
|
|
-- Processing for o switch
|
|
|
|
when 'o' =>
|
|
Ptr := Ptr + 1;
|
|
Suppress_Options (Overflow_Check) := False;
|
|
Opt.Enable_Overflow_Checks := True;
|
|
|
|
-- Processing for O switch
|
|
|
|
when 'O' =>
|
|
Store_Switch := False;
|
|
Ptr := Ptr + 1;
|
|
Output_File_Name_Present := True;
|
|
|
|
-- Processing for p switch
|
|
|
|
when 'p' =>
|
|
Ptr := Ptr + 1;
|
|
|
|
-- Set all specific options as well as All_Checks in the
|
|
-- Suppress_Options array, excluding Elaboration_Check, since
|
|
-- this is treated specially because we do not want -gnatp to
|
|
-- disable static elaboration processing.
|
|
|
|
for J in Suppress_Options'Range loop
|
|
if J /= Elaboration_Check then
|
|
Suppress_Options (J) := True;
|
|
end if;
|
|
end loop;
|
|
|
|
Validity_Checks_On := False;
|
|
Opt.Suppress_Checks := True;
|
|
Opt.Enable_Overflow_Checks := False;
|
|
|
|
-- Processing for P switch
|
|
|
|
when 'P' =>
|
|
Ptr := Ptr + 1;
|
|
Polling_Required := True;
|
|
|
|
-- Processing for q switch
|
|
|
|
when 'q' =>
|
|
Ptr := Ptr + 1;
|
|
Try_Semantics := True;
|
|
|
|
-- Processing for q switch
|
|
|
|
when 'Q' =>
|
|
Ptr := Ptr + 1;
|
|
Force_ALI_Tree_File := True;
|
|
Try_Semantics := True;
|
|
|
|
-- Processing for R switch
|
|
|
|
when 'R' =>
|
|
Ptr := Ptr + 1;
|
|
Back_Annotate_Rep_Info := True;
|
|
List_Representation_Info := 1;
|
|
|
|
while Ptr <= Max loop
|
|
C := Switch_Chars (Ptr);
|
|
|
|
if C in '1' .. '3' then
|
|
List_Representation_Info :=
|
|
Character'Pos (C) - Character'Pos ('0');
|
|
|
|
elsif Switch_Chars (Ptr) = 's' then
|
|
List_Representation_Info_To_File := True;
|
|
|
|
elsif Switch_Chars (Ptr) = 'm' then
|
|
List_Representation_Info_Mechanisms := True;
|
|
|
|
else
|
|
Bad_Switch (C);
|
|
end if;
|
|
|
|
Ptr := Ptr + 1;
|
|
end loop;
|
|
|
|
-- Processing for s switch
|
|
|
|
when 's' =>
|
|
if not First_Switch then
|
|
Osint.Fail
|
|
("-gnats must be first if combined with other switches");
|
|
end if;
|
|
|
|
Ptr := Ptr + 1;
|
|
Operating_Mode := Check_Syntax;
|
|
|
|
-- Processing for S switch
|
|
|
|
when 'S' =>
|
|
Print_Standard := True;
|
|
Ptr := Ptr + 1;
|
|
|
|
-- Processing for t switch
|
|
|
|
when 't' =>
|
|
Ptr := Ptr + 1;
|
|
Tree_Output := True;
|
|
|
|
if Operating_Mode = Check_Semantics then
|
|
ASIS_Mode := True;
|
|
end if;
|
|
|
|
Back_Annotate_Rep_Info := True;
|
|
|
|
-- Processing for T switch
|
|
|
|
when 'T' =>
|
|
Ptr := Ptr + 1;
|
|
Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C);
|
|
|
|
-- Processing for u switch
|
|
|
|
when 'u' =>
|
|
Ptr := Ptr + 1;
|
|
List_Units := True;
|
|
|
|
-- Processing for U switch
|
|
|
|
when 'U' =>
|
|
Ptr := Ptr + 1;
|
|
Unique_Error_Tag := True;
|
|
|
|
-- Processing for v switch
|
|
|
|
when 'v' =>
|
|
Ptr := Ptr + 1;
|
|
Verbose_Mode := True;
|
|
|
|
-- Processing for V switch
|
|
|
|
when 'V' =>
|
|
Store_Switch := False;
|
|
Storing (First_Stored) := 'V';
|
|
Ptr := Ptr + 1;
|
|
|
|
if Ptr > Max then
|
|
Bad_Switch (C);
|
|
|
|
else
|
|
declare
|
|
OK : Boolean;
|
|
|
|
begin
|
|
Set_Validity_Check_Options
|
|
(Switch_Chars (Ptr .. Max), OK, Ptr);
|
|
|
|
if not OK then
|
|
Bad_Switch (C);
|
|
end if;
|
|
|
|
for Index in First_Char + 1 .. Max loop
|
|
Storing (First_Stored + 1) :=
|
|
Switch_Chars (Index);
|
|
Store_Compilation_Switch
|
|
(Storing (Storing'First .. First_Stored + 1));
|
|
end loop;
|
|
end;
|
|
end if;
|
|
|
|
Ptr := Max + 1;
|
|
|
|
-- Processing for w switch
|
|
|
|
when 'w' =>
|
|
Store_Switch := False;
|
|
Storing (First_Stored) := 'w';
|
|
Ptr := Ptr + 1;
|
|
|
|
if Ptr > Max then
|
|
Bad_Switch (C);
|
|
end if;
|
|
|
|
while Ptr <= Max loop
|
|
C := Switch_Chars (Ptr);
|
|
|
|
if Set_Warning_Switch (C) then
|
|
null;
|
|
else
|
|
Bad_Switch (C);
|
|
end if;
|
|
|
|
if C /= 'w' then
|
|
Storing (First_Stored + 1) := C;
|
|
Store_Compilation_Switch
|
|
(Storing (Storing'First .. First_Stored + 1));
|
|
end if;
|
|
|
|
Ptr := Ptr + 1;
|
|
end loop;
|
|
|
|
return;
|
|
|
|
-- Processing for W switch
|
|
|
|
when 'W' =>
|
|
Ptr := Ptr + 1;
|
|
|
|
if Ptr > Max then
|
|
Bad_Switch (C);
|
|
end if;
|
|
|
|
begin
|
|
Wide_Character_Encoding_Method :=
|
|
Get_WC_Encoding_Method (Switch_Chars (Ptr));
|
|
exception
|
|
when Constraint_Error =>
|
|
Bad_Switch (C);
|
|
end;
|
|
|
|
Upper_Half_Encoding :=
|
|
Wide_Character_Encoding_Method in
|
|
WC_Upper_Half_Encoding_Method;
|
|
|
|
Ptr := Ptr + 1;
|
|
|
|
-- Processing for x switch
|
|
|
|
when 'x' =>
|
|
Ptr := Ptr + 1;
|
|
Xref_Active := False;
|
|
|
|
-- Processing for X switch
|
|
|
|
when 'X' =>
|
|
Ptr := Ptr + 1;
|
|
Extensions_Allowed := True;
|
|
Ada_Version := Ada_Version_Type'Last;
|
|
Ada_Version_Explicit := Ada_Version;
|
|
|
|
-- Processing for y switch
|
|
|
|
when 'y' =>
|
|
Ptr := Ptr + 1;
|
|
|
|
if Ptr > Max then
|
|
Set_Default_Style_Check_Options;
|
|
|
|
else
|
|
Store_Switch := False;
|
|
Storing (First_Stored) := 'y';
|
|
|
|
declare
|
|
OK : Boolean;
|
|
Last_Stored : Integer;
|
|
|
|
begin
|
|
Set_Style_Check_Options
|
|
(Switch_Chars (Ptr .. Max), OK, Ptr);
|
|
|
|
if not OK then
|
|
Osint.Fail
|
|
("bad -gnaty switch (" &
|
|
Style_Msg_Buf (1 .. Style_Msg_Len) & ')');
|
|
end if;
|
|
|
|
Ptr := First_Char + 1;
|
|
while Ptr <= Max loop
|
|
Last_Stored := First_Stored + 1;
|
|
Storing (Last_Stored) := Switch_Chars (Ptr);
|
|
|
|
if Switch_Chars (Ptr) = 'M' then
|
|
loop
|
|
Ptr := Ptr + 1;
|
|
exit when Ptr > Max
|
|
or else Switch_Chars (Ptr) not in '0' .. '9';
|
|
Last_Stored := Last_Stored + 1;
|
|
Storing (Last_Stored) := Switch_Chars (Ptr);
|
|
end loop;
|
|
|
|
else
|
|
Ptr := Ptr + 1;
|
|
end if;
|
|
|
|
Store_Compilation_Switch
|
|
(Storing (Storing'First .. Last_Stored));
|
|
end loop;
|
|
end;
|
|
end if;
|
|
|
|
-- Processing for z switch
|
|
|
|
when 'z' =>
|
|
Ptr := Ptr + 1;
|
|
|
|
-- Allowed for compiler only if this is the only
|
|
-- -z switch, we do not allow multiple occurrences
|
|
|
|
if Distribution_Stub_Mode = No_Stubs then
|
|
case Switch_Chars (Ptr) is
|
|
when 'r' =>
|
|
Distribution_Stub_Mode := Generate_Receiver_Stub_Body;
|
|
|
|
when 'c' =>
|
|
Distribution_Stub_Mode := Generate_Caller_Stub_Body;
|
|
|
|
when others =>
|
|
Bad_Switch (C);
|
|
end case;
|
|
|
|
Ptr := Ptr + 1;
|
|
|
|
end if;
|
|
|
|
-- Processing for Z switch
|
|
|
|
when 'Z' =>
|
|
Ptr := Ptr + 1;
|
|
Osint.Fail
|
|
("-gnatZ is no longer supported: consider using --RTS=zcx");
|
|
|
|
-- Processing for 83 switch
|
|
|
|
when '8' =>
|
|
if Ptr = Max then
|
|
Bad_Switch (C);
|
|
end if;
|
|
|
|
Ptr := Ptr + 1;
|
|
|
|
if Switch_Chars (Ptr) /= '3' then
|
|
Bad_Switch (C);
|
|
else
|
|
Ptr := Ptr + 1;
|
|
Ada_Version := Ada_83;
|
|
Ada_Version_Explicit := Ada_Version;
|
|
end if;
|
|
|
|
-- Processing for 95 switch
|
|
|
|
when '9' =>
|
|
if Ptr = Max then
|
|
Bad_Switch (C);
|
|
end if;
|
|
|
|
Ptr := Ptr + 1;
|
|
|
|
if Switch_Chars (Ptr) /= '5' then
|
|
Bad_Switch (C);
|
|
else
|
|
Ptr := Ptr + 1;
|
|
Ada_Version := Ada_95;
|
|
Ada_Version_Explicit := Ada_Version;
|
|
end if;
|
|
|
|
-- Processing for 05 switch
|
|
|
|
when '0' =>
|
|
if Ptr = Max then
|
|
Bad_Switch (C);
|
|
end if;
|
|
|
|
Ptr := Ptr + 1;
|
|
|
|
if Switch_Chars (Ptr) /= '5' then
|
|
Bad_Switch (C);
|
|
else
|
|
Ptr := Ptr + 1;
|
|
Ada_Version := Ada_05;
|
|
Ada_Version_Explicit := Ada_Version;
|
|
end if;
|
|
|
|
-- Ignore extra switch character
|
|
|
|
when '/' | '-' =>
|
|
Ptr := Ptr + 1;
|
|
|
|
-- Anything else is an error (illegal switch character)
|
|
|
|
when others =>
|
|
Bad_Switch (C);
|
|
end case;
|
|
end case;
|
|
|
|
if Store_Switch then
|
|
Storing (First_Stored .. First_Stored + Ptr - First_Char - 1) :=
|
|
Switch_Chars (First_Char .. Ptr - 1);
|
|
Store_Compilation_Switch
|
|
(Storing (Storing'First .. First_Stored + Ptr - First_Char - 1));
|
|
end if;
|
|
|
|
First_Switch := False;
|
|
end loop;
|
|
end Scan_Front_End_Switches;
|
|
|
|
end Switch.C;
|