diff options
author | Vincent Celier <celier@adacore.com> | 2007-08-14 10:43:34 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2007-08-14 10:43:34 +0200 |
commit | 2cd44f5a448ad1e160edae120cc7b945ca1a5db3 (patch) | |
tree | 5875d0102588a0bdaf32f61cb26f856f87ff7ec6 /gcc/ada/mlib.adb | |
parent | c9b9ec14ece5acf23bf0817633914e28c43c0678 (diff) | |
download | gcc-2cd44f5a448ad1e160edae120cc7b945ca1a5db3.zip gcc-2cd44f5a448ad1e160edae120cc7b945ca1a5db3.tar.gz gcc-2cd44f5a448ad1e160edae120cc7b945ca1a5db3.tar.bz2 |
clean.adb, [...] (Create_Sym_Links): New procedure.
2007-08-14 Vincent Celier <celier@adacore.com>
* clean.adb, fmap.adb, sinput-p.adb, sinput-p.ads, gnatcmd.adb,
gnatname.adb, makeutl.ads, makeutl.adb, makegpr.adb, mlib-tgt-vms.adb
mlib-tgt-darwin.adb, mlib-tgt-lynxos.adb, mlib-prj.adb, mlib-tgt.adb,
mlib-tgt.ads, mlib-tgt-irix.adb mlib-tgt-hpux.adb, mlib-tgt-linux.adb,
mlib-tgt-solaris.adb, mlib-tgt-vms-alpha.adb, mlib-tgt-vms-ia64.adb,
mlib-tgt-mingw.adb, mlib-tgt-vxworks.adb, mlib-tgt-aix.adb,
mlib-tgt-tru64.adb, mlib.ads, mlib.adb (Create_Sym_Links): New
procedure.
(Major_Id_Name): New function.
mlib-tgt.ads/mlib.tgt.adb:
(Library_Major_Minor_Id_Supported): New function, default returns True
Most mlib-tgt-*.adb that support shared libraries and symbolic links:
(Build_Dynamic_Library): Add support for major/minor ids for shared libs
Other mlib-tgt-*.adb (aix, mingw, vms, vxworks, xi):
Implementation of Library_Major_Minor_Id_Supported returns False
clean.adb:
(Clean_Library_Directory): If major/minor ids are supported, clean all
library files.
Major update of the Project Manager and of the project aware tools,
including gprmake, so that the same sources in the GNAT repository
can be used by gprbuild.
From-SVN: r127432
Diffstat (limited to 'gcc/ada/mlib.adb')
-rw-r--r-- | gcc/ada/mlib.adb | 144 |
1 files changed, 137 insertions, 7 deletions
diff --git a/gcc/ada/mlib.adb b/gcc/ada/mlib.adb index d2aeaab..3d261b7 100644 --- a/gcc/ada/mlib.adb +++ b/gcc/ada/mlib.adb @@ -26,6 +26,7 @@ with Ada.Characters.Handling; use Ada.Characters.Handling; with Interfaces.C.Strings; +with System; with Hostparm; with Opt; @@ -45,12 +46,9 @@ package body MLib is procedure Build_Library (Ofiles : Argument_List; - Afiles : Argument_List; Output_File : String; Output_Dir : String) is - pragma Warnings (Off, Afiles); - begin if Opt.Verbose_Mode and not Opt.Quiet_Output then Write_Line ("building a library..."); @@ -123,6 +121,8 @@ package body MLib is end if; end Verbose_Copy; + -- Start of processing for Copy_ALI_Files + begin if Interfaces'Length = 0 then @@ -152,6 +152,7 @@ package body MLib is declare File_Name : String := Base_Name (Files (Index).all); + begin Canonical_Case_File_Name (File_Name); @@ -214,9 +215,9 @@ package body MLib is end loop; -- We are done with the input file, so we close it + -- ignoring any bad status. Close (FD, Status); - -- We simply ignore any bad status P_Line_Found := False; @@ -274,11 +275,10 @@ package body MLib is end if; end; - else - -- This is not an interface ALI + -- This is not an interface ALI + else Success := True; - end if; end; @@ -289,6 +289,76 @@ package body MLib is end if; end Copy_ALI_Files; + ---------------------- + -- Create_Sym_Links -- + ---------------------- + + procedure Create_Sym_Links + (Lib_Path : String; + Lib_Version : String; + Lib_Dir : String; + Maj_Version : String) + is + function Symlink + (Oldpath : System.Address; + Newpath : System.Address) return Integer; + pragma Import (C, Symlink, "__gnat_symlink"); + + Success : Boolean; + Version_Path : String_Access; + + Result : Integer; + pragma Unreferenced (Result); + + begin + if Is_Absolute_Path (Lib_Version) then + Version_Path := new String (1 .. Lib_Version'Length + 1); + Version_Path (1 .. Lib_Version'Length) := Lib_Version; + + else + Version_Path := + new String (1 .. Lib_Dir'Length + 1 + Lib_Version'Length + 1); + Version_Path (1 .. Version_Path'Last - 1) := + Lib_Dir & Directory_Separator & Lib_Version; + end if; + + Version_Path (Version_Path'Last) := ASCII.NUL; + + if Maj_Version'Length = 0 then + declare + Newpath : String (1 .. Lib_Path'Length + 1); + begin + Newpath (1 .. Lib_Path'Length) := Lib_Path; + Newpath (Newpath'Last) := ASCII.NUL; + Delete_File (Lib_Path, Success); + Result := Symlink (Version_Path (1)'Address, Newpath'Address); + end; + + else + declare + Newpath1 : String (1 .. Lib_Path'Length + 1); + Maj_Path : constant String := + Lib_Dir & Directory_Separator & Maj_Version; + Newpath2 : String (1 .. Maj_Path'Length + 1); + + begin + Newpath1 (1 .. Lib_Path'Length) := Lib_Path; + Newpath1 (Newpath1'Last) := ASCII.NUL; + + Newpath2 (1 .. Maj_Path'Length) := Maj_Path; + Newpath2 (Newpath2'Last) := ASCII.NUL; + + Delete_File (Maj_Path, Success); + + Result := Symlink (Version_Path (1)'Address, Newpath2'Address); + + Delete_File (Lib_Path, Success); + + Result := Symlink (Newpath2'Address, Newpath1'Address); + end; + end if; + end Create_Sym_Links; + -------------------------------- -- Linker_Library_Path_Option -- -------------------------------- @@ -311,6 +381,66 @@ package body MLib is end if; end Linker_Library_Path_Option; + ------------------- + -- Major_Id_Name -- + ------------------- + + function Major_Id_Name + (Lib_Filename : String; + Lib_Version : String) + return String + is + Maj_Version : constant String := Lib_Version; + Last_Maj : Positive; + Last : Positive; + Ok_Maj : Boolean := False; + + begin + Last_Maj := Maj_Version'Last; + while Last_Maj > Maj_Version'First loop + if Maj_Version (Last_Maj) in '0' .. '9' then + Last_Maj := Last_Maj - 1; + + else + Ok_Maj := Last_Maj /= Maj_Version'Last and then + Maj_Version (Last_Maj) = '.'; + + if Ok_Maj then + Last_Maj := Last_Maj - 1; + end if; + + exit; + end if; + end loop; + + if Ok_Maj then + Last := Last_Maj; + while Last > Maj_Version'First loop + if Maj_Version (Last) in '0' .. '9' then + Last := Last - 1; + + else + Ok_Maj := Last /= Last_Maj and then + Maj_Version (Last) = '.'; + + if Ok_Maj then + Last := Last - 1; + Ok_Maj := + Maj_Version (Maj_Version'First .. Last) = Lib_Filename; + end if; + + exit; + end if; + end loop; + end if; + + if Ok_Maj then + return Maj_Version (Maj_Version'First .. Last_Maj); + else + return ""; + end if; + end Major_Id_Name; + -- Package elaboration begin |