Skip to content

R
riscv-gcc-1
Commit 68c3f02a by Vincent Celier Committed by Arnaud Charlet
Options

clean.adb (Parse_Cmd_Line): Recognize switch --subdirs= 

2008-04-08  Vincent Celier  <celier@adacore.com>

	* clean.adb (Parse_Cmd_Line): Recognize switch --subdirs=
	(Usage): Add line for switch --subdirs=
	Add new switch -eL, to follow symbolic links when processing project
	files.

	* gnatcmd.adb: Process switches -eL and --subdirs=
	(Non_VMS_Usage): Output "gnaampcmd" instead of "gnat", and call
	Program_Name to get proper tool names when AAMP_On_Target is set.
	(Gnatcmd): Call Add_Default_Search_Dirs and Get_Target_Parameters to get
	AAMP_On_Target set properly for use of GNAAMP tools (this is needed by
	Osint.Program_Name).

	* gnatname.adb: (Scan_Args): Recognize switches -eL and --subdirs=
	(Usage): Add lines for switches -eL and --subdirs=

	* makeusg.adb: Add line for switch --subdirs=

	* prj.ads: 
	(Source_Data): New Boolean component Compiled, defaulted to True
	(Empty_File_Name: New global variable in private part, initialized in
	procedure Initialize.
	(Subdirs_Option): New constant string
	(Subdirs): New String_Ptr global variable
	(Language_Config): New component Include_Compatible_Languages
	(Project_Qualifier): New type for project qualifiers
	(Project_Data): New component Qualifier
	(Project_Configuration): New component Archive_Builder_Append_Option

	* prj-nmsc.adb (Get_Unit_Exceptions): When a unit is already in
	another imported project indicate the name of this imported project.
	(Check_File): When a unit is in two project files, indicate the project
	names and the paths of the source files for each project.
	(Add_Source): Set Compiled to False if compiler driver is empty. Only
	set object, dependency and switches file names if Compiled is True.
	(Process_Compiler): Allow the empty string for value of attribute Driver
	(Get_Directories): When Subdirs is not null and Object_Dir is not
	 specified, locate and create if necessary the actual object dir.
	(Locate_Directory): When Subdirs is not empty and Create is not the
	empty string, locate and create if necessary the actual directory
	as a subdirectory of directory Name.
	(Check_Library_Attributes.Check_Library): Allow a project where the only
	"sources" are header files of file based languages to be imported by
	library projects, in multi-language mode (gprbuild).
	(Check_Library_Attributes.Check_Library): In multi-language mode
	(gprbuild), allow a library project to import a project with no
	sources, even when this is not declared explicitly.
	(Check_If_Externally_Built): A virtual project extending an externally
	built project is also externally built.
	(Check_Library_Attributes): For a virtual project extending a library
	project, inherit the library directory.
	(Process_Project_Level_Array_Attributes): Process new attribute
	Inherit_Source_Path.
	For projects with specified qualifiers "standard", "library" or
	"abstract", check that the project conforms to the qualifier.
	(Process_Project_Level_Simple_Attributes): Process new attribute
	 Archive_Builder_Append_Option.

	* switch-m.adb: (Scan_Make_Switches): Process switch --subdirs=
	(Normalize_Compiler_Switches): Only keep compiler switches that are
	passed to gnat1 by the gcc driver and that are stored in the ALI file
	by gnat1.
	Do not take into account switc -save-temps

	* makegpr.adb (Compile_Link_With_Gnatmake): Transmit switch -eL if
	gprmake is called with -eL.
	(Scan_Arg): Recognize switch -eL
	(Usage): Add line for switch -eL

	* prj.adb (Initialize): Initialize Empty_File_Name
	(Project_Empty): New component Qualifier

	* prj-attr.ads, prj-attr.adb: New project level attribute
	Inherit_Source_Path.
	New project level attribute Archive_Builder_Append_Option

	* prj-dect.adb: Replace System.Strings by GNAT.Strings.

	* prj-ext.adb (Initialize_Project_Path): In Multi_Language mode, add
	<prefix>/lib/gnat in the project path, after <prefix>/share/gpr, for
	upward compatibility.

	* prj-part.adb (Project_Path_Name_Of.Try_Path): In high verbosity, put
	each Trying ..." on different lines.
	(Parse_Single_Project): Recognize project qualifiers. Fail in qualifier
	is "configuration" when not in configuration. Fail when in configuration
	when a specified qualifier is other than "configuration".

	* prj-proc.adb (Process_Declarative_Items): Link new elements of copied
	full associative array together.
	(Recursive_Process): Put the project qualifier in the project data
	
	* prj-tree.ads, prj-tree.adb: (Project_Qualifier_Of): New function
	(Set_Project_Qualifier_Of): New procedure

From-SVN: r134023
parent a1e2130c
Showing with 813 additions and 318 deletions
gcc/ada/clean.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2003-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2003-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1669,6 +1669,18 @@ package body Clean is ...@@ -1669,6 +1669,18 @@ package body Clean is
end if; end if;
case Arg (2) is case Arg (2) is
when '-' =>
if Arg'Length > Subdirs_Option'Length and then
Arg (1 .. Subdirs_Option'Length) = Subdirs_Option
then
Subdirs :=
new String'
(Arg (Subdirs_Option'Length + 1 .. Arg'Last));
else
Bad_Argument;
end if;
when 'a' => when 'a' =>
if Arg'Length < 4 then if Arg'Length < 4 then
Bad_Argument; Bad_Argument;
...@@ -1725,6 +1737,14 @@ package body Clean is ...@@ -1725,6 +1737,14 @@ package body Clean is
end; end;
end if; end if;
when 'e' =>
if Arg = "-eL" then
Follow_Links_For_Files := True;
else
Bad_Argument;
end if;
when 'f' => when 'f' =>
Force_Deletions := True; Force_Deletions := True;
...@@ -1954,8 +1974,13 @@ package body Clean is ...@@ -1954,8 +1974,13 @@ package body Clean is
Put_Line (" names may be omitted if -P<project> is specified"); Put_Line (" names may be omitted if -P<project> is specified");
New_Line; New_Line;
Put_Line (" --subdirs=dir real obj/lib/exec dirs are subdirs");
New_Line;
Put_Line (" -c Only delete compiler generated files"); Put_Line (" -c Only delete compiler generated files");
Put_Line (" -D dir Specify dir as the object library"); Put_Line (" -D dir Specify dir as the object library");
Put_Line (" -eL Follow symbolic links when processing " &
"project files");
Put_Line (" -f Force deletions of unwritable files"); Put_Line (" -f Force deletions of unwritable files");
Put_Line (" -F Full project path name " & Put_Line (" -F Full project path name " &
"in brief error messages"); "in brief error messages");
......
gcc/ada/gnatcmd.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1996-2007, Free Software Foundation, Inc. -- -- Copyright (C) 1996-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -41,6 +41,7 @@ with Prj.Util; use Prj.Util; ...@@ -41,6 +41,7 @@ with Prj.Util; use Prj.Util;
with Sinput.P; with Sinput.P;
with Snames; use Snames; with Snames; use Snames;
with Table; with Table;
with Targparm;
with Tempdir; with Tempdir;
with Types; use Types; with Types; use Types;
with Hostparm; use Hostparm; with Hostparm; use Hostparm;
...@@ -233,7 +234,8 @@ procedure GNATCmd is ...@@ -233,7 +234,8 @@ procedure GNATCmd is
-- METRIC). -- METRIC).
procedure Delete_Temp_Config_Files; procedure Delete_Temp_Config_Files;
-- Delete all temporary config files -- Delete all temporary config files. The caller is responsible for
-- ensuring that Keep_Temporary_Files is False.
procedure Get_Closure; procedure Get_Closure;
-- Get the sources in the closure of the ASIS_Main and add them to the -- Get the sources in the closure of the ASIS_Main and add them to the
...@@ -721,38 +723,40 @@ procedure GNATCmd is ...@@ -721,38 +723,40 @@ procedure GNATCmd is
pragma Warnings (Off, Success); pragma Warnings (Off, Success);
begin begin
if not Keep_Temporary_Files then -- This should only be called if Keep_Temporary_Files is False
if Project /= No_Project then
for Prj in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
if
Project_Tree.Projects.Table (Prj).Config_File_Temp
then
if Verbose_Mode then
Output.Write_Str ("Deleting temp configuration file """);
Output.Write_Str
(Get_Name_String
(Project_Tree.Projects.Table
(Prj).Config_File_Name));
Output.Write_Line ("""");
end if;
Delete_File pragma Assert (not Keep_Temporary_Files);
(Name => Get_Name_String
if Project /= No_Project then
for Prj in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
if
Project_Tree.Projects.Table (Prj).Config_File_Temp
then
if Verbose_Mode then
Output.Write_Str ("Deleting temp configuration file """);
Output.Write_Str
(Get_Name_String
(Project_Tree.Projects.Table (Project_Tree.Projects.Table
(Prj).Config_File_Name), (Prj).Config_File_Name));
Success => Success); Output.Write_Line ("""");
end if; end if;
end loop;
end if;
-- If a temporary text file that contains a list of files for a tool Delete_File
-- has been created, delete this temporary file. (Name =>
Get_Name_String
(Project_Tree.Projects.Table (Prj).Config_File_Name),
Success => Success);
end if;
end loop;
end if;
if Temp_File_Name /= null then -- If a temporary text file that contains a list of files for a tool
Delete_File (Temp_File_Name.all, Success); -- has been created, delete this temporary file.
end if;
if Temp_File_Name /= null then
Delete_File (Temp_File_Name.all, Success);
end if; end if;
end Delete_Temp_Config_Files; end Delete_Temp_Config_Files;
...@@ -770,7 +774,8 @@ procedure GNATCmd is ...@@ -770,7 +774,8 @@ procedure GNATCmd is
6 => new String'("-bargs"), 6 => new String'("-bargs"),
7 => new String'("-R"), 7 => new String'("-R"),
8 => new String'("-Z")); 8 => new String'("-Z"));
-- Arguments of the invocation of gnatmake to get the list of -- Arguments for the invocation of gnatmake which are added to the
-- Last_Arguments list by this procedure.
FD : File_Descriptor; FD : File_Descriptor;
-- File descriptor for the temp file that will get the output of the -- File descriptor for the temp file that will get the output of the
...@@ -793,6 +798,8 @@ procedure GNATCmd is ...@@ -793,6 +798,8 @@ procedure GNATCmd is
File : Ada.Text_IO.File_Type; File : Ada.Text_IO.File_Type;
Line : String (1 .. 250); Line : String (1 .. 250);
Last : Natural; Last : Natural;
-- Used to read file if there is an error, it is good enough to display
-- just 250 characters if the first line of the file is very long.
Udata : Unit_Data; Udata : Unit_Data;
Path : Path_Name_Type; Path : Path_Name_Type;
...@@ -890,7 +897,6 @@ procedure GNATCmd is ...@@ -890,7 +897,6 @@ procedure GNATCmd is
if not Keep_Temporary_Files then if not Keep_Temporary_Files then
Delete (File); Delete (File);
else else
Close (File); Close (File);
end if; end if;
...@@ -1322,9 +1328,15 @@ procedure GNATCmd is ...@@ -1322,9 +1328,15 @@ procedure GNATCmd is
for C in Command_List'Range loop for C in Command_List'Range loop
if not Command_List (C).VMS_Only then if not Command_List (C).VMS_Only then
Put ("gnat " & To_Lower (Command_List (C).Cname.all)); if Targparm.AAMP_On_Target then
Put ("gnaampcmd ");
else
Put ("gnat ");
end if;
Put (To_Lower (Command_List (C).Cname.all));
Set_Col (25); Set_Col (25);
Put (Command_List (C).Unixcmd.all); Put (Program_Name (Command_List (C).Unixcmd.all).all);
declare declare
Sws : Argument_List_Access renames Command_List (C).Unixsws; Sws : Argument_List_Access renames Command_List (C).Unixsws;
...@@ -1375,6 +1387,16 @@ begin ...@@ -1375,6 +1387,16 @@ begin
Set_Mode (Ada_Only); Set_Mode (Ada_Only);
-- Add the default search directories, to be able to find system.ads in the
-- subsequent call to Targparm.Get_Target_Parameters.
Add_Default_Search_Dirs;
-- Get target parameters so that AAMP_On_Target will be set, for testing in
-- Osint.Program_Name to handle the mapping of GNAAMP tool names.
Targparm.Get_Target_Parameters;
-- Add the directory where the GNAT driver is invoked in front of the path, -- Add the directory where the GNAT driver is invoked in front of the path,
-- if the GNAT driver is invoked with directory information. Do not do this -- if the GNAT driver is invoked with directory information. Do not do this
-- for VMS, where the notion of path does not really exist. -- for VMS, where the notion of path does not really exist.
...@@ -1666,9 +1688,23 @@ begin ...@@ -1666,9 +1688,23 @@ begin
end if; end if;
end if; end if;
-- --subdirs=... Specify Subdirs
if Argv'Length > Subdirs_Option'Length and then
Argv
(Argv'First .. Argv'First + Subdirs_Option'Length - 1) =
Subdirs_Option
then
Subdirs :=
new String'
(Argv
(Argv'First + Subdirs_Option'Length .. Argv'Last));
Remove_Switch (Arg_Num);
-- -aPdir Add dir to the project search path -- -aPdir Add dir to the project search path
if Argv'Length > 3 elsif Argv'Length > 3
and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP" and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP"
then then
Add_Search_Project_Directory Add_Search_Project_Directory
...@@ -1676,6 +1712,13 @@ begin ...@@ -1676,6 +1712,13 @@ begin
Remove_Switch (Arg_Num); Remove_Switch (Arg_Num);
-- -eL Follow links for files
elsif Argv.all = "-eL" then
Follow_Links_For_Files := True;
Remove_Switch (Arg_Num);
-- -vPx Specify verbosity while parsing project files -- -vPx Specify verbosity while parsing project files
elsif Argv'Length = 4 elsif Argv'Length = 4
......
gcc/ada/gnatname.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -27,6 +27,7 @@ with Hostparm; ...@@ -27,6 +27,7 @@ with Hostparm;
with Opt; with Opt;
with Osint; use Osint; with Osint; use Osint;
with Output; use Output; with Output; use Output;
with Prj; use Prj;
with Prj.Makr; with Prj.Makr;
with Switch; use Switch; with Switch; use Switch;
with Table; with Table;
...@@ -194,10 +195,15 @@ procedure Gnatname is ...@@ -194,10 +195,15 @@ procedure Gnatname is
-- Scan options first -- Scan options first
loop loop
case Getopt ("c: d: gnatep=! gnatep! gnateD! D: h P: v x: f:") is case Getopt
("-subdirs=! c: d: gnatep=! gnatep! gnateD! eL D: h P: v x: f:")
is
when ASCII.NUL => when ASCII.NUL =>
exit; exit;
when '-' =>
Subdirs := new String'(Parameter);
when 'c' => when 'c' =>
if File_Set then if File_Set then
Fail ("only one -P or -c switch may be specified"); Fail ("only one -P or -c switch may be specified");
...@@ -213,6 +219,9 @@ procedure Gnatname is ...@@ -213,6 +219,9 @@ procedure Gnatname is
when 'D' => when 'D' =>
Get_Directories (Parameter); Get_Directories (Parameter);
when 'e' =>
Opt.Follow_Links_For_Files := True;
when 'f' => when 'f' =>
Foreign_Patterns.Increment_Last; Foreign_Patterns.Increment_Last;
Foreign_Patterns.Table (Foreign_Patterns.Last) := Foreign_Patterns.Table (Foreign_Patterns.Last) :=
...@@ -286,10 +295,15 @@ procedure Gnatname is ...@@ -286,10 +295,15 @@ procedure Gnatname is
Write_Eol; Write_Eol;
Write_Line ("switches:"); Write_Line ("switches:");
Write_Line (" --subdirs=dir real obj/lib/exec dirs are subdirs");
Write_Eol;
Write_Line (" -cfile create configuration pragmas file"); Write_Line (" -cfile create configuration pragmas file");
Write_Line (" -ddir use dir as one of the source " & Write_Line (" -ddir use dir as one of the source " &
"directories"); "directories");
Write_Line (" -Dfile get source directories from file"); Write_Line (" -Dfile get source directories from file");
Write_Line (" -eL follow symbolic links when processing " &
"project files");
Write_Line (" -fpat foreign pattern"); Write_Line (" -fpat foreign pattern");
Write_Line (" -gnateDsym=v preprocess with symbol definition"); Write_Line (" -gnateDsym=v preprocess with symbol definition");
Write_Line (" -gnatep=data preprocess files with data file"); Write_Line (" -gnatep=data preprocess files with data file");
......
gcc/ada/makegpr.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -283,6 +283,8 @@ package body Makegpr is ...@@ -283,6 +283,8 @@ package body Makegpr is
Dash_cargs : constant String_Access := Dash_cargs_String'Access; Dash_cargs : constant String_Access := Dash_cargs_String'Access;
Dash_d_String : aliased String := "-d"; Dash_d_String : aliased String := "-d";
Dash_d : constant String_Access := Dash_d_String'Access; Dash_d : constant String_Access := Dash_d_String'Access;
Dash_eL_String : aliased String := "-eL";
Dash_eL : constant String_Access := Dash_eL_String'Access;
Dash_f_String : aliased String := "-f"; Dash_f_String : aliased String := "-f";
Dash_f : constant String_Access := Dash_f_String'Access; Dash_f : constant String_Access := Dash_f_String'Access;
Dash_k_String : aliased String := "-k"; Dash_k_String : aliased String := "-k";
...@@ -2609,6 +2611,12 @@ package body Makegpr is ...@@ -2609,6 +2611,12 @@ package body Makegpr is
Add_Argument (Dash_d, True); Add_Argument (Dash_d, True);
end if; end if;
-- -eL
if Follow_Links_For_Files then
Add_Argument (Dash_eL, True);
end if;
-- -k -- -k
if Keep_Going then if Keep_Going then
...@@ -3375,8 +3383,8 @@ package body Makegpr is ...@@ -3375,8 +3383,8 @@ package body Makegpr is
-- Add the directory where gprmake is invoked in front of the path, -- Add the directory where gprmake is invoked in front of the path,
-- if gprmake is invoked from a bin directory or with directory -- if gprmake is invoked from a bin directory or with directory
-- information. Only do this if the platform is not VMS, -- information. Only do this if the platform is not VMS, where the
-- where the notion of path does not really exist. -- notion of path does not really exist.
-- Below code shares nasty code duplication with make.adb code??? -- Below code shares nasty code duplication with make.adb code???
...@@ -4231,6 +4239,9 @@ package body Makegpr is ...@@ -4231,6 +4239,9 @@ package body Makegpr is
elsif Arg = "-d" then elsif Arg = "-d" then
Display_Compilation_Progress := True; Display_Compilation_Progress := True;
elsif Arg = "-eL" then
Follow_Links_For_Files := True;
elsif Arg = "-f" then elsif Arg = "-f" then
Force_Compilations := True; Force_Compilations := True;
...@@ -4370,6 +4381,12 @@ package body Makegpr is ...@@ -4370,6 +4381,12 @@ package body Makegpr is
Write_Str (" -c Compile only"); Write_Str (" -c Compile only");
Write_Eol; Write_Eol;
-- Line for -eL
Write_Str (" -eL Follow symbolic links when processing " &
"project files");
Write_Eol;
-- Line for -f -- Line for -f
Write_Str (" -f Force recompilations"); Write_Str (" -f Force recompilations");
......
gcc/ada/makeusg.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -306,6 +306,11 @@ begin ...@@ -306,6 +306,11 @@ begin
Write_Str (" --RTS=dir specify the default source and object search" Write_Str (" --RTS=dir specify the default source and object search"
& " path"); & " path");
Write_Eol; Write_Eol;
-- Line for --subdirs=
Write_Str (" --subdirs=dir real obj/lib/exec dirs are subdirs");
Write_Eol;
Write_Eol; Write_Eol;
-- General Compiler, Binder, Linker switches -- General Compiler, Binder, Linker switches
......
gcc/ada/prj-attr.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -25,10 +25,13 @@ ...@@ -25,10 +25,13 @@
with Osint; with Osint;
with Prj.Com; use Prj.Com; with Prj.Com; use Prj.Com;
with System.Case_Util; use System.Case_Util;
with GNAT.Case_Util; use GNAT.Case_Util;
package body Prj.Attr is package body Prj.Attr is
use GNAT;
-- Data for predefined attributes and packages -- Data for predefined attributes and packages
-- Names are in lower case and end with '#' -- Names are in lower case and end with '#'
...@@ -74,6 +77,7 @@ package body Prj.Attr is ...@@ -74,6 +77,7 @@ package body Prj.Attr is
"SVobject_dir#" & "SVobject_dir#" &
"SVexec_dir#" & "SVexec_dir#" &
"LVsource_dirs#" & "LVsource_dirs#" &
"Lainherit_source_path#" &
"LVexcluded_source_dirs#" & "LVexcluded_source_dirs#" &
-- Source files -- Source files
...@@ -114,6 +118,7 @@ package body Prj.Attr is ...@@ -114,6 +118,7 @@ package body Prj.Attr is
-- Configuration - Archives -- Configuration - Archives
"LVarchive_builder#" & "LVarchive_builder#" &
"LVarchive_builder_append_option#" &
"LVarchive_indexer#" & "LVarchive_indexer#" &
"SVarchive_suffix#" & "SVarchive_suffix#" &
"LVlibrary_partial_linker#" & "LVlibrary_partial_linker#" &
......
gcc/ada/prj-attr.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -28,14 +28,13 @@ ...@@ -28,14 +28,13 @@
-- It is also possible to define new packages with their attributes -- It is also possible to define new packages with their attributes
with System.Strings;
with Table; with Table;
package Prj.Attr is with GNAT.Strings;
use System; package Prj.Attr is
function Package_Name_List return Strings.String_List; function Package_Name_List return GNAT.Strings.String_List;
-- Returns the list of valid package names, including those added by -- Returns the list of valid package names, including those added by
-- procedures Register_New_Package below. The String_Access components of -- procedures Register_New_Package below. The String_Access components of
-- the returned String_List should never be freed. -- the returned String_List should never be freed.
...@@ -55,6 +54,7 @@ package Prj.Attr is ...@@ -55,6 +54,7 @@ package Prj.Attr is
-- Characteristics of an attribute. Optional_Index indicates that there -- Characteristics of an attribute. Optional_Index indicates that there
-- may be an optional index in the index of the associative array, as in -- may be an optional index in the index of the associative array, as in
-- for Switches ("files.ada" at 2) use ... -- for Switches ("files.ada" at 2) use ...
-- Above character literals should be documented ???
subtype Defined_Attribute_Kind is Attribute_Kind subtype Defined_Attribute_Kind is Attribute_Kind
range Single .. Optional_Index_Case_Insensitive_Associative_Array; range Single .. Optional_Index_Case_Insensitive_Associative_Array;
......
gcc/ada/prj-dect.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -37,11 +37,11 @@ with Prj.Tree; use Prj.Tree; ...@@ -37,11 +37,11 @@ with Prj.Tree; use Prj.Tree;
with Snames; with Snames;
with Uintp; use Uintp; with Uintp; use Uintp;
with System.Strings; with GNAT.Strings;
package body Prj.Dect is package body Prj.Dect is
use System; use GNAT;
type Zone is (In_Project, In_Package, In_Case_Construction); type Zone is (In_Project, In_Package, In_Case_Construction);
-- Used to indicate if we are parsing a package (In_Package), -- Used to indicate if we are parsing a package (In_Package),
......
gcc/ada/prj-ext.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2000-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -260,19 +260,17 @@ package body Prj.Ext is ...@@ -260,19 +260,17 @@ package body Prj.Ext is
Prefix := new String'(Executable_Prefix_Path); Prefix := new String'(Executable_Prefix_Path);
if Prefix.all /= "" then if Prefix.all /= "" then
if Get_Mode = Ada_Only then if Get_Mode = Multi_Language then
Current_Project_Path := Add_Str_To_Name_Buffer
new String'(Name_Buffer (1 .. Name_Len) & (Path_Separator & Prefix.all &
Path_Separator & Directory_Separator & "share" &
Prefix.all & Directory_Separator & "gnat"); Directory_Separator & "gpr");
else
Current_Project_Path :=
new String'(Name_Buffer (1 .. Name_Len) &
Path_Separator &
Prefix.all & Directory_Separator &
"share" & Directory_Separator & "gpr");
end if; end if;
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
Directory_Separator & "lib" &
Directory_Separator & "gnat");
end if; end if;
else else
......
gcc/ada/prj-nmsc.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2000-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -610,7 +610,7 @@ package body Prj.Nmsc is ...@@ -610,7 +610,7 @@ package body Prj.Nmsc is
Src_Data : Source_Data := No_Source_Data; Src_Data : Source_Data := No_Source_Data;
begin begin
-- This is a new source. Create an entry for it in the Sources table. -- This is a new source so create an entry for it in the Sources table
Source_Data_Table.Increment_Last (In_Tree.Sources); Source_Data_Table.Increment_Last (In_Tree.Sources);
Id := Source_Data_Table.Last (In_Tree.Sources); Id := Source_Data_Table.Last (In_Tree.Sources);
...@@ -619,34 +619,41 @@ package body Prj.Nmsc is ...@@ -619,34 +619,41 @@ package body Prj.Nmsc is
Write_Str ("Adding source #"); Write_Str ("Adding source #");
Write_Str (Id'Img); Write_Str (Id'Img);
Write_Str (", File : "); Write_Str (", File : ");
Write_Str (Get_Name_String (File_Name));
if Lang_Kind = Unit_Based then if Lang_Kind = Unit_Based then
Write_Str (", Unit : "); Write_Str (", Unit : ");
Write_Str (Get_Name_String (Unit)); Write_Str (Get_Name_String (Unit));
end if; end if;
Write_Line (Get_Name_String (File_Name)); Write_Eol;
end if; end if;
Src_Data.Project := Project; Src_Data.Project := Project;
Src_Data.Language_Name := Lang; Src_Data.Language_Name := Lang;
Src_Data.Language := Lang_Id; Src_Data.Language := Lang_Id;
Src_Data.Lang_Kind := Lang_Kind; Src_Data.Lang_Kind := Lang_Kind;
Src_Data.Compiled := In_Tree.Languages_Data.Table
(Lang_Id).Config.Compiler_Driver /=
Empty_File_Name;
Src_Data.Kind := Kind; Src_Data.Kind := Kind;
Src_Data.Alternate_Languages := Alternate_Languages; Src_Data.Alternate_Languages := Alternate_Languages;
Src_Data.Other_Part := Other_Part; Src_Data.Other_Part := Other_Part;
Src_Data.Unit := Unit; Src_Data.Unit := Unit;
Src_Data.Index := Index; Src_Data.Index := Index;
Src_Data.File := File_Name; Src_Data.File := File_Name;
Src_Data.Object := Object_Name (File_Name);
Src_Data.Display_File := Display_File; Src_Data.Display_File := Display_File;
Src_Data.Dependency := Src_Data.Dependency := In_Tree.Languages_Data.Table
In_Tree.Languages_Data.Table (Lang_Id).Config.Dependency_Kind; (Lang_Id).Config.Dependency_Kind;
Src_Data.Dep_Name :=
Dependency_Name (File_Name, Src_Data.Dependency);
Src_Data.Switches := Switches_Name (File_Name);
Src_Data.Naming_Exception := Naming_Exception; Src_Data.Naming_Exception := Naming_Exception;
if Src_Data.Compiled then
Src_Data.Object := Object_Name (File_Name);
Src_Data.Dep_Name :=
Dependency_Name (File_Name, Src_Data.Dependency);
Src_Data.Switches := Switches_Name (File_Name);
end if;
if Path /= No_Path then if Path /= No_Path then
Src_Data.Path := Path; Src_Data.Path := Path;
Src_Data.Display_Path := Display_Path; Src_Data.Display_Path := Display_Path;
...@@ -732,6 +739,15 @@ package body Prj.Nmsc is ...@@ -732,6 +739,15 @@ package body Prj.Nmsc is
Check_Programming_Languages (In_Tree, Project, Data); Check_Programming_Languages (In_Tree, Project, Data);
if Data.Qualifier = Dry and then Data.Source_Dirs /= Nil_String then
Error_Msg
(Project,
In_Tree,
"an abstract project need to have no language, no sources or no " &
"source directories",
Data.Location);
end if;
-- Check configuration in multi language mode -- Check configuration in multi language mode
if Must_Check_Configuration then if Must_Check_Configuration then
...@@ -1475,14 +1491,6 @@ package body Prj.Nmsc is ...@@ -1475,14 +1491,6 @@ package body Prj.Nmsc is
Get_Name_String (Element.Value.Value); Get_Name_String (Element.Value.Value);
if Name_Len = 0 then
Error_Msg
(Project,
In_Tree,
"compiler driver name cannot be empty",
Element.Value.Location);
end if;
In_Tree.Languages_Data.Table In_Tree.Languages_Data.Table
(Lang_Index).Config.Compiler_Driver := (Lang_Index).Config.Compiler_Driver :=
File_Name_Type (Element.Value.Value); File_Name_Type (Element.Value.Value);
...@@ -1893,6 +1901,20 @@ package body Prj.Nmsc is ...@@ -1893,6 +1901,20 @@ package body Prj.Nmsc is
From_List => List, From_List => List,
In_Tree => In_Tree); In_Tree => In_Tree);
elsif Attribute.Name = Name_Archive_Builder_Append_Option then
-- Attribute Archive_Builder: the archive builder
-- (usually "ar") and its minimum options (usually "cr").
List := Attribute.Value.Values;
if List /= Nil_String then
Put
(Into_List => Data.Config.Archive_Builder_Append_Option,
From_List => List,
In_Tree => In_Tree);
end if;
elsif Attribute.Name = Name_Archive_Indexer then elsif Attribute.Name = Name_Archive_Indexer then
-- Attribute Archive_Indexer: the optional archive -- Attribute Archive_Indexer: the optional archive
...@@ -2043,9 +2065,9 @@ package body Prj.Nmsc is ...@@ -2043,9 +2065,9 @@ package body Prj.Nmsc is
Error_Msg Error_Msg
(Project, (Project,
In_Tree, In_Tree,
"invalid value """ & "invalid value """
Get_Name_String (Attribute.Value.Value) & & Get_Name_String (Attribute.Value.Value)
""" for Symbolic_Link_Supported", & """ for Symbolic_Link_Supported",
Attribute.Value.Location); Attribute.Value.Location);
end; end;
...@@ -2069,29 +2091,24 @@ package body Prj.Nmsc is ...@@ -2069,29 +2091,24 @@ package body Prj.Nmsc is
Attribute.Value.Location); Attribute.Value.Location);
end; end;
elsif elsif Attribute.Name = Name_Library_Auto_Init_Supported then
Attribute.Name = Name_Library_Auto_Init_Supported
then
declare declare
pragma Unsuppress (All_Checks); pragma Unsuppress (All_Checks);
begin begin
Data.Config.Auto_Init_Supported := Data.Config.Auto_Init_Supported :=
Boolean'Value (Get_Name_String Boolean'Value (Get_Name_String (Attribute.Value.Value));
(Attribute.Value.Value));
exception exception
when Constraint_Error => when Constraint_Error =>
Error_Msg Error_Msg
(Project, (Project,
In_Tree, In_Tree,
"invalid value """ & "invalid value """
Get_Name_String (Attribute.Value.Value) & & Get_Name_String (Attribute.Value.Value)
""" for Library_Auto_Init_Supported", & """ for Library_Auto_Init_Supported",
Attribute.Value.Location); Attribute.Value.Location);
end; end;
elsif elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
Attribute.Name = Name_Shared_Library_Minimum_Switches
then
List := Attribute.Value.Values; List := Attribute.Value.Values;
if List /= Nil_String then if List /= Nil_String then
...@@ -2100,9 +2117,7 @@ package body Prj.Nmsc is ...@@ -2100,9 +2117,7 @@ package body Prj.Nmsc is
In_Tree => In_Tree); In_Tree => In_Tree);
end if; end if;
elsif elsif Attribute.Name = Name_Library_Version_Switches then
Attribute.Name = Name_Library_Version_Switches
then
List := Attribute.Value.Values; List := Attribute.Value.Values;
if List /= Nil_String then if List /= Nil_String then
...@@ -2126,6 +2141,7 @@ package body Prj.Nmsc is ...@@ -2126,6 +2141,7 @@ package body Prj.Nmsc is
Current_Array : Array_Data; Current_Array : Array_Data;
Element_Id : Array_Element_Id; Element_Id : Array_Element_Id;
Element : Array_Element; Element : Array_Element;
List : String_List_Id;
begin begin
-- Process the associative array attributes at project level -- Process the associative array attributes at project level
...@@ -2144,6 +2160,19 @@ package body Prj.Nmsc is ...@@ -2144,6 +2160,19 @@ package body Prj.Nmsc is
if Lang_Index /= No_Language_Index then if Lang_Index /= No_Language_Index then
case Current_Array.Name is case Current_Array.Name is
when Name_Inherit_Source_Path =>
List := Element.Value.Values;
if List /= Nil_String then
Put
(Into_List =>
In_Tree.Languages_Data.Table (Lang_Index).
Config.Include_Compatible_Languages,
From_List => List,
In_Tree => In_Tree,
Lower_Case => True);
end if;
when Name_Toolchain_Description => when Name_Toolchain_Description =>
-- Attribute Toolchain_Description (<language>) -- Attribute Toolchain_Description (<language>)
...@@ -2613,6 +2642,14 @@ package body Prj.Nmsc is ...@@ -2613,6 +2642,14 @@ package body Prj.Nmsc is
end if; end if;
end if; end if;
-- A virtual project extending an externally built project is itself
-- externally built.
if Data.Virtual and then Data.Extends /= No_Project then
Data.Externally_Built :=
In_Tree.Projects.Table (Data.Extends).Externally_Built;
end if;
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str ("Project is "); Write_Str ("Project is ");
...@@ -2946,12 +2983,12 @@ package body Prj.Nmsc is ...@@ -2946,12 +2983,12 @@ package body Prj.Nmsc is
else else
Error_Msg_Name_1 := Unit; Error_Msg_Name_1 := Unit;
Error_Msg_Name_2 :=
In_Tree.Projects.Table (Other_Project).Name;
Error_Msg Error_Msg
(Project, (Project,
In_Tree, In_Tree,
"unit%% cannot belong to two projects " & "%% is already a source of project %%",
"simultaneously",
Element.Value.Location); Element.Value.Location);
end if; end if;
end if; end if;
...@@ -3534,6 +3571,8 @@ package body Prj.Nmsc is ...@@ -3534,6 +3571,8 @@ package body Prj.Nmsc is
Support_For_Libraries : Library_Support; Support_For_Libraries : Library_Support;
Library_Directory_Present : Boolean;
procedure Check_Library (Proj : Project_Id; Extends : Boolean); procedure Check_Library (Proj : Project_Id; Extends : Boolean);
-- Check if an imported or extended project if also a library project -- Check if an imported or extended project if also a library project
...@@ -3543,17 +3582,30 @@ package body Prj.Nmsc is ...@@ -3543,17 +3582,30 @@ package body Prj.Nmsc is
procedure Check_Library (Proj : Project_Id; Extends : Boolean) is procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
Proj_Data : Project_Data; Proj_Data : Project_Data;
Src_Id : Source_Id;
Src : Source_Data;
begin begin
if Proj /= No_Project then if Proj /= No_Project then
Proj_Data := In_Tree.Projects.Table (Proj); Proj_Data := In_Tree.Projects.Table (Proj);
if not Proj_Data.Library then if not Proj_Data.Library then
-- The only not library projects that are OK are those that -- The only not library projects that are OK are those that
-- have no sources. -- have no sources. However, header files from non-Ada
-- languages are OK, as there is nothing to compile.
Src_Id := Proj_Data.First_Source;
while Src_Id /= No_Source loop
Src := In_Tree.Sources.Table (Src_Id);
exit when Src.Lang_Kind /= File_Based
or else Src.Kind /= Spec;
if Proj_Data.Source_Dirs /= Nil_String then Src_Id := Src.Next_In_Project;
end loop;
if Src_Id /= No_Source then
Error_Msg_Name_1 := Data.Name; Error_Msg_Name_1 := Data.Name;
Error_Msg_Name_2 := Proj_Data.Name; Error_Msg_Name_2 := Proj_Data.Name;
...@@ -3608,6 +3660,8 @@ package body Prj.Nmsc is ...@@ -3608,6 +3660,8 @@ package body Prj.Nmsc is
-- Start of processing for Check_Library_Attributes -- Start of processing for Check_Library_Attributes
begin begin
Library_Directory_Present := Lib_Dir.Value /= Empty_String;
-- Special case of extending project -- Special case of extending project
if Data.Extends /= No_Project then if Data.Extends /= No_Project then
...@@ -3621,17 +3675,34 @@ package body Prj.Nmsc is ...@@ -3621,17 +3675,34 @@ package body Prj.Nmsc is
-- directory is specified. -- directory is specified.
if Extended_Data.Library then if Extended_Data.Library then
if Lib_Name.Default then if Data.Qualifier = Standard then
Data.Library_Name := Extended_Data.Library_Name; Error_Msg
end if; (Project, In_Tree,
"a standard project cannot extend a library project",
Data.Location);
if Lib_Dir.Default then else
if not Data.Virtual then if Lib_Name.Default then
Error_Msg Data.Library_Name := Extended_Data.Library_Name;
(Project, In_Tree, end if;
"a project extending a library project must " &
"specify an attribute Library_Dir", if Lib_Dir.Default then
Data.Location); if not Data.Virtual then
Error_Msg
(Project, In_Tree,
"a project extending a library project must " &
"specify an attribute Library_Dir",
Data.Location);
else
-- For a virtual project extending a library project,
-- inherit library directory.
Data.Library_Dir := Extended_Data.Library_Dir;
Data.Display_Library_Dir :=
Extended_Data.Display_Library_Dir;
Library_Directory_Present := True;
end if;
end if; end if;
end if; end if;
end if; end if;
...@@ -3662,24 +3733,26 @@ package body Prj.Nmsc is ...@@ -3662,24 +3733,26 @@ package body Prj.Nmsc is
pragma Assert (Lib_Dir.Kind = Single); pragma Assert (Lib_Dir.Kind = Single);
if Lib_Dir.Value = Empty_String then if not Library_Directory_Present then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Line ("No library directory"); Write_Line ("No library directory");
end if; end if;
else else
-- Find path name, check that it is a directory -- Find path name (unless inherited), check that it is a directory
Locate_Directory if Data.Library_Dir = No_Path then
(Project, Locate_Directory
In_Tree, (Project,
File_Name_Type (Lib_Dir.Value), In_Tree,
Data.Display_Directory, File_Name_Type (Lib_Dir.Value),
Data.Library_Dir, Data.Display_Directory,
Data.Display_Library_Dir, Data.Library_Dir,
Create => "library", Data.Display_Library_Dir,
Current_Dir => Current_Dir, Create => "library",
Location => Lib_Dir.Location); Current_Dir => Current_Dir,
Location => Lib_Dir.Location);
end if;
if Data.Library_Dir = No_Path then if Data.Library_Dir = No_Path then
...@@ -3817,6 +3890,30 @@ package body Prj.Nmsc is ...@@ -3817,6 +3890,30 @@ package body Prj.Nmsc is
and then and then
Data.Library_Name /= No_Name; Data.Library_Name /= No_Name;
if Data.Extends = No_Project then
case Data.Qualifier is
when Standard =>
if Data.Library then
Error_Msg
(Project, In_Tree,
"a standard project cannot be a library project",
Lib_Name.Location);
end if;
when Library =>
if not Data.Library then
Error_Msg
(Project, In_Tree,
"not a library project",
Data.Location);
end if;
when others =>
null;
end case;
end if;
if Data.Library then if Data.Library then
if Get_Mode = Multi_Language then if Get_Mode = Multi_Language then
Support_For_Libraries := Data.Config.Lib_Support; Support_For_Libraries := Data.Config.Lib_Support;
...@@ -4426,6 +4523,14 @@ package body Prj.Nmsc is ...@@ -4426,6 +4523,14 @@ package body Prj.Nmsc is
if Current = Nil_String then if Current = Nil_String then
Data.Source_Dirs := Nil_String; Data.Source_Dirs := Nil_String;
if Data.Qualifier = Standard then
Error_Msg
(Project,
In_Tree,
"a standard project cannot have no language declared",
Languages.Location);
end if;
else else
-- Look through all the languages specified in attribute -- Look through all the languages specified in attribute
-- Languages. -- Languages.
...@@ -6259,6 +6364,20 @@ package body Prj.Nmsc is ...@@ -6259,6 +6364,20 @@ package body Prj.Nmsc is
end if; end if;
end if; end if;
end if; end if;
elsif Subdirs /= null then
Name_Len := 1;
Name_Buffer (1) := '.';
Locate_Directory
(Project,
In_Tree,
Name_Find,
Data.Display_Directory,
Data.Object_Directory,
Data.Display_Object_Dir,
Create => "object",
Location => Object_Dir.Location,
Current_Dir => Current_Dir);
end if; end if;
if Current_Verbosity = High then if Current_Verbosity = High then
...@@ -6291,7 +6410,7 @@ package body Prj.Nmsc is ...@@ -6291,7 +6410,7 @@ package body Prj.Nmsc is
Exec_Dir.Location); Exec_Dir.Location);
else else
-- We check that the specified object directory does exist -- We check that the specified exec directory does exist
Locate_Directory Locate_Directory
(Project, (Project,
...@@ -6337,6 +6456,14 @@ package body Prj.Nmsc is ...@@ -6337,6 +6456,14 @@ package body Prj.Nmsc is
then then
Data.Source_Dirs := Nil_String; Data.Source_Dirs := Nil_String;
if Data.Qualifier = Standard then
Error_Msg
(Project,
In_Tree,
"a standard project cannot have no sources",
Source_Files.Location);
end if;
if Data.Extends = No_Project if Data.Extends = No_Project
and then Data.Object_Directory = Data.Directory and then Data.Object_Directory = Data.Directory
then then
...@@ -6368,6 +6495,13 @@ package body Prj.Nmsc is ...@@ -6368,6 +6495,13 @@ package body Prj.Nmsc is
end if; end if;
elsif Source_Dirs.Values = Nil_String then elsif Source_Dirs.Values = Nil_String then
if Data.Qualifier = Standard then
Error_Msg
(Project,
In_Tree,
"a standard project cannot have no source directories",
Source_Dirs.Location);
end if;
-- If Source_Dirs is an empty string list, this means that this -- If Source_Dirs is an empty string list, this means that this
-- project contains no source. For projects that don't extend other -- project contains no source. For projects that don't extend other
...@@ -6940,8 +7074,6 @@ package body Prj.Nmsc is ...@@ -6940,8 +7074,6 @@ package body Prj.Nmsc is
Current_Dir : String; Current_Dir : String;
Location : Source_Ptr := No_Location) Location : Source_Ptr := No_Location)
is is
The_Name : String := Get_Name_String (Name);
The_Parent : constant String := The_Parent : constant String :=
Get_Name_String (Parent) & Directory_Separator; Get_Name_String (Parent) & Directory_Separator;
...@@ -6950,18 +7082,35 @@ package body Prj.Nmsc is ...@@ -6950,18 +7082,35 @@ package body Prj.Nmsc is
Full_Name : File_Name_Type; Full_Name : File_Name_Type;
The_Name : File_Name_Type;
begin begin
Get_Name_String (Name);
-- Add Subdirs.all if it is a directory that may be created and
-- Subdirs is not null;
if Create /= "" and then Subdirs /= null then
if Name_Buffer (Name_Len) /= Directory_Separator then
Add_Char_To_Name_Buffer (Directory_Separator);
end if;
Add_Str_To_Name_Buffer (Subdirs.all);
end if;
-- Convert '/' to directory separator (for Windows) -- Convert '/' to directory separator (for Windows)
for J in The_Name'Range loop for J in 1 .. Name_Len loop
if The_Name (J) = '/' then if Name_Buffer (J) = '/' then
The_Name (J) := Directory_Separator; Name_Buffer (J) := Directory_Separator;
end if; end if;
end loop; end loop;
The_Name := Name_Find;
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str ("Locate_Directory ("""); Write_Str ("Locate_Directory (""");
Write_Str (The_Name); Write_Str (Get_Name_String (The_Name));
Write_Str (""", """); Write_Str (""", """);
Write_Str (The_Parent); Write_Str (The_Parent);
Write_Line (""")"); Write_Line (""")");
...@@ -6970,14 +7119,14 @@ package body Prj.Nmsc is ...@@ -6970,14 +7119,14 @@ package body Prj.Nmsc is
Dir := No_Path; Dir := No_Path;
Display := No_Path; Display := No_Path;
if Is_Absolute_Path (The_Name) then if Is_Absolute_Path (Get_Name_String (The_Name)) then
Full_Name := Name; Full_Name := The_Name;
else else
Name_Len := 0; Name_Len := 0;
Add_Str_To_Name_Buffer Add_Str_To_Name_Buffer
(The_Parent (The_Parent'First .. The_Parent_Last)); (The_Parent (The_Parent'First .. The_Parent_Last));
Add_Str_To_Name_Buffer (The_Name); Add_Str_To_Name_Buffer (Get_Name_String (The_Name));
Full_Name := Name_Find; Full_Name := Name_Find;
end if; end if;
...@@ -6985,7 +7134,8 @@ package body Prj.Nmsc is ...@@ -6985,7 +7134,8 @@ package body Prj.Nmsc is
Full_Path_Name : constant String := Get_Name_String (Full_Name); Full_Path_Name : constant String := Get_Name_String (Full_Name);
begin begin
if Setup_Projects and then Create'Length > 0 if (Setup_Projects or else Subdirs /= null)
and then Create'Length > 0
and then not Is_Directory (Full_Path_Name) and then not Is_Directory (Full_Path_Name)
then then
begin begin
...@@ -7331,7 +7481,7 @@ package body Prj.Nmsc is ...@@ -7331,7 +7481,7 @@ package body Prj.Nmsc is
and then Lang = Ada_Language_Index and then Lang = Ada_Language_Index
and then Data.Extends = No_Project and then Data.Extends = No_Project
then then
-- We should have found at least one source. If not, report an error. -- We should have found at least one source, if not report an error
if Data.Ada_Sources = Nil_String then if Data.Ada_Sources = Nil_String then
Report_No_Sources Report_No_Sources
...@@ -7979,8 +8129,10 @@ package body Prj.Nmsc is ...@@ -7979,8 +8129,10 @@ package body Prj.Nmsc is
Kind => Kind); Kind => Kind);
if Language = No_Language_Index then if Language = No_Language_Index then
-- A file name in a list must be a source of a language
if Name_Loc.Found then if Name_Loc.Found then
-- A file name in a list must be a source of a language.
Error_Msg_File_1 := File_Name; Error_Msg_File_1 := File_Name;
Error_Msg Error_Msg
(Project, (Project,
...@@ -8045,9 +8197,24 @@ package body Prj.Nmsc is ...@@ -8045,9 +8197,24 @@ package body Prj.Nmsc is
Error_Msg_Name_1 := Unit; Error_Msg_Name_1 := Unit;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"unit %% cannot belong to " & "unit %% cannot belong to several projects",
"several projects",
No_Location); No_Location);
Error_Msg_Name_1 := In_Tree.Projects.Table (Project).Name;
Error_Msg_Name_2 := Name_Id (Display_Path_Id);
Error_Msg
(Project, In_Tree,
"\ project %%, %%",
No_Location);
Error_Msg_Name_1 :=
In_Tree.Projects.Table (Src_Data.Project).Name;
Error_Msg_Name_2 := Name_Id (Src_Data.Display_Path);
Error_Msg
(Project, In_Tree,
"\ project %%, %%",
No_Location);
Add_Src := False; Add_Src := False;
end if; end if;
end if; end if;
...@@ -8847,7 +9014,7 @@ package body Prj.Nmsc is ...@@ -8847,7 +9014,7 @@ package body Prj.Nmsc is
Err_Vars.Error_Msg_Name_1 := Unit_Name; Err_Vars.Error_Msg_Name_1 := Unit_Name;
Error_Msg Error_Msg
(Project, In_Tree, "duplicate source %%", The_Location); (Project, In_Tree, "duplicate unit %%", The_Location);
Err_Vars.Error_Msg_Name_1 := Err_Vars.Error_Msg_Name_1 :=
In_Tree.Projects.Table In_Tree.Projects.Table
......
gcc/ada/prj-part.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -945,6 +945,9 @@ package body Prj.Part is ...@@ -945,6 +945,9 @@ package body Prj.Part is
Project_Comment_State : Tree.Comment_State; Project_Comment_State : Tree.Comment_State;
Proj_Qualifier : Project_Qualifier := Unspecified;
Qualifier_Location : Source_Ptr;
begin begin
Extends_All := False; Extends_All := False;
...@@ -1119,8 +1122,63 @@ package body Prj.Part is ...@@ -1119,8 +1122,63 @@ package body Prj.Part is
Project_Stack.Table (Project_Stack.Last).Id := Project; Project_Stack.Table (Project_Stack.Last).Id := Project;
Set_Directory_Of (Project, In_Tree, Project_Directory); Set_Directory_Of (Project, In_Tree, Project_Directory);
Set_Path_Name_Of (Project, In_Tree, Normed_Path_Name); Set_Path_Name_Of (Project, In_Tree, Normed_Path_Name);
Set_Location_Of (Project, In_Tree, Token_Ptr);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
-- Check if there is a qualifier before the reserved word "project"
Qualifier_Location := Token_Ptr;
if Token = Tok_Abstract then
Proj_Qualifier := Dry;
Scan (In_Tree);
elsif Token = Tok_Identifier then
case Token_Name is
when Snames.Name_Standard =>
Proj_Qualifier := Standard;
Scan (In_Tree);
when Snames.Name_Aggregate =>
Proj_Qualifier := Aggregate;
Scan (In_Tree);
if Token = Tok_Identifier and then
Token_Name = Snames.Name_Library
then
Proj_Qualifier := Aggregate_Library;
Scan (In_Tree);
end if;
when Snames.Name_Library =>
Proj_Qualifier := Library;
Scan (In_Tree);
when Snames.Name_Configuration =>
if not In_Configuration then
Error_Msg ("configuration projects cannot belong to a user" &
" project tree",
Token_Ptr);
end if;
Scan (In_Tree);
when others =>
null;
end case;
end if;
if Proj_Qualifier /= Unspecified then
if In_Configuration then
Error_Msg ("a configuration project cannot be qualified except " &
"as configuration project",
Qualifier_Location);
end if;
Set_Project_Qualifier_Of (Project, In_Tree, Proj_Qualifier);
end if;
Set_Location_Of (Project, In_Tree, Token_Ptr);
Expect (Tok_Project, "PROJECT"); Expect (Tok_Project, "PROJECT");
-- Mark location of PROJECT token if present -- Mark location of PROJECT token if present
...@@ -1780,7 +1838,7 @@ package body Prj.Part is ...@@ -1780,7 +1838,7 @@ package body Prj.Part is
begin begin
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str (" Trying "); Write_Str (" Trying ");
Write_Str (Path); Write_Line (Path);
end if; end if;
return Locate_Regular_File return Locate_Regular_File
......
gcc/ada/prj-proc.adb
...@@ -1621,8 +1621,11 @@ package body Prj.Proc is ...@@ -1621,8 +1621,11 @@ package body Prj.Proc is
if Next_Element = No_Array_Element then if Next_Element = No_Array_Element then
Array_Element_Table.Increment_Last Array_Element_Table.Increment_Last
(In_Tree.Array_Elements); (In_Tree.Array_Elements);
New_Element := Array_Element_Table.Last New_Element :=
(In_Tree.Array_Elements); Array_Element_Table.Last
(In_Tree.Array_Elements);
In_Tree.Array_Elements.Table
(Prev_Element).Next := New_Element;
else else
New_Element := Next_Element; New_Element := Next_Element;
...@@ -1636,8 +1639,7 @@ package body Prj.Proc is ...@@ -1636,8 +1639,7 @@ package body Prj.Proc is
In_Tree.Array_Elements.Table In_Tree.Array_Elements.Table
(New_Element) := (New_Element) :=
In_Tree.Array_Elements.Table In_Tree.Array_Elements.Table (Orig_Element);
(Orig_Element);
In_Tree.Array_Elements.Table In_Tree.Array_Elements.Table
(New_Element).Value.Project := Project; (New_Element).Value.Project := Project;
...@@ -1872,9 +1874,7 @@ package body Prj.Proc is ...@@ -1872,9 +1874,7 @@ package body Prj.Proc is
else else
In_Tree.Variable_Elements.Table In_Tree.Variable_Elements.Table
(The_Variable).Value := (The_Variable).Value := New_Value;
New_Value;
end if; end if;
-- Associative array attribute -- Associative array attribute
...@@ -2524,7 +2524,11 @@ package body Prj.Proc is ...@@ -2524,7 +2524,11 @@ package body Prj.Proc is
Processed_Projects.Set (Name, Project); Processed_Projects.Set (Name, Project);
Processed_Data.Name := Name; Processed_Data.Name := Name;
Processed_Data.Qualifier :=
Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree);
In_Tree.Projects.Table (Project).Name := Name; In_Tree.Projects.Table (Project).Name := Name;
In_Tree.Projects.Table (Project).Qualifier :=
Processed_Data.Qualifier;
Get_Name_String (Name); Get_Name_String (Name);
...@@ -2786,6 +2790,8 @@ package body Prj.Proc is ...@@ -2786,6 +2790,8 @@ package body Prj.Proc is
end if; end if;
end if; end if;
end; end;
In_Tree.Projects.Table (Project) := Processed_Data;
end if; end if;
-- Process limited withed projects -- Process limited withed projects
......
gcc/ada/prj-tree.adb
...@@ -108,6 +108,7 @@ package body Prj.Tree is ...@@ -108,6 +108,7 @@ package body Prj.Tree is
In_Tree.Project_Nodes.Table In_Tree.Project_Nodes.Table
(Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
(Kind => N_Comment_Zones, (Kind => N_Comment_Zones,
Qualifier => Unspecified,
Expr_Kind => Undefined, Expr_Kind => Undefined,
Location => No_Location, Location => No_Location,
Directory => No_Path, Directory => No_Path,
...@@ -153,6 +154,7 @@ package body Prj.Tree is ...@@ -153,6 +154,7 @@ package body Prj.Tree is
In_Tree.Project_Nodes.Table In_Tree.Project_Nodes.Table
(Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
(Kind => N_Comment, (Kind => N_Comment,
Qualifier => Unspecified,
Expr_Kind => Undefined, Expr_Kind => Undefined,
Flag1 => Comments.Table (J).Follows_Empty_Line, Flag1 => Comments.Table (J).Follows_Empty_Line,
Flag2 => Flag2 =>
...@@ -321,6 +323,7 @@ package body Prj.Tree is ...@@ -321,6 +323,7 @@ package body Prj.Tree is
Zone := Project_Node_Table.Last (In_Tree.Project_Nodes); Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
In_Tree.Project_Nodes.Table (Zone) := In_Tree.Project_Nodes.Table (Zone) :=
(Kind => N_Comment_Zones, (Kind => N_Comment_Zones,
Qualifier => Unspecified,
Location => No_Location, Location => No_Location,
Directory => No_Path, Directory => No_Path,
Expr_Kind => Undefined, Expr_Kind => Undefined,
...@@ -395,6 +398,7 @@ package body Prj.Tree is ...@@ -395,6 +398,7 @@ package body Prj.Tree is
In_Tree.Project_Nodes.Table In_Tree.Project_Nodes.Table
(Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
(Kind => Of_Kind, (Kind => Of_Kind,
Qualifier => Unspecified,
Location => No_Location, Location => No_Location,
Directory => No_Path, Directory => No_Path,
Expr_Kind => And_Expr_Kind, Expr_Kind => And_Expr_Kind,
...@@ -429,6 +433,7 @@ package body Prj.Tree is ...@@ -429,6 +433,7 @@ package body Prj.Tree is
In_Tree.Project_Nodes.Table In_Tree.Project_Nodes.Table
(Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
(Kind => N_Comment_Zones, (Kind => N_Comment_Zones,
Qualifier => Unspecified,
Expr_Kind => Undefined, Expr_Kind => Undefined,
Location => No_Location, Location => No_Location,
Directory => No_Path, Directory => No_Path,
...@@ -458,6 +463,7 @@ package body Prj.Tree is ...@@ -458,6 +463,7 @@ package body Prj.Tree is
In_Tree.Project_Nodes.Table In_Tree.Project_Nodes.Table
(Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
(Kind => N_Comment, (Kind => N_Comment,
Qualifier => Unspecified,
Expr_Kind => Undefined, Expr_Kind => Undefined,
Flag1 => Comments.Table (J).Follows_Empty_Line, Flag1 => Comments.Table (J).Follows_Empty_Line,
Flag2 => Flag2 =>
...@@ -1352,6 +1358,22 @@ package body Prj.Tree is ...@@ -1352,6 +1358,22 @@ package body Prj.Tree is
return In_Tree.Project_Nodes.Table (Node).Field2; return In_Tree.Project_Nodes.Table (Node).Field2;
end Project_Declaration_Of; end Project_Declaration_Of;
--------------------------
-- Project_Qualifier_Of --
--------------------------
function Project_Qualifier_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Qualifier
is
begin
pragma Assert
(Node /= Empty_Node
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Qualifier;
end Project_Qualifier_Of;
------------------------------------------- -------------------------------------------
-- Project_File_Includes_Unkept_Comments -- -- Project_File_Includes_Unkept_Comments --
------------------------------------------- -------------------------------------------
...@@ -2467,6 +2489,22 @@ package body Prj.Tree is ...@@ -2467,6 +2489,22 @@ package body Prj.Tree is
In_Tree.Project_Nodes.Table (Node).Field2 := To; In_Tree.Project_Nodes.Table (Node).Field2 := To;
end Set_Project_Declaration_Of; end Set_Project_Declaration_Of;
------------------------------
-- Set_Project_Qualifier_Of --
------------------------------
procedure Set_Project_Qualifier_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Qualifier)
is
begin
pragma Assert
(Node /= Empty_Node
and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Qualifier := To;
end Set_Project_Qualifier_Of;
----------------------------------------------- -----------------------------------------------
-- Set_Project_File_Includes_Unkept_Comments -- -- Set_Project_File_Includes_Unkept_Comments --
----------------------------------------------- -----------------------------------------------
......
gcc/ada/prj-tree.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -344,6 +344,12 @@ package Prj.Tree is ...@@ -344,6 +344,12 @@ package Prj.Tree is
pragma Inline (Project_Declaration_Of); pragma Inline (Project_Declaration_Of);
-- Only valid for N_Project nodes -- Only valid for N_Project nodes
function Project_Qualifier_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Qualifier;
pragma Inline (Project_Qualifier_Of);
-- Only valid for N_Project nodes
function Extending_Project_Of function Extending_Project_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
...@@ -694,6 +700,12 @@ package Prj.Tree is ...@@ -694,6 +700,12 @@ package Prj.Tree is
To : Project_Node_Id); To : Project_Node_Id);
pragma Inline (Set_Project_Declaration_Of); pragma Inline (Set_Project_Declaration_Of);
procedure Set_Project_Qualifier_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Qualifier);
pragma Inline (Set_Project_Qualifier_Of);
procedure Set_Extending_Project_Of procedure Set_Extending_Project_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref; In_Tree : Project_Node_Tree_Ref;
...@@ -912,6 +924,8 @@ package Prj.Tree is ...@@ -912,6 +924,8 @@ package Prj.Tree is
Kind : Project_Node_Kind; Kind : Project_Node_Kind;
Qualifier : Project_Qualifier := Unspecified;
Location : Source_Ptr := No_Location; Location : Source_Ptr := No_Location;
Directory : Path_Name_Type := No_Path; Directory : Path_Name_Type := No_Path;
......
gcc/ada/prj.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -88,84 +88,87 @@ package body Prj is ...@@ -88,84 +88,87 @@ package body Prj is
Supp_Suffixes => No_Supp_Language_Index); Supp_Suffixes => No_Supp_Language_Index);
Project_Empty : constant Project_Data := Project_Empty : constant Project_Data :=
(Externally_Built => False, (Qualifier => Unspecified,
Config => Default_Project_Config, Externally_Built => False,
Languages => No_Name_List, Config => Default_Project_Config,
First_Referred_By => No_Project, Languages => No_Name_List,
Name => No_Name, First_Referred_By => No_Project,
Display_Name => No_Name, Name => No_Name,
Path_Name => No_Path, Display_Name => No_Name,
Display_Path_Name => No_Path, Path_Name => No_Path,
Virtual => False, Display_Path_Name => No_Path,
Location => No_Location, Virtual => False,
Mains => Nil_String, Location => No_Location,
Directory => No_Path, Mains => Nil_String,
Display_Directory => No_Path, Directory => No_Path,
Dir_Path => null, Display_Directory => No_Path,
Library => False, Dir_Path => null,
Library_Dir => No_Path, Library => False,
Display_Library_Dir => No_Path, Library_Dir => No_Path,
Library_Src_Dir => No_Path, Display_Library_Dir => No_Path,
Display_Library_Src_Dir => No_Path, Library_Src_Dir => No_Path,
Library_ALI_Dir => No_Path, Display_Library_Src_Dir => No_Path,
Display_Library_ALI_Dir => No_Path, Library_ALI_Dir => No_Path,
Library_Name => No_Name, Display_Library_ALI_Dir => No_Path,
Library_Kind => Static, Library_Name => No_Name,
Lib_Internal_Name => No_Name, Library_Kind => Static,
Standalone_Library => False, Lib_Internal_Name => No_Name,
Lib_Interface_ALIs => Nil_String, Standalone_Library => False,
Lib_Auto_Init => False, Lib_Interface_ALIs => Nil_String,
Libgnarl_Needed => Unknown, Lib_Auto_Init => False,
Symbol_Data => No_Symbols, Libgnarl_Needed => Unknown,
Ada_Sources => Nil_String, Symbol_Data => No_Symbols,
Sources => Nil_String, Ada_Sources => Nil_String,
First_Source => No_Source, Sources => Nil_String,
Last_Source => No_Source, First_Source => No_Source,
Unit_Based_Language_Name => No_Name, Last_Source => No_Source,
Unit_Based_Language_Index => No_Language_Index, Unit_Based_Language_Name => No_Name,
Imported_Directories_Switches => null, Unit_Based_Language_Index => No_Language_Index,
Include_Path => null, Imported_Directories_Switches => null,
Include_Data_Set => False, Include_Path => null,
Include_Language => No_Language_Index, Include_Data_Set => False,
Source_Dirs => Nil_String, Include_Language => No_Language_Index,
Known_Order_Of_Source_Dirs => True, Source_Dirs => Nil_String,
Object_Directory => No_Path, Known_Order_Of_Source_Dirs => True,
Display_Object_Dir => No_Path, Object_Directory => No_Path,
Library_TS => Empty_Time_Stamp, Display_Object_Dir => No_Path,
Exec_Directory => No_Path, Library_TS => Empty_Time_Stamp,
Display_Exec_Dir => No_Path, Exec_Directory => No_Path,
Extends => No_Project, Display_Exec_Dir => No_Path,
Extended_By => No_Project, Extends => No_Project,
Naming => Std_Naming_Data, Extended_By => No_Project,
First_Language_Processing => No_Language_Index, Naming => Std_Naming_Data,
Decl => No_Declarations, First_Language_Processing => No_Language_Index,
Imported_Projects => Empty_Project_List, Decl => No_Declarations,
All_Imported_Projects => Empty_Project_List, Imported_Projects => Empty_Project_List,
Ada_Include_Path => null, All_Imported_Projects => Empty_Project_List,
Ada_Objects_Path => null, Ada_Include_Path => null,
Objects_Path => null, Ada_Objects_Path => null,
Include_Path_File => No_Path, Objects_Path => null,
Objects_Path_File_With_Libs => No_Path, Include_Path_File => No_Path,
Objects_Path_File_Without_Libs => No_Path, Objects_Path_File_With_Libs => No_Path,
Config_File_Name => No_Path, Objects_Path_File_Without_Libs => No_Path,
Config_File_Temp => False, Config_File_Name => No_Path,
Linker_Name => No_File, Config_File_Temp => False,
Linker_Path => No_Path, Linker_Name => No_File,
Minimum_Linker_Options => No_Name_List, Linker_Path => No_Path,
Config_Checked => False, Minimum_Linker_Options => No_Name_List,
Checked => False, Config_Checked => False,
Seen => False, Checked => False,
Need_To_Build_Lib => False, Seen => False,
Depth => 0, Need_To_Build_Lib => False,
Unkept_Comments => False, Depth => 0,
Langs => No_Languages, Unkept_Comments => False,
Supp_Languages => No_Supp_Language_Index, Langs => No_Languages,
Ada_Sources_Present => True, Supp_Languages => No_Supp_Language_Index,
Other_Sources_Present => True, Ada_Sources_Present => True,
First_Other_Source => No_Other_Source, Other_Sources_Present => True,
Last_Other_Source => No_Other_Source, First_Other_Source => No_Other_Source,
First_Lang_Processing => Default_First_Language_Processing_Data, Last_Other_Source => No_Other_Source,
Supp_Language_Processing => No_Supp_Language_Index); First_Lang_Processing =>
Default_First_Language_Processing_Data,
Supp_Language_Processing =>
No_Supp_Language_Index);
package Temp_Files is new Table.Table package Temp_Files is new Table.Table
(Table_Component_Type => Path_Name_Type, (Table_Component_Type => Path_Name_Type,
...@@ -626,6 +629,7 @@ package body Prj is ...@@ -626,6 +629,7 @@ package body Prj is
Name_Len := 0; Name_Len := 0;
The_Empty_String := Name_Find; The_Empty_String := Name_Find;
Empty_Name := The_Empty_String; Empty_Name := The_Empty_String;
Empty_File_Name := File_Name_Type (The_Empty_String);
Name_Len := 4; Name_Len := 4;
Name_Buffer (1 .. 4) := ".ads"; Name_Buffer (1 .. 4) := ".ads";
Default_Ada_Spec_Suffix_Id := Name_Find; Default_Ada_Spec_Suffix_Id := Name_Find;
...@@ -1418,7 +1422,6 @@ package body Prj is ...@@ -1418,7 +1422,6 @@ package body Prj is
if Tree = No_Project_Tree then if Tree = No_Project_Tree then
Prj.Initialize (Tree => No_Project_Tree); Prj.Initialize (Tree => No_Project_Tree);
return Std_Naming_Data; return Std_Naming_Data;
else else
return Tree.Private_Part.Default_Naming; return Tree.Private_Part.Default_Naming;
end if; end if;
......
gcc/ada/prj.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -43,6 +43,15 @@ with System.HTable; ...@@ -43,6 +43,15 @@ with System.HTable;
package Prj is package Prj is
Subdirs_Option : constant String := "--subdirs=";
-- Switch used to indicate that the real directories (object, exec,
-- library, ...) are subdirectories of what is indicated in the project
-- file.
Subdirs : String_Ptr := null;
-- The value after the equal sign in switch --subdirs=...
-- Contains the relative subdirectory.
type Library_Support is (None, Static_Only, Full); type Library_Support is (None, Static_Only, Full);
-- Support for Library Project File. -- Support for Library Project File.
-- - None: Library Project Files are not supported at all -- - None: Library Project Files are not supported at all
...@@ -55,6 +64,23 @@ package Prj is ...@@ -55,6 +64,23 @@ package Prj is
-- Tri-state to decide if -lgnarl is needed when linking -- Tri-state to decide if -lgnarl is needed when linking
type Mode is (Multi_Language, Ada_Only); type Mode is (Multi_Language, Ada_Only);
-- Ada_Only: mode for gnatmake, gnatname, the GNAT driver
-- Multi_Language: mode for gprbuild, gprclean
type Project_Qualifier is
(Unspecified,
Standard,
Library,
Dry,
Aggregate,
Aggregate_Library);
-- Qualifiers that can prefix the reserved word "project" in a project
-- file:
-- Standard: standard project ...
-- Library: library project is ...
-- Dry: abstract project is
-- Aggregate: aggregate project is
-- Aggregate_Library: aggregate library project is ...
function Get_Mode return Mode; function Get_Mode return Mode;
pragma Inline (Get_Mode); pragma Inline (Get_Mode);
...@@ -373,6 +399,12 @@ package Prj is ...@@ -373,6 +399,12 @@ package Prj is
Naming_Data : Lang_Naming_Data; Naming_Data : Lang_Naming_Data;
-- The naming data for the languages (prefixes, etc.) -- The naming data for the languages (prefixes, etc.)
Include_Compatible_Languages : Name_List_Index := No_Name_List;
-- The list of languages that are "include compatible" with this
-- language. A language B (for example "C") is "include compatible" with
-- a language A (for example "C++") if it is expected that sources of
-- language A may "include" header files from language B.
Compiler_Driver : File_Name_Type := No_File; Compiler_Driver : File_Name_Type := No_File;
-- The name of the executable for the compiler of the language -- The name of the executable for the compiler of the language
...@@ -488,38 +520,39 @@ package Prj is ...@@ -488,38 +520,39 @@ package Prj is
-- Record describing the configuration of a language -- Record describing the configuration of a language
No_Language_Config : constant Language_Config := No_Language_Config : constant Language_Config :=
(Kind => File_Based, (Kind => File_Based,
Naming_Data => No_Lang_Naming_Data, Naming_Data => No_Lang_Naming_Data,
Compiler_Driver => No_File, Include_Compatible_Languages => No_Name_List,
Compiler_Driver_Path => null, Compiler_Driver => No_File,
Compiler_Required_Switches => No_Name_List, Compiler_Driver_Path => null,
Compilation_PIC_Option => No_Name_List, Compiler_Required_Switches => No_Name_List,
Runtime_Library_Dir => No_Name, Compilation_PIC_Option => No_Name_List,
Mapping_File_Switches => No_Name_List, Runtime_Library_Dir => No_Name,
Mapping_Spec_Suffix => No_File, Mapping_File_Switches => No_Name_List,
Mapping_Body_Suffix => No_File, Mapping_Spec_Suffix => No_File,
Config_File_Switches => No_Name_List, Mapping_Body_Suffix => No_File,
Dependency_Kind => Makefile, Config_File_Switches => No_Name_List,
Dependency_Option => No_Name_List, Dependency_Kind => Makefile,
Compute_Dependency => No_Name_List, Dependency_Option => No_Name_List,
Include_Option => No_Name_List, Compute_Dependency => No_Name_List,
Include_Path => No_Name, Include_Option => No_Name_List,
Include_Path_File => No_Name, Include_Path => No_Name,
Objects_Path => No_Name, Include_Path_File => No_Name,
Objects_Path_File => No_Name, Objects_Path => No_Name,
Config_Body => No_Name, Objects_Path_File => No_Name,
Config_Spec => No_Name, Config_Body => No_Name,
Config_Body_Pattern => No_Name, Config_Spec => No_Name,
Config_Spec_Pattern => No_Name, Config_Body_Pattern => No_Name,
Config_File_Unique => False, Config_Spec_Pattern => No_Name,
Binder_Driver => No_File, Config_File_Unique => False,
Binder_Driver_Path => No_Path, Binder_Driver => No_File,
Binder_Required_Switches => No_Name_List, Binder_Driver_Path => No_Path,
Binder_Prefix => No_Name, Binder_Required_Switches => No_Name_List,
Toolchain_Version => No_Name, Binder_Prefix => No_Name,
Toolchain_Description => No_Name, Toolchain_Version => No_Name,
PIC_Option => No_Name, Toolchain_Description => No_Name,
Objects_Generated => True); PIC_Option => No_Name,
Objects_Generated => True);
type Language_Data is record type Language_Data is record
Name : Name_Id := No_Name; Name : Name_Id := No_Name;
...@@ -580,6 +613,9 @@ package Prj is ...@@ -580,6 +613,9 @@ package Prj is
Lang_Kind : Language_Kind := File_Based; Lang_Kind : Language_Kind := File_Based;
-- Kind of the language -- Kind of the language
Compiled : Boolean := True;
-- False when there is no compiler for the language
Alternate_Languages : Alternate_Language_Id := No_Alternate_Language; Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
-- List of languages a header file may also be, in addition of -- List of languages a header file may also be, in addition of
-- language Language_Name. -- language Language_Name.
...@@ -640,40 +676,40 @@ package Prj is ...@@ -640,40 +676,40 @@ package Prj is
Object_Path : Path_Name_Type := No_Path; Object_Path : Path_Name_Type := No_Path;
-- Object path of the real object file -- Object path of the real object file
Object_TS : Time_Stamp_Type := Empty_Time_Stamp; Object_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Object file time stamp -- Object file time stamp
Dep_Name : File_Name_Type := No_File; Dep_Name : File_Name_Type := No_File;
-- Dependency file simple name -- Dependency file simple name
Current_Dep_Path : Path_Name_Type := No_Path; Current_Dep_Path : Path_Name_Type := No_Path;
-- Path name of an existing dependency file -- Path name of an existing dependency file
Dep_Path : Path_Name_Type := No_Path; Dep_Path : Path_Name_Type := No_Path;
-- Path name of the real dependency file -- Path name of the real dependency file
Dep_TS : Time_Stamp_Type := Empty_Time_Stamp; Dep_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Dependency file time stamp -- Dependency file time stamp
Switches : File_Name_Type := No_File; Switches : File_Name_Type := No_File;
-- File name of the switches file -- File name of the switches file
Switches_Path : Path_Name_Type := No_Path; Switches_Path : Path_Name_Type := No_Path;
-- Path name of the switches file -- Path name of the switches file
Switches_TS : Time_Stamp_Type := Empty_Time_Stamp; Switches_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Switches file time stamp -- Switches file time stamp
Naming_Exception : Boolean := False; Naming_Exception : Boolean := False;
-- True if the source has an exceptional name -- True if the source has an exceptional name
Next_In_Sources : Source_Id := No_Source; Next_In_Sources : Source_Id := No_Source;
-- Link to another source in the project tree -- Link to another source in the project tree
Next_In_Project : Source_Id := No_Source; Next_In_Project : Source_Id := No_Source;
-- Link to another source in the project -- Link to another source in the project
Next_In_Lang : Source_Id := No_Source; Next_In_Lang : Source_Id := No_Source;
-- Link to another source of the same language -- Link to another source of the same language
end record; end record;
...@@ -682,6 +718,7 @@ package Prj is ...@@ -682,6 +718,7 @@ package Prj is
Language_Name => No_Name, Language_Name => No_Name,
Language => No_Language_Index, Language => No_Language_Index,
Lang_Kind => File_Based, Lang_Kind => File_Based,
Compiled => True,
Alternate_Languages => No_Alternate_Language, Alternate_Languages => No_Alternate_Language,
Kind => Spec, Kind => Spec,
Dependency => None, Dependency => None,
...@@ -1110,6 +1147,9 @@ package Prj is ...@@ -1110,6 +1147,9 @@ package Prj is
-- The name of the executable to build archives, with the minimum -- The name of the executable to build archives, with the minimum
-- switches. Specified in the configuration. -- switches. Specified in the configuration.
Archive_Builder_Append_Option : Name_List_Index := No_Name_List;
-- The options to append object files to an archive
Archive_Indexer : Name_List_Index := No_Name_List; Archive_Indexer : Name_List_Index := No_Name_List;
-- The name of the executable to index archives, with the minimum -- The name of the executable to index archives, with the minimum
-- switches. Specified in the configuration. -- switches. Specified in the configuration.
...@@ -1149,26 +1189,27 @@ package Prj is ...@@ -1149,26 +1189,27 @@ package Prj is
end record; end record;
Default_Project_Config : constant Project_Configuration := Default_Project_Config : constant Project_Configuration :=
(Run_Path_Option => No_Name_List, (Run_Path_Option => No_Name_List,
Executable_Suffix => No_Name, Executable_Suffix => No_Name,
Linker => No_Path, Linker => No_Path,
Minimum_Linker_Options => No_Name_List, Minimum_Linker_Options => No_Name_List,
Linker_Executable_Option => No_Name_List, Linker_Executable_Option => No_Name_List,
Linker_Lib_Dir_Option => No_Name, Linker_Lib_Dir_Option => No_Name,
Linker_Lib_Name_Option => No_Name, Linker_Lib_Name_Option => No_Name,
Library_Builder => No_Path, Library_Builder => No_Path,
Lib_Support => None, Lib_Support => None,
Archive_Builder => No_Name_List, Archive_Builder => No_Name_List,
Archive_Indexer => No_Name_List, Archive_Builder_Append_Option => No_Name_List,
Archive_Suffix => No_File, Archive_Indexer => No_Name_List,
Lib_Partial_Linker => No_Name_List, Archive_Suffix => No_File,
Shared_Lib_Prefix => No_File, Lib_Partial_Linker => No_Name_List,
Shared_Lib_Suffix => No_File, Shared_Lib_Prefix => No_File,
Shared_Lib_Min_Options => No_Name_List, Shared_Lib_Suffix => No_File,
Lib_Version_Options => No_Name_List, Shared_Lib_Min_Options => No_Name_List,
Symbolic_Link_Supported => False, Lib_Version_Options => No_Name_List,
Lib_Maj_Min_Id_Supported => False, Symbolic_Link_Supported => False,
Auto_Init_Supported => False); Lib_Maj_Min_Id_Supported => False,
Auto_Init_Supported => False);
-- The following record describes a project file representation -- The following record describes a project file representation
...@@ -1177,6 +1218,9 @@ package Prj is ...@@ -1177,6 +1218,9 @@ package Prj is
-- separator. -- separator.
type Project_Data is record type Project_Data is record
Qualifier : Project_Qualifier := Unspecified;
-- The eventual qualifier for this project
Externally_Built : Boolean := False; Externally_Built : Boolean := False;
-- True if the project is externally built. In such case, the Project -- True if the project is externally built. In such case, the Project
-- Manager will not modify anything in this project. -- Manager will not modify anything in this project.
...@@ -1436,21 +1480,21 @@ package Prj is ...@@ -1436,21 +1480,21 @@ package Prj is
Supp_Languages : Supp_Language_Index := No_Supp_Language_Index; Supp_Languages : Supp_Language_Index := No_Supp_Language_Index;
-- Indicate the different languages of the source of this project -- Indicate the different languages of the source of this project
Ada_Sources_Present : Boolean := True; Ada_Sources_Present : Boolean := True;
-- True if there are Ada sources in the project -- True if there are Ada sources in the project
Other_Sources_Present : Boolean := True; Other_Sources_Present : Boolean := True;
-- True if there are sources from languages other than Ada in the -- True if there are sources from languages other than Ada in the
-- project. -- project.
First_Other_Source : Other_Source_Id := No_Other_Source; First_Other_Source : Other_Source_Id := No_Other_Source;
-- First source of a language other than Ada -- First source of a language other than Ada
Last_Other_Source : Other_Source_Id := No_Other_Source; Last_Other_Source : Other_Source_Id := No_Other_Source;
-- Last source of a language other than Ada -- Last source of a language other than Ada
First_Lang_Processing : First_Language_Processing_Data := First_Lang_Processing : First_Language_Processing_Data :=
Default_First_Language_Processing_Data; Default_First_Language_Processing_Data;
Supp_Language_Processing : Supp_Language_Index := Supp_Language_Processing : Supp_Language_Index :=
No_Supp_Language_Index; No_Supp_Language_Index;
-- Language configurations -- Language configurations
...@@ -1740,8 +1784,12 @@ private ...@@ -1740,8 +1784,12 @@ private
-- normally forbidden for project names, there cannot be any name clash. -- normally forbidden for project names, there cannot be any name clash.
Empty_Name : Name_Id; Empty_Name : Name_Id;
-- Name_Id for an empty name (no characters). Initialized by the call -- Name_Id for an empty name (no characters). Initialized in procedure
-- to procedure Initialize. -- Initialize.
Empty_File_Name : File_Name_Type;
-- Empty File_Name_Type (no characters). Initialized in procedure
-- Initialize.
procedure Add_To_Buffer procedure Add_To_Buffer
(S : String; (S : String;
......
gcc/ada/switch-m.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -26,6 +26,7 @@ ...@@ -26,6 +26,7 @@
with Debug; use Debug; with Debug; use Debug;
with Osint; use Osint; with Osint; use Osint;
with Opt; use Opt; with Opt; use Opt;
with Prj; use Prj;
with Prj.Ext; use Prj.Ext; with Prj.Ext; use Prj.Ext;
with Table; with Table;
...@@ -150,20 +151,59 @@ package body Switch.M is ...@@ -150,20 +151,59 @@ package body Switch.M is
when False => when False =>
-- All switches that don't start with -gnat stay as is, -- All switches that don't start with -gnat stay as is,
-- except -v, -E and -pg -- except -pg, -Wall, -k8, -w
if Switch_Chars = "-pg" then if Switch_Chars = "-pg" or else Switch_Chars = "-p" then
-- The gcc driver converts -pg to -p, so that is what -- The gcc driver converts -pg to -p, so that is what
-- is stored in the ALI file. -- is stored in the ALI file.
Add_Switch_Component ("-p"); Add_Switch_Component ("-p");
-- Do not take into account switches that are not transmitted elsif Switch_Chars = "-Wall" then
-- to gnat1 by the gcc driver.
elsif C /= 'v' and then C /= 'E' then -- The gcc driver adds -gnatwa when -Wall is used
Add_Switch_Component ("-gnatwa");
Add_Switch_Component ("-Wall");
elsif Switch_Chars = "-k8" then
-- The gcc driver transforms -k8 into -gnatk8
Add_Switch_Component ("-gnatk8");
elsif Switch_Chars = "-w" then
-- The gcc driver adds -gnatws when -w is used
Add_Switch_Component ("-gnatws");
Add_Switch_Component ("-w");
elsif Switch_Chars'Length > 6
and then
Switch_Chars (Switch_Chars'First .. Switch_Chars'First + 5)
= "--RTS="
then
Add_Switch_Component (Switch_Chars); Add_Switch_Component (Switch_Chars);
-- When --RTS=mtp is used, the gcc driver adds -mrtp
if Switch_Chars = "--RTS=mtp" then
Add_Switch_Component ("-mrtp");
end if;
-- Take only into account switches that are transmitted to
-- gnat1 by the gcc driver and stored by gnat1 in the ALI file.
else
case C is
when 'O' | 'W' | 'w' | 'f' | 'd' | 'g' | 'm' =>
Add_Switch_Component (Switch_Chars);
when others =>
null;
end case;
end if; end if;
return; return;
...@@ -332,7 +372,8 @@ package body Switch.M is ...@@ -332,7 +372,8 @@ package body Switch.M is
Ptr := Ptr + 1; Ptr := Ptr + 1;
if Ptr <= Max if Ptr <= Max
and then Switch_Chars (Ptr) = 's' then and then Switch_Chars (Ptr) = 's'
then
Last_Stored := Last_Stored + 1; Last_Stored := Last_Stored + 1;
Storing (Last_Stored) := 's'; Storing (Last_Stored) := 's';
Ptr := Ptr + 1; Ptr := Ptr + 1;
...@@ -366,12 +407,9 @@ package body Switch.M is ...@@ -366,12 +407,9 @@ package body Switch.M is
-- -gnatyMxxx -- -gnatyMxxx
if C = 'M' and then if C = 'M' and then Storing (First_Stored) = 'y' then
Storing (First_Stored) = 'y'
then
Last_Stored := First_Stored + 1; Last_Stored := First_Stored + 1;
Storing (Last_Stored) := 'M'; Storing (Last_Stored) := 'M';
while Ptr <= Max loop while Ptr <= Max loop
C := Switch_Chars (Ptr); C := Switch_Chars (Ptr);
exit when C not in '0' .. '9'; exit when C not in '0' .. '9';
...@@ -517,8 +555,24 @@ package body Switch.M is ...@@ -517,8 +555,24 @@ package body Switch.M is
if Switch_Chars = "--create-missing-dirs" then if Switch_Chars = "--create-missing-dirs" then
Setup_Projects := True; Setup_Projects := True;
elsif Switch_Chars'Length > 3 and then elsif Switch_Chars'Length > Subdirs_Option'Length
Switch_Chars (Ptr .. Ptr + 1) = "aP" and then
Switch_Chars
(Switch_Chars'First ..
Switch_Chars'First + Subdirs_Option'Length - 1) =
Subdirs_Option
then
Subdirs :=
new String'
(Switch_Chars
(Switch_Chars'First + Subdirs_Option'Length ..
Switch_Chars'Last));
elsif Switch_Chars (Ptr) = '-' then
Bad_Switch (Switch_Chars);
elsif Switch_Chars'Length > 3
and then Switch_Chars (Ptr .. Ptr + 1) = "aP"
then then
Add_Search_Project_Directory Add_Search_Project_Directory
(Switch_Chars (Ptr + 2 .. Switch_Chars'Last)); (Switch_Chars (Ptr + 2 .. Switch_Chars'Last));
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment