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

gnatcmd.adb, [...] (Immediate_Directory_Of): Removed.

Browse Source 
2009-07-13  Emmanuel Briot  <briot@adacore.com>

	* gnatcmd.adb, make.adb, mlib-prj.adb, prj-part.adb, mlib.adb,
	prj.adb, prj.ads, clean.adb, prj-nmsc.adb, prj-nmsc.ads, prj-pars.adb,
	prj-pars.ads, prj-conf.adb, prj-conf.ads, prj-tree.adb,
	prj-tree.ads (Immediate_Directory_Of): Removed.
	(Prj.Pars): Now parse the project simulating a default config file.
	(Add_Default_GNAT_Naming_Scheme): New subprogram
	(Check_Naming_Multi_Lang): Fix default value for Dot_Replacement.
	Remove gnatmake-specific parsing of source files.
	(Check_Illegal_Suffix): Renames Is_Illegal_Suffix, since it now raises
	the error itself to provide more precise diagnostics.
	(Process_Exceptions_Unit_Based): Avoid duplicate error message when
	a unit belongs to several projects.
	(Copy_Interface_Sources): Search the full path of files to copy in the
	list of sources of the application rather than in the list of units.
	(Parse_Project_And_Apply_Config): Do not reset the name of the main
 	project file.
	(Check_File): Use htables to find out whether a source is duplicated.
	(Add_Source): check whether the source or unit were already seen earlier

	* gcc-interface/Makefile.in: Update gnatmake dependencies.

From-SVN: r149557
This commit is contained in:
Emmanuel Briot 2009-07-13 09:04:17 +00:00 committed by Arnaud Charlet
parent 1629f70052
commit fc2c32e2a1
18 changed files with 693 additions and 1216 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
gcc/ada/ChangeLog
View File

@ -1,3 +1,26 @@
2009-07-13 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, make.adb, mlib-prj.adb, prj-part.adb, mlib.adb,
prj.adb, prj.ads, clean.adb, prj-nmsc.adb, prj-nmsc.ads, prj-pars.adb,
prj-pars.ads, prj-conf.adb, prj-conf.ads, prj-tree.adb,
prj-tree.ads (Immediate_Directory_Of): Removed.
(Prj.Pars): Now parse the project simulating a default config file.
(Add_Default_GNAT_Naming_Scheme): New subprogram
(Check_Naming_Multi_Lang): Fix default value for Dot_Replacement.
Remove gnatmake-specific parsing of source files.
(Check_Illegal_Suffix): Renames Is_Illegal_Suffix, since it now raises
the error itself to provide more precise diagnostics.
(Process_Exceptions_Unit_Based): Avoid duplicate error message when
a unit belongs to several projects.
(Copy_Interface_Sources): Search the full path of files to copy in the
list of sources of the application rather than in the list of units.
(Parse_Project_And_Apply_Config): Do not reset the name of the main
project file.
(Check_File): Use htables to find out whether a source is duplicated.
(Add_Source): check whether the source or unit were already seen earlier
* gcc-interface/Makefile.in: Update gnatmake dependencies.
2009-07-13 Robert Dewar <dewar@adacore.com>
* par-ch3.adb (P_Discrete_Choice_List): Choice can only be simple

3
gcc/ada/clean.adb
View File

