diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-06-06 10:40:57 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-06-06 10:40:57 +0000 |
commit | 5c94c0dc65c17599419076890d5ae243656087bd (patch) | |
tree | ad06a04bf2d5c7b5b962784f36f8f4c897320e98 /gcc/ada | |
parent | d3ac8b3a5c0c76eba7ad2f6c0d00bfabf6cddabd (diff) | |
download | gcc-5c94c0dc65c17599419076890d5ae243656087bd.tar.gz |
2007-04-20 Vincent Celier <celier@adacore.com>
* prj.adb (Project_Empty): Gives default value for new component
Libgnarl_Needed
* prj-attr.ads: Minor reformatting
* prj-env.ads, prj-env.adb (For_All_Object_Dirs): Register object
directory using the untouched casing.
(For_All_Source_Dirs): Idem.
* prj-ext.ads, prj-ext.adb (Search_Directories): New table to record
directories specified with switches -aP.
(Add_Search_Project_Directory): New procedure
(Initialize_Project_Path): Put the directories in table
Search_Directories in the project search path.
(Initialize_Project_Path): For VMS, transform into canonical form the
project path.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@125442 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/prj-attr.ads | 28 | ||||
-rw-r--r-- | gcc/ada/prj-env.adb | 203 | ||||
-rw-r--r-- | gcc/ada/prj-env.ads | 6 | ||||
-rw-r--r-- | gcc/ada/prj-ext.adb | 167 | ||||
-rw-r--r-- | gcc/ada/prj-ext.ads | 8 | ||||
-rw-r--r-- | gcc/ada/prj.adb | 111 |
6 files changed, 282 insertions, 241 deletions
diff --git a/gcc/ada/prj-attr.ads b/gcc/ada/prj-attr.ads index 732feb3363a..abd55112638 100644 --- a/gcc/ada/prj-attr.ads +++ b/gcc/ada/prj-attr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2007, 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- -- @@ -274,12 +274,13 @@ private -- Data for an attribute package Attrs is - new Table.Table (Table_Component_Type => Attribute_Record, - Table_Index_Type => Attr_Node_Id, - Table_Low_Bound => First_Attribute, - Table_Initial => Attributes_Initial, - Table_Increment => Attributes_Increment, - Table_Name => "Prj.Attr.Attrs"); + new Table.Table + (Table_Component_Type => Attribute_Record, + Table_Index_Type => Attr_Node_Id, + Table_Low_Bound => First_Attribute, + Table_Initial => Attributes_Initial, + Table_Increment => Attributes_Increment, + Table_Name => "Prj.Attr.Attrs"); -- The table of the attributes -------------- @@ -294,12 +295,13 @@ private -- Data for a package package Package_Attributes is - new Table.Table (Table_Component_Type => Package_Record, - Table_Index_Type => Pkg_Node_Id, - Table_Low_Bound => First_Package, - Table_Initial => Packages_Initial, - Table_Increment => Packages_Increment, - Table_Name => "Prj.Attr.Packages"); + new Table.Table + (Table_Component_Type => Package_Record, + Table_Index_Type => Pkg_Node_Id, + Table_Low_Bound => First_Package, + Table_Initial => Packages_Initial, + Table_Increment => Packages_Increment, + Table_Name => "Prj.Attr.Packages"); -- The table of the packages end Prj.Attr; diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index c6668a5599f..589a98b430b 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2007, 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,7 +24,6 @@ -- -- ------------------------------------------------------------------------------ -with Namet; use Namet; with Opt; with Osint; use Osint; with Output; use Output; @@ -35,17 +34,16 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations; package body Prj.Env is - Current_Source_Path_File : Name_Id := No_Name; - -- Current value of project source path file env var. - -- Used to avoid setting the env var to the same value. + Current_Source_Path_File : Path_Name_Type := No_Path; + -- Current value of project source path file env var. Used to avoid setting + -- the env var to the same value. - Current_Object_Path_File : Name_Id := No_Name; - -- Current value of project object path file env var. - -- Used to avoid setting the env var to the same value. + Current_Object_Path_File : Path_Name_Type := No_Path; + -- Current value of project object path file env var. Used to avoid setting + -- the env var to the same value. Ada_Path_Buffer : String_Access := new String (1 .. 1024); - -- A buffer where values for ADA_INCLUDE_PATH - -- and ADA_OBJECTS_PATH are stored. + -- buffer where values for ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are stored Ada_Path_Length : Natural := 0; -- Index of the last valid character in Ada_Path_Buffer @@ -90,31 +88,29 @@ package body Prj.Env is procedure Add_To_Path (Dir : String); -- If Dir is not already in the global variable Ada_Path_Buffer, add it. - -- Increment Ada_Path_Length. - -- If Ada_Path_Length /= 0, prepend a Path_Separator character to - -- Path. + -- Increment Ada_Path_Length. If Ada_Path_Length /= 0, prepend a + -- Path_Separator character to Path. procedure Add_To_Source_Path (Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref); - -- Add to Ada_Path_B all the source directories in string list - -- Source_Dirs, if any. Increment Ada_Path_Length. + -- Add to Ada_Path_B all the source directories in string list Source_Dirs, + -- if any. Increment Ada_Path_Length. procedure Add_To_Object_Path - (Object_Dir : Name_Id; + (Object_Dir : Path_Name_Type; In_Tree : Project_Tree_Ref); -- Add Object_Dir to object path table. Make sure it is not duplicate -- and it is the last one in the current table. - function Contains_ALI_Files (Dir : Name_Id) return Boolean; + function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean; -- Return True if there is at least one ALI file in the directory Dir procedure Create_New_Path_File (In_Tree : Project_Tree_Ref; Path_FD : out File_Descriptor; - Path_Name : out Name_Id); - -- Create a new temporary path file. Get the file name in Path_Name. - -- The name is normally obtained by increasing the number in - -- Temp_Path_File_Name by 1. + Path_Name : out Path_Name_Type); + -- Create a new temporary path file. Get the file name in Path_Name. The + -- name is normally obtained by increasing Temp_Path_File_Name by 1. procedure Set_Path_File_Var (Name : String; Value : String); -- Call Setenv, after calling To_Host_File_Spec @@ -260,7 +256,7 @@ package body Prj.Env is if (Data.Library and then Including_Libraries) or else - (Data.Object_Directory /= No_Name + (Data.Object_Directory /= No_Path and then (not Including_Libraries or else not Data.Library)) then @@ -269,7 +265,7 @@ package body Prj.Env is -- files; otherwise add the object directory. if Data.Library then - if Data.Object_Directory = No_Name + if Data.Object_Directory = No_Path or else Contains_ALI_Files (Data.Library_ALI_Dir) then @@ -333,7 +329,8 @@ package body Prj.Env is ------------------------ procedure Add_To_Object_Path - (Object_Dir : Name_Id; In_Tree : Project_Tree_Ref) + (Object_Dir : Path_Name_Type; + In_Tree : Project_Tree_Ref) is begin -- Check if the directory is already in the table @@ -494,7 +491,7 @@ package body Prj.Env is -- If it is already, no need to add it if In_Tree.Private_Part.Source_Paths.Table (Index) = - Source_Dir.Value + File_Name_Type (Source_Dir.Value) then Add_It := False; exit; @@ -506,7 +503,7 @@ package body Prj.Env is (In_Tree.Private_Part.Source_Paths); In_Tree.Private_Part.Source_Paths.Table (Source_Path_Table.Last (In_Tree.Private_Part.Source_Paths)) := - Source_Dir.Value; + File_Name_Type (Source_Dir.Value); end if; -- Next source directory @@ -528,7 +525,7 @@ package body Prj.Env is -- If we don't know the path name of the body of this unit, -- we compute it, and we store it. - if Data.File_Names (Body_Part).Path = No_Name then + if Data.File_Names (Body_Part).Path = No_File then declare Current_Source : String_List_Id := In_Tree.Projects.Table @@ -581,10 +578,10 @@ package body Prj.Env is -- Contains_ALI_Files -- ------------------------ - function Contains_ALI_Files (Dir : Name_Id) return Boolean is + function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean is Dir_Name : constant String := Get_Name_String (Dir); Direct : Dir_Type; - Name : String (1 .. 1_000); + Name : String (1 .. 1_000); -- what is this magic constant 1000 ??? Last : Natural; Result : Boolean := False; @@ -629,7 +626,7 @@ package body Prj.Env is pragma Unreferenced (Main_Project); pragma Unreferenced (Include_Config_Files); - File_Name : Name_Id := No_Name; + File_Name : Path_Name_Type := No_Path; File : File_Descriptor := Invalid_FD; Current_Unit : Unit_Id := Unit_Table.First; @@ -654,7 +651,7 @@ package body Prj.Env is procedure Put (Unit_Name : Name_Id; - File_Name : Name_Id; + File_Name : File_Name_Type; Unit_Kind : Spec_Or_Body; Index : Int); -- Put an SFN pragma in the temporary file @@ -827,7 +824,7 @@ package body Prj.Env is procedure Put (Unit_Name : Name_Id; - File_Name : Name_Id; + File_Name : File_Name_Type; Unit_Kind : Spec_Or_Body; Index : Int) is @@ -993,7 +990,7 @@ package body Prj.Env is procedure Create_Mapping_File (Project : Project_Id; In_Tree : Project_Tree_Ref; - Name : out Name_Id) + Name : out Path_Name_Type) is File : File_Descriptor := Invalid_FD; The_Unit_Data : Unit_Data; @@ -1141,7 +1138,7 @@ package body Prj.Env is -- If there is a spec, put it mapping in the file if it is -- from a project in the closure of Project. - if Data.Name /= No_Name and then Present (Data.Project) then + if Data.Name /= No_File and then Present (Data.Project) then Put_Data (Spec => True); end if; @@ -1150,7 +1147,7 @@ package body Prj.Env is -- If there is a body (or subunit) put its mapping in the file -- if it is from a project in the closure of Project. - if Data.Name /= No_Name and then Present (Data.Project) then + if Data.Name /= No_File and then Present (Data.Project) then Put_Data (Spec => False); end if; @@ -1172,12 +1169,12 @@ package body Prj.Env is procedure Create_New_Path_File (In_Tree : Project_Tree_Ref; Path_FD : out File_Descriptor; - Path_Name : out Name_Id) + Path_Name : out Path_Name_Type) is begin Tempdir.Create_Temp_File (Path_FD, Path_Name); - if Path_Name /= No_Name then + if Path_Name /= No_Path then -- Record the name, so that the temp path file will be deleted -- at the end of the program. @@ -1200,7 +1197,7 @@ package body Prj.Env is for Index in Path_File_Table.First .. Path_File_Table.Last (In_Tree.Private_Part.Path_Files) loop - if In_Tree.Private_Part.Path_Files.Table (Index) /= No_Name then + if In_Tree.Private_Part.Path_Files.Table (Index) /= No_Path then Delete_File (Get_Name_String (In_Tree.Private_Part.Path_Files.Table (Index)), @@ -1249,9 +1246,9 @@ package body Prj.Env is Unit : Unit_Data; - The_Original_Name : Name_Id; - The_Spec_Name : Name_Id; - The_Body_Name : Name_Id; + The_Original_Name : File_Name_Type; + The_Spec_Name : File_Name_Type; + The_Body_Name : File_Name_Type; begin Canonical_Case_File_Name (Original_Name); @@ -1303,13 +1300,13 @@ package body Prj.Env is or else Unit.File_Names (Body_Part).Project = The_Project then declare - Current_Name : constant Name_Id := + Current_Name : constant File_Name_Type := Unit.File_Names (Body_Part).Name; begin -- Case of a body present - if Current_Name /= No_Name then + if Current_Name /= No_File then if Current_Verbosity = High then Write_Str (" Comparing with """); Write_Str (Get_Name_String (Current_Name)); @@ -1317,10 +1314,11 @@ package body Prj.Env is Write_Eol; end if; - -- If it has the name of the original name, - -- return the original name + -- If it has the name of the original name, return the + -- original name. - if Unit.Name = The_Original_Name + if Name_Id (Unit.Name) = Name_Id (The_Original_Name) + -- Type confusion in above comparison ??? or else Current_Name = The_Original_Name then if Current_Verbosity = High then @@ -1366,13 +1364,13 @@ package body Prj.Env is or else Unit.File_Names (Specification).Project = The_Project then declare - Current_Name : constant Name_Id := + Current_Name : constant File_Name_Type := Unit.File_Names (Specification).Name; begin -- Case of spec present - if Current_Name /= No_Name then + if Current_Name /= No_File then if Current_Verbosity = High then Write_Str (" Comparing with """); Write_Str (Get_Name_String (Current_Name)); @@ -1382,7 +1380,8 @@ package body Prj.Env is -- If name same as original name, return original name - if Unit.Name = The_Original_Name + if Name_Id (Unit.Name) = Name_Id (The_Original_Name) + -- Type confusion in the above comparison ??? or else Current_Name = The_Original_Name then if Current_Verbosity = High then @@ -1498,8 +1497,7 @@ package body Prj.Env is -- This project has never been visited, add it -- to the list. - Project_List_Table.Increment_Last - (In_Tree.Project_Lists); + Project_List_Table.Increment_Last (In_Tree.Project_Lists); In_Tree.Project_Lists.Table (Current).Next := Project_List_Table.Last (In_Tree.Project_Lists); In_Tree.Project_Lists.Table @@ -1512,8 +1510,8 @@ package body Prj.Env is -- If there is an object directory, call Action -- with its name - if Data.Object_Directory /= No_Name then - Get_Name_String (Data.Object_Directory); + if Data.Object_Directory /= No_Path then + Get_Name_String (Data.Display_Object_Dir); Action (Name_Buffer (1 .. Name_Len)); end if; @@ -1560,8 +1558,7 @@ package body Prj.Env is --------- procedure Add (Project : Project_Id) is - Data : constant Project_Data := - In_Tree.Projects.Table (Project); + Data : constant Project_Data := In_Tree.Projects.Table (Project); List : Project_List := Data.Imported_Projects; begin @@ -1569,10 +1566,8 @@ package body Prj.Env is -- for sure we never visited this project. if Seen = Empty_Project_List then - Project_List_Table.Increment_Last - (In_Tree.Project_Lists); - Seen := Project_List_Table.Last - (In_Tree.Project_Lists); + Project_List_Table.Increment_Last (In_Tree.Project_Lists); + Seen := Project_List_Table.Last (In_Tree.Project_Lists); In_Tree.Project_Lists.Table (Seen) := (Project => Project, Next => Empty_Project_List); @@ -1595,20 +1590,18 @@ package body Prj.Env is exit when In_Tree.Project_Lists.Table (Current).Next = Empty_Project_List; - Current := - In_Tree.Project_Lists.Table (Current).Next; + + Current := In_Tree.Project_Lists.Table (Current).Next; end loop; -- This project has never been visited, add it -- to the list. - Project_List_Table.Increment_Last - (In_Tree.Project_Lists); + Project_List_Table.Increment_Last (In_Tree.Project_Lists); In_Tree.Project_Lists.Table (Current).Next := Project_List_Table.Last (In_Tree.Project_Lists); In_Tree.Project_Lists.Table - (Project_List_Table.Last - (In_Tree.Project_Lists)) := + (Project_List_Table.Last (In_Tree.Project_Lists)) := (Project => Project, Next => Empty_Project_List); end; end if; @@ -1621,13 +1614,10 @@ package body Prj.Env is -- If there are Ada sources, call action with the name of every -- source directory. - if - In_Tree.Projects.Table (Project).Ada_Sources_Present - then + if In_Tree.Projects.Table (Project).Ada_Sources_Present then while Current /= Nil_String loop - The_String := - In_Tree.String_Elements.Table (Current); - Action (Get_Name_String (The_String.Value)); + The_String := In_Tree.String_Elements.Table (Current); + Action (Get_Name_String (The_String.Display_Value)); Current := The_String.Next; end loop; end if; @@ -1663,7 +1653,7 @@ package body Prj.Env is (Source_File_Name : String; In_Tree : Project_Tree_Ref; Project : out Project_Id; - Path : out Name_Id) + Path : out File_Name_Type) is begin -- Body below could use some comments ??? @@ -1686,14 +1676,14 @@ package body Prj.Env is loop Unit := In_Tree.Units.Table (Id); - if (Unit.File_Names (Specification).Name /= No_Name + if (Unit.File_Names (Specification).Name /= No_File and then Namet.Get_Name_String (Unit.File_Names (Specification).Name) = Original_Name) - or else (Unit.File_Names (Specification).Path /= No_Name + or else (Unit.File_Names (Specification).Path /= No_File and then Namet.Get_Name_String - (Unit.File_Names (Specification).Path) = + (Unit.File_Names (Specification).Path) = Original_Name) then Project := Ultimate_Extension_Of @@ -1708,11 +1698,11 @@ package body Prj.Env is return; - elsif (Unit.File_Names (Body_Part).Name /= No_Name + elsif (Unit.File_Names (Body_Part).Name /= No_File and then Namet.Get_Name_String (Unit.File_Names (Body_Part).Name) = Original_Name) - or else (Unit.File_Names (Body_Part).Path /= No_Name + or else (Unit.File_Names (Body_Part).Path /= No_File and then Namet.Get_Name_String (Unit.File_Names (Body_Part).Path) = Original_Name) @@ -1733,7 +1723,7 @@ package body Prj.Env is end; Project := No_Project; - Path := No_Name; + Path := No_File; if Current_Verbosity > Default then Write_Str ("Cannot be found."); @@ -1772,7 +1762,7 @@ package body Prj.Env is Name & Namet.Get_Name_String (Data.Naming.Ada_Body_Suffix); - First : Unit_Id := Unit_Table.First; + First : Unit_Id; Current : Unit_Id; Unit : Unit_Data; @@ -1796,6 +1786,7 @@ package body Prj.Env is Write_Eol; end if; + First := Unit_Table.First; while First <= Unit_Table.Last (In_Tree.Units) and then In_Tree.Units.Table (First).File_Names (Body_Part).Project /= Project @@ -1808,7 +1799,7 @@ package body Prj.Env is Unit := In_Tree.Units.Table (Current); if Unit.File_Names (Body_Part).Project = Project - and then Unit.File_Names (Body_Part).Name /= No_Name + and then Unit.File_Names (Body_Part).Name /= No_File then declare Current_Name : constant String := @@ -1842,7 +1833,7 @@ package body Prj.Env is end if; end; - elsif Unit.File_Names (Specification).Name /= No_Name then + elsif Unit.File_Names (Specification).Name /= No_File then declare Current_Name : constant String := Namet.Get_Name_String @@ -1902,7 +1893,7 @@ package body Prj.Env is Write_Str (" "); Write_Line (Namet.Get_Name_String (Unit.Name)); - if Unit.File_Names (Specification).Name /= No_Name then + if Unit.File_Names (Specification).Name /= No_File then if Unit.File_Names (Specification).Project = No_Project then Write_Line (" No project"); @@ -1920,7 +1911,7 @@ package body Prj.Env is (Unit.File_Names (Specification).Name)); end if; - if Unit.File_Names (Body_Part).Name /= No_Name then + if Unit.File_Names (Body_Part).Name /= No_File then if Unit.File_Names (Body_Part).Project = No_Project then Write_Line (" No project"); @@ -1956,7 +1947,7 @@ package body Prj.Env is Original_Name : String := Name; Data : constant Project_Data := - In_Tree.Projects.Table (Main_Project); + In_Tree.Projects.Table (Main_Project); Extended_Spec_Name : String := Name & Namet.Get_Name_String @@ -1967,11 +1958,12 @@ package body Prj.Env is Unit : Unit_Data; - Current_Name : Name_Id; + Current_Name : File_Name_Type; + The_Original_Name : File_Name_Type; + The_Spec_Name : File_Name_Type; + The_Body_Name : File_Name_Type; - The_Original_Name : Name_Id; - The_Spec_Name : Name_Id; - The_Body_Name : Name_Id; + -- Confusion here between unit names/file names, See ??? comments below begin Canonical_Case_File_Name (Original_Name); @@ -2000,12 +1992,12 @@ package body Prj.Env is -- Case of a body present - if Current_Name /= No_Name then + if Current_Name /= No_File then -- If it has the name of the original name or the body name, -- we have found the project. - if Unit.Name = The_Original_Name + if Name_Id (Unit.Name) = Name_Id (The_Original_Name) -- ??? or else Current_Name = The_Original_Name or else Current_Name = The_Body_Name then @@ -2018,12 +2010,12 @@ package body Prj.Env is Current_Name := Unit.File_Names (Specification).Name; - if Current_Name /= No_Name then + if Current_Name /= No_File then -- If name same as the original name, or the spec name, we have -- found the project. - if Unit.Name = The_Original_Name + if Name_Id (Unit.Name) = Name_Id (The_Original_Name) -- ??? or else Current_Name = The_Original_Name or else Current_Name = The_Spec_Name then @@ -2118,17 +2110,17 @@ package body Prj.Env is if (Data.Library and then Including_Libraries) or else - (Data.Object_Directory /= No_Name + (Data.Object_Directory /= No_Path and then (not Including_Libraries or else not Data.Library)) then - -- For a library project, add the library ALI - -- directory if there is no object directory or - -- if the library ALI directory contains ALI files; - -- otherwise add the object directory. + -- For a library project, add library ALI directory if + -- there is no object directory or if the library ALI + -- directory contains ALI files, otherwise add the + -- object directory. if Data.Library then - if Data.Object_Directory = No_Name + if Data.Object_Directory = No_Path or else Contains_ALI_Files (Data.Library_ALI_Dir) then Add_To_Object_Path @@ -2151,10 +2143,9 @@ package body Prj.Env is or else (Data.Extends /= No_Project and then - Data.Object_Directory /= No_Name)) + Data.Object_Directory /= No_Path)) then - Add_To_Object_Path - (Data.Object_Directory, In_Tree); + Add_To_Object_Path (Data.Object_Directory, In_Tree); end if; end if; end if; @@ -2197,9 +2188,7 @@ package body Prj.Env is -- If it is the first time we call this procedure for -- this project, compute the source path and/or the object path. - if In_Tree.Projects.Table (Project).Include_Path_File = - No_Name - then + if In_Tree.Projects.Table (Project).Include_Path_File = No_Path then Process_Source_Dirs := True; Create_New_Path_File (In_Tree, Source_FD, @@ -2211,7 +2200,7 @@ package body Prj.Env is if Including_Libraries then if In_Tree.Projects.Table - (Project).Objects_Path_File_With_Libs = No_Name + (Project).Objects_Path_File_With_Libs = No_Path then Process_Object_Dirs := True; Create_New_Path_File @@ -2221,7 +2210,7 @@ package body Prj.Env is else if In_Tree.Projects.Table - (Project).Objects_Path_File_Without_Libs = No_Name + (Project).Objects_Path_File_Without_Libs = No_Path then Process_Object_Dirs := True; Create_New_Path_File @@ -2363,7 +2352,7 @@ package body Prj.Env is Data : Unit_Data := In_Tree.Units.Table (Unit); begin - if Data.File_Names (Specification).Path = No_Name then + if Data.File_Names (Specification).Path = No_File then declare Current_Source : String_List_Id := In_Tree.Projects.Table diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index 59d2cfc0f67..a3a3db77c9b 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2005, Free Software Foundation, Inc -- +-- Copyright (C) 2001-2007, 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- -- @@ -39,7 +39,7 @@ package Prj.Env is procedure Create_Mapping_File (Project : Project_Id; In_Tree : Project_Tree_Ref; - Name : out Name_Id); + Name : out Path_Name_Type); -- Create a temporary mapping file for project Project. For each unit -- in the closure of immediate sources of Project, put the mapping of -- its spec and or body to its file name and path name in this file. @@ -135,7 +135,7 @@ package Prj.Env is (Source_File_Name : String; In_Tree : Project_Tree_Ref; Project : out Project_Id; - Path : out Name_Id); + Path : out File_Name_Type); -- Returns the project of a source and its path in displayable form generic diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb index f30c70936dd..4ab0a905322 100644 --- a/gcc/ada/prj-ext.adb +++ b/gcc/ada/prj-ext.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2007, 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,7 +26,6 @@ with Hostparm; with Makeutl; use Makeutl; -with Namet; use Namet; with Output; use Output; with Osint; use Osint; with Sdefault; @@ -68,6 +67,15 @@ package body Prj.Ext is -- first for external reference in this table, before checking the -- environment. Htable is emptied (reset) by procedure Reset. + package Search_Directories is new Table.Table + (Table_Component_Type => Name_Id, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 4, + Table_Increment => 100, + Table_Name => "Prj.Ext.Search_Directories"); + -- The table for the directories specified with -aP switches + --------- -- Add -- --------- @@ -89,6 +97,17 @@ package body Prj.Ext is Htable.Set (The_Key, The_Value); end Add; + ---------------------------------- + -- Add_Search_Project_Directory -- + ---------------------------------- + + procedure Add_Search_Project_Directory (Path : String) is + begin + Name_Len := 0; + Add_Str_To_Name_Buffer (Path); + Search_Directories.Append (Name_Find); + end Add_Search_Project_Directory; + ----------- -- Check -- ----------- @@ -121,10 +140,15 @@ package body Prj.Ext is Last : Positive; New_Len : Positive; New_Last : Positive; - Prj_Path : String_Access := Gpr_Prj_Path; + Prj_Path : String_Access := null; begin if Gpr_Prj_Path.all /= "" then + if Hostparm.OpenVMS then + Prj_Path := To_Canonical_Path_Spec ("GPR_PROJECT_PATH:"); + else + Prj_Path := To_Canonical_Path_Spec (Gpr_Prj_Path.all); + end if; -- Warn if both environment variables are defined @@ -133,8 +157,12 @@ package body Prj.Ext is Write_Line (" when GPR_PROJECT_PATH is defined"); end if; - else - Prj_Path := Ada_Prj_Path; + elsif Ada_Prj_Path.all /= "" then + if Hostparm.OpenVMS then + Prj_Path := To_Canonical_Path_Spec ("ADA_PROJECT_PATH:"); + else + Prj_Path := To_Canonical_Path_Spec (Ada_Prj_Path.all); + end if; end if; -- The current directory is always first @@ -142,80 +170,89 @@ package body Prj.Ext is Name_Len := 1; Name_Buffer (Name_Len) := '.'; - -- If environment variable is defined and not empty, add its content + -- If there are directories in the Search_Directories table, add them + + for J in 1 .. Search_Directories.Last loop + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := Path_Separator; + Add_Str_To_Name_Buffer + (Get_Name_String (Search_Directories.Table (J))); + end loop; + + -- If environment variable is defined, add its content - if Prj_Path.all /= "" then + if Prj_Path /= null then Name_Len := Name_Len + 1; Name_Buffer (Name_Len) := Path_Separator; Add_Str_To_Name_Buffer (Prj_Path.all); + end if; - -- Scan the directory path to see if "-" is one of the directories. - -- Remove each occurence of "-" and set Add_Default_Dir to False. - -- Also resolve relative paths and symbolic links. + -- Scan the directory path to see if "-" is one of the directories. + -- Remove each occurence of "-" and set Add_Default_Dir to False. + -- Also resolve relative paths and symbolic links. - First := 3; + First := 3; + loop + while First <= Name_Len + and then (Name_Buffer (First) = Path_Separator) loop - while First <= Name_Len - and then (Name_Buffer (First) = Path_Separator) - loop - First := First + 1; - end loop; + First := First + 1; + end loop; + + exit when First > Name_Len; + + Last := First; + + while Last < Name_Len + and then Name_Buffer (Last + 1) /= Path_Separator + loop + Last := Last + 1; + end loop; - exit when First > Name_Len; + -- If the directory is "-", set Add_Default_Dir to False and + -- remove from path. - Last := First; + if Name_Buffer (First .. Last) = No_Project_Default_Dir then + Add_Default_Dir := False; - while Last < Name_Len - and then Name_Buffer (Last + 1) /= Path_Separator - loop - Last := Last + 1; + for J in Last + 1 .. Name_Len loop + Name_Buffer (J - No_Project_Default_Dir'Length - 1) := + Name_Buffer (J); end loop; - -- If the directory is "-", set Add_Default_Dir to False and - -- remove from path. - - if Name_Buffer (First .. Last) = No_Project_Default_Dir then - Add_Default_Dir := False; - - for J in Last + 1 .. Name_Len loop - Name_Buffer (J - No_Project_Default_Dir'Length - 1) := - Name_Buffer (J); - end loop; - - Name_Len := Name_Len - No_Project_Default_Dir'Length - 1; - - elsif not Hostparm.OpenVMS - or else not Is_Absolute_Path (Name_Buffer (First .. Last)) - then - -- On VMS, only expand relative path names, as absolute paths - -- may correspond to multi-valued VMS logical names. - - declare - New_Dir : constant String := - Normalize_Pathname (Name_Buffer (First .. Last)); - - begin - -- If the absolute path was resolved and is different from - -- the original, replace original with the resolved path. - - if New_Dir /= Name_Buffer (First .. Last) - and then New_Dir'Length /= 0 - then - New_Len := Name_Len + New_Dir'Length - (Last - First + 1); - New_Last := First + New_Dir'Length - 1; - Name_Buffer (New_Last + 1 .. New_Len) := - Name_Buffer (Last + 1 .. Name_Len); - Name_Buffer (First .. New_Last) := New_Dir; - Name_Len := New_Len; - Last := New_Last; - end if; - end; - end if; + Name_Len := Name_Len - No_Project_Default_Dir'Length - 1; + + elsif not Hostparm.OpenVMS + or else not Is_Absolute_Path (Name_Buffer (First .. Last)) + then + -- On VMS, only expand relative path names, as absolute paths + -- may correspond to multi-valued VMS logical names. + + declare + New_Dir : constant String := + Normalize_Pathname (Name_Buffer (First .. Last)); + + begin + -- If the absolute path was resolved and is different from + -- the original, replace original with the resolved path. + + if New_Dir /= Name_Buffer (First .. Last) + and then New_Dir'Length /= 0 + then + New_Len := Name_Len + New_Dir'Length - (Last - First + 1); + New_Last := First + New_Dir'Length - 1; + Name_Buffer (New_Last + 1 .. New_Len) := + Name_Buffer (Last + 1 .. Name_Len); + Name_Buffer (First .. New_Last) := New_Dir; + Name_Len := New_Len; + Last := New_Last; + end if; + end; + end if; - First := Last + 1; - end loop; - end if; + First := Last + 1; + end loop; -- Set the initial value of Current_Project_Path diff --git a/gcc/ada/prj-ext.ads b/gcc/ada/prj-ext.ads index c0114ce2e08..c8ffaef81c0 100644 --- a/gcc/ada/prj-ext.ads +++ b/gcc/ada/prj-ext.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2007, 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- -- @@ -29,6 +29,12 @@ package Prj.Ext is + procedure Add_Search_Project_Directory (Path : String); + -- Add a directory to the project path. Directories added with this + -- procedure are added in order after the current directory and before + -- the path given by the environment variable GPR_PROJECT_PATH. A value + -- of "-" will remove the default project directory from the project path. + function Project_Path return String; -- Return the current value of the project path, either the value set -- during elaboration of the package or, if procedure Set_Project_Path has diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 7f85ed3041e..ea7807b3ac4 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2007, 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,7 +26,6 @@ with Ada.Characters.Handling; use Ada.Characters.Handling; -with Namet; use Namet; with Output; use Output; with Osint; use Osint; with Prj.Attr; @@ -46,9 +45,9 @@ package body Prj is Name_C_Plus_Plus : Name_Id; - Default_Ada_Spec_Suffix_Id : Name_Id; - Default_Ada_Body_Suffix_Id : Name_Id; - Slash_Id : Name_Id; + Default_Ada_Spec_Suffix_Id : File_Name_Type; + Default_Ada_Body_Suffix_Id : File_Name_Type; + Slash_Id : File_Name_Type; -- Initialized in Prj.Initialized, then never modified subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case; @@ -60,22 +59,23 @@ package body Prj is Initialized : Boolean := False; - Standard_Dot_Replacement : constant Name_Id := - First_Name_Id + Character'Pos ('-'); + Standard_Dot_Replacement : constant File_Name_Type := + File_Name_Type + (First_Name_Id + Character'Pos ('-')); Std_Naming_Data : Naming_Data := (Dot_Replacement => Standard_Dot_Replacement, Dot_Repl_Loc => No_Location, Casing => All_Lower_Case, Spec_Suffix => No_Array_Element, - Ada_Spec_Suffix => No_Name, + Ada_Spec_Suffix => No_File, Spec_Suffix_Loc => No_Location, Impl_Suffixes => No_Impl_Suffixes, Supp_Suffixes => No_Supp_Language_Index, Body_Suffix => No_Array_Element, - Ada_Body_Suffix => No_Name, + Ada_Body_Suffix => No_File, Body_Suffix_Loc => No_Location, - Separate_Suffix => No_Name, + Separate_Suffix => No_File, Sep_Suffix_Loc => No_Location, Specs => No_Array_Element, Bodies => No_Array_Element, @@ -89,27 +89,28 @@ package body Prj is First_Referred_By => No_Project, Name => No_Name, Display_Name => No_Name, - Path_Name => No_Name, - Display_Path_Name => No_Name, + Path_Name => No_Path, + Display_Path_Name => No_Path, Virtual => False, Location => No_Location, Mains => Nil_String, - Directory => No_Name, - Display_Directory => No_Name, + Directory => No_Path, + Display_Directory => No_Path, Dir_Path => null, Library => False, - Library_Dir => No_Name, - Display_Library_Dir => No_Name, - Library_Src_Dir => No_Name, - Display_Library_Src_Dir => No_Name, - Library_ALI_Dir => No_Name, - Display_Library_ALI_Dir => No_Name, - Library_Name => No_Name, + Library_Dir => No_Path, + Display_Library_Dir => No_Path, + Library_Src_Dir => No_Path, + Display_Library_Src_Dir => No_Path, + Library_ALI_Dir => No_Path, + Display_Library_ALI_Dir => No_Path, + Library_Name => No_File, Library_Kind => Static, - Lib_Internal_Name => No_Name, + Lib_Internal_Name => No_File, Standalone_Library => False, Lib_Interface_ALIs => Nil_String, Lib_Auto_Init => False, + Libgnarl_Needed => Unknown, Symbol_Data => No_Symbols, Ada_Sources_Present => True, Other_Sources_Present => True, @@ -121,27 +122,27 @@ package body Prj is Include_Data_Set => False, Source_Dirs => Nil_String, Known_Order_Of_Source_Dirs => True, - Object_Directory => No_Name, - Display_Object_Dir => No_Name, + Object_Directory => No_Path, + Display_Object_Dir => No_Path, Library_TS => Empty_Time_Stamp, - Exec_Directory => No_Name, - Display_Exec_Dir => No_Name, + Exec_Directory => No_Path, + Display_Exec_Dir => No_Path, Extends => No_Project, Extended_By => No_Project, Naming => Std_Naming_Data, First_Language_Processing => Default_First_Language_Processing_Data, Supp_Language_Processing => No_Supp_Language_Index, - Default_Linker => No_Name, - Default_Linker_Path => No_Name, + Default_Linker => No_File, + Default_Linker_Path => No_Path, Decl => No_Declarations, Imported_Projects => Empty_Project_List, All_Imported_Projects => Empty_Project_List, Ada_Include_Path => null, Ada_Objects_Path => null, - Include_Path_File => No_Name, - Objects_Path_File_With_Libs => No_Name, - Objects_Path_File_Without_Libs => No_Name, - Config_File_Name => No_Name, + Include_Path_File => No_Path, + Objects_Path_File_With_Libs => No_Path, + Objects_Path_File_Without_Libs => No_Path, + Config_File_Name => No_Path, Config_File_Temp => False, Config_Checked => False, Language_Independent_Checked => False, @@ -182,8 +183,7 @@ package body Prj is while Last + S'Length > To'Last loop declare - New_Buffer : constant String_Access := - new String (1 .. 2 * Last); + New_Buffer : constant String_Access := new String (1 .. 2 * Last); begin New_Buffer (1 .. Last) := To (1 .. Last); @@ -200,7 +200,7 @@ package body Prj is -- Default_Ada_Body_Suffix -- ----------------------------- - function Default_Ada_Body_Suffix return Name_Id is + function Default_Ada_Body_Suffix return File_Name_Type is begin return Default_Ada_Body_Suffix_Id; end Default_Ada_Body_Suffix; @@ -209,7 +209,7 @@ package body Prj is -- Default_Ada_Spec_Suffix -- ----------------------------- - function Default_Ada_Spec_Suffix return Name_Id is + function Default_Ada_Spec_Suffix return File_Name_Type is begin return Default_Ada_Spec_Suffix_Id; end Default_Ada_Spec_Suffix; @@ -314,6 +314,11 @@ package body Prj is return Hash (Get_Name_String (Name)); end Hash; + function Hash (Name : File_Name_Type) return Header_Num is + begin + return Hash (Get_Name_String (Name)); + end Hash; + ----------- -- Image -- ----------- @@ -454,13 +459,13 @@ package body Prj is procedure Register_Default_Naming_Scheme (Language : Name_Id; - Default_Spec_Suffix : Name_Id; - Default_Body_Suffix : Name_Id; + Default_Spec_Suffix : File_Name_Type; + Default_Body_Suffix : File_Name_Type; In_Tree : Project_Tree_Ref) is - Lang : Name_Id; - Suffix : Array_Element_Id; - Found : Boolean := False; + Lang : Name_Id; + Suffix : Array_Element_Id; + Found : Boolean := False; Element : Array_Element; begin @@ -481,7 +486,7 @@ package body Prj is if Element.Index = Lang then Found := True; - Element.Value.Value := Default_Spec_Suffix; + Element.Value.Value := Name_Id (Default_Spec_Suffix); In_Tree.Array_Elements.Table (Suffix) := Element; else @@ -500,13 +505,15 @@ package body Prj is Kind => Single, Location => No_Location, Default => False, - Value => Default_Spec_Suffix, + Value => Name_Id (Default_Spec_Suffix), Index => 0), Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix); + Array_Element_Table.Increment_Last (In_Tree.Array_Elements); + In_Tree.Array_Elements.Table - (Array_Element_Table.Last (In_Tree.Array_Elements)) := - Element; + (Array_Element_Table.Last (In_Tree.Array_Elements)) := Element; + In_Tree.Private_Part.Default_Naming.Spec_Suffix := Array_Element_Table.Last (In_Tree.Array_Elements); end if; @@ -522,7 +529,7 @@ package body Prj is if Element.Index = Lang then Found := True; - Element.Value.Value := Default_Body_Suffix; + Element.Value.Value := Name_Id (Default_Body_Suffix); In_Tree.Array_Elements.Table (Suffix) := Element; else @@ -541,7 +548,7 @@ package body Prj is Kind => Single, Location => No_Location, Default => False, - Value => Default_Body_Suffix, + Value => Name_Id (Default_Body_Suffix), Index => 0), Next => In_Tree.Private_Part.Default_Naming.Body_Suffix); Array_Element_Table.Increment_Last @@ -703,7 +710,7 @@ package body Prj is end Set; procedure Set - (Suffix : Name_Id; + (Suffix : File_Name_Type; For_Language : Language_Index; In_Project : in out Project_Data; In_Tree : Project_Tree_Ref) @@ -752,7 +759,7 @@ package body Prj is -- Slash -- ----------- - function Slash return Name_Id is + function Slash return File_Name_Type is begin return Slash_Id; end Slash; @@ -781,12 +788,12 @@ package body Prj is function Suffix_Of (Language : Language_Index; In_Project : Project_Data; - In_Tree : Project_Tree_Ref) return Name_Id + In_Tree : Project_Tree_Ref) return File_Name_Type is begin case Language is when No_Language_Index => - return No_Name; + return No_File; when First_Language_Indexes => return In_Project.Naming.Impl_Suffixes (Language); @@ -808,7 +815,7 @@ package body Prj is Supp_Index := Supp.Next; end loop; - return No_Name; + return No_File; end; end case; end Suffix_Of; |