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 623 additions and 128 deletions
gcc/ada/clean.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -1669,6 +1669,18 @@ package body Clean is
end if;
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' =>
if Arg'Length < 4 then
Bad_Argument;
......@@ -1725,6 +1737,14 @@ package body Clean is
end;
end if;
when 'e' =>
if Arg = "-eL" then
Follow_Links_For_Files := True;
else
Bad_Argument;
end if;
when 'f' =>
Force_Deletions := True;
......@@ -1954,8 +1974,13 @@ package body Clean is
Put_Line (" names may be omitted if -P<project> is specified");
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 (" -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 Full project path name " &
"in brief error messages");
......
gcc/ada/gnatcmd.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -41,6 +41,7 @@ with Prj.Util; use Prj.Util;
with Sinput.P;
with Snames; use Snames;
with Table;
with Targparm;
with Tempdir;
with Types; use Types;
with Hostparm; use Hostparm;
......@@ -233,7 +234,8 @@ procedure GNATCmd is
-- METRIC).
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;
-- Get the sources in the closure of the ASIS_Main and add them to the
......@@ -721,7 +723,10 @@ procedure GNATCmd is
pragma Warnings (Off, Success);
begin
if not Keep_Temporary_Files then
-- This should only be called if Keep_Temporary_Files is False
pragma Assert (not Keep_Temporary_Files);
if Project /= No_Project then
for Prj in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
......@@ -739,9 +744,9 @@ procedure GNATCmd is
end if;
Delete_File
(Name => Get_Name_String
(Project_Tree.Projects.Table
(Prj).Config_File_Name),
(Name =>
Get_Name_String
(Project_Tree.Projects.Table (Prj).Config_File_Name),
Success => Success);
end if;
end loop;
......@@ -753,7 +758,6 @@ procedure GNATCmd is
if Temp_File_Name /= null then
Delete_File (Temp_File_Name.all, Success);
end if;
end if;
end Delete_Temp_Config_Files;
-----------------
......@@ -770,7 +774,8 @@ procedure GNATCmd is
6 => new String'("-bargs"),
7 => new String'("-R"),
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;
-- File descriptor for the temp file that will get the output of the
......@@ -793,6 +798,8 @@ procedure GNATCmd is
File : Ada.Text_IO.File_Type;
Line : String (1 .. 250);
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;
Path : Path_Name_Type;
......@@ -890,7 +897,6 @@ procedure GNATCmd is
if not Keep_Temporary_Files then
Delete (File);
else
Close (File);
end if;
......@@ -1322,9 +1328,15 @@ procedure GNATCmd is
for C in Command_List'Range loop
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);
Put (Command_List (C).Unixcmd.all);
Put (Program_Name (Command_List (C).Unixcmd.all).all);
declare
Sws : Argument_List_Access renames Command_List (C).Unixsws;
......@@ -1375,6 +1387,16 @@ begin
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,
-- if the GNAT driver is invoked with directory information. Do not do this
-- for VMS, where the notion of path does not really exist.
......@@ -1666,9 +1688,23 @@ begin
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
if Argv'Length > 3
elsif Argv'Length > 3
and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP"
then
Add_Search_Project_Directory
......@@ -1676,6 +1712,13 @@ begin
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
elsif Argv'Length = 4
......
gcc/ada/gnatname.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -27,6 +27,7 @@ with Hostparm;
with Opt;
with Osint; use Osint;
with Output; use Output;
with Prj; use Prj;
with Prj.Makr;
with Switch; use Switch;
with Table;
......@@ -194,10 +195,15 @@ procedure Gnatname is
-- Scan options first
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 =>
exit;
when '-' =>
Subdirs := new String'(Parameter);
when 'c' =>
if File_Set then
Fail ("only one -P or -c switch may be specified");
......@@ -213,6 +219,9 @@ procedure Gnatname is
when 'D' =>
Get_Directories (Parameter);
when 'e' =>
Opt.Follow_Links_For_Files := True;
when 'f' =>
Foreign_Patterns.Increment_Last;
Foreign_Patterns.Table (Foreign_Patterns.Last) :=
......@@ -286,10 +295,15 @@ procedure Gnatname is
Write_Eol;
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 (" -ddir use dir as one of the source " &
"directories");
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 (" -gnateDsym=v preprocess with symbol definition");
Write_Line (" -gnatep=data preprocess files with data file");
......
gcc/ada/makegpr.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -283,6 +283,8 @@ package body Makegpr is
Dash_cargs : constant String_Access := Dash_cargs_String'Access;
Dash_d_String : aliased String := "-d";
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 : constant String_Access := Dash_f_String'Access;
Dash_k_String : aliased String := "-k";
......@@ -2609,6 +2611,12 @@ package body Makegpr is
Add_Argument (Dash_d, True);
end if;
-- -eL
if Follow_Links_For_Files then
Add_Argument (Dash_eL, True);
end if;
-- -k
if Keep_Going then
......@@ -3375,8 +3383,8 @@ package body Makegpr is
-- Add the directory where gprmake is invoked in front of the path,
-- if gprmake 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.
-- 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???
......@@ -4231,6 +4239,9 @@ package body Makegpr is
elsif Arg = "-d" then
Display_Compilation_Progress := True;
elsif Arg = "-eL" then
Follow_Links_For_Files := True;
elsif Arg = "-f" then
Force_Compilations := True;
......@@ -4370,6 +4381,12 @@ package body Makegpr is
Write_Str (" -c Compile only");
Write_Eol;
-- Line for -eL
Write_Str (" -eL Follow symbolic links when processing " &
"project files");
Write_Eol;
-- Line for -f
Write_Str (" -f Force recompilations");
......
gcc/ada/makeusg.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -306,6 +306,11 @@ begin
Write_Str (" --RTS=dir specify the default source and object search"
& " path");
Write_Eol;
-- Line for --subdirs=
Write_Str (" --subdirs=dir real obj/lib/exec dirs are subdirs");
Write_Eol;
Write_Eol;
-- General Compiler, Binder, Linker switches
......
gcc/ada/prj-attr.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -25,10 +25,13 @@
with Osint;
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
use GNAT;
-- Data for predefined attributes and packages
-- Names are in lower case and end with '#'
......@@ -74,6 +77,7 @@ package body Prj.Attr is
"SVobject_dir#" &
"SVexec_dir#" &
"LVsource_dirs#" &
"Lainherit_source_path#" &
"LVexcluded_source_dirs#" &
-- Source files
......@@ -114,6 +118,7 @@ package body Prj.Attr is
-- Configuration - Archives
"LVarchive_builder#" &
"LVarchive_builder_append_option#" &
"LVarchive_indexer#" &
"SVarchive_suffix#" &
"LVlibrary_partial_linker#" &
......
gcc/ada/prj-attr.ads
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -28,14 +28,13 @@
-- It is also possible to define new packages with their attributes
with System.Strings;
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
-- procedures Register_New_Package below. The String_Access components of
-- the returned String_List should never be freed.
......@@ -55,6 +54,7 @@ package Prj.Attr is
-- Characteristics of an attribute. Optional_Index indicates that there
-- may be an optional index in the index of the associative array, as in
-- for Switches ("files.ada" at 2) use ...
-- Above character literals should be documented ???
subtype Defined_Attribute_Kind is Attribute_Kind
range Single .. Optional_Index_Case_Insensitive_Associative_Array;
......
gcc/ada/prj-dect.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -37,11 +37,11 @@ with Prj.Tree; use Prj.Tree;
with Snames;
with Uintp; use Uintp;
with System.Strings;
with GNAT.Strings;
package body Prj.Dect is
use System;
use GNAT;
type Zone is (In_Project, In_Package, In_Case_Construction);
-- Used to indicate if we are parsing a package (In_Package),
......
gcc/ada/prj-ext.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -260,19 +260,17 @@ package body Prj.Ext is
Prefix := new String'(Executable_Prefix_Path);
if Prefix.all /= "" then
if Get_Mode = Ada_Only then
Current_Project_Path :=
new String'(Name_Buffer (1 .. Name_Len) &
Path_Separator &
Prefix.all & Directory_Separator & "gnat");
else
Current_Project_Path :=
new String'(Name_Buffer (1 .. Name_Len) &
Path_Separator &
Prefix.all & Directory_Separator &
"share" & Directory_Separator & "gpr");
if Get_Mode = Multi_Language then
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
Directory_Separator & "share" &
Directory_Separator & "gpr");
end if;
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
Directory_Separator & "lib" &
Directory_Separator & "gnat");
end if;
else
......
gcc/ada/prj-nmsc.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -610,7 +610,7 @@ package body Prj.Nmsc is
Src_Data : Source_Data := No_Source_Data;
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);
Id := Source_Data_Table.Last (In_Tree.Sources);
......@@ -619,33 +619,40 @@ package body Prj.Nmsc is
Write_Str ("Adding source #");
Write_Str (Id'Img);
Write_Str (", File : ");
Write_Str (Get_Name_String (File_Name));
if Lang_Kind = Unit_Based then
Write_Str (", Unit : ");
Write_Str (Get_Name_String (Unit));
end if;
Write_Line (Get_Name_String (File_Name));
Write_Eol;
end if;
Src_Data.Project := Project;
Src_Data.Language_Name := Lang;
Src_Data.Language := Lang_Id;
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.Alternate_Languages := Alternate_Languages;
Src_Data.Other_Part := Other_Part;
Src_Data.Unit := Unit;
Src_Data.Index := Index;
Src_Data.File := File_Name;
Src_Data.Object := Object_Name (File_Name);
Src_Data.Display_File := Display_File;
Src_Data.Dependency :=
In_Tree.Languages_Data.Table (Lang_Id).Config.Dependency_Kind;
Src_Data.Dependency := In_Tree.Languages_Data.Table
(Lang_Id).Config.Dependency_Kind;
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);
Src_Data.Naming_Exception := Naming_Exception;
end if;
if Path /= No_Path then
Src_Data.Path := Path;
......@@ -732,6 +739,15 @@ package body Prj.Nmsc is
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
if Must_Check_Configuration then
......@@ -1475,14 +1491,6 @@ package body Prj.Nmsc is
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
(Lang_Index).Config.Compiler_Driver :=
File_Name_Type (Element.Value.Value);
......@@ -1893,6 +1901,20 @@ package body Prj.Nmsc is
From_List => List,
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
-- Attribute Archive_Indexer: the optional archive
......@@ -2043,9 +2065,9 @@ package body Prj.Nmsc is
Error_Msg
(Project,
In_Tree,
"invalid value """ &
Get_Name_String (Attribute.Value.Value) &
""" for Symbolic_Link_Supported",
"invalid value """
& Get_Name_String (Attribute.Value.Value)
& """ for Symbolic_Link_Supported",
Attribute.Value.Location);
end;
......@@ -2069,29 +2091,24 @@ package body Prj.Nmsc is
Attribute.Value.Location);
end;
elsif
Attribute.Name = Name_Library_Auto_Init_Supported
then
elsif Attribute.Name = Name_Library_Auto_Init_Supported then
declare
pragma Unsuppress (All_Checks);
begin
Data.Config.Auto_Init_Supported :=
Boolean'Value (Get_Name_String
(Attribute.Value.Value));
Boolean'Value (Get_Name_String (Attribute.Value.Value));
exception
when Constraint_Error =>
Error_Msg
(Project,
In_Tree,
"invalid value """ &
Get_Name_String (Attribute.Value.Value) &
""" for Library_Auto_Init_Supported",
"invalid value """
& Get_Name_String (Attribute.Value.Value)
& """ for Library_Auto_Init_Supported",
Attribute.Value.Location);
end;
elsif
Attribute.Name = Name_Shared_Library_Minimum_Switches
then
elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
List := Attribute.Value.Values;
if List /= Nil_String then
......@@ -2100,9 +2117,7 @@ package body Prj.Nmsc is
In_Tree => In_Tree);
end if;
elsif
Attribute.Name = Name_Library_Version_Switches
then
elsif Attribute.Name = Name_Library_Version_Switches then
List := Attribute.Value.Values;
if List /= Nil_String then
......@@ -2126,6 +2141,7 @@ package body Prj.Nmsc is
Current_Array : Array_Data;
Element_Id : Array_Element_Id;
Element : Array_Element;
List : String_List_Id;
begin
-- Process the associative array attributes at project level
......@@ -2144,6 +2160,19 @@ package body Prj.Nmsc is
if Lang_Index /= No_Language_Index then
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 =>
-- Attribute Toolchain_Description (<language>)
......@@ -2613,6 +2642,14 @@ package body Prj.Nmsc is
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
Write_Str ("Project is ");
......@@ -2946,12 +2983,12 @@ package body Prj.Nmsc is
else
Error_Msg_Name_1 := Unit;
Error_Msg_Name_2 :=
In_Tree.Projects.Table (Other_Project).Name;
Error_Msg
(Project,
In_Tree,
"unit%% cannot belong to two projects " &
"simultaneously",
"%% is already a source of project %%",
Element.Value.Location);
end if;
end if;
......@@ -3534,6 +3571,8 @@ package body Prj.Nmsc is
Support_For_Libraries : Library_Support;
Library_Directory_Present : Boolean;
procedure Check_Library (Proj : Project_Id; Extends : Boolean);
-- Check if an imported or extended project if also a library project
......@@ -3543,17 +3582,30 @@ package body Prj.Nmsc is
procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
Proj_Data : Project_Data;
Src_Id : Source_Id;
Src : Source_Data;
begin
if Proj /= No_Project then
Proj_Data := In_Tree.Projects.Table (Proj);
if not Proj_Data.Library then
-- 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.
if Proj_Data.Source_Dirs /= Nil_String then
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;
Src_Id := Src.Next_In_Project;
end loop;
if Src_Id /= No_Source then
Error_Msg_Name_1 := Data.Name;
Error_Msg_Name_2 := Proj_Data.Name;
......@@ -3608,6 +3660,8 @@ package body Prj.Nmsc is
-- Start of processing for Check_Library_Attributes
begin
Library_Directory_Present := Lib_Dir.Value /= Empty_String;
-- Special case of extending project
if Data.Extends /= No_Project then
......@@ -3621,6 +3675,13 @@ package body Prj.Nmsc is
-- directory is specified.
if Extended_Data.Library then
if Data.Qualifier = Standard then
Error_Msg
(Project, In_Tree,
"a standard project cannot extend a library project",
Data.Location);
else
if Lib_Name.Default then
Data.Library_Name := Extended_Data.Library_Name;
end if;
......@@ -3632,6 +3693,16 @@ package body Prj.Nmsc is
"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;
......@@ -3662,14 +3733,15 @@ package body Prj.Nmsc is
pragma Assert (Lib_Dir.Kind = Single);
if Lib_Dir.Value = Empty_String then
if not Library_Directory_Present then
if Current_Verbosity = High then
Write_Line ("No library directory");
end if;
else
-- Find path name, check that it is a directory
-- Find path name (unless inherited), check that it is a directory
if Data.Library_Dir = No_Path then
Locate_Directory
(Project,
In_Tree,
......@@ -3680,6 +3752,7 @@ package body Prj.Nmsc is
Create => "library",
Current_Dir => Current_Dir,
Location => Lib_Dir.Location);
end if;
if Data.Library_Dir = No_Path then
......@@ -3817,6 +3890,30 @@ package body Prj.Nmsc is
and then
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 Get_Mode = Multi_Language then
Support_For_Libraries := Data.Config.Lib_Support;
......@@ -4426,6 +4523,14 @@ package body Prj.Nmsc is
if Current = Nil_String then
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
-- Look through all the languages specified in attribute
-- Languages.
......@@ -6259,6 +6364,20 @@ package body Prj.Nmsc is
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;
if Current_Verbosity = High then
......@@ -6291,7 +6410,7 @@ package body Prj.Nmsc is
Exec_Dir.Location);
else
-- We check that the specified object directory does exist
-- We check that the specified exec directory does exist
Locate_Directory
(Project,
......@@ -6337,6 +6456,14 @@ package body Prj.Nmsc is
then
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
and then Data.Object_Directory = Data.Directory
then
......@@ -6368,6 +6495,13 @@ package body Prj.Nmsc is
end if;
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
-- project contains no source. For projects that don't extend other
......@@ -6940,8 +7074,6 @@ package body Prj.Nmsc is
Current_Dir : String;
Location : Source_Ptr := No_Location)
is
The_Name : String := Get_Name_String (Name);
The_Parent : constant String :=
Get_Name_String (Parent) & Directory_Separator;
......@@ -6950,18 +7082,35 @@ package body Prj.Nmsc is
Full_Name : File_Name_Type;
The_Name : File_Name_Type;
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)
for J in The_Name'Range loop
if The_Name (J) = '/' then
The_Name (J) := Directory_Separator;
for J in 1 .. Name_Len loop
if Name_Buffer (J) = '/' then
Name_Buffer (J) := Directory_Separator;
end if;
end loop;
The_Name := Name_Find;
if Current_Verbosity = High then
Write_Str ("Locate_Directory (""");
Write_Str (The_Name);
Write_Str (Get_Name_String (The_Name));
Write_Str (""", """);
Write_Str (The_Parent);
Write_Line (""")");
......@@ -6970,14 +7119,14 @@ package body Prj.Nmsc is
Dir := No_Path;
Display := No_Path;
if Is_Absolute_Path (The_Name) then
Full_Name := Name;
if Is_Absolute_Path (Get_Name_String (The_Name)) then
Full_Name := The_Name;
else
Name_Len := 0;
Add_Str_To_Name_Buffer
(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;
end if;
......@@ -6985,7 +7134,8 @@ package body Prj.Nmsc is
Full_Path_Name : constant String := Get_Name_String (Full_Name);
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)
then
begin
......@@ -7331,7 +7481,7 @@ package body Prj.Nmsc is
and then Lang = Ada_Language_Index
and then Data.Extends = No_Project
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
Report_No_Sources
......@@ -7979,8 +8129,10 @@ package body Prj.Nmsc is
Kind => Kind);
if Language = No_Language_Index then
-- A file name in a list must be a source of a language
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
(Project,
......@@ -8045,9 +8197,24 @@ package body Prj.Nmsc is
Error_Msg_Name_1 := Unit;
Error_Msg
(Project, In_Tree,
"unit %% cannot belong to " &
"several projects",
"unit %% cannot belong to several projects",
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;
end if;
end if;
......@@ -8847,7 +9014,7 @@ package body Prj.Nmsc is
Err_Vars.Error_Msg_Name_1 := Unit_Name;
Error_Msg
(Project, In_Tree, "duplicate source %%", The_Location);
(Project, In_Tree, "duplicate unit %%", The_Location);
Err_Vars.Error_Msg_Name_1 :=
In_Tree.Projects.Table
......
gcc/ada/prj-part.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -945,6 +945,9 @@ package body Prj.Part is
Project_Comment_State : Tree.Comment_State;
Proj_Qualifier : Project_Qualifier := Unspecified;
Qualifier_Location : Source_Ptr;
begin
Extends_All := False;
......@@ -1119,8 +1122,63 @@ package body Prj.Part is
Project_Stack.Table (Project_Stack.Last).Id := Project;
Set_Directory_Of (Project, In_Tree, Project_Directory);
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);
-- 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");
-- Mark location of PROJECT token if present
......@@ -1780,7 +1838,7 @@ package body Prj.Part is
begin
if Current_Verbosity = High then
Write_Str (" Trying ");
Write_Str (Path);
Write_Line (Path);
end if;
return Locate_Regular_File
......
gcc/ada/prj-proc.adb
......@@ -1621,8 +1621,11 @@ package body Prj.Proc is
if Next_Element = No_Array_Element then
Array_Element_Table.Increment_Last
(In_Tree.Array_Elements);
New_Element := Array_Element_Table.Last
New_Element :=
Array_Element_Table.Last
(In_Tree.Array_Elements);
In_Tree.Array_Elements.Table
(Prev_Element).Next := New_Element;
else
New_Element := Next_Element;
......@@ -1636,8 +1639,7 @@ package body Prj.Proc is
In_Tree.Array_Elements.Table
(New_Element) :=
In_Tree.Array_Elements.Table
(Orig_Element);
In_Tree.Array_Elements.Table (Orig_Element);
In_Tree.Array_Elements.Table
(New_Element).Value.Project := Project;
......@@ -1872,9 +1874,7 @@ package body Prj.Proc is
else
In_Tree.Variable_Elements.Table
(The_Variable).Value :=
New_Value;
(The_Variable).Value := New_Value;
end if;
-- Associative array attribute
......@@ -2524,7 +2524,11 @@ package body Prj.Proc is
Processed_Projects.Set (Name, Project);
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).Qualifier :=
Processed_Data.Qualifier;
Get_Name_String (Name);
......@@ -2786,6 +2790,8 @@ package body Prj.Proc is
end if;
end if;
end;
In_Tree.Projects.Table (Project) := Processed_Data;
end if;
-- Process limited withed projects
......
gcc/ada/prj-tree.adb
......@@ -108,6 +108,7 @@ package body Prj.Tree is
In_Tree.Project_Nodes.Table
(Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
(Kind => N_Comment_Zones,
Qualifier => Unspecified,
Expr_Kind => Undefined,
Location => No_Location,
Directory => No_Path,
......@@ -153,6 +154,7 @@ package body Prj.Tree is
In_Tree.Project_Nodes.Table
(Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
(Kind => N_Comment,
Qualifier => Unspecified,
Expr_Kind => Undefined,
Flag1 => Comments.Table (J).Follows_Empty_Line,
Flag2 =>
......@@ -321,6 +323,7 @@ package body Prj.Tree is
Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
In_Tree.Project_Nodes.Table (Zone) :=
(Kind => N_Comment_Zones,
Qualifier => Unspecified,
Location => No_Location,
Directory => No_Path,
Expr_Kind => Undefined,
......@@ -395,6 +398,7 @@ package body Prj.Tree is
In_Tree.Project_Nodes.Table
(Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
(Kind => Of_Kind,
Qualifier => Unspecified,
Location => No_Location,
Directory => No_Path,
Expr_Kind => And_Expr_Kind,
......@@ -429,6 +433,7 @@ package body Prj.Tree is
In_Tree.Project_Nodes.Table
(Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
(Kind => N_Comment_Zones,
Qualifier => Unspecified,
Expr_Kind => Undefined,
Location => No_Location,
Directory => No_Path,
......@@ -458,6 +463,7 @@ package body Prj.Tree is
In_Tree.Project_Nodes.Table
(Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
(Kind => N_Comment,
Qualifier => Unspecified,
Expr_Kind => Undefined,
Flag1 => Comments.Table (J).Follows_Empty_Line,
Flag2 =>
......@@ -1352,6 +1358,22 @@ package body Prj.Tree is
return In_Tree.Project_Nodes.Table (Node).Field2;
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 --
-------------------------------------------
......@@ -2467,6 +2489,22 @@ package body Prj.Tree is
In_Tree.Project_Nodes.Table (Node).Field2 := To;
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 --
-----------------------------------------------
......
gcc/ada/prj-tree.ads
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -344,6 +344,12 @@ package Prj.Tree is
pragma Inline (Project_Declaration_Of);
-- 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
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
......@@ -694,6 +700,12 @@ package Prj.Tree is
To : Project_Node_Id);
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
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
......@@ -912,6 +924,8 @@ package Prj.Tree is
Kind : Project_Node_Kind;
Qualifier : Project_Qualifier := Unspecified;
Location : Source_Ptr := No_Location;
Directory : Path_Name_Type := No_Path;
......
gcc/ada/prj.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -88,7 +88,8 @@ package body Prj is
Supp_Suffixes => No_Supp_Language_Index);
Project_Empty : constant Project_Data :=
(Externally_Built => False,
(Qualifier => Unspecified,
Externally_Built => False,
Config => Default_Project_Config,
Languages => No_Name_List,
First_Referred_By => No_Project,
......@@ -164,8 +165,10 @@ package body Prj is
Other_Sources_Present => True,
First_Other_Source => No_Other_Source,
Last_Other_Source => No_Other_Source,
First_Lang_Processing => Default_First_Language_Processing_Data,
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
(Table_Component_Type => Path_Name_Type,
......@@ -626,6 +629,7 @@ package body Prj is
Name_Len := 0;
The_Empty_String := Name_Find;
Empty_Name := The_Empty_String;
Empty_File_Name := File_Name_Type (The_Empty_String);
Name_Len := 4;
Name_Buffer (1 .. 4) := ".ads";
Default_Ada_Spec_Suffix_Id := Name_Find;
......@@ -1418,7 +1422,6 @@ package body Prj is
if Tree = No_Project_Tree then
Prj.Initialize (Tree => No_Project_Tree);
return Std_Naming_Data;
else
return Tree.Private_Part.Default_Naming;
end if;
......
gcc/ada/prj.ads
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -43,6 +43,15 @@ with System.HTable;
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);
-- Support for Library Project File.
-- - None: Library Project Files are not supported at all
......@@ -55,6 +64,23 @@ package Prj is
-- Tri-state to decide if -lgnarl is needed when linking
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;
pragma Inline (Get_Mode);
......@@ -373,6 +399,12 @@ package Prj is
Naming_Data : Lang_Naming_Data;
-- 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;
-- The name of the executable for the compiler of the language
......@@ -490,6 +522,7 @@ package Prj is
No_Language_Config : constant Language_Config :=
(Kind => File_Based,
Naming_Data => No_Lang_Naming_Data,
Include_Compatible_Languages => No_Name_List,
Compiler_Driver => No_File,
Compiler_Driver_Path => null,
Compiler_Required_Switches => No_Name_List,
......@@ -580,6 +613,9 @@ package Prj is
Lang_Kind : Language_Kind := File_Based;
-- Kind of the language
Compiled : Boolean := True;
-- False when there is no compiler for the language
Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
-- List of languages a header file may also be, in addition of
-- language Language_Name.
......@@ -682,6 +718,7 @@ package Prj is
Language_Name => No_Name,
Language => No_Language_Index,
Lang_Kind => File_Based,
Compiled => True,
Alternate_Languages => No_Alternate_Language,
Kind => Spec,
Dependency => None,
......@@ -1110,6 +1147,9 @@ package Prj is
-- The name of the executable to build archives, with the minimum
-- 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;
-- The name of the executable to index archives, with the minimum
-- switches. Specified in the configuration.
......@@ -1159,6 +1199,7 @@ package Prj is
Library_Builder => No_Path,
Lib_Support => None,
Archive_Builder => No_Name_List,
Archive_Builder_Append_Option => No_Name_List,
Archive_Indexer => No_Name_List,
Archive_Suffix => No_File,
Lib_Partial_Linker => No_Name_List,
......@@ -1177,6 +1218,9 @@ package Prj is
-- separator.
type Project_Data is record
Qualifier : Project_Qualifier := Unspecified;
-- The eventual qualifier for this project
Externally_Built : Boolean := False;
-- True if the project is externally built. In such case, the Project
-- Manager will not modify anything in this project.
......@@ -1740,8 +1784,12 @@ private
-- normally forbidden for project names, there cannot be any name clash.
Empty_Name : Name_Id;
-- Name_Id for an empty name (no characters). Initialized by the call
-- to procedure Initialize.
-- Name_Id for an empty name (no characters). Initialized in procedure
-- Initialize.
Empty_File_Name : File_Name_Type;
-- Empty File_Name_Type (no characters). Initialized in procedure
-- Initialize.
procedure Add_To_Buffer
(S : String;
......
gcc/ada/switch-m.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -26,6 +26,7 @@
with Debug; use Debug;
with Osint; use Osint;
with Opt; use Opt;
with Prj; use Prj;
with Prj.Ext; use Prj.Ext;
with Table;
......@@ -150,20 +151,59 @@ package body Switch.M is
when False =>
-- 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
-- is stored in the ALI file.
Add_Switch_Component ("-p");
-- Do not take into account switches that are not transmitted
-- to gnat1 by the gcc driver.
elsif Switch_Chars = "-Wall" then
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);
-- 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;
return;
......@@ -332,7 +372,8 @@ package body Switch.M is
Ptr := Ptr + 1;
if Ptr <= Max
and then Switch_Chars (Ptr) = 's' then
and then Switch_Chars (Ptr) = 's'
then
Last_Stored := Last_Stored + 1;
Storing (Last_Stored) := 's';
Ptr := Ptr + 1;
......@@ -366,12 +407,9 @@ package body Switch.M is
-- -gnatyMxxx
if C = 'M' and then
Storing (First_Stored) = 'y'
then
if C = 'M' and then Storing (First_Stored) = 'y' then
Last_Stored := First_Stored + 1;
Storing (Last_Stored) := 'M';
while Ptr <= Max loop
C := Switch_Chars (Ptr);
exit when C not in '0' .. '9';
......@@ -517,8 +555,24 @@ package body Switch.M is
if Switch_Chars = "--create-missing-dirs" then
Setup_Projects := True;
elsif Switch_Chars'Length > 3 and then
Switch_Chars (Ptr .. Ptr + 1) = "aP"
elsif Switch_Chars'Length > Subdirs_Option'Length
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
Add_Search_Project_Directory
(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