@ -1391,8 +1391,7 @@ package body Clean is
(Project => Main_Project,
In_Tree => Project_Tree,
Project_File_Name => Project_File_Name.all,
Packages_To_Check => Packages_To_Check_By_Gnatmake,
Is_Config_File => False);
Packages_To_Check => Packages_To_Check_By_Gnatmake);
if Main_Project = No_Project then
Fail ("""" & Project_File_Name.all & """ processing failed");

1
gcc/ada/gcc-interface/Makefile.in
View File

@ -295,6 +295,7 @@ GNATMAKE_OBJS = a-except.o ali.o ali-util.o s-casuti.o \
make.o makeusg.o makeutl.o mlib.o mlib-fil.o mlib-prj.o mlib-tgt.o \
mlib-tgt-specific.o mlib-utl.o namet.o nlists.o opt.o osint.o osint-m.o \
output.o prj.o prj-attr.o prj-attr-pm.o prj-com.o prj-dect.o prj-env.o \
prj-conf.o \
prj-err.o prj-ext.o prj-nmsc.o prj-pars.o prj-part.o prj-proc.o prj-strt.o \
prj-tree.o prj-util.o rident.o s-exctab.o s-secsta.o s-stalib.o s-stoele.o \
scans.o scng.o sdefault.o sfn_scan.o s-purexc.o s-htable.o sinfo.o sinput.o \

12
gcc/ada/gnatcmd.adb
View File

@ -365,7 +365,6 @@ procedure GNATCmd is
new String'
(Get_Name_String
(Proj.Project.Object_Directory.Name) &
Directory_Separator &
B_Start.all &
MLib.Fil.Ext_To
(Get_Name_String
@ -392,7 +391,6 @@ procedure GNATCmd is
new String'
(Get_Name_String
(Proj.Project.Object_Directory.Name) &
Directory_Separator &
B_Start.all &
Get_Name_String (Proj.Project.Library_Name) &
".ci");
@ -514,7 +512,6 @@ procedure GNATCmd is
(Get_Name_String
(Unit.File_Names
(Impl).Project. Object_Directory.Name) &
Directory_Separator &
MLib.Fil.Ext_To
(Get_Name_String
(Unit.File_Names (Impl).Display_File),
@ -1077,7 +1074,6 @@ procedure GNATCmd is
begin
if Is_Regular_File
(Dir &
Directory_Separator &
ALI_File (1 .. Last))
then
-- We have found the correct project, so we
@ -1085,8 +1081,8 @@ procedure GNATCmd is
Last_Switches.Table (J) :=
new String'
(Dir & Directory_Separator &
ALI_File (1 .. Last));
(Dir
& ALI_File (1 .. Last));
-- And we are done
@ -1155,7 +1151,6 @@ procedure GNATCmd is
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'(Name_Buffer (1 .. Name_Len) &
Directory_Separator &
Executable_Name
(Base_Name (Arg (Arg'First .. Last))));
exit;
@ -1784,8 +1779,7 @@ begin
(Project => Project,
In_Tree => Project_Tree,
Project_File_Name => Project_File.all,
Packages_To_Check => Packages_To_Check,
Is_Config_File => False);
Packages_To_Check => Packages_To_Check);
if Project = Prj.No_Project then
Fail ("""" & Project_File.all & """ processing failed");

22
gcc/ada/make.adb
View File

@ -1978,12 +1978,8 @@ package body Make is
Name_Len := 0;
Add_Str_To_Name_Buffer (Res_Obj_Dir);
if Name_Len > 1 and then
(Name_Buffer (Name_Len) = '/'
or else
Name_Buffer (Name_Len) = Directory_Separator)
then
Name_Len := Name_Len - 1;
if not Is_Directory_Separator (Name_Buffer (Name_Len)) then
Add_Char_To_Name_Buffer (Directory_Separator);
end if;
Obj_Dir := Name_Find;
@ -4450,8 +4446,8 @@ package body Make is
(ALI_Project.Object_Directory.Name);
end if;
if Name_Buffer (Name_Len) /=
Directory_Separator
if not Is_Directory_Separator
(Name_Buffer (Name_Len))
then
Add_Char_To_Name_Buffer (Directory_Separator);
end if;
@ -5312,7 +5308,9 @@ package body Make is
if not Is_Absolute_Path (Exec_File_Name) then
Get_Name_String (Main_Project.Exec_Directory.Name);
if Name_Buffer (Name_Len) /= Directory_Separator then
if
not Is_Directory_Separator (Name_Buffer (Name_Len))
then
Add_Char_To_Name_Buffer (Directory_Separator);
end if;
@ -6867,8 +6865,7 @@ package body Make is
(Project => Main_Project,
In_Tree => Project_Tree,
Project_File_Name => Project_File_Name.all,
Packages_To_Check => Packages_To_Check_By_Gnatmake,
Is_Config_File => False);
Packages_To_Check => Packages_To_Check_By_Gnatmake);
-- The parsing of project files may have changed the current output
@ -7611,8 +7608,7 @@ package body Make is
-- separator.
if Argv (Argv'Last) = Directory_Separator then
Object_Directory_Path :=
new String'(Argv);
Object_Directory_Path := new String'(Argv);
else
Object_Directory_Path :=
new String'(Argv & Directory_Separator);

70
gcc/ada/mlib-prj.adb
View File

@ -2152,20 +2152,12 @@ package body MLib.Prj is
First_Unit : ALI.Unit_Id;
Second_Unit : ALI.Unit_Id;
Data : Unit_Index;
Copy_Subunits : Boolean := False;
-- When True, indicates that subunits, if any, need to be copied too
procedure Copy (File_Name : File_Name_Type);
-- Copy one source of the project to the target directory
function Is_Same_Or_Extension
(Extending : Project_Id;
Extended : Project_Id) return Boolean;
-- Return True if project Extending is equal to or extends project
-- Extended.
----------
-- Copy --
----------
@ -2174,56 +2166,26 @@ package body MLib.Prj is
Success : Boolean;
pragma Warnings (Off, Success);
Source : Standard.Prj.Source_Id;
begin
Data := Units_Htable.Get_First (In_Tree.Units_HT);
Source := Find_Source
(In_Tree, For_Project,
In_Extended_Only => True,
Base_Name => File_Name);
Unit_Loop :
while Data /= No_Unit_Index loop
-- Find and copy the immediate or inherited source
for J in Data.File_Names'Range loop
if Data.File_Names (J) /= null
and then Is_Same_Or_Extension
(For_Project, Data.File_Names (J).Project)
and then Data.File_Names (J).File = File_Name
then
Copy_File
(Get_Name_String (Data.File_Names (J).Path.Name),
Target,
Success,
Mode => Overwrite,
Preserve => Preserve);
exit Unit_Loop;
end if;
end loop;
Data := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop Unit_Loop;
if Source /= No_Source
and then not Source.Locally_Removed
and then Source.Replaced_By = No_Source
then
Copy_File
(Get_Name_String (Source.Path.Name),
Target,
Success,
Mode => Overwrite,
Preserve => Preserve);
end if;
end Copy;
--------------------------
-- Is_Same_Or_Extension --
--------------------------
function Is_Same_Or_Extension
(Extending : Project_Id;
Extended : Project_Id) return Boolean
is
Ext : Project_Id;
begin
Ext := Extending;
while Ext /= No_Project loop
if Ext = Extended then
return True;
end if;
Ext := Ext.Extends;
end loop;
return False;
end Is_Same_Or_Extension;
-- Start of processing for Copy_Interface_Sources
begin

2
gcc/ada/mlib.adb
View File

@ -55,7 +55,7 @@ package body MLib is
Write_Line (Output_File);
end if;
Ar (Output_Dir & Directory_Separator &
Ar (Output_Dir &
"lib" & Output_File & ".a", Objects => Ofiles);
end Build_Library;

84
gcc/ada/prj-conf.adb
View File

@ -34,7 +34,6 @@ with Prj.Proc; use Prj.Proc;
with Prj.Tree; use Prj.Tree;
with Prj.Util; use Prj.Util;
with Prj; use Prj;
with Sinput.P;
with Snames; use Snames;
with System.Case_Util; use System.Case_Util;
with System;
@ -908,7 +907,9 @@ package body Prj.Conf is
Report_Error : Put_Line_Access := null;
On_Load_Config : Config_File_Hook := null;
Compiler_Driver_Mandatory : Boolean := True;
Allow_Duplicate_Basenames : Boolean := False)
Allow_Duplicate_Basenames : Boolean := False;
Reset_Tree : Boolean := True;
When_No_Sources : Error_Warning := Warning)
is
Main_Config_Project : Project_Id;
Success : Boolean;
@ -923,7 +924,8 @@ package body Prj.Conf is
Success => Success,
From_Project_Node => User_Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
Report_Error => Report_Error);
Report_Error => Report_Error,
Reset_Tree => Reset_Tree);
if not Success then
Main_Project := No_Project;
@ -951,8 +953,6 @@ package body Prj.Conf is
-- Finish processing the user's project
Sinput.P.Reset_First;
Prj.Proc.Process_Project_Tree_Phase_2
(In_Tree => Project_Tree,
Project => Main_Project,
@ -961,7 +961,7 @@ package body Prj.Conf is
From_Project_Node_Tree => Project_Node_Tree,
Report_Error => Report_Error,
Current_Dir => Current_Directory,
When_No_Sources => Warning,
When_No_Sources => When_No_Sources,
Compiler_Driver_Mandatory => Compiler_Driver_Mandatory,
Allow_Duplicate_Basenames => Allow_Duplicate_Basenames,
Is_Config_File => False);
@ -1121,4 +1121,76 @@ package body Prj.Conf is
end if;
end Runtime_Name_For;
------------------------------------
-- Add_Default_GNAT_Naming_Scheme --
------------------------------------
procedure Add_Default_GNAT_Naming_Scheme
(Config_File : in out Project_Node_Id;
Project_Tree : Project_Node_Tree_Ref)
is
Name : Name_Id;
begin
if Config_File = Empty_Node then
-- Create a dummy config file is none was found.
Name_Len := Auto_Cgpr'Length;
Name_Buffer (1 .. Name_Len) := Auto_Cgpr;
Name := Name_Find;
Config_File := Create_Project
(In_Tree => Project_Tree,
Name => Name,
Full_Path => Path_Name_Type (Name),
Is_Config_File => True);
-- ??? This isn't strictly required, since Prj.Nmsc.Add_Language
-- already has a workaround in the Ada_Only case. But it would be
-- nicer to do it this way
-- Likewise for the default language, hard-coded in
-- Pjr.Nmsc.Check_Programming_Languages
-- Update_Attribute_Value_In_Scenario
-- (Tree => Project_Tree,
-- Project => Config_File,
-- Scenario_Variables => No_Scenario,
-- Attribute => "default_language",
-- Value => "Ada");
--
-- Update_Attribute_Value_In_Scenario
-- (Tree => Project_Tree,
-- Project => Config_File,
-- Scenario_Variables => No_Scenario,
-- Attribute => Separate_Suffix_Attribute,
-- Value => ".adb",
-- Attribute_Index => "Ada");
-- Update_Attribute_Value_In_Scenario
-- (Tree => Project_Tree,
-- Project => Config_File,
-- Scenario_Variables => No_Scenario,
-- Attribute => Spec_Suffix_Attribute,
-- Value => ".ads",
-- Attribute_Index => "Ada");
-- Update_Attribute_Value_In_Scenario
-- (Tree => Project_Tree,
-- Project => Config_File,
-- Scenario_Variables => No_Scenario,
-- Attribute => Impl_Suffix_Attribute,
-- Value => ".adb",
-- Attribute_Index => "Ada");
-- Update_Attribute_Value_In_Scenario
-- (Tree => Project_Tree,
-- Project => Config_File,
-- Scenario_Variables => No_Scenario,
-- Attribute => Dot_Replacement_Attribute,
-- Value => "-");
-- Update_Attribute_Value_In_Scenario
-- (Tree => Project_Tree,
-- Project => Config_File,
-- Scenario_Variables => No_Scenario,
-- Attribute => Casing_Attribute,
-- Value => "lowercase");
end if;
end Add_Default_GNAT_Naming_Scheme;
end Prj.Conf;

16
gcc/ada/prj-conf.ads
View File

@ -99,10 +99,15 @@ package Prj.Conf is
Report_Error : Put_Line_Access := null;
On_Load_Config : Config_File_Hook := null;
Compiler_Driver_Mandatory : Boolean := True;
Allow_Duplicate_Basenames : Boolean := False);
Allow_Duplicate_Basenames : Boolean := False;
Reset_Tree : Boolean := True;
When_No_Sources : Error_Warning := Warning);
-- Same as above, except the project must already have been parsed through
-- Prj.Part.Parse, and only the processing of the project and the
-- configuration is done at this level.
-- If Reset_Tree is true, all projects are first removed from the tree.
-- When_No_Sources indicates what should be done when no sources are found
-- for one of the languages of the project.
Invalid_Config : exception;
@ -162,6 +167,15 @@ package Prj.Conf is
-- projects, so that when the second phase of the processing is performed
-- these attributes are automatically taken into account.
procedure Add_Default_GNAT_Naming_Scheme
(Config_File : in out Prj.Tree.Project_Node_Id;
Project_Tree : Prj.Tree.Project_Node_Tree_Ref);
-- A hook for Get_Or_Create_Configuration_File and
-- Process_Project_And_Apply_Config that will create a new config file (in
-- memory) and add the default GNAT naming scheme to it. Nothing is done
-- if the config_file already exists, to avoid overriding what the user
-- might have put in there.
--------------
-- Runtimes --
--------------

1434
gcc/ada/prj-nmsc.adb
View File

File diff suppressed because it is too large Load Diff

2
gcc/ada/prj-nmsc.ads
View File

@ -83,6 +83,6 @@ private package Prj.Nmsc is
private
type Processing_Data is record
Units : Files_Htable.Instance;
-- Mapping from file base name to the project containing the file
-- Mapping from file base name to the Source_Id of the file
end record;
end Prj.Nmsc;

52
gcc/ada/prj-pars.adb
View File

@ -27,9 +27,9 @@ with Ada.Exceptions; use Ada.Exceptions;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with Output; use Output;
with Prj.Conf; use Prj.Conf;
with Prj.Err; use Prj.Err;
with Prj.Part;
with Prj.Proc;
with Prj.Tree; use Prj.Tree;
with Sinput.P;
@ -46,15 +46,15 @@ package body Prj.Pars is
Packages_To_Check : String_List_Access := All_Packages;
When_No_Sources : Error_Warning := Error;
Report_Error : Put_Line_Access := null;
Reset_Tree : Boolean := True;
Is_Config_File : Boolean := False)
Reset_Tree : Boolean := True)
is
Project_Node : Project_Node_Id := Empty_Node;
The_Project : Project_Id := No_Project;
Success : Boolean := True;
Current_Dir : constant String := Get_Current_Dir;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Automatically_Generated : Boolean;
Config_File_Path : String_Access;
begin
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);
@ -69,22 +69,42 @@ package body Prj.Pars is
Always_Errout_Finalize => False,
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Dir,
Is_Config_File => Is_Config_File);
Is_Config_File => False);
-- If there were no error, process the tree
if Project_Node /= Empty_Node then
Prj.Proc.Process
(In_Tree => In_Tree,
Project => The_Project,
Success => Success,
From_Project_Node => Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
Report_Error => Report_Error,
Reset_Tree => Reset_Tree,
When_No_Sources => When_No_Sources,
Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File);
begin
-- No config file should be read from the disk for gnatmake.
-- However, we will simulate one that only contains the
-- default GNAT naming scheme.
Process_Project_And_Apply_Config
(Main_Project => The_Project,
User_Project_Node => Project_Node,
Config_File_Name => "",
Autoconf_Specified => False,
Project_Tree => In_Tree,
Project_Node_Tree => Project_Node_Tree,
Packages_To_Check => null,
Allow_Automatic_Generation => False,
Automatically_Generated => Automatically_Generated,
Config_File_Path => Config_File_Path,
Report_Error => Report_Error,
Normalized_Hostname => "",
Compiler_Driver_Mandatory => False,
Allow_Duplicate_Basenames => False,
On_Load_Config =>
Add_Default_GNAT_Naming_Scheme'Access,
Reset_Tree => Reset_Tree,
When_No_Sources => When_No_Sources);
Success := The_Project /= No_Project;
exception
when Invalid_Config =>
Success := False;
end;
Prj.Err.Finalize;

