OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

errutil.adb (Initialize): Initialize warnings table... 

2007-04-06  Vincent Celier  <celier@adacore.com>

	* errutil.adb (Initialize): Initialize warnings table, if all warnings
	are suppressed, supply an initial dummy entry covering all possible
	source locations.

	* make.adb (Scan_Make_Arg): Reject options that should start with "--"
	and start with only one, such as "-RTS=none".
	(Collect_Arguments): Do not check for sources outside of projects.
	Do not collect arguments if project is externally built.
	(Compile_Sources): Do nothing, not even check if the source is up to
	date, if its project is externally built.
	(Compile): When compiling a predefined source, add -gnatpg
	as the second switch, after -c.
	(Compile_Sources): Allow compilation of Annex J renames without -a
	(Is_In_Object_Directory): Check if the ALI file is in the object
	even if there is no project extension.
	(Create_Binder_Mapping_File): Only put a unit in the mapping file for
	gnatbind if the ALI file effectively exists.
	(Initialize): Add the directory where gnatmake is invoked in front of
	the path if it is invoked from a bin directory, even without directory
	information, so that the correct GNAT tools will be used when spawned
	without directory information.

	* makeusg.adb: Change switch -S to -eS
	Add lines for new switches -we, -wn and -ws
	Add line for new switch -p

	* prj-proc.adb (Process): Set Success to False when Warning_Mode is
	Treat_As_Error and there are warnings.

	* switch-m.ads, switch-m.adb (Normalize_Compiler_Switches): Do not skip
	-gnatww Change gnatmake switch -S to -eS
	(Scan_Make_Switches): Code reorganisation. Process separately multi
	character switches and single character switches.
	(Scan_Make_Switches): New Boolean out parameter Success. Set Success to
	False when switch is not recognized by gnatmake.
	(Scan_Make_Switches): Set Setup_Projects True when -p or
	--create-missing-dirs is specified.

	* fname.adb (Is_Predefined_File_Name): Return True for annex J
	renamings Calendar, Machine_Code, Unchecked_Conversion and
	Unchecked_Deallocation only when Renamings_Included is True.

	* par.adb: Allow library units Calendar, Machine_Code,
	Unchecked_Conversion and Unchecked_Deallocation to be recompiled even
	when -gnatg is not specified.
	(P_Interface_Type_Definition): Remove the formal Is_Synchronized because
	there is no need to generate always a record_definition_node in case
	of synchronized interface types.
	(SIS_Entry_Active): Initialize global variable to False
	(P_Null_Exclusion): For AI-447: Add parameter Allow_Anonymous_In_95 to
	indicate cases where AI-447 says "not null" is legal.

	* makeutl.ads, makeutil.adb (Executable_Prefix_Path): New function

	* makegpr.adb (Check_Compilation_Needed): Take into account dependency
	files with with several lines starting with the object fileb name.
	(Scan_Arg): Set Setup_Projects True when -p or --create-missing-dirs
	is specified.
	(Initialize): Add the directory where gprmake is invoked in front of the
	path, if it is invoked from a bin directory or with directory
	information, so that the correct GNAT tools will be used when invoked
	directly.
	(Check_Compilation_Needed): Process correctly backslashes on Windows.

	* vms_data.ads: Update switches/qualifiers

From-SVN: r123560
This commit is contained in:
Vincent Celier 2007-04-06 11:19:38 +02:00 committed by Arnaud Charlet
parent fea9e956ec
commit 958a816e69
12 changed files with 1018 additions and 621 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ada/errutil.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1991-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1991-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- --
@ -582,6 +582,12 @@ package body Errutil is
-- an initial dummy entry covering all possible source locations.
Warnings.Init;
if Warning_Mode = Suppress then
Warnings.Increment_Last;
Warnings.Table (Warnings.Last).Start := Source_Ptr'First;
Warnings.Table (Warnings.Last).Stop := Source_Ptr'Last;
end if;
end Initialize;
------------------------

12
gcc/ada/fname.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -120,22 +120,22 @@ package body Fname is
Predef_Names : constant array (1 .. 11) of Str8 :=
("ada ", -- Ada
"calendar", -- Calendar
"interfac", -- Interfaces
"system ", -- System
"machcode", -- Machine_Code
"unchconv", -- Unchecked_Conversion
"unchdeal", -- Unchecked_Deallocation
-- Remaining entries are only considered if Renamings_Included true
"calendar", -- Calendar
"machcode", -- Machine_Code
"unchconv", -- Unchecked_Conversion
"unchdeal", -- Unchecked_Deallocation
"directio", -- Direct_IO
"ioexcept", -- IO_Exceptions
"sequenio", -- Sequential_IO
"text_io "); -- Text_IO
Num_Entries : constant Natural :=
7 + 4 * Boolean'Pos (Renamings_Included);
3 + 8 * Boolean'Pos (Renamings_Included);
begin
-- Remove extension (if present)

320
gcc/ada/make.adb
View File

