-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2005, Ada Core Technologies, Inc. --
+-- Copyright (C) 2001-2006, 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- --
with ALI; use ALI;
with Gnatvsn; use Gnatvsn;
-with Hostparm;
with MLib.Fil; use MLib.Fil;
with MLib.Tgt; use MLib.Tgt;
with MLib.Utl; use MLib.Utl;
with Snames; use Snames;
with Switch; use Switch;
with Table;
+with Targparm; use Targparm;
with Ada.Characters.Handling;
pragma Import (C, Prj_Add_Obj_Files, "__gnat_prj_add_obj_files");
Add_Object_Files : constant Boolean := Prj_Add_Obj_Files /= 0;
-- Indicates if object files in pragmas Linker_Options (found in the
- -- binder generated file) should be taken when linking aq stand-alone
- -- library.
- -- False for Windows, True for other platforms.
+ -- binder generated file) should be taken when linking a stand-alone
+ -- library. False for Windows, True for other platforms.
ALI_Suffix : constant String := ".ali";
- B_Start : String := "b~";
+
+ B_Start : String_Ptr := new String'("b~");
+ -- Prefix of bind file, changed to b__ for VMS
S_Osinte_Ads : Name_Id := No_Name;
-- Name_Id for "s-osinte.ads"
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;
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,
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,
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;
-- Display invocation of gnatbind and of the compiler with the arguments
-- in Arguments, except when Quiet_Output is True.
+ function Index (S, Pattern : String) return Natural;
+ -- Return the last occurrence of Pattern in S, or 0 if none
+
procedure Process_Binder_File (Name : String);
-- For Stand-Alone libraries, get the Linker Options in the binder
-- generated file.
-- 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 --
------------------
-- 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)
begin
if not Libgnarl_Needed or
- (Hostparm.OpenVMS and then
+ (OpenVMS_On_Target and then
((not Libdecgnat_Needed) or
(not Gtrasymobj_Needed)))
then
if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then
Libgnarl_Needed := True;
- elsif Hostparm.OpenVMS then
+ elsif OpenVMS_On_Target then
if ALI.Sdep.Table (Index).Sfile = S_Dec_Ads then
Libdecgnat_Needed := True;
Arguments := new String_List (1 .. Initial_Argument_Max);
end if;
- -- Add "-n -o b~<lib>.adb (b$<lib>.adb on VMS) -L<lib>"
+ -- Add "-n -o b~<lib>.adb (b__<lib>.adb on VMS) -L<lib>"
Argument_Number := 2;
Arguments (1) := No_Main;
Arguments (2) := Output_Switch;
- if Hostparm.OpenVMS then
- B_Start (B_Start'Last) := '$';
+ if OpenVMS_On_Target then
+ B_Start := new String'("b__");
end if;
Add_Argument
- (B_Start & Get_Name_String (Data.Library_Name) & ".adb");
+ (B_Start.all & Get_Name_String (Data.Library_Name) & ".adb");
Add_Argument ("-L" & Get_Name_String (Data.Library_Name));
if Data.Lib_Auto_Init and then SALs_Use_Constructors then
In_Tree => In_Tree,
Including_Libraries => True);
- -- Invoke <gcc> -c b$$<lib>.adb
+ -- Invoke <gcc> -c b__<lib>.adb
-- Allocate Arguments, if it is the first time we see a standalone
-- library.
Argument_Number := 1;
Arguments (1) := Compile_Switch;
- if Hostparm.OpenVMS then
- B_Start (B_Start'Last) := '$';
+ if OpenVMS_On_Target then
+ B_Start := new String'("b__");
end if;
Add_Argument
- (B_Start & Get_Name_String (Data.Library_Name) & ".adb");
+ (B_Start.all & Get_Name_String (Data.Library_Name) & ".adb");
-- If necessary, add the PIC option
-- Add the objects found in the object directory and the object
-- directories of the extended files, if any, except for generated
- -- object files (b~.. or B$..) from extended projects.
+ -- object files (b~.. or B__..) from extended projects.
-- When there are one or more extended files, only add an object file
-- if no object file with the same name have already been added.
if In_Main_Object_Directory
or else Last < 5
- or else Filename (1 .. B_Start'Length) /= B_Start
+ or else Filename (1 .. B_Start'Length) /= B_Start.all
then
Name_Len := Last;
Name_Buffer (1 .. Name_Len) := Filename (1 .. Last);
-- Rpath.
if Path_Option /= null then
- Add_Rpath (Lib_Directory);
+ declare
+ Libdir : constant String := Lib_Directory;
+ GCC_Index : Natural := 0;
+
+ begin
+ Add_Rpath (Libdir);
+
+ -- For shared libraries, add to the Path Option the directory
+ -- of the shared version of libgcc.
+
+ if The_Build_Mode /= Static then
+ GCC_Index := Index (Libdir, "/lib/");
+
+ if GCC_Index = 0 then
+ GCC_Index :=
+ Index
+ (Libdir,
+ Directory_Separator & "lib" & Directory_Separator);
+ end if;
+
+ if GCC_Index /= 0 then
+ Add_Rpath (Libdir (Libdir'First .. GCC_Index + 3));
+ end if;
+ end if;
+ end;
end if;
if Libgnarl_Needed then
if Libdecgnat_Needed then
Opts.Increment_Last;
+
Opts.Table (Opts.Last) :=
new String'("-L" & Lib_Directory & "/../declib");
+
Opts.Increment_Last;
- Opts.Table (Opts.Last) := new String'("-ldecgnat");
+
+ if The_Build_Mode = Static then
+ Opts.Table (Opts.Last) := new String'("-ldecgnat");
+ else
+ Opts.Table (Opts.Last) := new String'(Shared_Lib ("decgnat"));
+ end if;
end if;
Opts.Increment_Last;
declare
DLL_Name : aliased String :=
- Lib_Dirpath.all & "/lib" &
+ Lib_Dirpath.all & '/' & DLL_Prefix &
Lib_Filename.all & "." & DLL_Ext;
Archive_Name : aliased String :=
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, ".");
- Copy_Dir :=
- In_Tree.Projects.Table (For_Project).Library_Dir;
- Clean (Copy_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;
+
+ Close (Dir);
+
+ Change_Dir (Current_Dir);
+ end;
-- Call procedure to build the library, depending on the build mode
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.
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
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 := False;
+ 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;
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 OpenVMS_On_Target then
+ B_Start := new String'("b__");
end if;
- end loop;
-
- Change_Dir (Current);
- end;
- end if;
- end Check_Library;
- -----------
- -- Clean --
- -----------
+ -- If the library file does not exist, then the time stamp will
+ -- be Empty_Time_Stamp, earlier than any other time stamp.
- procedure Clean (Directory : Name_Id) is
- Current : constant Dir_Name_Str := Get_Current_Dir;
+ Change_Dir (Get_Name_String (Data.Object_Directory));
+ Open (Dir => Object_Dir, Dir_Name => ".");
- Dir : Dir_Type;
+ -- For all entries in the object directory
- Name : String (1 .. 200);
- Last : Natural;
+ loop
+ Read (Object_Dir, Name_Buffer, Name_Len);
+ exit when Name_Len = 0;
- Disregard : Boolean;
+ -- Check if it is an object file, but ignore any binder
+ -- generated file.
- begin
- Get_Name_String (Directory);
-
- -- 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.all
+ 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 --
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.
function Is_Same_Or_Extension
(Extending : Project_Id;
- Extended : Project_Id)
- return Boolean
+ Extended : Project_Id) return Boolean
is
Ext : Project_Id := Extending;
end if;
end Display;
+ -----------
+ -- Index --
+ -----------
+
+ function Index (S, Pattern : String) return Natural is
+ Len : constant Natural := Pattern'Length;
+
+ begin
+ for J in reverse S'First .. S'Last - Len + 1 loop
+ if Pattern = S (J .. J + Len - 1) then
+ return J;
+ end if;
+ end loop;
+
+ return 0;
+ end Index;
+
-------------------------
-- Process_Binder_File --
-------------------------
Next_Line (1 .. Nlast) /= "-lgnarl" and then
Next_Line (1 .. Nlast) /= "-lgnat" and then
Next_Line
+ (1 .. Natural'Min (Nlast, 10 + Library_Version'Length)) /=
+ Shared_Lib ("decgnat") and then
+ Next_Line
(1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) /=
Shared_Lib ("gnarl") and then
Next_Line
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;
OSDN Git Service