6
gcc/ada/prj-pars.ads
View File

@ -37,8 +37,7 @@ package Prj.Pars is
Packages_To_Check : String_List_Access := All_Packages;
When_No_Sources : Error_Warning := Error;
Report_Error : Prj.Put_Line_Access := null;
Reset_Tree : Boolean := True;
Is_Config_File : Boolean := False);
Reset_Tree : Boolean := True);
-- Parse and process a project files and all its imported project files, in
-- the project tree In_Tree.
-- All the project files are parsed (through Prj.Tree) to create a tree in
@ -62,8 +61,5 @@ package Prj.Pars is
--
-- When Reset_Tree is True, all the project data are removed from the
-- project table before processing.
--
-- Is_Config_File should be set to True if the project represents a config
-- file (.cgpr) since some specific checks apply.
end Prj.Pars;

92
gcc/ada/prj-part.adb
View File

@ -214,12 +214,6 @@ package body Prj.Part is
-- Returns the path name of a project file. Returns an empty string
-- if project file cannot be found.
function Immediate_Directory_Of
(Path_Name : Path_Name_Type) return Path_Name_Type;
-- Get the directory of the file with the specified path name.
-- This includes the directory separator as the last character.
-- Returns "./" if Path_Name contains no directory separator.
function Project_Name_From
(Path_Name : String;
Is_Config_File : Boolean) return Name_Id;
@ -249,10 +243,6 @@ package body Prj.Part is
-- Fake path name of the virtual extending project. The directory is
-- the same directory as the extending all project.
Virtual_Dir_Id : constant Path_Name_Type :=
Immediate_Directory_Of (Path_Name_Of (Main_Project, In_Tree));
-- The directory of the extending all project
-- The source of the virtual extending project is something like:
-- project V$<project name> extends <project path> is
@ -266,15 +256,11 @@ package body Prj.Part is
-- Nodes that made up the virtual extending project
Virtual_Project : constant Project_Node_Id :=
Default_Project_Node
(In_Tree, N_Project);
Virtual_Project : Project_Node_Id;
With_Clause : constant Project_Node_Id :=
Default_Project_Node
(In_Tree, N_With_Clause);
Project_Declaration : constant Project_Node_Id :=
Default_Project_Node
(In_Tree, N_Project_Declaration);
Project_Declaration : Project_Node_Id;
Source_Dirs_Declaration : constant Project_Node_Id :=
Default_Project_Node
(In_Tree, N_Declarative_Item);
@ -292,12 +278,6 @@ package body Prj.Part is
(In_Tree, N_Literal_String_List, List);
begin
-- Get the virtual name id
Name_Len := Virtual_Name'Length;
Name_Buffer (1 .. Name_Len) := Virtual_Name;
Virtual_Name_Id := Name_Find;
-- Get the virtual path name
Get_Name_String (Path_Name_Of (Main_Project, In_Tree));
@ -314,6 +294,20 @@ package body Prj.Part is
Name_Len := Name_Len + Virtual_Name'Length;
Virtual_Path_Id := Name_Find;
-- Get the virtual name id
Name_Len := Virtual_Name'Length;
Name_Buffer (1 .. Name_Len) := Virtual_Name;
Virtual_Name_Id := Name_Find;
Virtual_Project := Create_Project
(In_Tree => In_Tree,
Name => Virtual_Name_Id,
Full_Path => Virtual_Path_Id,
Is_Config_File => False);
Project_Declaration := Project_Declaration_Of (Virtual_Project, In_Tree);
-- With clause
Set_Name_Of (With_Clause, In_Tree, Virtual_Name_Id);
@ -325,13 +319,8 @@ package body Prj.Part is
-- Virtual project node
Set_Name_Of (Virtual_Project, In_Tree, Virtual_Name_Id);
Set_Path_Name_Of (Virtual_Project, In_Tree, Virtual_Path_Id);
Set_Location_Of
(Virtual_Project, In_Tree, Location_Of (Main_Project, In_Tree));
Set_Directory_Of (Virtual_Project, In_Tree, Virtual_Dir_Id);
Set_Project_Declaration_Of
(Virtual_Project, In_Tree, Project_Declaration);
Set_Extended_Project_Path_Of
(Virtual_Project, In_Tree, Path_Name_Of (For_Project, In_Tree));
@ -361,54 +350,8 @@ package body Prj.Part is
Set_Current_Term (Source_Dirs_Term, In_Tree, Source_Dirs_List);
-- Source_Dirs empty list: nothing to do
-- Put virtual project into Projects_Htable
Prj.Tree.Tree_Private_Part.Projects_Htable.Set
(T => In_Tree.Projects_HT,
K => Virtual_Name_Id,
E => (Name => Virtual_Name_Id,
Node => Virtual_Project,
Canonical_Path => No_Path,
Extended => False,
Proj_Qualifier => Unspecified));
end Create_Virtual_Extending_Project;
----------------------------
-- Immediate_Directory_Of --
----------------------------
function Immediate_Directory_Of
(Path_Name : Path_Name_Type) return Path_Name_Type
is
begin
Get_Name_String (Path_Name);
for Index in reverse 1 .. Name_Len loop
if Name_Buffer (Index) = '/'
or else Name_Buffer (Index) = Dir_Sep
then
-- Remove all chars after last directory separator from name
if Index > 1 then
Name_Len := Index - 1;
else
Name_Len := Index;
end if;
return Name_Find;
end if;
end loop;
-- There is no directory separator in name. Return "./" or ".\"
Name_Len := 2;
Name_Buffer (1) := '.';
Name_Buffer (2) := Dir_Sep;
return Name_Find;
end Immediate_Directory_Of;
-----------------------------------
-- Look_For_Virtual_Projects_For --
-----------------------------------
@ -1167,7 +1110,8 @@ package body Prj.Part is
Write_Eol;
end if;
Project_Directory := Immediate_Directory_Of (Normed_Path_Name);
Project_Directory := Path_Name_Type
(Get_Directory (File_Name_Type (Normed_Path_Name)));
-- Is there any imported project?