@ -1811,21 +1811,16 @@ package body Make is
Path => Arguments_Path_Name,
In_Tree => Project_Tree);
-- If the source is not a source of a project file, check if
-- this is allowed.
-- If the source is not a source of a project file, add the
-- recorded arguments. Check will be done later if the source
-- need to be compiled that the switch -x has been used.
if Arguments_Project = No_Project then
if not External_Unit_Compilation_Allowed then
Make_Failed ("external source (", Source_File_Name,
") is not part of any project; cannot be " &
"compiled without gnatmake switch -x");
end if;
-- If it is allowed, simply add the saved gcc switches
Add_Arguments (The_Saved_Gcc_Switches.all);
else
elsif not Project_Tree.Projects.Table
(Arguments_Project).Externally_Built
then
-- We get the project directory for the relative path
-- switches and arguments.
@ -2521,8 +2516,10 @@ package body Make is
begin
if Is_Predefined_File_Name (Fname, False) then
if Check_Readonly_Files then
Comp_Args (Comp_Args'First + 2 .. Comp_Last + 1) :=
Comp_Args (Comp_Args'First + 1 .. Comp_Last);
Comp_Last := Comp_Last + 1;
Comp_Args (Comp_Last) := GNAT_Flag;
Comp_Args (Comp_Args'First + 1) := GNAT_Flag;
else
Make_Failed
@ -2816,7 +2813,7 @@ package body Make is
elsif not Check_Readonly_Files
and then Full_Lib_File /= No_File
and then Is_Internal_File_Name (Source_File)
and then Is_Internal_File_Name (Source_File, False)
then
if Force_Compilations then
Fail
@ -2837,49 +2834,60 @@ package body Make is
else
Arguments_Collected := False;
-- Don't waste any time if we have to recompile anyway
-- Do nothing if project of source is externally built
Obj_Stamp := Empty_Time_Stamp;
Need_To_Compile := Force_Compilations;
Collect_Arguments (Source_File, Source_Index, Args);
if not Force_Compilations then
Read_Only :=
Full_Lib_File /= No_File
and then not Check_Readonly_Files
and then Is_Readonly_Library (Full_Lib_File);
Check (Source_File, Source_Index, Args, Lib_File,
Read_Only, ALI, Obj_File, Obj_Stamp);
Need_To_Compile := (ALI = No_ALI_Id);
end if;
if Arguments_Project = No_Project
or else not Project_Tree.Projects.Table
(Arguments_Project).Externally_Built
then
-- Don't waste any time if we have to recompile anyway
if not Need_To_Compile then
Obj_Stamp := Empty_Time_Stamp;
Need_To_Compile := Force_Compilations;
-- The ALI file is up-to-date. Record its Id
Record_Good_ALI (ALI);
-- Record the time stamp of the most recent object file
-- as long as no (re)compilations are needed.
if First_Compiled_File = No_File
and then (Most_Recent_Obj_File = No_File
or else Obj_Stamp > Most_Recent_Obj_Stamp)
then
Most_Recent_Obj_File := Obj_File;
Most_Recent_Obj_Stamp := Obj_Stamp;
if not Force_Compilations then
Read_Only :=
Full_Lib_File /= No_File
and then not Check_Readonly_Files
and then Is_Readonly_Library (Full_Lib_File);
Check (Source_File, Source_Index, Args, Lib_File,
Read_Only, ALI, Obj_File, Obj_Stamp);
Need_To_Compile := (ALI = No_ALI_Id);
end if;
else
-- Do nothing if project of source is externally built
if not Need_To_Compile then
-- The ALI file is up-to-date. Record its Id
if not Arguments_Collected then
Collect_Arguments (Source_File, Source_Index, Args);
end if;
Record_Good_ALI (ALI);
-- Record the time stamp of the most recent object
-- file as long as no (re)compilations are needed.
if First_Compiled_File = No_File
and then (Most_Recent_Obj_File = No_File
or else Obj_Stamp > Most_Recent_Obj_Stamp)
then
Most_Recent_Obj_File := Obj_File;
Most_Recent_Obj_Stamp := Obj_Stamp;
end if;
else
-- Check that switch -x has been used if a source
-- outside of project files need to be compiled.
if Main_Project /= No_Project and then
Arguments_Project = No_Project and then
not External_Unit_Compilation_Allowed
then
Make_Failed ("external source (",
Get_Name_String (Source_File),
") is not part of any project;"
& " cannot be compiled without" &
" gnatmake switch -x");
end if;
if Arguments_Project = No_Project
or else not Project_Tree.Projects.Table
(Arguments_Project).Externally_Built
then
-- Is this the first file we have to compile?
if First_Compiled_File = No_File then
@ -3088,7 +3096,7 @@ package body Make is
Debug_Msg ("Skipping marked file:", Sfile);
elsif not Check_Readonly_Files
and then Is_Internal_File_Name (Sfile)
and then Is_Internal_File_Name (Sfile, False)
then
Debug_Msg ("Skipping internal file:", Sfile);
@ -3938,47 +3946,18 @@ package body Make is
and then
Project_Tree.Projects.Table
(ALI_Project).Extended_By = No_Project
and then
Project_Tree.Projects.Table
(ALI_Project).Extends = No_Project
and then
Project_Tree.Projects.Table
(ALI_Project).Extends = No_Project
then
-- First line is the unit name
Get_Name_String (ALI_Unit);
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := ASCII.LF;
Bytes :=
Write
(Mapping_FD,
Name_Buffer (1)'Address,
Name_Len);
OK := Bytes = Name_Len;
exit when not OK;
-- Second line it the ALI file name
Get_Name_String (ALI_Name);
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := ASCII.LF;
Bytes :=
Write
(Mapping_FD,
Name_Buffer (1)'Address,
Name_Len);
OK := Bytes = Name_Len;
exit when not OK;
-- Third line it the ALI path name, concatenation
-- of either the library directory or the object
-- directory with the ALI file name.
-- First check if the ALI file exists. If it does not,
-- do not put the unit in the mapping file.
declare
ALI : constant String :=
Get_Name_String (ALI_Name);
PD : Project_Data renames
Project_Tree.Projects.Table (ALI_Project);
Project_Tree.Projects.Table (ALI_Project);
begin
-- For library projects, use the library directory,
@ -4004,19 +3983,61 @@ package body Make is
Name_Len :=
Name_Len + ALI'Length + 1;
Name_Buffer (Name_Len) := ASCII.LF;
Bytes :=
Write
(Mapping_FD,
Name_Buffer (1)'Address,
Name_Len);
OK := Bytes = Name_Len;
declare
ALI_Path_Name : constant String :=
Name_Buffer (1 .. Name_Len);
begin
if Is_Regular_File
(ALI_Path_Name (1 .. ALI_Path_Name'Last - 1))
then
-- First line is the unit name
Get_Name_String (ALI_Unit);
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := ASCII.LF;
Bytes :=
Write
(Mapping_FD,
Name_Buffer (1)'Address,
Name_Len);
OK := Bytes = Name_Len;
exit when not OK;
-- Second line it the ALI file name
Get_Name_String (ALI_Name);
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := ASCII.LF;
Bytes :=
Write
(Mapping_FD,
Name_Buffer (1)'Address,
Name_Len);
OK := Bytes = Name_Len;
exit when not OK;
-- Third line it the ALI path name.
Bytes :=
Write
(Mapping_FD,
ALI_Path_Name (1)'Address,
ALI_Path_Name'Length);
OK := Bytes = ALI_Path_Name'Length;
-- If OK is False, it means we were unable
-- to write a line. No point in continuing
-- with the other units.
exit when not OK;
end if;
end;
end;
-- If OK is False, it means we were unable
-- to write a line. No point in continuing
-- with the other units.
exit when not OK;
end if;
end if;
end;
@ -6086,34 +6107,45 @@ package body Make is
Mains.Delete;
-- Add the directory where gnatmake is invoked in front of the
-- path, if gnatmake is invoked with directory information.
-- Only do this if the platform is not VMS, where the notion of path
-- does not really exist.
-- path, if gnatmake is invoked from a bin directory or with directory
-- information. Only do this if the platform is not VMS, where the
-- notion of path does not really exist.
if not OpenVMS then
declare
Prefix : constant String := Executable_Prefix_Path;
Command : constant String := Command_Name;
begin
for Index in reverse Command'Range loop
if Command (Index) = Directory_Separator then
declare
Absolute_Dir : constant String :=
Normalize_Pathname
(Command (Command'First .. Index));
if Prefix'Length > 0 then
declare
PATH : constant String :=
Prefix & Directory_Separator & "bin" &
Path_Separator &
Getenv ("PATH").all;
begin
Setenv ("PATH", PATH);
end;
PATH : constant String :=
Absolute_Dir &
Path_Separator &
Getenv ("PATH").all;
else
for Index in reverse Command'Range loop
if Command (Index) = Directory_Separator then
declare
Absolute_Dir : constant String :=
Normalize_Pathname
(Command (Command'First .. Index));
PATH : constant String :=
Absolute_Dir &
Path_Separator &
Getenv ("PATH").all;
begin
Setenv ("PATH", PATH);
end;
begin
Setenv ("PATH", PATH);
end;
exit;
end if;
end loop;
exit;
end if;
end loop;
end if;
end;
end if;
@ -6541,13 +6573,7 @@ package body Make is
-- in its object directory. If it is not, return False, so that
-- the ALI file will not be skipped.
-- If the source is not in an extending project, we fall back to
-- the general case and return True at the end of the function.
if Project /= No_Project
and then Project_Tree.Projects.Table
(Project).Extends /= No_Project
then
if Project /= No_Project then
Data := Project_Tree.Projects.Table (Project);
declare
@ -6843,6 +6869,8 @@ package body Make is
-------------------
procedure Scan_Make_Arg (Argv : String; And_Save : Boolean) is
Success : Boolean;
begin
pragma Assert (Argv'First = 1);
@ -7098,7 +7126,7 @@ package body Make is
end if;
else
Make_Failed ("unknown switch: ", Argv);
Scan_Make_Switches (Argv, Success);
end if;
-- If we have seen a regular switch process it
@ -7108,6 +7136,15 @@ package body Make is
if Argv'Length = 1 then
Make_Failed ("switch character cannot be followed by a blank");
-- Incorrect switches that should start with "--"
elsif (Argv'Length > 5 and then Argv (1 .. 5) = "-RTS=")
or else (Argv'Length > 5 and then Argv (1 .. 5) = "-GCC=")
or else (Argv'Length > 10 and then Argv (1 .. 10) = "-GNATLINK=")
or else (Argv'Length > 10 and then Argv (1 .. 10) = "-GNATBIND=")
then
Make_Failed ("option ", Argv, " should start with '--'");
-- -I-
elsif Argv (2 .. Argv'Last) = "I-" then
@ -7206,7 +7243,7 @@ package body Make is
"project file");
else
Scan_Make_Switches (Argv);
Scan_Make_Switches (Argv, Success);
end if;
-- -d
@ -7224,13 +7261,13 @@ package body Make is
"project file");
else
Scan_Make_Switches (Argv);
Scan_Make_Switches (Argv, Success);
end if;
-- -j (need to save the result)
elsif Argv (2) = 'j' then
Scan_Make_Switches (Argv);
Scan_Make_Switches (Argv, Success);
if And_Save then
Saved_Maximum_Processes := Maximum_Processes;
@ -7365,29 +7402,16 @@ package body Make is
Add_Switch (Argv, Compiler, And_Save => And_Save);
Add_Switch (Argv, Binder, And_Save => And_Save);
-- By default all switches with more than one character or one
-- character switches are passed to the compiler with the
-- exception of those tested below, which belong to make.
elsif Argv (2) /= 'd'
and then Argv (2) /= 'e'
and then Argv (2 .. Argv'Last) /= "B"
and then Argv (2 .. Argv'Last) /= "C"
and then Argv (2 .. Argv'Last) /= "F"
and then Argv (2 .. Argv'Last) /= "M"
and then Argv (2 .. Argv'Last) /= "R"
and then Argv (2 .. Argv'Last) /= "S"
and then Argv (2 .. Argv'Last) /= "vl"
and then Argv (2 .. Argv'Last) /= "vm"
and then Argv (2 .. Argv'Last) /= "vh"
and then (Argv'Length > 2 or else Argv (2) not in 'a' .. 'z')
then
Add_Switch (Argv, Compiler, And_Save => And_Save);
-- All other options are handled by Scan_Make_Switches
-- All other switches are processed by Scan_Make_Switches.
-- If the call returns with Success = False, then the switch is
-- passed to the compiler.
else
Scan_Make_Switches (Argv);
Scan_Make_Switches (Argv, Success);
if not Success then
Add_Switch (Argv, Compiler, And_Save => And_Save);
end if;
end if;
-- If not a switch it must be a file name

379
gcc/ada/makegpr.adb
View File

@ -31,6 +31,7 @@ with Ada.Unchecked_Deallocation;
with Csets;
with Gnatvsn;
with Hostparm; use Hostparm;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.Dynamic_Tables;
@ -56,6 +57,10 @@ with Types; use Types;
package body Makegpr is
On_Windows : constant Boolean := Directory_Separator = '\';
-- True when on Windows. Used in Check_Compilation_Needed when processing
-- C/C++ dependency files for backslash handling.
Max_In_Archives : constant := 50;
-- The maximum number of arguments for a single invocation of the
-- Archive Indexer (ar).
@ -1803,6 +1808,9 @@ package body Makegpr is
Start : Natural;
Finish : Natural;
Looping : Boolean := False;
-- Set to True at the end of the first Big_Loop
begin
-- Assume the worst, so that statement "return;" may be used if there
-- is any problem.
@ -1881,179 +1889,213 @@ package body Makegpr is
return;
end if;
declare
End_Of_File_Reached : Boolean := False;
-- Loop Big_Loop is executed several times only when the dependency file
-- contains several times
-- <object file>: <source1> ...
-- When there is only one of such occurence, Big_Loop is exited
-- successfully at the beginning of the second loop.
begin
loop
if End_Of_File (Dep_File) then
End_Of_File_Reached := True;
exit;
Big_Loop :
loop
declare
End_Of_File_Reached : Boolean := False;
begin
loop
if End_Of_File (Dep_File) then
End_Of_File_Reached := True;
exit;
end if;
Get_Line (Dep_File, Name_Buffer, Name_Len);
exit when Name_Len > 0 and then Name_Buffer (1) /= '#';
end loop;
-- If dependency file contains only empty lines or comments, then
-- dependencies are unknown, and the source needs to be
-- recompiled.
if End_Of_File_Reached then
-- If we have reached the end of file after the first loop,
-- there is nothing else to do.
exit Big_Loop when Looping;
if Verbose_Mode then
Write_Str (" -> dependency file ");
Write_Str (Dep_Name);
Write_Line (" is empty");
end if;
Close (Dep_File);
return;
end if;
end;
Get_Line (Dep_File, Name_Buffer, Name_Len);
Start := 1;
Finish := Index (Name_Buffer (1 .. Name_Len), ": ");
exit when Name_Len > 0 and then Name_Buffer (1) /= '#';
end loop;
-- First line must start with name of object file, followed by colon
-- If dependency file contains only empty lines or comments, then
-- dependencies are unknown, and the source needs to be recompiled.
if End_Of_File_Reached then
if Finish = 0 or else
Name_Buffer (1 .. Finish - 1) /= Object_Name
then
if Verbose_Mode then
Write_Str (" -> dependency file ");
Write_Str (Dep_Name);
Write_Line (" is empty");
Write_Line (" has wrong format");
end if;
Close (Dep_File);
return;
end if;
end;
Start := 1;
Finish := Index (Name_Buffer (1 .. Name_Len), ": ");
else
Start := Finish + 2;
-- First line must start with name of object file, followed by colon
-- Process each line
if Finish = 0 or else Name_Buffer (1 .. Finish - 1) /= Object_Name then
if Verbose_Mode then
Write_Str (" -> dependency file ");
Write_Str (Dep_Name);
Write_Line (" has wrong format");
end if;
Line_Loop : loop
declare
Line : String := Name_Buffer (1 .. Name_Len);
Last : Natural := Name_Len;
Close (Dep_File);
return;
begin
Name_Loop : loop
else
Start := Finish + 2;
-- Find the beginning of the next source path name
-- Process each line
while Start < Last and then Line (Start) = ' ' loop
Start := Start + 1;
end loop;
Line_Loop : loop
declare
Line : String := Name_Buffer (1 .. Name_Len);
Last : Natural := Name_Len;
-- Go to next line when there is a continuation character
-- \ at the end of the line.
begin
Name_Loop : loop
exit Name_Loop when Start = Last
and then Line (Start) = '\';
-- Find the beginning of the next source path name
-- We should not be at the end of the line, without
-- a continuation character \.
while Start < Last and then Line (Start) = ' ' loop
Start := Start + 1;
end loop;
-- Go to next line when there is a continuation character \
-- at the end of the line.
exit Name_Loop when Start = Last
and then Line (Start) = '\';
-- We should not be at the end of the line, without
-- a continuation character \.
if Start = Last then
if Verbose_Mode then
Write_Str (" -> dependency file ");
Write_Str (Dep_Name);
Write_Line (" has wrong format");
end if;
Close (Dep_File);
return;
end if;
-- Look for the end of the source path name
Finish := Start;
while Finish < Last loop
if Line (Finish) = '\' then
-- When we are getting a '\' that is not the last
-- character of the line, the next character is part
-- of the path name, even if it is a space.
Line (Finish .. Last - 1) := Line (Finish + 1 .. Last);
Last := Last - 1;
else
-- A space that is not preceded by '\' indicates the
-- end of the path name.
exit when Line (Finish + 1) = ' ';
Finish := Finish + 1;
end if;
end loop;
-- Check this source
declare
Src_Name : constant String :=
Normalize_Pathname
(Name => Line (Start .. Finish),
Resolve_Links => False,
Case_Sensitive => False);
Src_TS : Time_Stamp_Type;
begin
-- If it is original source, set Source_In_Dependencies
if Src_Name = Source_Path then
Source_In_Dependencies := True;
end if;
Name_Len := 0;
Add_Str_To_Name_Buffer (Src_Name);
Src_TS := File_Stamp (Name_Find);
-- If the source does not exist, we need to recompile
if Src_TS = Empty_Time_Stamp then
if Start = Last then
if Verbose_Mode then
Write_Str (" -> source ");
Write_Str (Src_Name);
Write_Line (" does not exist");
end if;
Close (Dep_File);
return;
-- If the source has been modified after the object file,
-- we need to recompile.
elsif Src_TS > Source.Object_TS then
if Verbose_Mode then
Write_Str (" -> source ");
Write_Str (Src_Name);
Write_Line
(" has time stamp later than object file");
Write_Str (" -> dependency file ");
Write_Str (Dep_Name);
Write_Line (" has wrong format");
end if;
Close (Dep_File);
return;
end if;
end;
-- If the source path name ends the line, we are done
-- Look for the end of the source path name
exit Line_Loop when Finish = Last;
Finish := Start;
while Finish < Last loop
if Line (Finish) = '\' then
-- Go get the next source on the line
-- On Windows, a '\' is part of the path name,
-- except when it is followed by another '\' or by
-- a space. On other platforms, when we are getting
-- a '\' that is not the last character of the
-- line, the next character is part of the path
-- name, even if it is a space.
Start := Finish + 1;
end loop Name_Loop;
end;
if On_Windows and then
Line (Finish + 1) /= '\' and then
Line (Finish + 1) /= ' '
then
Finish := Finish + 1;
-- If we are here, we had a continuation character \ at the end
-- of the line, so we continue with the next line.
else
Line (Finish .. Last - 1) :=
Line (Finish + 1 .. Last);
Last := Last - 1;
end if;
Get_Line (Dep_File, Name_Buffer, Name_Len);
Start := 1;
end loop Line_Loop;
end if;
else
-- A space that is not preceded by '\' indicates
-- the end of the path name.
exit when Line (Finish + 1) = ' ';
Finish := Finish + 1;
end if;
end loop;
-- Check this source
declare
Src_Name : constant String :=
Normalize_Pathname
(Name =>
Line (Start .. Finish),
Resolve_Links => False,
Case_Sensitive => False);
Src_TS : Time_Stamp_Type;
begin
-- If it is original source, set
-- Source_In_Dependencies.
if Src_Name = Source_Path then
Source_In_Dependencies := True;
end if;
Name_Len := 0;
Add_Str_To_Name_Buffer (Src_Name);
Src_TS := File_Stamp (Name_Find);
-- If the source does not exist, we need to recompile
if Src_TS = Empty_Time_Stamp then
if Verbose_Mode then
Write_Str (" -> source ");
Write_Str (Src_Name);
Write_Line (" does not exist");
end if;
Close (Dep_File);
return;
-- If the source has been modified after the object
-- file, we need to recompile.
elsif Src_TS > Source.Object_TS then
if Verbose_Mode then
Write_Str (" -> source ");
Write_Str (Src_Name);
Write_Line
(" has time stamp later than object file");
end if;
Close (Dep_File);
return;
end if;
end;
-- If the source path name ends the line, we are done
exit Line_Loop when Finish = Last;
-- Go get the next source on the line
Start := Finish + 1;
end loop Name_Loop;
end;
-- If we are here, we had a continuation character \ at the end
-- of the line, so we continue with the next line.
Get_Line (Dep_File, Name_Buffer, Name_Len);
Start := 1;
end loop Line_Loop;
end if;
-- Set Looping at the end of the first loop
Looping := True;
end loop Big_Loop;
Close (Dep_File);
@ -3271,6 +3313,51 @@ package body Makegpr is
Prj.Initialize (Project_Tree);
Mains.Delete;
-- Add the directory where gprmake is invoked in front of the path,
-- if gprmake is invoked from a bin directory or with directory
-- information. information. Only do this if the platform is not VMS,
-- where the notion of path does not really exist.
-- Below code shares nasty code duplication with make.adb code???
if not OpenVMS then
declare
Prefix : constant String := Executable_Prefix_Path;
Command : constant String := Command_Name;
begin
if Prefix'Length > 0 then
declare
PATH : constant String :=
Prefix & Directory_Separator & "bin" &
Path_Separator &
Getenv ("PATH").all;
begin
Setenv ("PATH", PATH);
end;
else
for Index in reverse Command'Range loop
if Command (Index) = Directory_Separator then
declare
Absolute_Dir : constant String :=
Normalize_Pathname
(Command (Command'First .. Index));
PATH : constant String :=
Absolute_Dir &
Path_Separator &
Getenv ("PATH").all;
begin
Setenv ("PATH", PATH);
end;
exit;
end if;
end loop;
end if;
end;
end if;
-- Set Name_Ide and Name_Compiler_Command
Name_Len := 0;
@ -4107,6 +4194,9 @@ package body Makegpr is
Project_File_Name := new String'(Arg (3 .. Arg'Last));
end if;
elsif Arg = "-p" or else Arg = "--create-missing-dirs" then
Setup_Projects := True;
elsif Arg = "-q" then
Quiet_Output := True;
@ -4193,11 +4283,7 @@ package body Makegpr is
Write_Str ("Usage: ");
Osint.Write_Program_Name;
Write_Str (" -P<project file> [opts] [name] {");
for Lang in First_Language_Indexes loop
Write_Str ("[-cargs:lang opts] ");
end loop;
Write_Str ("[-cargs:lang opts] ");
Write_Str ("[-largs opts] [-gargs opts]}");
Write_Eol;
Write_Eol;
@ -4230,6 +4316,11 @@ package body Makegpr is
Write_Str (" -o name Choose an alternate executable name");
Write_Eol;
-- Line for -p
Write_Str (" -p Create missing obj, lib and exec dirs");
Write_Eol;
-- Line for -P
Write_Str (" -Pproj Use GNAT Project File proj");

29
gcc/ada/makeusg.adb
View File

@ -99,6 +99,11 @@ begin
"project files");
Write_Eol;
-- Line for -eS
Write_Str (" -eS Echo commands to stdout instead of stderr");
Write_Eol;
-- Line for -f
Write_Str (" -f Force recompilations of non predefined units");
@ -151,6 +156,11 @@ begin
Write_Str (" -o name Choose an alternate executable name");
Write_Eol;
-- Line for -p
Write_Str (" -p Create missing obj, lib and exec dirs");
Write_Eol;
-- Line for -P
Write_Str (" -Pproj Use GNAT Project File proj");
@ -171,10 +181,6 @@ begin
Write_Str (" -s Recompile if compiler switches have changed");
Write_Eol;
-- Line for -S
Write_Str (" -S Echo commands to stdout instead of stderr");
-- Line for -u
Write_Str (" -u Unique compilation, only compile the given files");
@ -195,6 +201,21 @@ begin
Write_Str (" -vPx Specify verbosity when parsing GNAT Project Files");
Write_Eol;
-- Line for -we
Write_Str (" -we treat all Warnings as Errors");
Write_Eol;
-- Line for -wn
Write_Str (" -wn Normal Warning mode (cancels -we/-ws)");
Write_Eol;
-- Line for -ws
Write_Str (" -ws Suppress all Warnings");
Write_Eol;
-- Line for -x
Write_Str (" -x " &

65
gcc/ada/makeutl.adb
View File

@ -24,6 +24,8 @@
-- --
------------------------------------------------------------------------------
with Ada.Command_Line; use Ada.Command_Line;
with Namet; use Namet;
with Osint; use Osint;
with Prj.Ext;
@ -31,6 +33,7 @@ with Prj.Util;
with Snames; use Snames;
with Table;
with System.Case_Util; use System.Case_Util;
with System.HTable;
package body Makeutl is
@ -117,6 +120,68 @@ package body Makeutl is
Marks.Reset;
end Delete_All_Marks;
----------------------------
-- Executable_Prefix_Path --
----------------------------
function Executable_Prefix_Path return String is
Exec_Name : constant String := Command_Name;
function Get_Install_Dir (S : String) return String;
-- S is the executable name preceeded by the absolute or relative
-- path, e.g. "c:\usr\bin\gcc.exe". Returns the absolute directory
-- where "bin" lies (in the example "C:\usr").
-- If the executable is not in a "bin" directory, return "".
---------------------
-- Get_Install_Dir --
---------------------
function Get_Install_Dir (S : String) return String is
Exec : String := S;
Path_Last : Integer := 0;
begin
for J in reverse Exec'Range loop
if Exec (J) = Directory_Separator then
Path_Last := J - 1;
exit;
end if;
end loop;
if Path_Last >= Exec'First + 2 then
To_Lower (Exec (Path_Last - 2 .. Path_Last));
end if;
if Path_Last < Exec'First + 2
or else Exec (Path_Last - 2 .. Path_Last) /= "bin"
or else (Path_Last - 3 >= Exec'First
and then Exec (Path_Last - 3) /= Directory_Separator)
then
return "";
end if;
return Normalize_Pathname (Exec (Exec'First .. Path_Last - 4));
end Get_Install_Dir;
-- Beginning of Executable_Prefix_Path
begin
-- First determine if a path prefix was placed in front of the
-- executable name.
for J in reverse Exec_Name'Range loop
if Exec_Name (J) = Directory_Separator then
return Get_Install_Dir (Exec_Name);
end if;
end loop;
-- If we get here, the user has typed the executable name with no
-- directory prefix.
return Get_Install_Dir (Locate_Exec_On_Path (Exec_Name).all);
end Executable_Prefix_Path;
----------
-- Hash --
----------

7
gcc/ada/makeutl.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- Copyright (C) 2004-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- --
@ -43,6 +43,11 @@ package Makeutl is
-- Find the index of a unit in a source file. Return zero if the file
-- is not a multi-unit source file.
function Executable_Prefix_Path return String;
-- Return the absolute path parent directory of the directory where the
-- current executable resides, if its directory is named "bin", otherwise
-- return an empty string.
function Is_External_Assignment (Argv : String) return Boolean;
-- Verify that an external assignment switch is syntactically correct
--

30
gcc/ada/par.adb
View File

@ -142,7 +142,7 @@ is
-- whose body is required and has not yet been found. The prefix SIS
-- stands for "Subprogram IS" handling.
SIS_Entry_Active : Boolean;
SIS_Entry_Active : Boolean := False;
-- Set True to indicate that an entry is active (i.e. that a subprogram
-- declaration has been encountered, and no body for this subprogram has
-- been encountered). The remaining fields are valid only if this is True.
@ -605,22 +605,22 @@ is
-- declaration of this type for details.
function P_Interface_Type_Definition
(Abstract_Present : Boolean;
Is_Synchronized : Boolean) return Node_Id;
(Abstract_Present : Boolean) return Node_Id;
-- Ada 2005 (AI-251): Parse the interface type definition part. Abstract
-- Present indicates if the reserved word "abstract" has been previously
-- found. It is used to report an error message because interface types
-- are by definition abstract tagged. Is_Synchronized is True in case of
-- task interfaces, protected interfaces, and synchronized interfaces;
-- it is used to generate a record_definition node. In the rest of cases
-- (limited interfaces and interfaces) we generate a record_definition
-- are by definition abstract tagged. We generate a record_definition
-- node if the list of interfaces is empty; otherwise we generate a
-- derived_type_definition node (the first interface in this list is the
-- ancestor interface).
function P_Null_Exclusion return Boolean;
-- Ada 2005 (AI-231): Parse the null-excluding part. True indicates
-- that the null-excluding part was present.
function P_Null_Exclusion
(Allow_Anonymous_In_95 : Boolean := False) return Boolean;
-- Ada 2005 (AI-231): Parse the null-excluding part. A True result
-- indicates that the null-excluding part was present.
-- Allow_Anonymous_In_95 is True if we are in a context that allows
-- anonymous access types in Ada 95, in which case "not null" is legal
-- if it precedes "access".
function P_Subtype_Indication
(Not_Null_Present : Boolean := False) return Node_Id;
@ -1362,13 +1362,9 @@ begin
Name := Uname (Uname'First .. Uname'Last - 2);
if Name = "ada" or else
Name = "calendar" or else
Name = "interfaces" or else
Name = "system" or else
Name = "machine_code" or else
Name = "unchecked_conversion" or else
Name = "unchecked_deallocation"
if Name = "ada" or else
Name = "interfaces" or else
Name = "system"
then
Error_Msg
("language defined units may not be recompiled",

11
gcc/ada/prj-proc.adb
View File

@ -26,7 +26,7 @@
with Err_Vars; use Err_Vars;
with Namet; use Namet;
with Opt;
with Opt; use Opt;
with Osint; use Osint;
with Output; use Output;
with Prj.Attr; use Prj.Attr;
@ -950,7 +950,7 @@ package body Prj.Proc is
Value := Prj.Ext.Value_Of (Name, Default);
if Value = No_Name then
if not Opt.Quiet_Output then
if not Quiet_Output then
if Error_Report = null then
Error_Msg
("?undefined external reference",
@ -1268,7 +1268,10 @@ package body Prj.Proc is
end loop;
end if;
Success := Total_Errors_Detected = 0;
Success :=
Total_Errors_Detected = 0
and then
(Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
end Process;
-------------------------------
@ -2295,7 +2298,7 @@ package body Prj.Proc is
(Imported_Project_List).Next;
end loop;
if Opt.Verbose_Mode then
if Verbose_Mode then
Write_Str ("Checking project file """);
Write_Str (Get_Name_String (Data.Name));
Write_Line ("""");

468
gcc/ada/switch-m.adb
View File

@ -363,44 +363,40 @@ package body Switch.M is
C := Switch_Chars (Ptr);
Ptr := Ptr + 1;
-- 'w' should be skipped in -gnatw
-- -gnatyMxxx
if C /= 'w' or else Storing (First_Stored) /= 'w' then
if C = 'M' and then
Storing (First_Stored) = 'y'
then
Last_Stored := First_Stored + 1;
Storing (Last_Stored) := 'M';
-- -gnatyMxxx
while Ptr <= Max loop
C := Switch_Chars (Ptr);
exit when C not in '0' .. '9';
Last_Stored := Last_Stored + 1;
Storing (Last_Stored) := C;
Ptr := Ptr + 1;
end loop;
if C = 'M'
and then Storing (First_Stored) = 'y' then
Last_Stored := First_Stored + 1;
Storing (Last_Stored) := 'M';
-- If there is no digit after -gnatyM,
-- the switch is invalid.
while Ptr <= Max loop
C := Switch_Chars (Ptr);
exit when C not in '0' .. '9';
Last_Stored := Last_Stored + 1;
Storing (Last_Stored) := C;
Ptr := Ptr + 1;
end loop;
if Last_Stored = First_Stored + 1 then
Last := 0;
return;
-- If there is no digit after -gnatyM,
-- the switch is invalid.
if Last_Stored = First_Stored + 1 then
Last := 0;
return;
else
Add_Switch_Component
(Storing (Storing'First .. Last_Stored));
end if;
else
Add_Switch_Component
(Storing (Storing'First .. Last_Stored));
end if;
-- All other switches are -gnatxx
else
Storing (First_Stored + 1) := C;
Add_Switch_Component
(Storing (Storing'First .. First_Stored + 1));
end if;
else
Storing (First_Stored + 1) := C;
Add_Switch_Component
(Storing (Storing'First .. First_Stored + 1));
end if;
end loop;
@ -481,12 +477,19 @@ package body Switch.M is
-- Scan_Make_Switches --
------------------------
procedure Scan_Make_Switches (Switch_Chars : String) is
procedure Scan_Make_Switches
(Switch_Chars : String;
Success : out Boolean)
is
Ptr : Integer := Switch_Chars'First;
Max : constant Integer := Switch_Chars'Last;
C : Character := ' ';
begin
-- Assume a good switch
Success := True;
-- Skip past the initial character (must be the switch character)
if Ptr = Max then
@ -496,70 +499,42 @@ package body Switch.M is
Ptr := Ptr + 1;
end if;
-- A little check, "gnat" at the start of a switch is not allowed
-- except for the compiler (where it was already removed)
-- A little check, "gnat" at the start of a switch is for the compiler
if Switch_Chars'Length >= Ptr + 3
and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
then
Osint.Fail
("invalid switch: """, Switch_Chars, """ (gnat not needed here)");
Success := False;
return;
end if;
-- Loop to scan through switches given in switch string
C := Switch_Chars (Ptr);
Check_Switch : begin
C := Switch_Chars (Ptr);
-- Multiple character switches
-- Processing for a switch
if Switch_Chars'Length > 2 then
if Switch_Chars = "--create-missing-dirs" then
Setup_Projects := True;
case C is
when 'a' =>
elsif C = 'v' and then Switch_Chars'Length = 3 then
Ptr := Ptr + 1;
Check_Readonly_Files := True;
Verbose_Mode := True;
-- Processing for b switch
case Switch_Chars (Ptr) is
when 'l' =>
Verbosity_Level := Opt.Low;
when 'b' =>
Ptr := Ptr + 1;
Bind_Only := True;
Make_Steps := True;
when 'm' =>
Verbosity_Level := Opt.Medium;
-- Processing for B switch
when 'h' =>
Verbosity_Level := Opt.High;
when 'B' =>
Ptr := Ptr + 1;
Build_Bind_And_Link_Full_Project := True;
when others =>
Success := False;
end case;
-- Processing for c switch
when 'c' =>
Ptr := Ptr + 1;
Compile_Only := True;
Make_Steps := True;
-- Processing for C switch
when 'C' =>
Ptr := Ptr + 1;
Create_Mapping_File := True;
-- Processing for D switch
when 'D' =>
Ptr := Ptr + 1;
if Object_Directory_Present then
Osint.Fail ("duplicate -D switch");
else
Object_Directory_Present := True;
end if;
-- Processing for d switch
when 'd' =>
elsif C = 'd' then
-- Note: for the debug switch, the remaining characters in this
-- switch field must all be debug flags, since all valid switch
@ -580,17 +555,9 @@ package body Switch.M is
end if;
end loop;
return;
-- Processing for e switch
when 'e' =>
elsif C = 'e' then
Ptr := Ptr + 1;
if Ptr > Max then
Bad_Switch (Switch_Chars);
end if;
case Switch_Chars (Ptr) is
-- Processing for eI switch
@ -599,164 +566,219 @@ package body Switch.M is
Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, Max, Ptr, Main_Index, C);
if Ptr <= Max then
Bad_Switch (Switch_Chars);
end if;
-- Processing for eL switch
when 'L' =>
Ptr := Ptr + 1;
Follow_Links := True;
if Ptr /= Max then
Bad_Switch (Switch_Chars);
else
Follow_Links := True;
end if;
-- Processing for eS switch
when 'S' =>
if Ptr /= Max then
Bad_Switch (Switch_Chars);
else
Commands_To_Stdout := True;
end if;
when others =>
Bad_Switch (Switch_Chars);
end case;
-- Processing for f switch
when 'f' =>
Ptr := Ptr + 1;
Force_Compilations := True;
-- Processing for F switch
when 'F' =>
Ptr := Ptr + 1;
Full_Path_Name_For_Brief_Errors := True;
-- Processing for h switch
when 'h' =>
Ptr := Ptr + 1;
Usage_Requested := True;
-- Processing for i switch
when 'i' =>
Ptr := Ptr + 1;
In_Place_Mode := True;
-- Processing for j switch
when 'j' =>
if Ptr = Max then
Bad_Switch (Switch_Chars);
end if;
elsif C = 'j' then
Ptr := Ptr + 1;
declare
Max_Proc : Pos;
begin
Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc, C);
Maximum_Processes := Positive (Max_Proc);
if Ptr <= Max then
Bad_Switch (Switch_Chars);
else
Maximum_Processes := Positive (Max_Proc);
end if;
end;
-- Processing for k switch
when 'k' =>
Ptr := Ptr + 1;
Keep_Going := True;
-- Processing for l switch
when 'l' =>
Ptr := Ptr + 1;
Link_Only := True;
Make_Steps := True;
when 'M' =>
Ptr := Ptr + 1;
List_Dependencies := True;
-- Processing for n switch
when 'n' =>
Ptr := Ptr + 1;
Do_Not_Execute := True;
-- Processing for o switch
when 'o' =>
elsif C = 'w' and then Switch_Chars'Length = 3 then
Ptr := Ptr + 1;
if Output_File_Name_Present then
Osint.Fail ("duplicate -o switch");
if Switch_Chars = "-we" then
Warning_Mode := Treat_As_Error;
elsif Switch_Chars = "-wn" then
Warning_Mode := Normal;
elsif Switch_Chars = "-ws" then
Warning_Mode := Suppress;
else
Output_File_Name_Present := True;
Success := False;
end if;
-- Processing for q switch
when 'q' =>
Ptr := Ptr + 1;
Quiet_Output := True;
-- Processing for R switch
when 'R' =>
Ptr := Ptr + 1;
Run_Path_Option := False;
-- Processing for s switch
when 's' =>
Ptr := Ptr + 1;
Check_Switches := True;
-- Processing for S switch
when 'S' =>
Ptr := Ptr + 1;
Commands_To_Stdout := True;
-- Processing for v switch
when 'v' =>
Ptr := Ptr + 1;
Verbose_Mode := True;
Verbosity_Level := Opt.High;
if Ptr <= Max then
case Switch_Chars (Ptr) is
when 'l' =>
Verbosity_Level := Opt.Low;
when 'm' =>
Verbosity_Level := Opt.Medium;
when 'h' =>
Verbosity_Level := Opt.High;
when others =>
Bad_Switch (Switch_Chars);
end case;
Ptr := Ptr + 1;
end if;
-- Processing for x switch
when 'x' =>
Ptr := Ptr + 1;
External_Unit_Compilation_Allowed := True;
-- Processing for z switch
when 'z' =>
Ptr := Ptr + 1;
No_Main_Subprogram := True;
-- Anything else is an error (illegal switch character)
when others =>
Bad_Switch (Switch_Chars);
end case;
if Ptr <= Max then
Bad_Switch (Switch_Chars);
else
Success := False;
end if;
end Check_Switch;
-- Single-character switches
else
Check_Switch : begin
case C is
when 'a' =>
Check_Readonly_Files := True;
-- Processing for b switch
when 'b' =>
Bind_Only := True;
Make_Steps := True;
-- Processing for B switch
when 'B' =>
Build_Bind_And_Link_Full_Project := True;
-- Processing for c switch
when 'c' =>
Compile_Only := True;
Make_Steps := True;
-- Processing for C switch
when 'C' =>
Create_Mapping_File := True;
-- Processing for D switch
when 'D' =>
if Object_Directory_Present then
Osint.Fail ("duplicate -D switch");
else
Object_Directory_Present := True;
end if;
-- Processing for f switch
when 'f' =>
Force_Compilations := True;
-- Processing for F switch
when 'F' =>
Full_Path_Name_For_Brief_Errors := True;
-- Processing for h switch
when 'h' =>
Usage_Requested := True;
-- Processing for i switch
when 'i' =>
In_Place_Mode := True;
-- Processing for j switch
when 'j' =>
-- -j not followed by a number is an error
Bad_Switch (Switch_Chars);
-- Processing for k switch
when 'k' =>
Keep_Going := True;
-- Processing for l switch
when 'l' =>
Link_Only := True;
Make_Steps := True;
-- Processing for M switch
when 'M' =>
List_Dependencies := True;
-- Processing for n switch
when 'n' =>
Do_Not_Execute := True;
-- Processing for o switch
when 'o' =>
if Output_File_Name_Present then
Osint.Fail ("duplicate -o switch");
else
Output_File_Name_Present := True;
end if;
-- Processing for p switch
when 'p' =>
Setup_Projects := True;
-- Processing for q switch
when 'q' =>
Quiet_Output := True;
-- Processing for R switch
when 'R' =>
Run_Path_Option := False;
-- Processing for s switch
when 's' =>
Ptr := Ptr + 1;
Check_Switches := True;
-- Processing for v switch
when 'v' =>
Verbose_Mode := True;
Verbosity_Level := Opt.High;
-- Processing for x switch
when 'x' =>
External_Unit_Compilation_Allowed := True;
-- Processing for z switch
when 'z' =>
No_Main_Subprogram := True;
-- Any other small letter is an illegal switch
when others =>
if C in 'a' .. 'z' then
Bad_Switch (Switch_Chars);
else
Success := False;
end if;
end case;
end Check_Switch;
end if;
end Scan_Make_Switches;
end Switch.M;

18
gcc/ada/switch-m.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001 Free Software Foundation, Inc. --
-- 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- --
@ -34,14 +34,14 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
package Switch.M is
procedure Scan_Make_Switches (Switch_Chars : String);
-- Procedures to scan out binder switches stored in the given string.
-- The first character is known to be a valid switch character, and there
-- are no blanks or other switch terminator characters in the string, so
-- the entire string should consist of valid switch characters, except that
-- an optional terminating NUL character is allowed. A bad switch causes
-- a fatal error exit and control does not return. The call also sets
-- Usage_Requested to True if a ? switch is encountered.
procedure Scan_Make_Switches
(Switch_Chars : String;
Success : out Boolean);
-- Scan a gnatmake switch and act accordingly. For switches that are
-- recognized, Success is set to True. A switch that is not recognized and
-- consists of one small letter causes a fatal error exit and control does
-- not return. For all other not recognized switches, Success is set to
-- False, so that the switch may be passed to the compiler.
procedure Normalize_Compiler_Switches
(Switch_Chars : String;

292
gcc/ada/vms_data.ads
View File

@ -1961,6 +1961,8 @@ package VMS_Data is
"-gnaty9 " &
"ATTRIBUTE " &
"-gnatya " &
"ARRAY_INDEXES " &
"-gnatyA " &
"BLANKS " &
"-gnatyb " &
"COMMENTS " &
@ -2030,6 +2032,12 @@ package VMS_Data is
-- underscore must be uppercase.
-- All other letters must be lowercase.
--
-- ARRAY_INDEXES Check indexes of array attributes.
-- For array attributes First, Last, Range,
-- or Length, the index number must be omitted
-- for one-dimensional arrays and is required
-- for multi-dimensional arrays.
--
-- BLANKS Blanks not allowed at statement end.
-- Trailing blanks are not allowed at the end of
-- statements. The purpose of this rule, together
@ -4101,6 +4109,14 @@ package VMS_Data is
-- when the only modifications to a source file consist in
-- adding/removing comments, empty lines, spaces or tabs.
S_Make_Missing : aliased constant S := "/CREATE_MISSING_DIRS " &
"-p";
-- /NOCREATE_MISSING_DIRS (D)
-- /CREATE_MISSING_DIRS
--
-- When an object directory, a library directory or an exec directory
-- in missing, attempt to create the directory.
S_Make_Nolink : aliased constant S := "/NOLINK " &
"-c";
-- /NOLINK
@ -4212,7 +4228,7 @@ package VMS_Data is
-- When looking for source files also look in the specified directories.
S_Make_Stand : aliased constant S := "/STANDARD_OUTPUT_FOR_COMMANDS " &
"-S";
"-eS";
-- /NOSTANDARD_OUTPUT_FOR_COMMANDS (D)
-- /STANDARD_OUTPUT_FOR_COMMANDS
--
@ -4286,6 +4302,7 @@ package VMS_Data is
S_Make_Med_Verb'Access,
S_Make_Mess 'Access,
S_Make_Minimal 'Access,
S_Make_Missing 'Access,
S_Make_Nolink 'Access,
S_Make_Nomain 'Access,
S_Make_Nonpro 'Access,
@ -4993,6 +5010,36 @@ package VMS_Data is
-- used in the default dictionary file, are defined in the GNAT User's
-- Guide.
S_Pretty_Encoding : aliased constant S := "/RESULT_ENCODING=" &
"BRACKETS " &
"-Wb " &
"HEX_ESC " &
"-Wh " &
"UPPER_HALF " &
"-Wu " &
"SHIFT_JIS " &
"-Ws " &
"EUC " &
"-We " &
"UTF_8 " &
"-W8";
-- /RESULT_ENCODING[=encoding-option]
--
-- Specify the wide character encoding of the result file.
-- '=encoding-option' may be one of:
--
-- BRACKETS (D) Brackets encoding.
--
-- HEX_ESC Hex ESC encoding.
--
-- UPPER_HALF Upper half encoding.
--
-- SHIFT_JIS Shift-JIS encoding.
--
-- EUC EUC Encoding.
--
-- UTF_8 UTF-8 encoding.
S_Pretty_Files : aliased constant S := "/FILES=@" &
"-files=@";
-- /FILES=filename
@ -5225,6 +5272,7 @@ package VMS_Data is
S_Pretty_Dico 'Access,
S_Pretty_Eol 'Access,
S_Pretty_Ext 'Access,
S_Pretty_Encoding 'Access,
S_Pretty_Files 'Access,
S_Pretty_Forced 'Access,
S_Pretty_Formfeed 'Access,
@ -5249,69 +5297,6 @@ package VMS_Data is
S_Pretty_Verbose 'Access,
S_Pretty_Warnings 'Access);
-----------------------------
-- Switches for GNAT SETUP --
-----------------------------
S_Setup_Ext : aliased constant S := "/EXTERNAL_REFERENCE=" & '"' &
"-X" & '"';
-- /EXTERNAL_REFERENCE="name=val"
--
-- Specifies an external reference to the project manager. Useful only if
-- /PROJECT_FILE is used.
--
-- Example:
-- /EXTERNAL_REFERENCE="DEBUG=TRUE"
S_Setup_Mess : aliased constant S := "/MESSAGES_PROJECT_FILE=" &
"DEFAULT " &
"-vP0 " &
"MEDIUM " &
"-vP1 " &
"HIGH " &
"-vP2";
-- /MESSAGES_PROJECT_FILE[=messages-option]
--
-- Specifies the "verbosity" of the parsing of project files.
-- messages-option may be one of the following:
--
-- DEFAULT (D) No messages are output if there is no error or warning.
--
-- MEDIUM A small number of messages are output.
--
-- HIGH A great number of messages are output, most of them not
-- being useful for the user.
S_Setup_Project : aliased constant S := "/PROJECT_FILE=<" &
"-P>";
-- /PROJECT_FILE=filename
--
-- Specifies the main project file to be used. The project files rooted
-- at the main project file are parsed and non existing object
-- directories, library directories and exec directories are created.
S_Setup_Quiet : aliased constant S := "/QUIET " &
"-q";
-- /NOQUIET (D)
-- /QUIET
--
-- Work quietly, only output warnings and errors.
S_Setup_Verbose : aliased constant S := "/VERBOSE " &
"-v";
-- /NOVERBOSE (D)
-- /VERBOSE
--
-- Verbose mode; GNAT PRETTY generates version information and then a
-- trace of the actions it takes to produce or obtain the ASIS tree.
Setup_Switches : aliased constant Switches :=
(S_Setup_Ext 'Access,
S_Setup_Mess 'Access,
S_Setup_Project 'Access,
S_Setup_Quiet 'Access,
S_Setup_Verbose 'Access);
------------------------------
-- Switches for GNAT SHARED --
------------------------------
@ -5390,6 +5375,185 @@ package VMS_Data is
S_Shared_Verb 'Access,
S_Shared_ZZZZZ 'Access);
-----------------------------
-- Switches for GNAT STACK --
-----------------------------
S_Stack_All : aliased constant S := "/ALL_SUBPROGRAMS " &
"-a";
-- /NOALL_SUBPROGRAMS (D)
-- /ALL_SUBPROGRAMS
--
-- Consider all subprograms as entry points.
S_Stack_All_Cycles : aliased constant S := "/ALL_CYCLES " &
"-ca";
-- /NOALL_CYCLES (D)
-- /ALL_CYCLES
--
-- Extract all possible cycles in the call graph.
S_Stack_All_Prjs : aliased constant S := "/ALL_PROJECTS " &
"-U";
-- /NOALL_PROJECTS (D)
-- /ALL_PROJECTS
--
-- When GNAT STACK is used with a Project File and no source is
-- specified, the underlying tool gnatstack is called for all the
-- units of all the Project Files in the project tree.
S_Stack_Debug : aliased constant S := "/DEBUG " &
"-g";
-- /NODEBUG (D)
-- /DEBUG
--
-- Generate internal debug information.
S_Stack_Directory : aliased constant S := "/DIRECTORY=*" &
"-aO*";
-- /DIRECTORY=(direc[,...])
--
-- When looking for .ci files look also in directories specified.
S_Stack_Entries : aliased constant S := "/ENTRIES=*" &
"-e*";
--
-- /ENTRY=(entry_point[,...])
--
-- Name of symbol to be used as entry point for the analysis.
S_Stack_Files : aliased constant S := "/FILES=@" &
"-files=@";
-- /FILES=filename
--
-- Take as arguments the files that are listed in the specified
-- text file.
S_Stack_Help : aliased constant S := "/HELP " &
"-h";
-- /NOHELP (D)
-- /HELP
--
-- Output a message explaining the usage of gnatstack.
S_Stack_List : aliased constant S := "/LIST=#" &
"-l#";
-- /LIST=nnn
--
-- Print the nnn subprograms requiring the biggest local stack usage. By
-- default none will be displayed.
S_Stack_Order : aliased constant S := "/ORDER=" &
"STACK " &
"-os " &
"ALPHABETICAL " &
"-oa";
-- /ORDER[=order-option]
--
-- Specifies the order for displaying the different call graphs.
-- order-option may be one of the following:
--
-- STACK (D) Select stack usage order
--
-- ALPHABETICAL Select alphabetical order
S_Stack_Path : aliased constant S := "/PATH " &
"-p";
-- /NOPATH (D)
-- /PATH
--
-- Print all the subprograms that make up the worst-case path for every
-- entry point.
S_Stack_Project : aliased constant S := "/PROJECT_FILE=<" &
"-P>";
-- /PROJECT_FILE=filename
--
-- Specifies the main project file to be used. The project files rooted
-- at the main project file will be parsed before the invocation of
-- gnatstack.
S_Stack_Output : aliased constant S := "/OUTPUT=@" &
"-f@";
-- /OUTPUT=filename
--
-- Name of the file containing the generated graph (VCG format).
S_Stack_Regexp : aliased constant S := "/EXPRESSION=|" &
"-r|";
--
-- /EXPRESSION=regular-expression
--
-- Any symbol matching the regular expression will be considered as a
-- potential entry point for the analysis.
S_Stack_Unbounded : aliased constant S := "/UNBOUNDED=#" &
"-d#";
-- /UNBOUNDED=nnn
--
-- Default stack size to be used for unbounded (dynamic) frames.
S_Stack_Unknown : aliased constant S := "/UNKNOWN=#" &
"-u#";
-- /UNKNOWN=nnn
--
-- Default stack size to be used for unknown (external) calls.
S_Stack_Verbose : aliased constant S := "/VERBOSE " &
"-v";
-- /NOVERBOSE (D)
-- /VERBOSE
--
-- Specifies the amount of information to be displayed about the
-- different subprograms. In verbose mode the full location of the
-- subprogram will be part of the output, as well as detailed information
-- about inaccurate data.
S_Stack_Warnings : aliased constant S := "/WARNINGS=" &
"ALL " &
"-Wa " &
"CYCLES " &
"-Wc " &
"UNBOUNDED " &
"-Wu " &
"EXTERNAL " &
"-We " &
"INDIRECT " &
"-Wi";
-- /WARNINGS[=(keyword[,...])]
--
-- The following keywords are supported:
--
-- ALL Turn on all optional warnings
--
-- CYCLES Turn on warnings for cycles
--
-- UNBOUNDED Turn on warnings for unbounded frames
--
-- EXTERNAL Turn on warnings for external calls
--
-- INDIRECT Turn on warnings for indirect calls
Stack_Switches : aliased constant Switches :=
(S_Stack_All 'Access,
S_Stack_All_Cycles 'Access,
S_Stack_All_Prjs 'Access,
S_Stack_Debug 'Access,
S_Stack_Directory 'Access,
S_Stack_Entries 'Access,
S_Stack_Files 'Access,
S_Stack_Help 'Access,
S_Stack_List 'Access,
S_Stack_Order 'Access,
S_Stack_Path 'Access,
S_Stack_Project 'Access,
S_Stack_Output 'Access,
S_Stack_Regexp 'Access,
S_Stack_Unbounded 'Access,
S_Stack_Unknown 'Access,
S_Stack_Verbose 'Access,
S_Stack_Warnings 'Access);
----------------------------
-- Switches for GNAT STUB --
----------------------------