diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-11-15 13:56:14 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-11-15 13:56:14 +0000 |
| commit | 7ebd25a4a4b1394c9647db307d162beeb5751c12 (patch) | |
| tree | 670ec552e0e07e24221f4ff7c9afded0eb8cb6ed /gcc | |
| parent | 7919e3c25c8b4e1a9301b8f879adebdcfaba4976 (diff) | |
| download | gcc-7ebd25a4a4b1394c9647db307d162beeb5751c12.tar.gz | |
2005-11-14 Vincent Celier <celier@adacore.com>
* clean.adb (Check_Project): Look for Ada code in extending project,
even if Ada is not specified as a language.
Use new function DLL_Prefix for DLL_Name
(Clean_Interface_Copy_Directory): New procedure
(Clean_Library_Directory): New procedure
(Clean_Directory): Remove procedure, no longer used
(Clean_Project): Do not delete any file in an externally built project
* prj-env.adb (Set_Ada_Paths.Add.Recursive_Add): Add the object
directory of an extending project, even when there are no Ada source
present.
(Ada_Objects_Path.Add): Add Library_ALI_Dir, not Library_Dir to the path
(Set_Ada_Paths.Add.Recursive_Add): Ditto
* mlib-prj.adb (Check_Library): For all library projects, get the
library file timestamp.
(Build_Library): Copy ALI files in Library_ALI_Dir, not in Library_Dir
(Build_Library): Use new function DLL_Prefix for the DLL_Name
(Clean): Remove procedure, no longer used
(Ultimate_Extension_Of): New function
(Build_Library): When cleaning the library directory, only remove an
existing library file and any ALI file of a source of the project.
When cleaning the interface copy directory, remove any source that
could be a source of the project.
* prj.ads, prj.adb (Project_Empty): Add values of new components
Library_TS and All_Imported_Projects.
(Project_Empty): Add values for new components of Project_Data:
Library_ALI_Dir and Display_Library_ALI_Dir
* prj-attr.adb: New project level attribute name Library_ALI_Dir
* prj-nmsc.adb (Check_Library_Attributes): Take into account new
attribute Library_ALI_Dir.
(Check_Library_Attributes): The library directory cannot be the same as
any source directory of the project tree.
(Check_Stand_Alone_Library): The interface copy directory cannot be
the same as any source directory of the project tree.
* mlib.adb: Use Prj.Com.Fail, instead of Osint.Fail directly, to delete
all temporary files.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@106967 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/clean.adb | 701 | ||||
| -rw-r--r-- | gcc/ada/mlib-prj.adb | 418 | ||||
| -rw-r--r-- | gcc/ada/mlib.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/prj-attr.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 38 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 285 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 100 |
8 files changed, 1133 insertions, 446 deletions
diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index c70cec7ff1e..e5682d08b30 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -24,8 +24,6 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Command_Line; use Ada.Command_Line; - with ALI; use ALI; with Csets; with Gnatvsn; @@ -45,6 +43,8 @@ with Snames; with Table; with Types; use Types; +with Ada.Command_Line; use Ada.Command_Line; + with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.IO; use GNAT.IO; with GNAT.OS_Lib; use GNAT.OS_Lib; @@ -191,13 +191,17 @@ package body Clean is -- Delete a global archive or a fake library project archive and the -- dependency file, if they exist. - procedure Clean_Directory (Dir : Name_Id); - -- Delete all regular files in a library directory or in a library - -- interface dir. - procedure Clean_Executables; -- Do the cleaning work when no project file is specified + procedure Clean_Interface_Copy_Directory (Project : Project_Id); + -- Delete files in an interface coy directory directory: any file that is + -- a copy of a source of the project. + + procedure Clean_Library_Directory (Project : Project_Id); + -- Delete the library file in a library directory and any ALI file + -- of a source of the project in a library ALI directory. + procedure Clean_Project (Project : Project_Id); -- Do the cleaning work when a project file is specified. -- This procedure calls itself recursively when there are several @@ -241,6 +245,11 @@ package body Clean is -- Returns True iff Prj is an extension of Of_Project or if Of_Project is -- an extension of Prj. + function Ultimate_Extension_Of (Project : Project_Id) return Project_Id; + -- Returns either Project, if it is not extended by another project, or + -- the project that extends Project, directly or indirectly, and that is + -- not itself extended. Returns No_Project if Project is No_Project. + procedure Usage; -- Display the usage. -- If called several times, the usage is displayed only the first time. @@ -356,46 +365,6 @@ package body Clean is Change_Dir (Current_Dir); end Clean_Archive; - --------------------- - -- Clean_Directory -- - --------------------- - - procedure Clean_Directory (Dir : Name_Id) is - Directory : constant String := Get_Name_String (Dir); - Current : constant Dir_Name_Str := Get_Current_Dir; - - Direc : Dir_Type; - - Name : String (1 .. 200); - Last : Natural; - - begin - Change_Dir (Directory); - Open (Direc, "."); - - -- For each regular file in the directory, if switch -n has not been - -- specified, make it writable and delete the file. - - loop - Read (Direc, Name, Last); - exit when Last = 0; - - if Is_Regular_File (Name (1 .. Last)) then - if not Do_Nothing then - Set_Writable (Name (1 .. Last)); - end if; - - Delete (Directory, Name (1 .. Last)); - end if; - end loop; - - Close (Direc); - - -- Restore the initial working directory - - Change_Dir (Current); - end Clean_Directory; - ----------------------- -- Clean_Executables -- ----------------------- @@ -550,6 +519,242 @@ package body Clean is end loop; end Clean_Executables; + ------------------------------------ + -- Clean_Interface_Copy_Directory -- + ------------------------------------ + + procedure Clean_Interface_Copy_Directory (Project : Project_Id) is + Current : constant String := Get_Current_Dir; + Data : constant Project_Data := Project_Tree.Projects.Table (Project); + + Direc : Dir_Type; + + Name : String (1 .. 200); + Last : Natural; + + Delete_File : Boolean; + Unit : Unit_Data; + + begin + if Data.Library and then Data.Library_Src_Dir /= No_Name then + declare + Directory : constant String := + Get_Name_String (Data.Library_Src_Dir); + + begin + Change_Dir (Get_Name_String (Data.Library_Src_Dir)); + Open (Direc, "."); + + -- For each regular file in the directory, if switch -n has not + -- been specified, make it writable and delete the file if it is + -- a copy of a source of the project. + + loop + Read (Direc, Name, Last); + exit when Last = 0; + + if Is_Regular_File (Name (1 .. Last)) then + Canonical_Case_File_Name (Name (1 .. Last)); + Delete_File := False; + + -- Compare with source file names of the project + + for Index in 1 .. Unit_Table.Last (Project_Tree.Units) loop + Unit := Project_Tree.Units.Table (Index); + + if Ultimate_Extension_Of + (Unit.File_Names (Body_Part).Project) = Project + and then + Get_Name_String + (Unit.File_Names (Body_Part).Name) = + Name (1 .. Last) + then + Delete_File := True; + exit; + end if; + + if Ultimate_Extension_Of + (Unit.File_Names (Specification).Project) = Project + and then + Get_Name_String + (Unit.File_Names (Specification).Name) = + Name (1 .. Last) + then + Delete_File := True; + exit; + end if; + end loop; + + if Delete_File then + if not Do_Nothing then + Set_Writable (Name (1 .. Last)); + end if; + + Delete (Directory, Name (1 .. Last)); + end if; + end if; + end loop; + + Close (Direc); + + -- Restore the initial working directory + + Change_Dir (Current); + end; + end if; + end Clean_Interface_Copy_Directory; + + ----------------------------- + -- Clean_Library_Directory -- + ----------------------------- + + procedure Clean_Library_Directory (Project : Project_Id) is + Current : constant String := Get_Current_Dir; + Data : constant Project_Data := Project_Tree.Projects.Table (Project); + + Lib_Filename : constant String := Get_Name_String (Data.Library_Name); + DLL_Name : constant String := + DLL_Prefix & Lib_Filename & "." & DLL_Ext; + Archive_Name : constant String := + "lib" & Lib_Filename & "." & Archive_Ext; + Direc : Dir_Type; + + Name : String (1 .. 200); + Last : Natural; + + Delete_File : Boolean; + + begin + if Data.Library then + declare + Lib_Directory : constant String := + Get_Name_String (Data.Library_Dir); + Lib_ALI_Directory : constant String := + Get_Name_String (Data.Library_ALI_Dir); + + begin + Change_Dir (Lib_Directory); + Open (Direc, "."); + + -- For each regular file in the directory, if switch -n has not + -- been specified, make it writable and delete the file if it is + -- the library file. + + loop + Read (Direc, Name, Last); + exit when Last = 0; + + if Is_Regular_File (Name (1 .. Last)) then + Canonical_Case_File_Name (Name (1 .. Last)); + Delete_File := False; + + if (Data.Library_Kind = Static and then + Name (1 .. Last) = Archive_Name) + or else + ((Data.Library_Kind = Dynamic or else + Data.Library_Kind = Relocatable) + and then + Name (1 .. Last) = DLL_Name) + then + if not Do_Nothing then + Set_Writable (Name (1 .. Last)); + end if; + + Delete (Lib_Directory, Name (1 .. Last)); + exit; + end if; + end if; + end loop; + + Close (Direc); + + Change_Dir (Lib_ALI_Directory); + Open (Direc, "."); + + -- For each regular file in the directory, if switch -n has not + -- been specified, make it writable and delete the file if it is + -- any ALI file of a source of the project. + + loop + Read (Direc, Name, Last); + exit when Last = 0; + + if Is_Regular_File (Name (1 .. Last)) then + Canonical_Case_File_Name (Name (1 .. Last)); + Delete_File := False; + + if Last > 4 and then Name (Last - 3 .. Last) = ".ali" then + declare + Unit : Unit_Data; + begin + -- Compare with ALI file names of the project + + for + Index in 1 .. Unit_Table.Last (Project_Tree.Units) + loop + Unit := Project_Tree.Units.Table (Index); + + if Unit.File_Names (Body_Part).Project /= + No_Project + then + if Ultimate_Extension_Of + (Unit.File_Names (Body_Part).Project) = + Project + then + Get_Name_String + (Unit.File_Names (Body_Part).Name); + Name_Len := Name_Len - + File_Extension + (Name (1 .. Name_Len))'Length; + if Name_Buffer (1 .. Name_Len) = + Name (1 .. Last - 4) + then + Delete_File := True; + exit; + end if; + end if; + + elsif Ultimate_Extension_Of + (Unit.File_Names (Specification).Project) = + Project + then + Get_Name_String + (Unit.File_Names (Specification).Name); + Name_Len := Name_Len - + File_Extension + (Name (1 .. Name_Len))'Length; + + if Name_Buffer (1 .. Name_Len) = + Name (1 .. Last - 4) + then + Delete_File := True; + exit; + end if; + end if; + end loop; + end; + end if; + + if Delete_File then + if not Do_Nothing then + Set_Writable (Name (1 .. Last)); + end if; + + Delete (Lib_ALI_Directory, Name (1 .. Last)); + end if; + + end if; + end loop; + + Close (Direc); + + -- Restore the initial working directory + + Change_Dir (Current); + end; + end if; + end Clean_Library_Directory; + ------------------- -- Clean_Project -- ------------------- @@ -588,251 +793,271 @@ package body Clean is ("Cannot specify executable(s) for a Library Project File"); end if; - if Verbose_Mode then - Put ("Cleaning project """); - Put (Get_Name_String (Data.Name)); - Put_Line (""""); - end if; + -- Nothing to clean in an externally built project - -- Add project to the list of processed projects + if Data.Externally_Built then + if Verbose_Mode then + Put ("Nothing to do to clean externally built project """); + Put (Get_Name_String (Data.Name)); + Put_Line (""""); + end if; - Processed_Projects.Increment_Last; - Processed_Projects.Table (Processed_Projects.Last) := Project; + else + if Verbose_Mode then + Put ("Cleaning project """); + Put (Get_Name_String (Data.Name)); + Put_Line (""""); + end if; - if Data.Object_Directory /= No_Name then - declare - Obj_Dir : constant String := - Get_Name_String (Data.Object_Directory); + -- Add project to the list of processed projects - begin - Change_Dir (Obj_Dir); + Processed_Projects.Increment_Last; + Processed_Projects.Table (Processed_Projects.Last) := Project; - -- First, deal with Ada + if Data.Object_Directory /= No_Name then + declare + Obj_Dir : constant String := + Get_Name_String (Data.Object_Directory); - -- Look through the units to find those that are either immediate - -- sources or inherited sources of the project. + begin + Change_Dir (Obj_Dir); - if Data.Languages (Ada_Language_Index) then - for Unit in Unit_Table.First .. - Unit_Table.Last (Project_Tree.Units) - loop - U_Data := Project_Tree.Units.Table (Unit); - File_Name1 := No_Name; - File_Name2 := No_Name; + -- First, deal with Ada - -- If either the spec or the body is a source of the - -- project, check for the corresponding ALI file in the - -- object directory. + -- Look through the units to find those that are either + -- immediate sources or inherited sources of the project. + -- Extending projects may have no language specified, if + -- Source_Dirs or Source_Files is specified as an empty list, + -- so always look for Ada units in extending projects. - if In_Extension_Chain - (U_Data.File_Names (Body_Part).Project, Project) - or else - In_Extension_Chain - (U_Data.File_Names (Specification).Project, Project) - then - File_Name1 := U_Data.File_Names (Body_Part).Name; - Index1 := U_Data.File_Names (Body_Part).Index; - File_Name2 := U_Data.File_Names (Specification).Name; - Index2 := U_Data.File_Names (Specification).Index; - - -- If there is no body file name, then there may be only - -- a spec. - - if File_Name1 = No_Name then - File_Name1 := File_Name2; - Index1 := Index2; - File_Name2 := No_Name; - Index2 := 0; + if Data.Languages (Ada_Language_Index) + or else Data.Extends /= No_Project + then + for Unit in Unit_Table.First .. + Unit_Table.Last (Project_Tree.Units) + loop + U_Data := Project_Tree.Units.Table (Unit); + File_Name1 := No_Name; + File_Name2 := No_Name; + + -- If either the spec or the body is a source of the + -- project, check for the corresponding ALI file in the + -- object directory. + + if In_Extension_Chain + (U_Data.File_Names (Body_Part).Project, Project) + or else + In_Extension_Chain + (U_Data.File_Names (Specification).Project, Project) + then + File_Name1 := U_Data.File_Names (Body_Part).Name; + Index1 := U_Data.File_Names (Body_Part).Index; + File_Name2 := U_Data.File_Names (Specification).Name; + Index2 := U_Data.File_Names (Specification).Index; + + -- If there is no body file name, then there may be + -- only a spec. + + if File_Name1 = No_Name then + File_Name1 := File_Name2; + Index1 := Index2; + File_Name2 := No_Name; + Index2 := 0; + end if; end if; - end if; - -- If there is either a spec or a body, look for files - -- in the object directory. + -- If there is either a spec or a body, look for files + -- in the object directory. - if File_Name1 /= No_Name then - Lib_File := Osint.Lib_File_Name (File_Name1, Index1); + if File_Name1 /= No_Name then + Lib_File := Osint.Lib_File_Name (File_Name1, Index1); - declare - Asm : constant String := Assembly_File_Name (Lib_File); - ALI : constant String := ALI_File_Name (Lib_File); - Obj : constant String := Object_File_Name (Lib_File); - Adt : constant String := Tree_File_Name (Lib_File); - Deb : constant String := - Debug_File_Name (File_Name1); - Rep : constant String := - Repinfo_File_Name (File_Name1); - Del : Boolean := True; + declare + Asm : constant String := + Assembly_File_Name (Lib_File); + ALI : constant String := + ALI_File_Name (Lib_File); + Obj : constant String := + Object_File_Name (Lib_File); + Adt : constant String := + Tree_File_Name (Lib_File); + Deb : constant String := + Debug_File_Name (File_Name1); + Rep : constant String := + Repinfo_File_Name (File_Name1); + Del : Boolean := True; - begin - -- If the ALI file exists and is read-only, no file - -- is deleted. + begin + -- If the ALI file exists and is read-only, no file + -- is deleted. - if Is_Regular_File (ALI) then - if Is_Writable_File (ALI) then - Delete (Obj_Dir, ALI); + if Is_Regular_File (ALI) then + if Is_Writable_File (ALI) then + Delete (Obj_Dir, ALI); - else - Del := False; + else + Del := False; - if Verbose_Mode then - Put ('"'); - Put (Obj_Dir); + if Verbose_Mode then + Put ('"'); + Put (Obj_Dir); - if Obj_Dir (Obj_Dir'Last) /= + if Obj_Dir (Obj_Dir'Last) /= Dir_Separator - then - Put (Dir_Separator); - end if; + then + Put (Dir_Separator); + end if; - Put (ALI); - Put_Line (""" is read-only"); + Put (ALI); + Put_Line (""" is read-only"); + end if; end if; end if; - end if; - if Del then + if Del then - -- Object file + -- Object file - if Is_Regular_File (Obj) then - Delete (Obj_Dir, Obj); - end if; + if Is_Regular_File (Obj) then + Delete (Obj_Dir, Obj); + end if; - -- Assembly file + -- Assembly file - if Is_Regular_File (Asm) then - Delete (Obj_Dir, Asm); - end if; + if Is_Regular_File (Asm) then + Delete (Obj_Dir, Asm); + end if; - -- Tree file + -- Tree file - if Is_Regular_File (Adt) then - Delete (Obj_Dir, Adt); - end if; + if Is_Regular_File (Adt) then + Delete (Obj_Dir, Adt); + end if; - -- First expanded source file + -- First expanded source file - if Is_Regular_File (Deb) then - Delete (Obj_Dir, Deb); - end if; + if Is_Regular_File (Deb) then + Delete (Obj_Dir, Deb); + end if; - -- Repinfo file + -- Repinfo file - if Is_Regular_File (Rep) then - Delete (Obj_Dir, Rep); - end if; + if Is_Regular_File (Rep) then + Delete (Obj_Dir, Rep); + end if; - -- Second expanded source file - - if File_Name2 /= No_Name then - declare - Deb : constant String := - Debug_File_Name (File_Name2); - Rep : constant String := - Repinfo_File_Name (File_Name2); - begin - if Is_Regular_File (Deb) then - Delete (Obj_Dir, Deb); - end if; + -- Second expanded source file - if Is_Regular_File (Rep) then - Delete (Obj_Dir, Rep); - end if; - end; + if File_Name2 /= No_Name then + declare + Deb : constant String := + Debug_File_Name (File_Name2); + Rep : constant String := + Repinfo_File_Name (File_Name2); + + begin + if Is_Regular_File (Deb) then + Delete (Obj_Dir, Deb); + end if; + + if Is_Regular_File (Rep) then + Delete (Obj_Dir, Rep); + end if; + end; + end if; end if; - end if; - end; - end if; - end loop; - end if; + end; + end if; + end loop; + end if; - -- Check if a global archive and it dependency file could have - -- been created and, if they exist, delete them. + -- Check if a global archive and it dependency file could have + -- been created and, if they exist, delete them. - if Project = Main_Project and then not Data.Library then - Global_Archive := False; + if Project = Main_Project and then not Data.Library then + Global_Archive := False; - for Proj in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - if Project_Tree.Projects.Table + for Proj in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop + if Project_Tree.Projects.Table (Proj).Other_Sources_Present - then - Global_Archive := True; - exit; - end if; - end loop; + then + Global_Archive := True; + exit; + end if; + end loop; - if Global_Archive then - Clean_Archive (Project); + if Global_Archive then + Clean_Archive (Project); + end if; end if; - end if; - - if Data.Other_Sources_Present then - -- There is non-Ada code: delete the object files and - -- the dependency files if they exist. + if Data.Other_Sources_Present then - Source_Id := Data.First_Other_Source; + -- There is non-Ada code: delete the object files and + -- the dependency files if they exist. - while Source_Id /= No_Other_Source loop - Source := - Project_Tree.Other_Sources.Table (Source_Id); + Source_Id := Data.First_Other_Source; + while Source_Id /= No_Other_Source loop + Source := + Project_Tree.Other_Sources.Table (Source_Id); - if Is_Regular_File + if Is_Regular_File (Get_Name_String (Source.Object_Name)) - then - Delete (Obj_Dir, Get_Name_String (Source.Object_Name)); - end if; + then + Delete (Obj_Dir, Get_Name_String (Source.Object_Name)); + end if; - if Is_Regular_File (Get_Name_String (Source.Dep_Name)) then - Delete (Obj_Dir, Get_Name_String (Source.Dep_Name)); - end if; + if + Is_Regular_File (Get_Name_String (Source.Dep_Name)) + then + Delete (Obj_Dir, Get_Name_String (Source.Dep_Name)); + end if; - Source_Id := Source.Next; - end loop; + Source_Id := Source.Next; + end loop; - -- If it is a library with only non Ada sources, delete - -- the fake archive and the dependency file, if they exist. + -- If it is a library with only non Ada sources, delete + -- the fake archive and the dependency file, if they exist. - if Data.Library - and then not Data.Languages (Ada_Language_Index) - then - Clean_Archive (Project); + if Data.Library + and then not Data.Languages (Ada_Language_Index) + then + Clean_Archive (Project); + end if; end if; - end if; - end; - end if; + end; + end if; - -- If this is a library project, clean the library directory, the - -- interface copy dir and, for a Stand-Alone Library, the binder - -- generated files of the library. + -- If this is a library project, clean the library directory, the + -- interface copy dir and, for a Stand-Alone Library, the binder + -- generated files of the library. - -- The directories are cleaned only if switch -c is not specified + -- The directories are cleaned only if switch -c is not specified - if Data.Library then - if not Compile_Only then - Clean_Directory (Data.Library_Dir); + if Data.Library then + if not Compile_Only then + Clean_Library_Directory (Project); + + if Data.Library_Src_Dir /= No_Name then + Clean_Interface_Copy_Directory (Project); + end if; + end if; - if Data.Library_Src_Dir /= No_Name - and then Data.Library_Src_Dir /= Data.Library_Dir + if Data.Standalone_Library and then + Data.Object_Directory /= No_Name then - Clean_Directory (Data.Library_Src_Dir); + Delete_Binder_Generated_Files + (Get_Name_String (Data.Object_Directory), Data.Library_Name); end if; end if; - if Data.Standalone_Library and then - Data.Object_Directory /= No_Name - then - Delete_Binder_Generated_Files - (Get_Name_String (Data.Object_Directory), Data.Library_Name); + if Verbose_Mode then + New_Line; end if; end if; - if Verbose_Mode then - New_Line; - end if; - -- If switch -r is specified, call Clean_Project recursively for the -- imported projects and the project being extended. @@ -1610,6 +1835,26 @@ package body Clean is return Src & Tree_Suffix; end Tree_File_Name; + --------------------------- + -- Ultimate_Extension_Of -- + --------------------------- + + function Ultimate_Extension_Of (Project : Project_Id) return Project_Id is + Result : Project_Id := Project; + Data : Project_Data; + + begin + if Project /= No_Project then + loop + Data := Project_Tree.Projects.Table (Result); + exit when Data.Extended_By = No_Project; + Result := Data.Extended_By; + end loop; + end if; + + return Result; + end Ultimate_Extension_Of; + ----------- -- Usage -- ----------- diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 2a2d858e5d1..8169f6b0752 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2005, Ada Core Technologies, Inc. -- +-- Copyright (C) 2001-2005, AdaCore -- -- -- -- 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- -- @@ -139,7 +139,7 @@ package body MLib.Prj is Table_Initial => 50, Table_Increment => 100); - -- List of options set in the command line. + -- List of options set in the command line Options : Argument_List_Access; @@ -182,7 +182,7 @@ package body MLib.Prj is Hash => Hash, Equal => "="); - -- The projects imported directly or indirectly. + -- The projects imported directly or indirectly package Processed_Projects is new GNAT.HTable.Simple_HTable (Header_Num => Header_Num, @@ -192,7 +192,7 @@ package body MLib.Prj is Hash => Hash, Equal => "="); - -- The library projects imported directly or indirectly. + -- The library projects imported directly or indirectly package Library_Projs is new Table.Table ( Table_Component_Type => Project_Id, @@ -205,22 +205,18 @@ package body MLib.Prj is type Build_Mode_State is (None, Static, Dynamic, Relocatable); procedure Add_Argument (S : String); - -- Add one argument to the array Arguments. - -- If Arguments is full, double its size. + -- Add one argument to Arguments array, if array is full, double its size function ALI_File_Name (Source : String) return String; - -- Return the ALI file name corresponding to a source. + -- Return the ALI file name corresponding to a source procedure Check (Filename : String); - -- Check if filename is a regular file. Fail if it is not. + -- Check if filename is a regular file. Fail if it is not procedure Check_Context; -- Check each object files in table Object_Files -- Fail if any of them is not a regular file - procedure Clean (Directory : Name_Id); - -- Attempt to delete all files in Directory, but not subdirectories - procedure Copy_Interface_Sources (For_Project : Project_Id; In_Tree : Project_Tree_Ref; @@ -244,6 +240,12 @@ package body MLib.Prj is -- Indicate if Stand-Alone Libraries are automatically initialized using -- the constructor mechanism. + function Ultimate_Extension_Of + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return Project_Id; + -- Returns the Project_Id of project Project. Returns No_Project + -- if Project is No_Project. + ------------------ -- Add_Argument -- ------------------ @@ -360,9 +362,6 @@ package body MLib.Prj is -- If null, Path Option is not supported. -- Not a constant so that it can be deallocated. - Copy_Dir : Name_Id; - -- Directory where to copy ALI files and possibly interface sources - First_ALI : Name_Id := No_Name; -- Store the ALI file name of a source of the library (the first found) @@ -1395,7 +1394,7 @@ package body MLib.Prj is declare DLL_Name : aliased String := - Lib_Dirpath.all & "/lib" & + Lib_Dirpath.all & '/' & DLL_Prefix & Lib_Filename.all & "." & DLL_Ext; Archive_Name : aliased String := @@ -1477,14 +1476,120 @@ package body MLib.Prj is end; end if; - -- Clean the library directory, if it is also the directory where - -- the ALI files are copied, either because there is no interface - -- copy directory or because the interface copy directory is the - -- same as the library directory. + declare + Current_Dir : constant String := Get_Current_Dir; + Dir : Dir_Type; + + Name : String (1 .. 200); + Last : Natural; + + Disregard : Boolean; + + DLL_Name : aliased constant String := + Lib_Filename.all & "." & DLL_Ext; + + Archive_Name : aliased constant String := + Lib_Filename.all & "." & Archive_Ext; + + Delete : Boolean := False; + + begin + -- Clean the library directory: remove any file with the name of + -- the library file and any ALI file of a source of the project. + + begin + Get_Name_String + (In_Tree.Projects.Table (For_Project).Library_Dir); + Change_Dir (Name_Buffer (1 .. Name_Len)); + + exception + when others => + Com.Fail + ("unable to access library directory """, + Name_Buffer (1 .. Name_Len), + """"); + end; + + Open (Dir, "."); + + loop + Read (Dir, Name, Last); + exit when Last = 0; + + if Is_Regular_File (Name (1 .. Last)) then + Canonical_Case_File_Name (Name (1 .. Last)); + Delete := False; + + if (The_Build_Mode = Static and then + Name (1 .. Last) = Archive_Name) + or else + ((The_Build_Mode = Dynamic or else + The_Build_Mode = Relocatable) + and then + Name (1 .. Last) = DLL_Name) + then + Delete := True; + + elsif Last > 4 and then Name (Last - 3 .. Last) = ".ali" then + declare + Unit : Unit_Data; + begin + -- Compare with ALI file names of the project + + for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop + Unit := In_Tree.Units.Table (Index); + + if Unit.File_Names (Body_Part).Project /= + No_Project + then + if Ultimate_Extension_Of + (Unit.File_Names (Body_Part).Project, In_Tree) + = For_Project + then + Get_Name_String + (Unit.File_Names (Body_Part).Name); + Name_Len := Name_Len - + File_Extension + (Name (1 .. Name_Len))'Length; + if Name_Buffer (1 .. Name_Len) = + Name (1 .. Last - 4) + then + Delete := True; + exit; + end if; + end if; + + elsif Ultimate_Extension_Of + (Unit.File_Names (Specification).Project, In_Tree) + = For_Project + then + Get_Name_String + (Unit.File_Names (Specification).Name); + Name_Len := Name_Len - + File_Extension (Name (1 .. Name_Len))'Length; + + if Name_Buffer (1 .. Name_Len) = + Name (1 .. Last - 4) + then + Delete := True; + exit; + end if; + end if; + end loop; + end; + end if; + + if Delete then + Set_Writable (Name (1 .. Last)); + Delete_File (Name (1 .. Last), Disregard); + end if; + end if; + end loop; - Copy_Dir := - In_Tree.Projects.Table (For_Project).Library_Dir; - Clean (Copy_Dir); + Close (Dir); + + Change_Dir (Current_Dir); + end; -- Call procedure to build the library, depending on the build mode @@ -1516,7 +1621,7 @@ package body MLib.Prj is end case; -- We need to copy the ALI files from the object directory to - -- the library directory, so that the linker find them there, + -- the library ALI directory, so that the linker find them there, -- and does not need to look in the object directory where it -- would also find the object files; and we don't want that: -- we want the linker to use the library. @@ -1526,7 +1631,7 @@ package body MLib.Prj is Copy_ALI_Files (Files => Ali_Files.all, - To => Copy_Dir, + To => In_Tree.Projects.Table (For_Project).Library_ALI_Dir, Interfaces => Arguments (1 .. Argument_Number)); -- Copy interface sources if Library_Src_Dir specified @@ -1535,23 +1640,89 @@ package body MLib.Prj is and then In_Tree.Projects.Table (For_Project).Library_Src_Dir /= No_Name then - -- Clean the interface copy directory, if it is not also the - -- library directory. If it is also the library directory, it - -- has already been cleaned before generation of the library. + -- Clean the interface copy directory: remove any source that + -- could be a source of the project. - if In_Tree.Projects.Table - (For_Project).Library_Src_Dir /= Copy_Dir - then - Copy_Dir := In_Tree.Projects.Table - (For_Project).Library_Src_Dir; - Clean (Copy_Dir); - end if; + begin + Get_Name_String + (In_Tree.Projects.Table (For_Project).Library_Src_Dir); + Change_Dir (Name_Buffer (1 .. Name_Len)); + + exception + when others => + Com.Fail + ("unable to access library source copy directory """, + Name_Buffer (1 .. Name_Len), + """"); + end; + + declare + Dir : Dir_Type; + Delete : Boolean; + Unit : Unit_Data; + + Name : String (1 .. 200); + Last : Natural; + + Disregard : Boolean; + + begin + Open (Dir, "."); + + loop + Read (Dir, Name, Last); + exit when Last = 0; + + if Is_Regular_File (Name (1 .. Last)) then + Canonical_Case_File_Name (Name (1 .. Last)); + Delete := False; + + -- Compare with source file names of the project + + for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop + Unit := In_Tree.Units.Table (Index); + + if Ultimate_Extension_Of + (Unit.File_Names (Body_Part).Project, In_Tree) = + For_Project + and then + Get_Name_String + (Unit.File_Names (Body_Part).Name) = + Name (1 .. Last) + then + Delete := True; + exit; + end if; + + if Ultimate_Extension_Of + (Unit.File_Names (Specification).Project, In_Tree) = + For_Project + and then + Get_Name_String + (Unit.File_Names (Specification).Name) = + Name (1 .. Last) + then + Delete := True; + exit; + end if; + end loop; + end if; + + if Delete then + Set_Writable (Name (1 .. Last)); + Delete_File (Name (1 .. Last), Disregard); + end if; + end loop; + + Close (Dir); + end; Copy_Interface_Sources (For_Project => For_Project, In_Tree => In_Tree, Interfaces => Arguments (1 .. Argument_Number), - To_Dir => Copy_Dir); + To_Dir => In_Tree.Projects.Table + (For_Project).Library_Src_Dir); end if; end if; @@ -1591,130 +1762,84 @@ package body MLib.Prj is procedure Check_Library (For_Project : Project_Id; In_Tree : Project_Tree_Ref) is - Data : constant Project_Data := - In_Tree.Projects.Table (For_Project); + Data : constant Project_Data := + In_Tree.Projects.Table (For_Project); + Lib_TS : Time_Stamp_Type; + Current : constant Dir_Name_Str := Get_Current_Dir; begin -- No need to build the library if there is no object directory, -- hence no object files to build the library. - if Data.Library - and then not Data.Need_To_Build_Lib - and then Data.Object_Directory /= No_Name - then + if Data.Library then declare - Current : constant Dir_Name_Str := Get_Current_Dir; Lib_Name : constant Name_Id := - Library_File_Name_For (For_Project, In_Tree); - Lib_TS : Time_Stamp_Type; - Obj_TS : Time_Stamp_Type; - - Object_Dir : Dir_Type; - + Library_File_Name_For (For_Project, In_Tree); begin - if Hostparm.OpenVMS then - B_Start (B_Start'Last) := '$'; - end if; - Change_Dir (Get_Name_String (Data.Library_Dir)); - Lib_TS := File_Stamp (Lib_Name); + In_Tree.Projects.Table (For_Project).Library_TS := Lib_TS; + end; - -- If the library file does not exist, then the time stamp will - -- be Empty_Time_Stamp, earlier than any other time stamp. - - Change_Dir (Get_Name_String (Data.Object_Directory)); - Open (Dir => Object_Dir, Dir_Name => "."); - - -- For all entries in the object directory - - loop - Read (Object_Dir, Name_Buffer, Name_Len); - exit when Name_Len = 0; - - -- Check if it is an object file, but ignore any binder - -- generated file. - - if Is_Obj (Name_Buffer (1 .. Name_Len)) - and then Name_Buffer (1 .. B_Start'Length) /= B_Start - then - -- Get the object file time stamp - - Obj_TS := File_Stamp (Name_Find); - - -- If library file time stamp is earlier, set - -- Need_To_Build_Lib and return. String comparaison is used, - -- otherwise time stamps may be too close and the - -- comparaison would return True, which would trigger - -- an unnecessary rebuild of the library. - - if String (Lib_TS) < String (Obj_TS) then - - -- Library must be rebuilt + if not Data.Externally_Built + and then not Data.Need_To_Build_Lib + and then Data.Object_Directory /= No_Name + then + declare + Obj_TS : Time_Stamp_Type; + Object_Dir : Dir_Type; - In_Tree.Projects.Table - (For_Project).Need_To_Build_Lib := True; - exit; - end if; + begin + if Hostparm.OpenVMS then + B_Start (B_Start'Last) := '$'; end if; - end loop; - Change_Dir (Current); - end; - end if; - end Check_Library; + -- If the library file does not exist, then the time stamp will + -- be Empty_Time_Stamp, earlier than any other time stamp. - ----------- - -- Clean -- - ----------- - - procedure Clean (Directory : Name_Id) is - Current : constant Dir_Name_Str := Get_Current_Dir; - - Dir : Dir_Type; + Change_Dir (Get_Name_String (Data.Object_Directory)); + Open (Dir => Object_Dir, Dir_Name => "."); - Name : String (1 .. 200); - Last : Natural; + -- For all entries in the object directory - Disregard : Boolean; + loop + Read (Object_Dir, Name_Buffer, Name_Len); + exit when Name_Len = 0; - begin - Get_Name_String (Directory); + -- Check if it is an object file, but ignore any binder + -- generated file. - -- Change the working directory to the directory to clean + if Is_Obj (Name_Buffer (1 .. Name_Len)) + and then Name_Buffer (1 .. B_Start'Length) /= B_Start + then + -- Get the object file time stamp - begin - Change_Dir (Name_Buffer (1 .. Name_Len)); + Obj_TS := File_Stamp (Name_Find); - exception - when others => - Com.Fail - ("unable to access directory """, - Name_Buffer (1 .. Name_Len), - """"); - end; + -- If library file time stamp is earlier, set + -- Need_To_Build_Lib and return. String comparaison is + -- used, otherwise time stamps may be too close and the + -- comparaison would return True, which would trigger + -- an unnecessary rebuild of the library. - Open (Dir, "."); + if String (Lib_TS) < String (Obj_TS) then - -- For each regular file in the directory, make it writable and - -- delete the file. + -- Library must be rebuilt - loop - Read (Dir, Name, Last); - exit when Last = 0; + In_Tree.Projects.Table + (For_Project).Need_To_Build_Lib := True; + exit; + end if; + end if; + end loop; - if Is_Regular_File (Name (1 .. Last)) then - Set_Writable (Name (1 .. Last)); - Delete_File (Name (1 .. Last), Disregard); + Close (Object_Dir); + end; end if; - end loop; - - Close (Dir); - -- Restore the initial working directory - - Change_Dir (Current); - end Clean; + Change_Dir (Current); + end if; + end Check_Library; ---------------------------- -- Copy_Interface_Sources -- @@ -1749,8 +1874,7 @@ package body MLib.Prj is function Is_Same_Or_Extension (Extending : Project_Id; - Extended : Project_Id) - return Boolean; + Extended : Project_Id) return Boolean; -- Return True if project Extending is equal to or extends project -- Extended. @@ -1793,8 +1917,7 @@ package body MLib.Prj is function Is_Same_Or_Extension (Extending : Project_Id; - Extended : Project_Id) - return Boolean + Extended : Project_Id) return Boolean is Ext : Project_Id := Extending; @@ -2075,4 +2198,27 @@ package body MLib.Prj is return C_SALs_Init_Using_Constructors /= 0; end SALs_Use_Constructors; + --------------------------- + -- Ultimate_Extension_Of -- + --------------------------- + + function Ultimate_Extension_Of + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return Project_Id + is + Result : Project_Id := Project; + Data : Project_Data; + + begin + if Project /= No_Project then + loop + Data := In_Tree.Projects.Table (Result); + exit when Data.Extended_By = No_Project; + Result := Data.Extended_By; + end loop; + end if; + + return Result; + end Ultimate_Extension_Of; + end MLib.Prj; diff --git a/gcc/ada/mlib.adb b/gcc/ada/mlib.adb index 338a304ab12..549578a25b2 100644 --- a/gcc/ada/mlib.adb +++ b/gcc/ada/mlib.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2005, Ada Core Technologies, Inc. -- +-- Copyright (C) 1999-2005, AdaCore -- -- -- -- 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- -- @@ -34,6 +34,8 @@ with Namet; use Namet; with MLib.Utl; use MLib.Utl; +with Prj.Com; + with GNAT.Directory_Operations; use GNAT.Directory_Operations; package body MLib is @@ -67,24 +69,24 @@ package body MLib is procedure Check_Library_Name (Name : String) is begin if Name'Length = 0 then - Fail ("library name cannot be empty"); + Prj.Com.Fail ("library name cannot be empty"); end if; if Name'Length > Max_Characters_In_Library_Name then - Fail ("illegal library name """, Name, """: too long"); + Prj.Com.Fail ("illegal library name """, Name, """: too long"); end if; if not Is_Letter (Name (Name'First)) then - Fail ("illegal library name """, - Name, - """: should start with a letter"); + Prj.Com.Fail ("illegal library name """, + Name, + """: should start with a letter"); end if; for Index in Name'Range loop if not Is_Alphanumeric (Name (Index)) then - Fail ("illegal library name """, - Name, - """: should include only letters and digits"); + Prj.Com.Fail ("illegal library name """, + Name, + """: should include only letters and digits"); end if; end loop; end Check_Library_Name; @@ -273,7 +275,7 @@ package body MLib is end; if not Success then - Fail ("could not copy ALI files to library dir"); + Prj.Com.Fail ("could not copy ALI files to library dir"); end if; end loop; end if; diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index b49c51134d9..b43fe801bc3 100644 --- a/gcc/ada/prj-attr.adb +++ b/gcc/ada/prj-attr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005, 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- -- @@ -55,7 +55,7 @@ package body Prj.Attr is -- insensitive -- 'c' same as 'b', with optional index - -- End is indicated by two consecutive '#'. + -- End is indicated by two consecutive '#' Initialization_Data : constant String := @@ -75,6 +75,7 @@ package body Prj.Attr is "SVlibrary_auto_init#" & "LVlibrary_options#" & "SVlibrary_src_dir#" & + "SVlibrary_ali_dir#" & "SVlibrary_gcc#" & "SVlibrary_symbol_file#" & "SVlibrary_symbol_policy#" & diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 26fd99b7c94..c20be6dd739 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005, 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- -- @@ -48,7 +48,7 @@ package body Prj.Env is -- and ADA_OBJECTS_PATH are stored. Ada_Path_Length : Natural := 0; - -- Index of the last valid character in Ada_Path_Buffer. + -- Index of the last valid character in Ada_Path_Buffer Ada_Prj_Include_File_Set : Boolean := False; Ada_Prj_Objects_File_Set : Boolean := False; @@ -270,9 +270,9 @@ package body Prj.Env is if Data.Library then if Data.Object_Directory = No_Name or else - Contains_ALI_Files (Data.Library_Dir) + Contains_ALI_Files (Data.Library_ALI_Dir) then - Add_To_Path (Get_Name_String (Data.Library_Dir)); + Add_To_Path (Get_Name_String (Data.Library_ALI_Dir)); else Add_To_Path (Get_Name_String (Data.Object_Directory)); end if; @@ -2121,16 +2121,17 @@ package body Prj.Env is and then (not Including_Libraries or else not Data.Library)) then - -- For a library project, add the library directory - -- if there is no object directory or if the library - -- directory contains ALI files; otherwise add the - -- object directory. + -- 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. if Data.Library then if Data.Object_Directory = No_Name - or else Contains_ALI_Files (Data.Library_Dir) + or else Contains_ALI_Files (Data.Library_ALI_Dir) then - Add_To_Object_Path (Data.Library_Dir, In_Tree); + Add_To_Object_Path + (Data.Library_ALI_Dir, In_Tree); else Add_To_Object_Path (Data.Object_Directory, In_Tree); @@ -2138,13 +2139,18 @@ package body Prj.Env is -- For a non-library project, add the object -- directory, if it is not a virtual project, and - -- if there are Ada sources. If there are no Ada - -- sources, adding the object directory could - -- disrupt the order of the object dirs in the path. + -- if there are Ada sources or if the project is an + -- extending project. if There Are No Ada sources, + -- adding the object directory could disrupt + -- the order of the object dirs in the path. elsif not Data.Virtual - and then In_Tree.Projects.Table - (Project).Ada_Sources_Present + and then (In_Tree.Projects.Table + (Project).Ada_Sources_Present + or else + (Data.Extends /= No_Project + and then + Data.Object_Directory /= No_Name)) then Add_To_Object_Path (Data.Object_Directory, In_Tree); @@ -2230,7 +2236,7 @@ package body Prj.Env is Add (Project); end if; - -- Write and 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 Source_Path_Table.First .. diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index bc7adfa375a..959294405d0 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2005, 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- -- @@ -1383,12 +1383,16 @@ package body Prj.Nmsc is Lib_Name : constant Prj.Variable_Value := Prj.Util.Value_Of - (Snames.Name_Library_Name, Attributes, In_Tree); + (Snames.Name_Library_Name, Attributes, In_Tree); Lib_Version : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Version, Attributes, In_Tree); + Lib_ALI_Dir : constant Prj.Variable_Value := + Prj.Util.Value_Of + (Snames.Name_Library_Ali_Dir, Attributes, In_Tree); + The_Lib_Kind : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Kind, Attributes, In_Tree); @@ -1488,14 +1492,78 @@ package body Prj.Nmsc is Data.Library_Dir := No_Name; Data.Display_Library_Dir := No_Name; - -- Display the Library directory in high verbosity - else - if Current_Verbosity = High then - Write_Str ("Library directory ="""); - Write_Str (Get_Name_String (Data.Display_Library_Dir)); - Write_Line (""""); - end if; + declare + OK : Boolean := True; + Dirs_Id : String_List_Id; + Dir_Elem : String_Element; + + begin + -- The library directory cannot be the same as a source + -- directory of the current project. + + Dirs_Id := Data.Source_Dirs; + while Dirs_Id /= Nil_String loop + Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id); + Dirs_Id := Dir_Elem.Next; + + if Data.Library_Dir = Dir_Elem.Value then + Err_Vars.Error_Msg_Name_1 := Dir_Elem.Value; + Error_Msg + (Project, In_Tree, + "library directory cannot be the same " & + "as source directory {", + Lib_Dir.Location); + OK := False; + exit; + end if; + end loop; + + if OK then + + -- The library directory cannot be the same as a source + -- directory of another project either. + + Project_Loop : + for Pid in 1 .. Project_Table.Last (In_Tree.Projects) loop + if Pid /= Project then + Dirs_Id := In_Tree.Projects.Table (Pid).Source_Dirs; + + Dir_Loop : while Dirs_Id /= Nil_String loop + Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id); + Dirs_Id := Dir_Elem.Next; + + if Data.Library_Dir = Dir_Elem.Value then + Err_Vars.Error_Msg_Name_1 := Dir_Elem.Value; + Err_Vars.Error_Msg_Name_2 := + In_Tree.Projects.Table (Pid).Name; + + Error_Msg + (Project, In_Tree, + "library directory cannot be the same " & + "as source directory { of project {", + Lib_Dir.Location); + OK := False; + exit Project_Loop; + end if; + end loop Dir_Loop; + end if; + end loop Project_Loop; + end if; + + if not OK then + Data.Library_Dir := No_Name; + Data.Display_Library_Dir := No_Name; + + elsif Current_Verbosity = High then + + -- Display the Library directory in high verbosity + + Write_Str ("Library directory ="""); + Write_Str (Get_Name_String (Data.Display_Library_Dir)); + Write_Line (""""); + end if; + end; end if; end if; @@ -1536,6 +1604,158 @@ package body Prj.Nmsc is Data.Library := False; else + if Lib_ALI_Dir.Value = Empty_String then + if Current_Verbosity = High then + Write_Line ("No library 'A'L'I directory specified"); + end if; + Data.Library_ALI_Dir := Data.Library_Dir; + Data.Display_Library_ALI_Dir := Data.Display_Library_Dir; + + else + -- Find path name, check that it is a directory + + Locate_Directory + (Lib_ALI_Dir.Value, Data.Display_Directory, + Data.Library_ALI_Dir, Data.Display_Library_ALI_Dir); + + if Data.Library_ALI_Dir = No_Name then + + -- Get the absolute name of the library ALI directory that + -- does not exist, to report an error. + + declare + Dir_Name : constant String := + Get_Name_String (Lib_ALI_Dir.Value); + + begin + if Is_Absolute_Path (Dir_Name) then + Err_Vars.Error_Msg_Name_1 := Lib_Dir.Value; + + else + Get_Name_String (Data.Display_Directory); + + if Name_Buffer (Name_Len) /= Directory_Separator then + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := Directory_Separator; + end if; + + Name_Buffer + (Name_Len + 1 .. Name_Len + Dir_Name'Length) := + Dir_Name; + Name_Len := Name_Len + Dir_Name'Length; + Err_Vars.Error_Msg_Name_1 := Name_Find; + end if; + + -- Report the error + + Error_Msg + (Project, In_Tree, + "library 'A'L'I directory { does not exist", + Lib_ALI_Dir.Location); + end; + end if; + + if Data.Library_ALI_Dir /= Data.Library_Dir then + + -- The library ALI directory cannot be the same as the + -- Object directory. + + if Data.Library_ALI_Dir = Data.Object_Directory then + Error_Msg + (Project, In_Tree, + "library 'A'L'I directory cannot be the same " & + "as object directory", + Lib_ALI_Dir.Location); + Data.Library_ALI_Dir := No_Name; + Data.Display_Library_ALI_Dir := No_Name; + + else + declare + OK : Boolean := True; + Dirs_Id : String_List_Id; + Dir_Elem : String_Element; + + begin + -- The library ALI directory cannot be the same as + -- a source directory of the current project. + + Dirs_Id := Data.Source_Dirs; + while Dirs_Id /= Nil_String loop + Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id); + Dirs_Id := Dir_Elem.Next; + + if Data.Library_ALI_Dir = Dir_Elem.Value then + Err_Vars.Error_Msg_Name_1 := Dir_Elem.Value; + Error_Msg + (Project, In_Tree, + "library 'A'L'I directory cannot be " & + "the same as source directory {", + Lib_ALI_Dir.Location); + OK := False; + exit; + end if; + end loop; + + if OK then + + -- The library ALI directory cannot be the same as + -- a source directory of another project either. + + ALI_Project_Loop : + for + Pid in 1 .. Project_Table.Last (In_Tree.Projects) + loop + if Pid /= Project then + Dirs_Id := + In_Tree.Projects.Table (Pid).Source_Dirs; + + ALI_Dir_Loop : + while Dirs_Id /= Nil_String loop + Dir_Elem := + In_Tree.String_Elements.Table (Dirs_Id); + Dirs_Id := Dir_Elem.Next; + + if + Data.Library_ALI_Dir = Dir_Elem.Value + then + Err_Vars.Error_Msg_Name_1 := + Dir_Elem.Value; + Err_Vars.Error_Msg_Name_2 := + In_Tree.Projects.Table (Pid).Name; + + Error_Msg + (Project, In_Tree, + "library 'A'L'I directory cannot " & + "be the same as source directory " & + "{ of project {", + Lib_ALI_Dir.Location); + OK := False; + exit ALI_Project_Loop; + end if; + end loop ALI_Dir_Loop; + end if; + end loop ALI_Project_Loop; + end if; + + if not OK then + Data.Library_ALI_Dir := No_Name; + Data.Display_Library_ALI_Dir := No_Name; + + elsif Current_Verbosity = High then + + -- Display the Library ALI directory in high + -- verbosity. + + Write_Str ("Library ALI directory ="""); + Write_Str + (Get_Name_String (Data.Display_Library_ALI_Dir)); + Write_Line (""""); + end if; + end; + end if; + end if; + end if; + pragma Assert (Lib_Version.Kind = Single); if Lib_Version.Value = Empty_String then @@ -2279,18 +2499,19 @@ package body Prj.Nmsc is Lib_Src_Dir.Location); Data.Library_Src_Dir := No_Name; - -- Check if it is same as one of the source directories - else declare - Src_Dirs : String_List_Id := Data.Source_Dirs; + Src_Dirs : String_List_Id; Src_Dir : String_Element; begin + -- Interface copy directory cannot be one of the source + -- directory of the current project. + + Src_Dirs := Data.Source_Dirs; while Src_Dirs /= Nil_String loop Src_Dir := In_Tree.String_Elements.Table (Src_Dirs); - Src_Dirs := Src_Dir.Next; -- Report error if it is one of the source directories @@ -2303,7 +2524,45 @@ package body Prj.Nmsc is Data.Library_Src_Dir := No_Name; exit; end if; + + Src_Dirs := Src_Dir.Next; end loop; + + if Data.Library_Src_Dir /= No_Name then + + -- It cannot be a source directory of any other + -- project either. + + Project_Loop : for Pid in 1 .. + Project_Table.Last (In_Tree.Projects) + loop + Src_Dirs := + In_Tree.Projects.Table (Pid).Source_Dirs; + Dir_Loop : while Src_Dirs /= Nil_String loop + Src_Dir := + In_Tree.String_Elements.Table (Src_Dirs); + + -- Report error if it is one of the source + -- directories + + if Data.Library_Src_Dir = Src_Dir.Value then + Error_Msg_Name_1 := Src_Dir.Value; + Error_Msg_Name_2 := + In_Tree.Projects.Table (Pid).Name; + Error_Msg + (Project, In_Tree, + "directory to copy interfaces cannot " & + "be the same as source directory { of " & + "project {", + Lib_Src_Dir.Location); + Data.Library_Src_Dir := No_Name; + exit Project_Loop; + end if; + + Src_Dirs := Src_Dir.Next; + end loop Dir_Loop; + end loop Project_Loop; + end if; end; -- In high verbosity, if there is a valid Library_Src_Dir, diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 5a8c2996e83..4f689adc555 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005, 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- -- @@ -102,6 +102,8 @@ package body Prj is 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_Kind => Static, Lib_Internal_Name => No_Name, @@ -121,6 +123,7 @@ package body Prj is Known_Order_Of_Source_Dirs => True, Object_Directory => No_Name, Display_Object_Dir => No_Name, + Library_TS => Empty_Time_Stamp, Exec_Directory => No_Name, Display_Exec_Dir => No_Name, Extends => No_Project, @@ -132,6 +135,7 @@ package body Prj is Default_Linker_Path => No_Name, 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, @@ -485,7 +489,7 @@ package body Prj is end if; end loop; - -- If none can be found, create a new one. + -- If none can be found, create a new one if not Found then Element := @@ -526,7 +530,7 @@ package body Prj is end if; end loop; - -- If none can be found, create a new one. + -- If none can be found, create a new one if not Found then Element := diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 0f3429c09ba..e360bddb410 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005, 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- -- @@ -73,9 +73,11 @@ package Prj is -- Canonical_Case_File_Name is called on this variable in the body of Prj. ----------------------------------------------------- - -- Multi-language stuff that will be modified soon -- + -- Multi-language Stuff That Will be Modified Soon -- ----------------------------------------------------- + -- Still should be properly commented ??? + type Language_Index is new Nat; No_Language_Index : constant Language_Index := 0; @@ -232,6 +234,7 @@ package Prj is type Other_Source_Id is new Nat; No_Other_Source : constant Other_Source_Id := 0; + type Other_Source is record Language : Language_Index; -- language of the source File_Name : Name_Id; -- source file simple name @@ -273,10 +276,10 @@ package Prj is type Policy is (Autonomous, Compliant, Controlled, Restricted); -- Type to specify the symbol policy, when symbol control is supported. -- See full explanation about this type in package Symbols. - -- Autonomous: Create a symbol file without considering any reference - -- Compliant: Try to be as compatible as possible with an existing ref - -- Controlled: Fail if symbols are not the same as those in the reference - -- Restricted: Restrict the symbols to those in the symbol file + -- Autonomous: Create a symbol file without considering any reference + -- Compliant: Try to be as compatible as possible with an existing ref + -- Controlled: Fail if symbols are not the same as those in the reference + -- Restricted: Restrict the symbols to those in the symbol file type Symbol_Record is record Symbol_File : Name_Id := No_Name; @@ -301,12 +304,12 @@ package Prj is type String_List_Id is new Nat; Nil_String : constant String_List_Id := 0; type String_Element is record - Value : Name_Id := No_Name; - Index : Int := 0; + Value : Name_Id := No_Name; + Index : Int := 0; Display_Value : Name_Id := No_Name; - Location : Source_Ptr := No_Location; - Flag : Boolean := False; - Next : String_List_Id := Nil_String; + Location : Source_Ptr := No_Location; + Flag : Boolean := False; + Next : String_List_Id := Nil_String; end record; -- To hold values for string list variables and array elements. -- Component Flag may be used for various purposes. For source @@ -353,9 +356,9 @@ package Prj is type Variable_Id is new Nat; No_Variable : constant Variable_Id := 0; type Variable is record - Next : Variable_Id := No_Variable; - Name : Name_Id; - Value : Variable_Value; + Next : Variable_Id := No_Variable; + Name : Name_Id; + Value : Variable_Value; end record; -- To hold the list of variables in a project file and in packages @@ -430,7 +433,7 @@ package Prj is Parent : Package_Id := No_Package; Next : Package_Id := No_Package; end record; - -- A package. Includes declarations that may include other packages + -- A package (includes declarations that may include other packages) package Package_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Package_Element, @@ -473,8 +476,8 @@ package Prj is -- The position in the project file source where -- Ada_Spec_Suffix is defined. - Impl_Suffixes : Impl_Suffix_Array := No_Impl_Suffixes; - Supp_Suffixes : Supp_Language_Index := No_Supp_Language_Index; + Impl_Suffixes : Impl_Suffix_Array := No_Impl_Suffixes; + Supp_Suffixes : Supp_Language_Index := No_Supp_Language_Index; -- The source suffixes of the different languages Body_Suffix : Array_Element_Id := No_Array_Element; @@ -553,7 +556,7 @@ package Prj is Supp_Languages : Supp_Language_Index := No_Supp_Language_Index; -- Indicate the different languages of the source of this project - First_Referred_By : Project_Id := No_Project; + First_Referred_By : Project_Id := No_Project; -- The project, if any, that was the first to be known as importing or -- extending this project. Set by Prj.Proc.Process. @@ -585,6 +588,7 @@ package Prj is -- Directory where the project file resides. Set by Prj.Proc.Process Display_Directory : Name_Id := No_Name; + -- comment ??? Dir_Path : String_Access; -- Same as Directory, but as an access to String. Set by @@ -603,18 +607,31 @@ package Prj is -- different from Library_Dir for platforms where the file names are -- case-insensitive. + Library_TS : Time_Stamp_Type := Empty_Time_Stamp; + -- The timestamp of a library file in a library project. + -- Set by MLib.Prj.Check_Library. + Library_Src_Dir : Name_Id := No_Name; - -- If a library project, directory where the sources and the ALI files - -- of the library are copied. By default, if attribute Library_Src_Dir - -- is not specified, sources are not copied anywhere and ALI files are - -- copied in the Library Directory. Set by - -- Prj.Nmsc.Language_Independent_Check. + -- If a Stand-Alone Library project, directory where the sources + -- of the interfaces of the library are copied. By default, if + -- attribute Library_Src_Dir is not specified, sources of the interfaces + -- are not copied anywhere. Set by Prj.Nmsc.Check_Stand_Alone_Library. Display_Library_Src_Dir : Name_Id := No_Name; -- The name of the library source directory, for display purposes. -- May be different from Library_Src_Dir for platforms where the file -- names are case-insensitive. + Library_ALI_Dir : Name_Id := No_Name; + -- In a library project, directory where the ALI files are copied. + -- If attribute Library_ALI_Dir is not specified, ALI files are + -- copied in the Library_Dir. Set by Prj.Nmsc.Check_Library_Attributes. + + Display_Library_ALI_Dir : Name_Id := No_Name; + -- The name of the library ALI directory, for display purposes. May be + -- different from Library_ALI_Dir for platforms where the file names are + -- case-insensitive. + Library_Name : Name_Id := No_Name; -- If a library project, name of the library -- Set by Prj.Nmsc.Language_Independent_Check. @@ -653,8 +670,8 @@ package Prj is -- A flag that indicates that there are non-Ada sources in this project Sources : String_List_Id := Nil_String; - -- The list of all the source file names. Set by - -- Prj.Nmsc.Check_Ada_Naming_Scheme. + -- The list of all the source file names. + -- Set by Prj.Nmsc.Check_Ada_Naming_Scheme. First_Other_Source : Other_Source_Id := No_Other_Source; Last_Other_Source : Other_Source_Id := No_Other_Source; @@ -711,13 +728,14 @@ package Prj is -- Set by Prj.Nmsc.Check_Naming_Scheme. First_Language_Processing : First_Language_Processing_Data := - Default_First_Language_Processing_Data; + Default_First_Language_Processing_Data; + -- Comment needed ??? - Supp_Language_Processing : Supp_Language_Index := - No_Supp_Language_Index; + Supp_Language_Processing : Supp_Language_Index := No_Supp_Language_Index; + -- Comment needed - Default_Linker : Name_Id := No_Name; - Default_Linker_Path : Name_Id := No_Name; + Default_Linker : Name_Id := No_Name; + Default_Linker_Path : Name_Id := No_Name; Decl : Declarations := No_Declarations; -- The declarations (variables, attributes and packages) of this @@ -727,6 +745,10 @@ package Prj is -- The list of all directly imported projects, if any. Set by -- Prj.Proc.Process. + All_Imported_Projects : Project_List := Empty_Project_List; + -- The list of all projects imported directly or indirectly, if any. + -- Set by Make.Initialize. + Ada_Include_Path : String_Access := null; -- The cached value of ADA_INCLUDE_PATH for this project file. Do not -- use this field directly outside of the compiler, use @@ -771,7 +793,7 @@ package Prj is -- A flag to avoid checking repetitively the naming scheme of -- this project file. Set by Prj.Nmsc.Check_Ada_Naming_Scheme. - Seen : Boolean := False; + Seen : Boolean := False; -- A flag to mark a project as "visited" to avoid processing the same -- project several time. @@ -943,14 +965,14 @@ package Prj is In_Project : Project_Data; In_Tree : Project_Tree_Ref) return Boolean; -- Return True when Language is one of the languages used in - -- project Project. + -- project In_Project. procedure Set (Language : Language_Index; Present : Boolean; In_Project : in out Project_Data; In_Tree : Project_Tree_Ref); - -- Indicate if Language is or not a language used in project Project + -- Indicate if Language is or not a language used in project In_Project function Language_Processing_Data_Of (Language : Language_Index; @@ -1018,6 +1040,7 @@ private Table_Low_Bound => 1, Table_Initial => 5, Table_Increment => 100); + -- Comment ??? package Path_File_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Name_Id, @@ -1045,10 +1068,11 @@ private -- A table to store the object dirs, before creating the object path file type Private_Project_Tree_Data is record - Namings : Naming_Table.Instance; - Path_Files : Path_File_Table.Instance; - Source_Paths : Source_Path_Table.Instance; - Object_Paths : Object_Path_Table.Instance; - Default_Naming : Naming_Data; + Namings : Naming_Table.Instance; + Path_Files : Path_File_Table.Instance; + Source_Paths : Source_Path_Table.Instance; + Object_Paths : Object_Path_Table.Instance; + Default_Naming : Naming_Data; end record; + -- Comment ??? end Prj; |