44
gcc/ada/prj-tree.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2009, 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- --
@ -24,6 +24,7 @@
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with Osint; use Osint;
with Prj.Err;
package body Prj.Tree is
@ -2820,4 +2821,45 @@ package body Prj.Tree is
return Unkept_Comments;
end There_Are_Unkept_Comments;
--------------------
-- Create_Project --
--------------------
function Create_Project
(In_Tree : Project_Node_Tree_Ref;
Name : Name_Id;
Full_Path : Path_Name_Type;
Is_Config_File : Boolean := False) return Project_Node_Id
is
Project : Project_Node_Id;
Qualifier : Project_Qualifier := Unspecified;
begin
Project := Default_Project_Node (In_Tree, N_Project);
Set_Name_Of (Project, In_Tree, Name);
Set_Directory_Of
(Project, In_Tree,
Path_Name_Type (Get_Directory (File_Name_Type (Full_Path))));
Set_Path_Name_Of (Project, In_Tree, Full_Path);
Set_Project_Declaration_Of
(Project, In_Tree,
Default_Project_Node (In_Tree, N_Project_Declaration));
if Is_Config_File then
Qualifier := Configuration;
end if;
Prj.Tree.Tree_Private_Part.Projects_Htable.Set
(In_Tree.Projects_HT,
Name,
Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
(Name => Name,
Canonical_Path => No_Path, -- ??? in GPS: Path_Name_Type (Name),
Node => Project,
Extended => False,
Proj_Qualifier => Qualifier));
return Project;
end Create_Project;
end Prj.Tree;

