diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2004-03-18 16:18:36 +0100 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2004-03-18 16:18:36 +0100 |
commit | a336eacaf1fe8e0ac28decabbc59c7972766f742 (patch) | |
tree | c005e46c28cc0d31445b8654f494f202ecaac7fd /gcc/ada/prj-env.adb | |
parent | 214ee4a2c634d178c3725178a36c341bb08c4397 (diff) | |
download | gcc-a336eacaf1fe8e0ac28decabbc59c7972766f742.zip gcc-a336eacaf1fe8e0ac28decabbc59c7972766f742.tar.gz gcc-a336eacaf1fe8e0ac28decabbc59c7972766f742.tar.bz2 |
[multiple changes]
2004-03-18 Arnaud Charlet <charlet@act-europe.fr>
* 5atpopsp.adb: Remove RTEMS from list of platforms using this file.
Code clean up:
* 5ataprop.adb, 5ftaprop.adb, 5htaprop.adb, 5itaprop.adb, 5staprop.adb,
5vtaprop.adb, 5wtaprop.adb, 7staprop.adb (Finalize_TCB): Use
Specific.Set instead of direct call to e.g pthread_setspecific.
2004-03-18 Thomas Quinot <quinot@act-europe.fr>
* adaint.c: Update comments.
* Makefile.in: set PREFIX_OBJS, SYMLIB, THREADSLIB, and
GNATLIB_SHARED for FreeBSD.
2004-03-18 Jose Ruiz <ruiz@act-europe.fr>
* init.c [VxWorks]: Do not fix the stack size for the environment task.
When needed (stack checking) the stack size is retrieved
from the VxWorks kernel.
* Makefile.in: Flag -nostdinc is required when building the run time
for avoiding looking for files in the base compiler.
Add the VxWorks specific version of the package body for
System.Stack_checking.Operations (5zstchop.adb).
* Make-lang.in: Add the object file for
System.Stack_Checking.Operations.
* Makefile.rtl: Add object file for the package
System.Stack_Checking.Operations.
* s-stchop.ads, s-stchop.adb, 5zstchop.adb: New files.
* s-stache.ads, s-stache.adb: Move the operations related to stack
checking from this package to package System.Stack_Checking.Operations.
This way, stack checking operations are only linked in the final
executable when using the -fstack-check flag.
2004-03-18 Doug Rupp <rupp@gnat.com>
* Makefile.in [VMS]: Handle 64 bit specs (5qsystem.ads, 5xcrtl.ads).
Reorganize ifeq's.
* 5qsystem.ads, 5xcrtl.ads: New files.
2004-03-18 Vincent Celier <celier@gnat.com>
* prj.adb (Reset): Reset hash table Files_Htable
* prj-env.adb (Source_Paths, Object_Paths): New tables.
(Add_To_Source_Path, Add_To_Object_Path): New procedures, to replace
the procedures Add_To_Path_File.
(Set_Ada_Paths): Accumulate source and object dirs in the tables,
making sure that each directory is present only once and, for object
dirs, when a directory already present is added, the duplicate is
removed and the directory is always put as the last in the table.
Write the path files at the end of these accumulations.
* prj-nmsc.adb (Record_Source): Add source file name in hash table
Files_Htable for all sources.
* prj-proc.adb (Process): Remove restrictions between not directly
related extending projects.
2004-03-18 Emmanuel Briot <briot@act-europe.fr>
* prj-nmsc.ads, prj-nmsc.adb (Ada_Check): New parameter Trusted_Mode.
(Find_Sources): Minor speed optimization.
* prj-proc.ads, prj-proc.adb (Check, Recursive_Check, Process): New
parameter Trusted_Mode.
2004-03-18 Sergey Rybin <rybin@act-europe.fr>
* scn.adb (Determine_License): Take into account a degenerated case
when the source contains only comments.
2004-03-18 Ed Schonberg <schonberg@gnat.com>
* sem_warn.adb (Check_References): For a warning on a selected
component that does not come from source, locate an uninitialized
component of the record type to produce a more precise error message.
From-SVN: r79623
Diffstat (limited to 'gcc/ada/prj-env.adb')
-rw-r--r-- | gcc/ada/prj-env.adb | 266 |
1 files changed, 171 insertions, 95 deletions
diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index d7a47b0..f974e0f 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -87,6 +87,24 @@ package body Prj.Env is -- A Boolean array type used in Create_Mapping_File to select the projects -- in the closure of a specific project. + package Source_Paths is new Table.Table + (Table_Component_Type => Name_Id, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 50, + Table_Increment => 50, + Table_Name => "Prj.Env.Source_Paths"); + -- A table to store the source dirs before creating the source path file + + package Object_Paths is new Table.Table + (Table_Component_Type => Name_Id, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 50, + Table_Increment => 50, + Table_Name => "Prj.Env.Source_Paths"); + -- A table to store the object dirs, before creating the object path file + ----------------------- -- Local Subprograms -- ----------------------- @@ -109,16 +127,13 @@ package body Prj.Env is -- If Ada_Path_Length /= 0, prepend a Path_Separator character to -- Path. - procedure Add_To_Path_File - (Source_Dirs : String_List_Id; - Path_File : File_Descriptor); - -- Add to Ada_Path_Buffer all the source directories in string list + procedure Add_To_Source_Path (Source_Dirs : String_List_Id); + -- Add to Ada_Path_B all the source directories in string list -- Source_Dirs, if any. Increment Ada_Path_Length. - procedure Add_To_Path_File - (Path : String; - Path_File : File_Descriptor); - -- Add Path to path file + procedure Add_To_Object_Path (Object_Dir : Name_Id); + -- Add Object_Dir to object path table. Make sure it is not duplicate + -- and it is the last one in the current table. procedure Create_New_Path_File (Path_FD : out File_Descriptor; @@ -311,6 +326,34 @@ package body Prj.Env is return Projects.Table (Project).Ada_Objects_Path; end Ada_Objects_Path; + ------------------------ + -- Add_To_Object_Path -- + ------------------------ + + procedure Add_To_Object_Path (Object_Dir : Name_Id) is + begin + -- Check if the directory is already in the table + + for Index in 1 .. Object_Paths.Last loop + -- If it is, remove it, and add it as the last one + + if Object_Paths.Table (Index) = Object_Dir then + for Index2 in Index + 1 .. Object_Paths.Last loop + Object_Paths.Table (Index2 - 1) := + Object_Paths.Table (Index2); + end loop; + + Object_Paths.Table (Object_Paths.Last) := Object_Dir; + return; + end if; + end loop; + + -- The directory is not already in the table, add it + + Object_Paths.Increment_Last; + Object_Paths.Table (Object_Paths.Last) := Object_Dir; + end Add_To_Object_Path; + ----------------- -- Add_To_Path -- ----------------- @@ -402,41 +445,43 @@ package body Prj.Env is Ada_Path_Length := Ada_Path_Length + Dir'Length; end Add_To_Path; - ---------------------- - -- Add_To_Path_File -- - ---------------------- + ------------------------ + -- Add_To_Source_Path -- + ------------------------ - procedure Add_To_Path_File - (Source_Dirs : String_List_Id; - Path_File : File_Descriptor) - is + procedure Add_To_Source_Path (Source_Dirs : String_List_Id) is Current : String_List_Id := Source_Dirs; Source_Dir : String_Element; + Add_It : Boolean; begin + -- Add each source directory + while Current /= Nil_String loop Source_Dir := String_Elements.Table (Current); - Add_To_Path_File (Get_Name_String (Source_Dir.Value), Path_File); - Current := Source_Dir.Next; - end loop; - end Add_To_Path_File; + Add_It := True; - procedure Add_To_Path_File - (Path : String; - Path_File : File_Descriptor) - is - Line : String (1 .. Path'Length + 1); - Len : Natural; + -- Check if the source directory is already in the table - begin - Line (1 .. Path'Length) := Path; - Line (Line'Last) := ASCII.LF; - Len := Write (Path_File, Line (1)'Address, Line'Length); + for Index in 1 .. Source_Paths.Last loop + -- If it is already, no need to add it - if Len /= Line'Length then - Prj.Com.Fail ("disk full"); - end if; - end Add_To_Path_File; + if Source_Paths.Table (Index) = Source_Dir.Value then + Add_It := False; + exit; + end if; + end loop; + + if Add_It then + Source_Paths.Increment_Last; + Source_Paths.Table (Source_Paths.Last) := Source_Dir.Value; + end if; + + -- Next source directory + + Current := Source_Dir.Next; + end loop; + end Add_To_Source_Path; ----------------------- -- Body_Path_Name_Of -- @@ -1845,87 +1890,100 @@ package body Prj.Env is Status : Boolean; -- For calls to Close - procedure Add (Project : Project_Id); + Len : Natural; + + procedure Add (Proj : Project_Id); -- Add all the source/object directories of a project to the path only - -- if this project has not been visited. Calls itself recursively for - -- projects being extended, and imported projects. + -- if this project has not been visited. Calls an internal procedure + -- recursively for projects being extended, and imported projects. --------- -- Add -- --------- - procedure Add (Project : Project_Id) is - begin - -- If Seen is False, then the project has not yet been visited + procedure Add (Proj : Project_Id) is - if not Projects.Table (Project).Seen then - Projects.Table (Project).Seen := True; + procedure Recursive_Add (Project : Project_Id); + -- Recursive procedure to add the source/object paths of extended/ + -- imported projects. - declare - Data : constant Project_Data := Projects.Table (Project); - List : Project_List := Data.Imported_Projects; + ------------------- + -- Recursive_Add -- + ------------------- - begin - if Process_Source_Dirs then + procedure Recursive_Add (Project : Project_Id) is + begin + -- If Seen is False, then the project has not yet been visited - -- Add to path all source directories of this project - -- if there are Ada sources. + if not Projects.Table (Project).Seen then + Projects.Table (Project).Seen := True; - if Projects.Table (Project).Sources_Present then - Add_To_Path_File (Data.Source_Dirs, Source_FD); + declare + Data : constant Project_Data := Projects.Table (Project); + List : Project_List := Data.Imported_Projects; + + begin + if Process_Source_Dirs then + + -- Add to path all source directories of this project + -- if there are Ada sources. + + if Projects.Table (Project).Sources_Present then + Add_To_Source_Path (Data.Source_Dirs); + end if; end if; - end if; - if Process_Object_Dirs then + if Process_Object_Dirs then - -- Add to path the object directory of this project - -- except if we don't include library project and - -- this is a library project. + -- Add to path the object directory of this project + -- except if we don't include library project and + -- this is a library project. - if (Data.Library and then Including_Libraries) - or else - (Data.Object_Directory /= No_Name - and then - (not Including_Libraries or else not Data.Library)) - then - -- For a library project, add the library directory + if (Data.Library and then Including_Libraries) + or else + (Data.Object_Directory /= No_Name + and then + (not Including_Libraries or else not Data.Library)) + then + -- For a library project, add the library directory - if Data.Library then - declare - New_Path : constant String := - Get_Name_String (Data.Library_Dir); + if Data.Library then + Add_To_Object_Path (Data.Library_Dir); - begin - Add_To_Path_File (New_Path, Object_FD); - end; + else + -- For a non library project, add the object + -- directory. - else - -- For a non library project, add the object directory - - declare - New_Path : constant String := - Get_Name_String (Data.Object_Directory); - begin - Add_To_Path_File (New_Path, Object_FD); - end; + Add_To_Object_Path (Data.Object_Directory); + end if; end if; end if; - end if; - -- Call Add to the project being extended, if any + -- Call Add to the project being extended, if any - if Data.Extends /= No_Project then - Add (Data.Extends); - end if; + if Data.Extends /= No_Project then + Recursive_Add (Data.Extends); + end if; - -- Call Add for each imported project, if any + -- Call Add for each imported project, if any - while List /= Empty_Project_List loop - Add (Project_Lists.Table (List).Project); - List := Project_Lists.Table (List).Next; - end loop; - end; - end if; + while List /= Empty_Project_List loop + Recursive_Add (Project_Lists.Table (List).Project); + List := Project_Lists.Table (List).Next; + end loop; + end; + end if; + end Recursive_Add; + + begin + Source_Paths.Set_Last (0); + Object_Paths.Set_Last (0); + + for Index in 1 .. Projects.Last loop + Projects.Table (Index).Seen := False; + end loop; + + Recursive_Add (Proj); end Add; -- Start of processing for Set_Ada_Paths @@ -1966,16 +2024,23 @@ package body Prj.Env is -- then call the recursive procedure Add for Project. if Process_Source_Dirs or Process_Object_Dirs then - for Index in 1 .. Projects.Last loop - Projects.Table (Index).Seen := False; - end loop; - Add (Project); end if; - -- Close any file that has been created. + -- Write and close any file that has been created. if Source_FD /= Invalid_FD then + for Index in 1 .. Source_Paths.Last loop + Get_Name_String (Source_Paths.Table (Index)); + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := ASCII.LF; + Len := Write (Source_FD, Name_Buffer (1)'Address, Name_Len); + + if Len /= Name_Len then + Prj.Com.Fail ("disk full"); + end if; + end loop; + Close (Source_FD, Status); if not Status then @@ -1984,6 +2049,17 @@ package body Prj.Env is end if; if Object_FD /= Invalid_FD then + for Index in 1 .. Object_Paths.Last loop + Get_Name_String (Object_Paths.Table (Index)); + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := ASCII.LF; + Len := Write (Object_FD, Name_Buffer (1)'Address, Name_Len); + + if Len /= Name_Len then + Prj.Com.Fail ("disk full"); + end if; + end loop; + Close (Object_FD, Status); if not Status then |