Skip to content

R
riscv-gcc-1
Commit fc2c32e2 by Emmanuel Briot Committed by Arnaud Charlet
Options

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

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
parent 1629f700
Showing with 283 additions and 194 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/clean.adb
......@@ -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");
......
gcc/ada/gcc-interface/Makefile.in
......@@ -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 \
......
gcc/ada/gnatcmd.adb
......@@ -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");
......
gcc/ada/make.adb
......@@ -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);
......
gcc/ada/mlib-prj.adb
......@@ -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);
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;
Source := Find_Source
(In_Tree, For_Project,
In_Extended_Only => True,
Base_Name => File_Name);
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
......
gcc/ada/mlib.adb
......@@ -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;
......
gcc/ada/prj-conf.adb
......@@ -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;
gcc/ada/prj-conf.ads
......@@ -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 --
--------------
......
gcc/ada/prj-nmsc.ads
......@@ -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;
gcc/ada/prj-pars.adb
......@@ -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;
......
gcc/ada/prj-pars.ads
......@@ -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;
gcc/ada/prj-part.adb
......@@ -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?
......
gcc/ada/prj-tree.adb
......@@ -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;
gcc/ada/prj-tree.ads
......@@ -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;
......
gcc/ada/prj.adb
......@@ -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
......
gcc/ada/prj.ads
......@@ -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 --
......
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