-- --
-- B o d y --
-- --
--- $Revision$
--- --
--- Copyright (C) 1999-2001, Ada Core Technologies, Inc. --
+-- Copyright (C) 1999-2004, Ada Core Technologies, 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- --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Characters.Handling; use Ada.Characters.Handling;
+with Interfaces.C.Strings;
+
+with Hostparm;
with Opt;
-with Osint; use Osint;
-with Output; use Output;
-with MLib.Utl;
+with Output; use Output;
+with Namet; use Namet;
-package body MLib is
+with MLib.Utl; use MLib.Utl;
- package Tools renames MLib.Utl;
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+
+with System;
+
+package body MLib is
-------------------
-- Build_Library --
Write_Line (Output_File);
end if;
- Tools.Ar (Output_Dir & "/lib" & Output_File & ".a", Objects => Ofiles);
-
+ Ar (Output_Dir & "/lib" & Output_File & ".a", Objects => Ofiles);
end Build_Library;
------------------------
end if;
if Name'Length > Max_Characters_In_Library_Name then
- Fail ("illegal library name """,
- Name,
- """: too long");
+ Fail ("illegal library name """, Name, """: too long");
end if;
if not Is_Letter (Name (Name'First)) then
end loop;
end Check_Library_Name;
+ --------------------
+ -- Copy_ALI_Files --
+ --------------------
+
+ procedure Copy_ALI_Files
+ (Files : Argument_List;
+ To : Name_Id;
+ Interfaces : String_List)
+ is
+ Success : Boolean := False;
+ To_Dir : constant String := Get_Name_String (To);
+ Interface : Boolean := False;
+
+ procedure Set_Readonly (Name : System.Address);
+ pragma Import (C, Set_Readonly, "__gnat_set_readonly");
+
+ procedure Verbose_Copy (Index : Positive);
+ -- In verbose mode, output a message that the indexed file is copied
+ -- to the destination directory.
+
+ ------------------
+ -- Verbose_Copy --
+ ------------------
+
+ procedure Verbose_Copy (Index : Positive) is
+ begin
+ if Opt.Verbose_Mode then
+ Write_Str ("Copying """);
+ Write_Str (Files (Index).all);
+ Write_Str (""" to """);
+ Write_Str (To_Dir);
+ Write_Line ("""");
+ end if;
+ end Verbose_Copy;
+
+ begin
+ if Interfaces'Length = 0 then
+
+ -- If there are no Interfaces, copy all the ALI files as is
+
+ for Index in Files'Range loop
+ Verbose_Copy (Index);
+ Copy_File
+ (Files (Index).all,
+ To_Dir,
+ Success,
+ Mode => Overwrite,
+ Preserve => Preserve);
+
+ exit when not Success;
+ end loop;
+
+ else
+ -- Copy only the interface ALI file, and put the special indicator
+ -- "SL" on the P line.
+
+ for Index in Files'Range loop
+
+ declare
+ File_Name : String := Base_Name (Files (Index).all);
+ begin
+ Canonical_Case_File_Name (File_Name);
+
+ -- Check if this is one of the interface ALIs
+
+ Interface := False;
+
+ for Index in Interfaces'Range loop
+ if File_Name = Interfaces (Index).all then
+ Interface := True;
+ exit;
+ end if;
+ end loop;
+
+ -- If it is an interface ALI, copy line by line. Insert
+ -- the interface indication at the end of the P line.
+ -- Do not copy ALI files that are not Interfaces.
+
+ if Interface then
+ Success := False;
+ Verbose_Copy (Index);
+
+ declare
+ FD : File_Descriptor;
+ Len : Integer;
+ Actual_Len : Integer;
+ S : String_Access;
+ Curr : Natural;
+ P_Line_Found : Boolean;
+ Status : Boolean;
+
+ begin
+ -- Open the file
+
+ Name_Len := Files (Index)'Length;
+ Name_Buffer (1 .. Name_Len) := Files (Index).all;
+ Name_Len := Name_Len + 1;
+ Name_Buffer (Name_Len) := ASCII.NUL;
+
+ FD := Open_Read (Name_Buffer'Address, Binary);
+
+ if FD /= Invalid_FD then
+ Len := Integer (File_Length (FD));
+
+ 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
+ Actual_Len := Read (FD, S (Curr)'Address, Len);
+ Curr := Curr + Actual_Len;
+ end loop;
+
+ -- We are done with the input file, so we close it
+
+ Close (FD, Status);
+ -- We simply ignore any bad status
+
+ P_Line_Found := False;
+
+ -- Look for the P line. When found, add marker SL
+ -- 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'
+ then
+ S (Index + 5 .. Len + 3) := S (Index + 2 .. Len);
+ S (Index + 2 .. Index + 4) := " SL";
+ P_Line_Found := True;
+ exit;
+ end if;
+ end loop;
+
+ if P_Line_Found then
+
+ -- Create new modified ALI file
+
+ Name_Len := To_Dir'Length;
+ Name_Buffer (1 .. Name_Len) := To_Dir;
+ Name_Len := Name_Len + 1;
+ Name_Buffer (Name_Len) := Directory_Separator;
+ Name_Buffer
+ (Name_Len + 1 .. Name_Len + File_Name'Length) :=
+ File_Name;
+ Name_Len := Name_Len + File_Name'Length + 1;
+ Name_Buffer (Name_Len) := ASCII.NUL;
+
+ FD := Create_File (Name_Buffer'Address, Binary);
+
+ -- Write the modified text and close the newly
+ -- created file.
+
+ if FD /= Invalid_FD then
+ Actual_Len := Write (FD, S (1)'Address, Len + 3);
+
+ Close (FD, Status);
+
+ -- Set Success to True only if the newly
+ -- created file has been correctly written.
+
+ Success := Status and Actual_Len = Len + 3;
+
+ if Success then
+ Set_Readonly (Name_Buffer'Address);
+ end if;
+ end if;
+ end if;
+ end if;
+ end;
+
+ else
+ -- This is not an interface ALI
+
+ Success := True;
+
+ end if;
+ end;
+
+ if not Success then
+ Fail ("could not copy ALI files to library dir");
+ end if;
+ end loop;
+ end if;
+ end Copy_ALI_Files;
+
+ --------------------------------
+ -- Linker_Library_Path_Option --
+ --------------------------------
+
+ function Linker_Library_Path_Option return String_Access is
+
+ Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option");
+ -- Pointer to string representing the native linker option which
+ -- specifies the path where the dynamic loader should find shared
+ -- libraries. Equal to null string if this system doesn't support it.
+
+ S : constant String := Interfaces.C.Strings.Value (Run_Path_Option_Ptr);
+
+ begin
+ if S'Length = 0 then
+ return null;
+ else
+ return new String'(S);
+ end if;
+ end Linker_Library_Path_Option;
+
+-- Package elaboration
+
+begin
+ -- Copy_Attributes always fails on VMS
+
+ if Hostparm.OpenVMS then
+ Preserve := None;
+ end if;
end MLib;
OSDN Git Service
