-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2007, AdaCore --
+-- Copyright (C) 1999-2009, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Interfaces.C.Strings;
+with System;
with Hostparm;
with Opt;
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...");
Write_Line (Output_File);
end if;
- Ar (Output_Dir & Directory_Separator &
+ Ar (Output_Dir &
"lib" & Output_File & ".a", Objects => Ofiles);
end Build_Library;
end if;
if Name'Length > Max_Characters_In_Library_Name then
- Prj.Com.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
- Prj.Com.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
- Prj.Com.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;
end if;
end Verbose_Copy;
+ -- Start of processing for Copy_ALI_Files
+
begin
if Interfaces'Length = 0 then
declare
File_Name : String := Base_Name (Files (Index).all);
+
begin
Canonical_Case_File_Name (File_Name);
if FD /= Invalid_FD then
Len := Integer (File_Length (FD));
+ -- ??? Why "+3" here
+
S := new String (1 .. Len + 3);
-- Read the file. Note that the loop is not necessary
-- since the whole file is read at once except on VMS.
- Curr := 1;
- Actual_Len := Len;
-
- while Actual_Len /= 0 loop
+ Curr := S'First;
+ while Curr <= Len loop
Actual_Len := Read (FD, S (Curr)'Address, Len);
+
+ -- Exit if we could not read for some reason
+
+ exit when Actual_Len = 0;
+
Curr := Curr + Actual_Len;
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;
-- at the beginning of the P line.
for Index in 1 .. Len - 3 loop
- if (S (Index) = ASCII.LF or else
- S (Index) = ASCII.CR)
- and then
- S (Index + 1) = 'P'
+ if (S (Index) = ASCII.LF
+ or else
+ S (Index) = ASCII.CR)
+ and then S (Index + 1) = 'P'
then
S (Index + 5 .. Len + 3) := S (Index + 2 .. Len);
S (Index + 2 .. Index + 4) := " SL";
-- Set Success to True only if the newly
-- created file has been correctly written.
- Success := Status and Actual_Len = Len + 3;
+ Success := Status and then Actual_Len = Len + 3;
if Success then
- Set_Read_Only (
- Name_Buffer (1 .. Name_Len - 1));
+
+ -- Set_Read_Only is used here, rather than
+ -- Set_Non_Writable, so that gprbuild can
+ -- he compiled with older compilers.
+
+ Set_Read_Only
+ (Name_Buffer (1 .. Name_Len - 1));
end if;
end if;
end if;
end if;
end;
- else
- -- This is not an interface ALI
+ -- This is not an interface ALI
+ else
Success := True;
-
end if;
end;
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");
+
+ Version_Path : String_Access;
+
+ Success : Boolean;
+ Result : Integer;
+ pragma Unreferenced (Success, Result);
+
+ begin
+ Version_Path := new String (1 .. Lib_Version'Length + 1);
+ Version_Path (1 .. Lib_Version'Length) := Lib_Version;
+ 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);
+ Maj_Ver : String (1 .. Maj_Version'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;
+
+ Maj_Ver (1 .. Maj_Version'Length) := Maj_Version;
+ Maj_Ver (Maj_Ver'Last) := ASCII.NUL;
+
+ Delete_File (Maj_Path, Success);
+
+ Result := Symlink (Version_Path (1)'Address, Newpath2'Address);
+
+ Delete_File (Lib_Path, Success);
+
+ Result := Symlink (Maj_Ver'Address, Newpath1'Address);
+ end;
+ end if;
+ end Create_Sym_Links;
+
--------------------------------
-- Linker_Library_Path_Option --
--------------------------------
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;
+
+ -------------------------------
+ -- Separate_Run_Path_Options --
+ -------------------------------
+
+ function Separate_Run_Path_Options return Boolean is
+ Separate_Paths : Boolean;
+ for Separate_Paths'Size use Character'Size;
+ pragma Import (C, Separate_Paths, "__gnat_separate_run_path_options");
+ begin
+ return Separate_Paths;
+ end Separate_Run_Path_Options;
+
-- Package elaboration
begin
OSDN Git Service