19
gcc/ada/prj-tree.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2009, 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- --
@ -92,11 +92,11 @@ package Prj.Tree is
function Present (Node : Project_Node_Id) return Boolean;
pragma Inline (Present);
-- Return True iff Node /= Empty_Node
-- Return True if Node /= Empty_Node
function No (Node : Project_Node_Id) return Boolean;
pragma Inline (No);
-- Return True iff Node = Empty_Node
-- Return True if Node = Empty_Node
procedure Initialize (Tree : Project_Node_Tree_Ref);
-- Initialize the Project File tree: empty the Project_Nodes table
@ -108,6 +108,15 @@ package Prj.Tree is
And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id;
-- Returns a Project_Node_Record with the specified Kind and Expr_Kind. All
-- the other components have default nil values.
-- To create a node for a project itself, see Create_Project below instead
function Create_Project
(In_Tree : Project_Node_Tree_Ref;
Name : Name_Id;
Full_Path : Path_Name_Type;
Is_Config_File : Boolean := False) return Project_Node_Id;
-- Create a new node for a project and register it in the tree so that it
-- can be retrieved later on
function Hash (N : Project_Node_Id) return Header_Num;
-- Used for hash tables where the key is a Project_Node_Id
@ -285,7 +294,9 @@ package Prj.Tree is
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Path_Name_Type;
pragma Inline (Directory_Of);
-- Only valid for N_Project nodes
-- Only valid for N_Project nodes.
-- Returns the directory that contains the project file. This always
-- ends with a directory separator
function Expression_Kind_Of
(Node : Project_Node_Id;

16
gcc/ada/prj.adb
View File

@ -476,7 +476,8 @@ package body Prj is
function Find_Source
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
In_Imported_Only : Boolean;
In_Imported_Only : Boolean := False;
In_Extended_Only : Boolean := False;
Base_Name : File_Name_Type) return Source_Id
is
Result : Source_Id := No_Source;
@ -506,10 +507,21 @@ package body Prj is
procedure For_Imported_Projects is new For_Every_Project_Imported
(State => Source_Id, Action => Look_For_Sources);
Proj : Project_Id;
-- Start of processing for Find_Source
begin
if In_Imported_Only then
if In_Extended_Only then
Proj := Project;
while Proj /= No_Project loop
Look_For_Sources (Proj, Result);
exit when Result /= No_Source;
Proj := Proj.Extends;
end loop;
elsif In_Imported_Only then
Look_For_Sources (Project, Result);
if Result = No_Source then

11
gcc/ada/prj.ads
View File

@ -145,6 +145,7 @@ package Prj is
Name : Path_Name_Type := No_Path;
Display_Name : Path_Name_Type := No_Path;
end record;
-- Directory names always end with a directory separator
No_Path_Information : constant Path_Information := (No_Path, No_Path);
@ -1269,8 +1270,8 @@ package Prj is
package Files_Htable is new Simple_HTable
(Header_Num => Header_Num,
Element => Project_Id,
No_Element => No_Project,
Element => Source_Id,
No_Element => No_Source,
Key => File_Name_Type,
Hash => Hash,
Equal => "=");
@ -1298,11 +1299,13 @@ package Prj is
function Find_Source
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
In_Imported_Only : Boolean;
In_Imported_Only : Boolean := False;
In_Extended_Only : Boolean := False;
Base_Name : File_Name_Type) return Source_Id;
-- Find the first source file with the given name either in the whole tree
-- (if In_Imported_Only is False) or in the projects imported or extended
-- by Project otherwise.
-- by Project otherwise. In_Extended_Only implies In_Imported_Only, and
-- will only look in Project and the projects it extends
-----------------------
-- Project_Tree_Data --