-----------------------------
procedure Add_Source_Dir (N : String);
- -- Call Add_Src_Search_Dir.
- -- Output one line when in verbose mode.
+ -- Call Add_Src_Search_Dir and output one line when in verbose mode
procedure Add_Source_Directories is
new Prj.Env.For_All_Source_Dirs (Action => Add_Source_Dir);
procedure Add_Object_Dir (N : String);
- -- Call Add_Lib_Search_Dir.
- -- Output one line when in verbose mode.
+ -- Call Add_Lib_Search_Dir and output one line when in verbose mode
procedure Add_Object_Directories is
new Prj.Env.For_All_Object_Dirs (Action => Add_Object_Dir);
function Assembly_File_Name (Source : File_Name_Type) return String;
-- Returns the assembly file name corresponding to Source
- procedure Clean_Archive (Project : Project_Id);
- -- Delete a global archive or a fake library project archive and the
- -- dependency file, if they exist.
+ procedure Clean_Archive (Project : Project_Id; Global : Boolean);
+ -- Delete a global archive or library project archive and the dependency
+ -- file, if they exist.
procedure Clean_Executables;
-- Do the cleaning work when no project file is specified
-- 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.
+ -- 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
- -- project files in the tree rooted at the main project file and switch -r
- -- has been specified.
+ -- Do the cleaning work when a project file is specified. This procedure
+ -- calls itself recursively when there are several project files in the
+ -- tree rooted at the main project file and switch -r has been specified.
function Debug_File_Name (Source : File_Name_Type) return String;
-- Name of the expanded source file corresponding to Source
-- 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.
+ -- Display the usage. If called several times, the usage is displayed only
+ -- the first time.
--------------------
-- Add_Object_Dir --
-- Clean_Archive --
-------------------
- procedure Clean_Archive (Project : Project_Id) is
- Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
- Data : constant Project_Data :=
- Project_Tree.Projects.Table (Project);
- Lib_Prefix : constant String :=
- "lib" & Get_Name_String (Data.Display_Name);
+ procedure Clean_Archive (Project : Project_Id; Global : Boolean) is
+ Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
+
+ Data : constant Project_Data := Project_Tree.Projects.Table (Project);
- Archive_Name : constant String :=
- Lib_Prefix & '.' & Archive_Ext;
+ Lib_Prefix : String_Access;
+ Archive_Name : String_Access;
-- The name of the archive file for this project
- Archive_Dep_Name : constant String :=
- Lib_Prefix & ".deps";
+ Archive_Dep_Name : String_Access;
-- The name of the archive dependency file for this project
Obj_Dir : constant String :=
begin
Change_Dir (Obj_Dir);
- if Is_Regular_File (Archive_Name) then
- Delete (Obj_Dir, Archive_Name);
+ -- First, get the lib prefix, the archive file name and the archive
+ -- dependency file name.
+
+ if Global then
+ Lib_Prefix :=
+ new String'("lib" & Get_Name_String (Data.Display_Name));
+ else
+ Lib_Prefix :=
+ new String'("lib" & Get_Name_String (Data.Library_Name));
end if;
- if Is_Regular_File (Archive_Dep_Name) then
- Delete (Obj_Dir, Archive_Dep_Name);
+ Archive_Name := new String'(Lib_Prefix.all & '.' & Archive_Ext);
+ Archive_Dep_Name := new String'(Lib_Prefix.all & ".deps");
+
+ -- Delete the archive file and the archive dependency file, if they
+ -- exist.
+
+ if Is_Regular_File (Archive_Name.all) then
+ Delete (Obj_Dir, Archive_Name.all);
+ end if;
+
+ if Is_Regular_File (Archive_Dep_Name.all) then
+ Delete (Obj_Dir, Archive_Dep_Name.all);
end if;
Change_Dir (Current_Dir);
-- Clean_Library_Directory --
-----------------------------
+ Empty_String : aliased String := "";
+
procedure Clean_Library_Directory (Project : Project_Id) is
Current : constant String := Get_Current_Dir;
Data : constant Project_Data := Project_Tree.Projects.Table (Project);
Delete_File : Boolean;
+ Minor : String_Access := Empty_String'Unchecked_Access;
+ Major : String_Access := Empty_String'Unchecked_Access;
+
begin
if Data.Library then
+ if Data.Library_Kind /= Static
+ and then MLib.Tgt.Library_Major_Minor_Id_Supported
+ and then Data.Lib_Internal_Name /= No_Name
+ then
+ Minor := new String'(Get_Name_String (Data.Lib_Internal_Name));
+ Major := new String'(MLib.Major_Id_Name (DLL_Name, Minor.all));
+ end if;
+
declare
Lib_Directory : constant String :=
Get_Name_String (Data.Display_Library_Dir);
declare
Filename : constant String := Name (1 .. Last);
begin
- if Is_Regular_File (Filename) then
+ if Is_Regular_File (Filename)
+ or else Is_Symbolic_Link (Filename)
+ then
Canonical_Case_File_Name (Name (1 .. Last));
Delete_File := False;
or else
((Data.Library_Kind = Dynamic or else
Data.Library_Kind = Relocatable)
- and then Name (1 .. Last) = DLL_Name)
+ and then
+ (Name (1 .. Last) = DLL_Name
+ or else Name (1 .. Last) = Minor.all
+ or else Name (1 .. Last) = Major.all))
then
if not Do_Nothing then
Set_Writable (Filename);
end if;
Delete (Lib_Directory, Filename);
- exit;
end if;
end if;
end;
-- Source_Dirs or Source_Files is specified as an empty list,
-- so always look for Ada units in extending projects.
- if Data.Languages (Ada_Language_Index)
+ if Data.Langs (Ada_Language_Index)
or else Data.Extends /= No_Project
then
for Unit in Unit_Table.First ..
end loop;
if Global_Archive then
- Clean_Archive (Project);
+ Clean_Archive (Project, Global => True);
end if;
end if;
-- the fake archive and the dependency file, if they exist.
if Data.Library
- and then not Data.Languages (Ada_Language_Index)
+ and then not Data.Langs (Ada_Language_Index)
then
- Clean_Archive (Project);
+ Clean_Archive (Project, Global => False);
end if;
end if;
end;
then
Delete_Binder_Generated_Files
(Get_Name_String (Data.Display_Object_Dir),
- Data.Library_Name);
+ File_Name_Type (Data.Library_Name));
end if;
end if;
else
if Force_Deletions
or else Is_Writable_File (Full_Name (1 .. Last))
+ or else Is_Symbolic_Link (Full_Name (1 .. Last))
then
Delete_File (Full_Name (1 .. Last), Success);
else
File_Name : File_Name_Type;
Path_Name : File_Name_Type)
is
+ Unit_Entry : constant Int := Unit_Hash_Table.Get (Unit_Name);
+ File_Entry : constant Int := File_Hash_Table.Get (File_Name);
begin
- File_Mapping.Increment_Last;
- Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last);
- File_Mapping.Table (File_Mapping.Last) :=
- (Uname => Unit_Name, Fname => File_Name);
- Path_Mapping.Increment_Last;
- File_Hash_Table.Set (File_Name, Path_Mapping.Last);
- Path_Mapping.Table (Path_Mapping.Last) :=
- (Uname => Unit_Name, Fname => Path_Name);
+ if Unit_Entry = No_Entry or else
+ File_Mapping.Table (Unit_Entry).Fname /= File_Name
+ then
+ File_Mapping.Increment_Last;
+ Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last);
+ File_Mapping.Table (File_Mapping.Last) :=
+ (Uname => Unit_Name, Fname => File_Name);
+ end if;
+
+ if File_Entry = No_Entry or else
+ Path_Mapping.Table (File_Entry).Fname /= Path_Name
+ then
+ Path_Mapping.Increment_Last;
+ File_Hash_Table.Set (File_Name, Path_Mapping.Last);
+ Path_Mapping.Table (Path_Mapping.Last) :=
+ (Uname => Unit_Name, Fname => Path_Name);
+ end if;
end Add_To_File_Map;
----------
Name_Buffer (1 .. Name_Len) := SP (First .. Last);
Pname := Find_File_Name;
- -- Check for duplicate entries
-
- if Unit_Hash_Table.Get (Uname) /= No_Entry then
- Empty_Tables;
- return;
- end if;
-
- if File_Hash_Table.Get (Fname) /= No_Entry then
- Empty_Tables;
- return;
- end if;
-
-- Add the mappings for this unit name
Add_To_File_Map (Uname, Fname, Pname);
File : File_Descriptor;
N_Bytes : Integer;
+ File_Entry : Int;
+
Status : Boolean;
-- For the call to Close
for Unit in Last_In_Table + 1 .. File_Mapping.Last loop
Put_Line (Name_Id (File_Mapping.Table (Unit).Uname));
Put_Line (Name_Id (File_Mapping.Table (Unit).Fname));
- Put_Line (Name_Id (Path_Mapping.Table (Unit).Fname));
+ File_Entry :=
+ File_Hash_Table.Get (File_Mapping.Table (Unit).Fname);
+ Put_Line (Name_Id (Path_Mapping.Table (File_Entry).Fname));
end loop;
- -- Before closing the file, write the buffer to the file.
- -- It is guaranteed that the Buffer is not empty, because
- -- Put_Line has been called at least 3 times, and after
- -- a call to Put_Line, the Buffer is not empty.
+ -- Before closing the file, write the buffer to the file. It is
+ -- guaranteed that the Buffer is not empty, because Put_Line has
+ -- been called at least 3 times, and after a call to Put_Line, the
+ -- Buffer is not empty.
N_Bytes := Write (File, Buffer (1)'Address, Buffer_Last);
-- Prefix of binder generated file, changed to b__ for VMS
Old_Project_File_Used : Boolean := False;
- -- This flag indicates a switch -p (for gnatxref and gnatfind) for an old
- -- fashioned project file. -p cannot be used in conjonction with -P.
+ -- This flag indicates a switch -p (for gnatxref and gnatfind) for
+ -- an old fashioned project file. -p cannot be used in conjonction
+ -- with -P.
Max_Files_On_The_Command_Line : constant := 30; -- Arbitrary
Temp_File_Name : String_Access := null;
-- The name of the temporary text file to put a list of source/object
- -- files to pass to a tool, when the number of files exceeds the value of
- -- Max_Files_On_The_Command_Line.
+ -- files to pass to a tool, when there are more than
+ -- Max_Files_On_The_Command_Line files.
ASIS_Main : String_Access := null;
-- Main for commands Check, Metric and Pretty, when -U is used
-- exec directory. This procedure is only used for GNAT LINK when a project
-- file is specified.
- function Configuration_Pragmas_File return Name_Id;
+ function Configuration_Pragmas_File return Path_Name_Type;
-- Return an argument, if there is a configuration pragmas file to be
-- specified for Project, otherwise return No_Name. Used for gnatstub (GNAT
-- STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric (GNAT
-- There is a body, check if it is for this project
if All_Projects or else
- Unit_Data.File_Names (Body_Part).Project = Project
+ Unit_Data.File_Names (Body_Part).Project = Project
then
Subunit := False;
- if Unit_Data.File_Names (Specification).Name =
- No_File
+ if
+ Unit_Data.File_Names (Specification).Name = No_File
then
-- We have a body with no spec: we need to check if
-- this is a subunit, because gnatls will complain
-- Configuration_Pragmas_File --
--------------------------------
- function Configuration_Pragmas_File return Name_Id is
+ function Configuration_Pragmas_File return Path_Name_Type is
begin
Prj.Env.Create_Config_Pragmas_File
(Project, Project, Project_Tree, Include_Config_Files => False);
- return Name_Id (Project_Tree.Projects.Table (Project).Config_File_Name);
+ return Project_Tree.Projects.Table (Project).Config_File_Name;
end Configuration_Pragmas_File;
------------------------------
Last : Natural;
Udata : Unit_Data;
- Path : File_Name_Type;
+ Path : Path_Name_Type;
begin
if GN_Path = null then
while not End_Of_File (File) loop
Get_Line (File, Line, Last);
- Path := No_File;
+ Path := No_Path;
for Unit in Unit_Table.First ..
Unit_Table.Last (Project_Tree.Units)
Last_Switches.Increment_Last;
- if Path /= No_File then
+ if Path /= No_Path then
Last_Switches.Table (Last_Switches.Last) :=
new String'(Get_Name_String (Path));
-- Check if there are library project files
- if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
+ if MLib.Tgt.Support_For_Libraries /= None then
Set_Libraries (Project, Project_Tree, There_Are_Libraries);
end if;
VMS_Conv.Initialize;
+ Set_Mode (Ada_Only);
+
-- Add the directory where the GNAT driver is invoked in front of the path,
-- if the GNAT driver is invoked with directory information. Do not do this
-- for VMS, where the notion of path does not really exist.
end loop;
declare
- CP_File : constant Name_Id := Configuration_Pragmas_File;
+ CP_File : constant Path_Name_Type := Configuration_Pragmas_File;
begin
- if CP_File /= No_Name then
+ if CP_File /= No_Path then
if The_Command = Elim then
First_Switches.Increment_Last;
First_Switches.Table (First_Switches.Last) :=
-- indicate to gnatstub the name of the body file with
-- a -o switch.
- if Data.Naming.Ada_Spec_Suffix /=
- Prj.Default_Ada_Spec_Suffix
+ if Body_Suffix_Id_Of (Project_Tree, "ada", Data.Naming) /=
+ Prj.Default_Ada_Spec_Suffix
then
if File_Index /= 0 then
declare
Last : Natural := Spec'Last;
begin
- Get_Name_String (Data.Naming.Ada_Spec_Suffix);
+ Get_Name_String
+ (Spec_Suffix_Id_Of
+ (Project_Tree, "ada", Data.Naming));
if Spec'Length > Name_Len
and then Spec (Last - Name_Len + 1 .. Last) =
Name_Buffer (1 .. Name_Len)
then
Last := Last - Name_Len;
- Get_Name_String (Data.Naming.Ada_Body_Suffix);
+ Get_Name_String
+ (Body_Suffix_Id_Of
+ (Project_Tree, "ada", Data.Naming));
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'("-o");
if ASIS_Main /= null then
Get_Closure;
+ -- On VMS, set up again the env var for source dirs file. This is
+ -- because the call to gnatmake has set this env var to another
+ -- file that has now been deleted.
+
+ if Hostparm.OpenVMS then
+ Setenv
+ (Project_Include_Path_File,
+ Prj.Env.Ada_Include_Path
+ (Project, Project_Tree, Recursive => True));
+ end if;
+
-- For gnat check, gnat pretty, gnat metric, gnat list, and gnat
-- stack, if no file has been put on the command line, call tool
-- with all the sources of the main project.
exception
when Error_Exit =>
- Prj.Env.Delete_All_Path_Files (Project_Tree);
- Delete_Temp_Config_Files;
+ if not Keep_Temporary_Files then
+ Prj.Env.Delete_All_Path_Files (Project_Tree);
+ Delete_Temp_Config_Files;
+ end if;
+
Set_Exit_Status (Failure);
when Normal_Exit =>
- Prj.Env.Delete_All_Path_Files (Project_Tree);
- Delete_Temp_Config_Files;
+ if not Keep_Temporary_Files then
+ Prj.Env.Delete_All_Path_Files (Project_Tree);
+ Delete_Temp_Config_Files;
+ end if;
-- Since GNATCmd is normally called from DCL (the VMS shell), it must
-- return an understandable VMS exit status. However the exit status
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2007, 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- --
-- Start of processing for Gnatname
begin
+ Prj.Set_Mode (Prj.Ada_Only);
+
-- Add the directory where gnatname is invoked in front of the
-- path, if gnatname is invoked with directory information.
-- Only do this if the platform is not VMS, where the notion of path
Source : Other_Source;
Archive_Name : constant String :=
- "lib" & Get_Name_String (Data.Display_Name)
+ "lib" & Get_Name_String (Data.Library_Name)
& '.' & Archive_Ext;
-- The name of the archive file for this project
Archive_Dep_Name : constant String :=
- "lib" & Get_Name_String (Data.Display_Name)
+ "lib" & Get_Name_String (Data.Library_Name)
& ".deps";
-- The name of the archive dependency file for this project
Lib_Opts : Argument_List_Access := No_Argument'Access;
begin
+ -- Nothing to do if the project is externally built
+
+ if Data.Externally_Built then
+ return;
+ end if;
+
Check_Archive_Builder;
-- If Unconditionally is False, check if the archive need to be built
-- If there are sources in Ada, then gnatmake will build the library,
-- so nothing to do.
- if not Data.Languages (Ada_Language_Index) then
+ if not Data.Langs (Ada_Language_Index) then
-- Get all the object files of the project
if Data.Library_Kind = Static then
MLib.Build_Library
(Ofiles => Arguments (1 .. Last_Argument),
- Afiles => No_Argument,
Output_File => Get_Name_String (Data.Library_Name),
Output_Dir => Get_Name_String (Data.Display_Library_Dir));
MLib.Tgt.Build_Dynamic_Library
(Ofiles => Arguments (1 .. Last_Argument),
- Foreign => Arguments (1 .. Last_Argument),
- Afiles => No_Argument,
- Options => No_Argument,
- Options_2 => Lib_Opts.all,
+ Options => Lib_Opts.all,
Interfaces => No_Argument,
Lib_Filename => Get_Name_String (Data.Library_Name),
Lib_Dir => Get_Name_String (Data.Library_Dir),
Source_Name : constant String := Get_Name_String (Source.File_Name);
Source_Path : constant String := Get_Name_String (Source.Path_Name);
Object_Name : constant String := Get_Name_String (Source.Object_Name);
+ C_Object_Name : String := Object_Name;
Dep_Name : constant String := Get_Name_String (Source.Dep_Name);
C_Source_Path : String := Source_Path;
begin
Canonical_Case_File_Name (C_Source_Path);
+ Canonical_Case_File_Name (C_Object_Name);
-- Assume the worst, so that statement "return;" may be used if there
-- is any problem.
Start := 1;
Finish := Index (Name_Buffer (1 .. Name_Len), ": ");
+ if Finish /= 0 then
+ Canonical_Case_File_Name (Name_Buffer (1 .. Finish - 1));
+ end if;
+
-- First line must start with name of object file, followed by colon
if Finish = 0 or else
- Name_Buffer (1 .. Finish - 1) /= Object_Name
+ Name_Buffer (1 .. Finish - 1) /= C_Object_Name
then
if Verbose_Mode then
Write_Str (" -> dependency file ");
Project_Table.Last (Project_Tree.Projects)
loop
if
- Project_Tree.Projects.Table (Project).Languages
+ Project_Tree.Projects.Table (Project).Langs
(C_Plus_Plus_Language_Index)
then
C_Plus_Plus_Is_Used := True;
Dummy : Boolean := False;
Ada_Is_A_Language : constant Boolean :=
- Data.Languages (Ada_Language_Index);
+ Data.Langs (Ada_Language_Index);
begin
Ada_Mains.Init;
if not Local_Errors
and then Data.Library
- and then not Data.Languages (Ada_Language_Index)
+ and then not Data.Langs (Ada_Language_Index)
and then not Compile_Only
then
Build_Library (Project, Need_To_Rebuild_Archive);
procedure Initialize is
begin
+ Set_Mode (Ada_Only);
+
-- Do some necessary package initializations
Csets.Initialize;
-- Only Ada sources in the main project, and even maybe not
- if not Data.Languages (Ada_Language_Index) then
+ if not Data.Langs (Ada_Language_Index) then
-- Fail if the main project has no source of any language
-- There are other language sources. First check if there are also
-- sources in Ada.
- if Data.Languages (Ada_Language_Index) then
+ if Data.Langs (Ada_Language_Index) then
-- There is a mix of Ada and other language sources in the main
-- project. Any main that is not a source of the other languages
-- If C++ is one of the languages, add the --LINK switch to
-- the linking switches.
- if Data.Languages (C_Plus_Plus_Language_Index) then
+ if Data.Langs (C_Plus_Plus_Language_Index) then
Add_Argument (Dash_largs, Verbose_Mode);
Add_C_Plus_Plus_Link_For_Gnatmake;
Add_Argument (Dash_margs, Verbose_Mode);
-- First, get the linker to invoke
- if Data.Languages (C_Plus_Plus_Language_Index) then
+ if Data.Langs (C_Plus_Plus_Language_Index) then
Get_Compiler (C_Plus_Plus_Language_Index);
Linker_Name := Compiler_Names (C_Plus_Plus_Language_Index);
Linker_Path := Compiler_Paths (C_Plus_Plus_Language_Index);
-- --
------------------------------------------------------------------------------
-with Ada.Command_Line; use Ada.Command_Line;
-
+with Ada.Command_Line; use Ada.Command_Line;
with Osint; use Osint;
+with Output; use Output;
with Prj.Ext;
with Prj.Util;
with Snames; use Snames;
procedure Add_Linker_Option (Option : String);
+ ---------
+ -- Add --
+ ---------
+
+ procedure Add
+ (Option : String_Access;
+ To : in out String_List_Access;
+ Last : in out Natural)
+ is
+ begin
+ if Last = To'Last then
+ declare
+ New_Options : constant String_List_Access :=
+ new String_List (1 .. To'Last * 2);
+ begin
+ New_Options (To'Range) := To.all;
+
+ -- Set all elements of the original options to null to avoid
+ -- deallocation of copies.
+
+ To.all := (others => null);
+
+ Free (To);
+ To := New_Options;
+ end;
+ end if;
+
+ Last := Last + 1;
+ To (Last) := Option;
+ end Add;
+
+ procedure Add
+ (Option : String;
+ To : in out String_List_Access;
+ Last : in out Natural)
+ is
+ begin
+ Add (Option => new String'(Option), To => To, Last => Last);
+ end Add;
+
-----------------------
-- Add_Linker_Option --
-----------------------
end if;
end Add_Linker_Option;
+ -----------------
+ -- Create_Name --
+ -----------------
+
+ function Create_Name (Name : String) return File_Name_Type is
+ begin
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Name);
+ return Name_Find;
+ end Create_Name;
+
+ function Create_Name (Name : String) return Name_Id is
+ begin
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Name);
+ return Name_Find;
+ end Create_Name;
+
+ function Create_Name (Name : String) return Path_Name_Type is
+ begin
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Name);
+ return Name_Find;
+ end Create_Name;
+
----------------------
-- Delete_All_Marks --
----------------------
return Union_Id (Key.File) mod Max_Mask_Num;
end Hash;
+ ------------
+ -- Inform --
+ ------------
+
+ procedure Inform (N : File_Name_Type; Msg : String) is
+ begin
+ Inform (Name_Id (N), Msg);
+ end Inform;
+
+ procedure Inform (N : Name_Id := No_Name; Msg : String) is
+ begin
+ Osint.Write_Program_Name;
+
+ Write_Str (": ");
+
+ if N /= No_Name then
+ Write_Str ("""");
+ Write_Name (N);
+ Write_Str (""" ");
+ end if;
+
+ Write_Str (Msg);
+ Write_Eol;
+ end Inform;
+
----------------------------
-- Is_External_Assignment --
----------------------------
S2 : String := "";
S3 : String := "");
Do_Fail : Fail_Proc := Osint.Fail'Access;
- -- Comment required ???
-
- function Unit_Index_Of (ALI_File : File_Name_Type) return Int;
- -- Find the index of a unit in a source file. Return zero if the file
- -- is not a multi-unit source file.
+ -- Failing procedure called from procedure Test_If_Relative_Path below.
+ -- May be redirected.
+
+ Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data;
+ -- The project tree
+
+ Main_Config_Project : Project_Id;
+ -- The project id of the main configuration project
+
+ procedure Add
+ (Option : String_Access;
+ To : in out String_List_Access;
+ Last : in out Natural);
+ procedure Add
+ (Option : String;
+ To : in out String_List_Access;
+ Last : in out Natural);
+ -- Add a string to a list of strings
+
+ function Create_Name (Name : String) return File_Name_Type;
+ function Create_Name (Name : String) return Name_Id;
+ function Create_Name (Name : String) return Path_Name_Type;
+ -- Get the Name_Id of a name
function Executable_Prefix_Path return String;
-- Return the absolute path parent directory of the directory where the
-- current executable resides, if its directory is named "bin", otherwise
-- return an empty string.
+ procedure Inform (N : Name_Id := No_Name; Msg : String);
+ procedure Inform (N : File_Name_Type; Msg : String);
+ -- Prints out the program name followed by a colon, N and S
+
function Is_External_Assignment (Argv : String) return Boolean;
-- Verify that an external assignment switch is syntactically correct
--
-- and to retrieve them when a project file is used, to verify that the
-- files exist and that they belong to a project file.
+ function Unit_Index_Of (ALI_File : File_Name_Type) return Int;
+ -- Find the index of a unit in a source file. Return zero if the file
+ -- is not a multi-unit source file.
+
package Mains is
-- Mains are stored in a table. An index is used to retrieve the mains
-- --
-- GNAT COMPILER COMPONENTS --
-- --
--- M L I B . P R J --
+-- M L I B . P R J --
-- --
-- B o d y --
-- --
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.HTable;
-
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System; use System;
with System.Case_Util; use System.Case_Util;
G_Trasym_Ads : File_Name_Type := No_File;
-- Name_Id for "g-trasym.ads"
- No_Argument_List : aliased String_List := (1 .. 0 => null);
- No_Argument : constant String_List_Access := No_Argument_List'Access;
-
Arguments : String_List_Access := No_Argument;
-- Used to accumulate arguments for the invocation of gnatbind and of
-- the compiler. Also used to collect the interface ALI when copying
Hash => Hash,
Equal => "=");
- -- List of non-Ada object files
-
- Foreign_Objects : Argument_List_Access;
-
- package Foreigns is new Table.Table
- (Table_Name => "Mlib.Prj.Foreigns",
- Table_Component_Type => String_Access,
- Table_Index_Type => Natural,
- Table_Low_Bound => 1,
- Table_Initial => 20,
- Table_Increment => 100);
-
-- List of ALI files
Ali_Files : Argument_List_Access;
procedure Reset_Tables;
-- Make sure that all the above tables are empty
- -- (Objects, ALIs, Options, ...).
+ -- (Objects, Ali_Files, Options).
function SALs_Use_Constructors return Boolean;
-- Indicate if Stand-Alone Libraries are automatically initialized using
-- Set to True for the first warning about a unit missing from the
-- interface set.
- Gtrasymobj_Needed : Boolean := False;
- -- On OpenVMS, set to True if library needs to be linked with
- -- g-trasym.obj.
-
Data : Project_Data := In_Tree.Projects.Table (For_Project);
Libgnarl_Needed : Yes_No_Unknown := Data.Libgnarl_Needed;
Libdecgnat_Needed : Boolean := False;
-- On OpenVMS, set to True if library needs to be linked with libdecgnat
+ Gtrasymobj_Needed : Boolean := False;
+ -- On OpenVMS, set to True if library needs to be linked with
+ -- g-trasym.obj.
+
Object_Directory_Path : constant String :=
- Get_Name_String (Data.Display_Object_Dir);
+ Get_Name_String (Data.Display_Object_Dir);
Standalone : constant Boolean := Data.Standalone_Library;
In_Main_Object_Directory : Boolean := True;
+ There_Are_Foreign_Sources : Boolean;
+
Rpath : String_Access := null;
-- Allocated only if Path Option is supported
-- Store the ALI file name of a source of the library (the first found)
procedure Add_ALI_For (Source : File_Name_Type);
- -- Add the name of the ALI file corresponding to Source to the arguments
+ -- Add the name of the ALI file corresponding to Source to the
+ -- Arguments.
procedure Add_Rpath (Path : String);
-- Add a path name to Rpath
ALI.ALIs.Table (Id).Last_Sdep
loop
if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then
- Libgnarl_Needed := Yes;
+ Libgnarl_Needed := Yes;
if Main_Project then
In_Tree.Projects.Table (For_Project).Libgnarl_Needed :=
Process_Project (For_Project);
-- Add the -L and -l switches and, if the Rpath option is supported,
- -- add the directory to the Rpath.
-
- -- As the library projects are in the wrong order, process from the
- -- last to the first.
+ -- add the directory to the Rpath. As the library projects are in the
+ -- wrong order, process from the last to the first.
for Index in reverse 1 .. Library_Projs.Last loop
Current := Library_Projs.Table (Index);
end if;
-- If this is the first time Build_Library is called, get the Name_Id
- -- values of "s-osinte.ads", "dec.ads", and "g-trasym.ads".
+ -- of "s-osinte.ads".
if S_Osinte_Ads = No_File then
Name_Len := 0;
begin
Src_Ind := Sinput.P.Load_Project_File
(Get_Name_String
- (Unit.File_Names (Body_Part).Path));
+ (Unit.File_Names
+ (Body_Part).Path));
-- Add the ALI file only if it is not a subunit
- if
- not Sinput.P.Source_File_Is_Subunit (Src_Ind)
+ if not
+ Sinput.P.Source_File_Is_Subunit (Src_Ind)
then
Add_ALI_For
(Unit.File_Names (Body_Part).Name);
Display (Gnatbind);
- -- Check the size of the arguments
-
Size := 0;
for J in 1 .. Argument_Number loop
Size := Size + Arguments (J)'Length + 1;
-- Read it
- A := Scan_ALI
- (First_ALI, T, Ignore_ED => False, Err => False);
+ A :=
+ Scan_ALI (First_ALI, T, Ignore_ED => False, Err => False);
if A /= No_ALI_Id then
for Index in
-- generated file.
Display (Gcc);
- GNAT.OS_Lib.Spawn
+ Spawn
(Gcc_Path.all, Arguments (1 .. Argument_Number), Success);
if not Success then
-- Build the library only if Link is True
if Link then
+
-- If attribute Library_GCC was specified, get the driver name
Library_GCC :=
if not Library_Options.Default then
declare
- Current : String_List_Id := Library_Options.Values;
+ Current : String_List_Id;
Element : String_Element;
begin
+ Current := Library_Options.Values;
while Current /= Nil_String loop
- Element :=
- In_Tree.String_Elements.Table (Current);
+ Element := In_Tree.String_Elements.Table (Current);
Get_Name_String (Element.Value);
if Name_Len /= 0 then
end;
end if;
- Lib_Dirpath :=
+ Lib_Dirpath :=
new String'(Get_Name_String (Data.Display_Library_Dir));
- Lib_Filename :=
- new String'(Get_Name_String (Data.Library_Name));
+ Lib_Filename := new String'(Get_Name_String (Data.Library_Name));
case Data.Library_Kind is
when Static =>
-- Get the library version, if any
- if Data.Lib_Internal_Name /= No_File then
+ if Data.Lib_Internal_Name /= No_Name then
Lib_Version :=
new String'(Get_Name_String (Data.Lib_Internal_Name));
end if;
-- 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.
-
-- 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.
In_Main_Object_Directory := True;
+ There_Are_Foreign_Sources := Data.Other_Sources_Present;
+
loop
declare
Object_Dir_Path : constant String :=
if In_Main_Object_Directory
or else Last < 5
or else C_Filename (1 .. B_Start'Length) /=
- B_Start.all
+ B_Start.all
then
Name_Len := Last;
Name_Buffer (1 .. Name_Len) :=
Id := Name_Find;
if not Objects_Htable.Get (Id) then
-
- -- Record this object file
-
- Objects_Htable.Set (Id, True);
- Objects.Increment_Last;
- Objects.Table (Objects.Last) :=
- new String'(Object_Path);
-
declare
ALI_File : constant String :=
+ Ext_To
+ (Filename (1 .. Last), "ali");
+ ALI_Path : constant String :=
Ext_To (Object_Path, "ali");
+ Add_It : Boolean :=
+ There_Are_Foreign_Sources
+ or else
+ (Last > 5
+ and then
+ C_Filename
+ (1 .. B_Start'Length) =
+ B_Start.all);
+ Fname : File_Name_Type;
+ Proj : Project_Id;
begin
- if Is_Regular_File (ALI_File) then
+ if Is_Regular_File (ALI_Path) then
+
+ -- If there is an ALI file, check if the
+ -- object file should be added to the
+ -- library. If there are foreign sources
+ -- we put all object files in the library.
+
+ if not Add_It then
+ for Index in
+ 1 .. Unit_Table.Last (In_Tree.Units)
+ loop
+ if In_Tree.Units.Table
+ (Index).File_Names
+ (Body_Part).Name /= No_File
+ then
+ Proj :=
+ In_Tree.Units.Table (Index).
+ File_Names
+ (Body_Part).Project;
+ Fname :=
+ In_Tree.Units.Table (Index).
+ File_Names (Body_Part).Name;
+
+ elsif
+ In_Tree.Units.Table
+ (Index).File_Names
+ (Specification).Name /= No_File
+ then
+ Proj :=
+ In_Tree.Units.Table
+ (Index).File_Names
+ (Specification).Project;
+ Fname :=
+ In_Tree.Units.Table
+ (Index).File_Names
+ (Specification).Name;
+
+ else
+ Proj := No_Project;
+ end if;
+
+ Add_It := Proj /= No_Project;
+
+ -- If the source is in the project
+ -- or a project it extends, we may
+ -- put it in the library.
+
+ if Add_It then
+ Add_It := Check_Project (Proj);
+ end if;
+
+ -- But we don't, if the ALI file
+ -- does not correspond to the unit.
+
+ if Add_It then
+ declare
+ F : constant String :=
+ Ext_To
+ (Get_Name_String
+ (Fname), "ali");
+ begin
+ Add_It := F = ALI_File;
+ end;
+ end if;
+
+ exit when Add_It;
+ end loop;
+ end if;
- -- Record the ALI file
+ if Add_It then
+ Objects_Htable.Set (Id, True);
+ Objects.Append
+ (new String'(Object_Path));
- ALIs.Increment_Last;
- ALIs.Table (ALIs.Last) :=
- new String'(ALI_File);
+ -- Record the ALI file
- -- Find out if for this ALI file, libgnarl
- -- or libdecgnat or g-trasym.obj (on
- -- OpenVMS) is necessary.
+ ALIs.Append (new String'(ALI_Path));
- Check_Libs (ALI_File, True);
+ -- Find out if for this ALI file,
+ -- libgnarl or libdecgnat or
+ -- g-trasym.obj (on OpenVMS) is
+ -- necessary.
- else
- -- Object file is a foreign object file
+ Check_Libs (ALI_Path, True);
+ end if;
- Foreigns.Increment_Last;
- Foreigns.Table (Foreigns.Last) :=
- new String'(Object_Path);
+ elsif There_Are_Foreign_Sources then
+ Objects.Append (new String'(Object_Path));
end if;
end;
end if;
else
Opts.Table (Opts.Last) := new String'(Shared_Lib ("gnarl"));
end if;
-
- else
- In_Tree.Projects.Table (For_Project).Libgnarl_Needed := No;
end if;
if Gtrasymobj_Needed then
new Argument_List'
(Argument_List (Objects.Table (1 .. Objects.Last)));
- Foreign_Objects :=
- new Argument_List'(Argument_List
- (Foreigns.Table (1 .. Foreigns.Last)));
-
Ali_Files :=
new Argument_List'(Argument_List (ALIs.Table (1 .. ALIs.Last)));
Options :=
new Argument_List'(Argument_List (Opts.Table (1 .. Opts.Last)));
- -- We fail if there are no object to put in the library (Ada or
- -- foreign objects).
+ -- We fail if there are no object to put in the library
+ -- (Ada or foreign objects).
if Object_Files'Length = 0 then
Com.Fail ("no object files for library """ &
Data := In_Tree.Projects.Table (For_Project);
declare
- Iface : String_List_Id;
+ Iface : String_List_Id := Data.Lib_Interface_ALIs;
ALI : File_Name_Type;
begin
- Iface := Data.Lib_Interface_ALIs;
while Iface /= Nil_String loop
ALI :=
File_Name_Type
declare
Current_Dir : constant String := Get_Current_Dir;
- DLL_Name : aliased constant String :=
- Lib_Filename.all & "." & DLL_Ext;
+ 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;
- Dir : Dir_Type;
- Name : String (1 .. 200);
- Last : Natural;
- Disregard : Boolean;
- Delete : Boolean := False;
+
+ Delete : Boolean := False;
begin
-- Clean the library directory: remove any file with the name of
then
Get_Name_String
(Unit.File_Names (Specification).Name);
- Name_Len := Name_Len -
+ Name_Len :=
+ Name_Len -
File_Extension
(Name (1 .. Name_Len))'Length;
when Dynamic | Relocatable =>
Build_Dynamic_Library
(Ofiles => Object_Files.all,
- Foreign => Foreign_Objects.all,
- Afiles => Ali_Files.all,
Options => Options.all,
- Options_2 => No_Argument_List,
Interfaces => Arguments (1 .. Argument_Number),
Lib_Filename => Lib_Filename.all,
Lib_Dir => Lib_Dirpath.all,
when Static =>
MLib.Build_Library
(Object_Files.all,
- Ali_Files.all,
Lib_Filename.all,
Lib_Dirpath.all);
null;
end case;
- -- We need to copy the ALI files from the object directory to
- -- 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.
+ -- We need to copy the ALI files from the object directory to 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 the ALI files and make the copies read-only. For interfaces,
-- mark the copies as interfaces.
Copy_ALI_Files
(Files => Ali_Files.all,
- To => In_Tree.Projects.Table
- (For_Project).Display_Library_ALI_Dir,
+ To => In_Tree.Projects.Table (For_Project).Library_ALI_Dir,
Interfaces => Arguments (1 .. Argument_Number));
-- Copy interface sources if Library_Src_Dir specified
end;
declare
- Dir : Dir_Type;
- Delete : Boolean := False;
- Unit : Unit_Data;
- Name : String (1 .. 200);
- Last : Natural;
+ Dir : Dir_Type;
+ Delete : Boolean := False;
+ Unit : Unit_Data;
+
+ Name : String (1 .. 200);
+ Last : Natural;
+
Disregard : Boolean;
begin
Read (Dir, Name, Last);
exit when Last = 0;
- declare
- Filename : constant String := Name (1 .. Last);
+ if Is_Regular_File (Name (1 .. Last)) then
+ Canonical_Case_File_Name (Name (1 .. Last));
+ Delete := False;
- begin
- if Is_Regular_File (Filename) 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;
+ -- Compare with source file names of the project
- 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;
+ for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop
+ Unit := In_Tree.Units.Table (Index);
- if Delete then
- Set_Writable (Filename);
- Delete_File (Filename, Disregard);
- end if;
- end;
+ 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);
-------------------
procedure Check_Library
- (For_Project : Project_Id;
- In_Tree : Project_Tree_Ref)
+ (For_Project : Project_Id; In_Tree : Project_Tree_Ref)
is
Data : constant Project_Data :=
In_Tree.Projects.Table (For_Project);
if Data.Library then
declare
Lib_Name : constant File_Name_Type :=
- Library_File_Name_For (For_Project, In_Tree);
+ Library_File_Name_For (For_Project, In_Tree);
begin
Change_Dir (Get_Name_String (Data.Library_Dir));
Lib_TS := File_Stamp (Lib_Name);
(Extending : Project_Id;
Extended : Project_Id) return Boolean
is
- Ext : Project_Id := Extending;
+ Ext : Project_Id;
begin
+ Ext := Extending;
while Ext /= No_Project loop
if Ext = Extended then
return True;
begin
Objects.Init;
Objects_Htable.Reset;
- Foreigns.Init;
ALIs.Init;
Opts.Init;
Processed_Projects.Reset;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
function DLL_Ext return String;
+ function Library_Major_Minor_Id_Supported return Boolean;
+
function Support_For_Libraries return Library_Support;
-- Local variables
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Lib_Version : String := "";
Auto_Init : Boolean := False)
is
- pragma Unreferenced (Foreign);
- pragma Unreferenced (Afiles);
pragma Unreferenced (Interfaces);
pragma Unreferenced (Symbol_Data);
pragma Unreferenced (Lib_Version);
Objects => Ofiles,
Options => Options & Bexpall_Option,
Driver_Name => Driver_Name,
- Options_2 => Options_2 & Thread_Opts.all);
+ Options_2 => Thread_Opts.all);
end Build_Dynamic_Library;
-------------
return "a";
end DLL_Ext;
+ --------------------------------------
+ -- Library_Major_Minor_Id_Supported --
+ --------------------------------------
+
+ function Library_Major_Minor_Id_Supported return Boolean is
+ begin
+ return False;
+ end Library_Major_Minor_Id_Supported;
+
---------------------------
-- Support_For_Libraries --
---------------------------
begin
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
DLL_Ext_Ptr := DLL_Ext'Access;
+ Library_Major_Minor_Id_Supported_Ptr :=
+ Library_Major_Minor_Id_Supported'Access;
Support_For_Libraries_Ptr := Support_For_Libraries'Access;
end MLib.Tgt.Specific;
with Opt; use Opt;
with Output; use Output;
-with System;
-
package body MLib.Tgt.Specific is
-- Non default subprograms
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Shared_Libgcc : aliased String := "-shared-libgcc";
Shared_Options : constant Argument_List :=
- (1 => Flat_Namespace'Access,
- 2 => Shared_Libgcc'Access);
+ (1 => Flat_Namespace'Access,
+ 2 => Shared_Libgcc'Access);
-----------------------------
-- Archive_Indexer_Options --
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Lib_Version : String := "";
Auto_Init : Boolean := False)
is
- pragma Unreferenced (Foreign);
- pragma Unreferenced (Afiles);
pragma Unreferenced (Interfaces);
pragma Unreferenced (Symbol_Data);
pragma Unreferenced (Auto_Init);
Lib_File : constant String :=
- Lib_Dir & Directory_Separator & "lib" &
- Fil.Append_To (Lib_Filename, DLL_Ext);
+ "lib" & Fil.Append_To (Lib_Filename, DLL_Ext);
+
+ Lib_Path : constant String :=
+ Lib_Dir & Directory_Separator & Lib_File;
Symbolic_Link_Needed : Boolean := False;
Objects => Ofiles,
Options => Options & Shared_Options,
Driver_Name => Driver_Name,
- Options_2 => Options_2);
+ Options_2 => No_Argument_List);
else
-
- if Is_Absolute_Path (Lib_Version) then
- Utl.Gcc
- (Output_File => Lib_Version,
- Objects => Ofiles,
- Options => Options & Shared_Options,
- Driver_Name => Driver_Name,
- Options_2 => Options_2);
- Symbolic_Link_Needed := Lib_Version /= Lib_File;
-
- else
- Utl.Gcc
- (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
- Objects => Ofiles,
- Options => Options & Shared_Options,
- Driver_Name => Driver_Name,
- Options_2 => Options_2);
- Symbolic_Link_Needed :=
- Lib_Dir & Directory_Separator & Lib_Version /= Lib_File;
- end if;
-
- if Symbolic_Link_Needed then
- declare
- Success : Boolean;
- Oldpath : String (1 .. Lib_Version'Length + 1);
- Newpath : String (1 .. Lib_File'Length + 1);
-
- Result : Integer;
- pragma Unreferenced (Result);
-
- function Symlink
- (Oldpath : System.Address;
- Newpath : System.Address) return Integer;
- pragma Import (C, Symlink, "__gnat_symlink");
-
- begin
- Oldpath (1 .. Lib_Version'Length) := Lib_Version;
- Oldpath (Oldpath'Last) := ASCII.NUL;
- Newpath (1 .. Lib_File'Length) := Lib_File;
- Newpath (Newpath'Last) := ASCII.NUL;
-
- Delete_File (Lib_File, Success);
-
- Result := Symlink (Oldpath'Address, Newpath'Address);
- end;
- end if;
+ declare
+ Maj_Version : constant String :=
+ Major_Id_Name (Lib_File, Lib_Version);
+ begin
+ if Is_Absolute_Path (Lib_Version) then
+ Utl.Gcc
+ (Output_File => Lib_Version,
+ Objects => Ofiles,
+ Options => Options & Shared_Options,
+ Driver_Name => Driver_Name,
+ Options_2 => No_Argument_List);
+ Symbolic_Link_Needed := Lib_Version /= Lib_File;
+
+ else
+ Utl.Gcc
+ (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
+ Objects => Ofiles,
+ Options => Options & Shared_Options,
+ Driver_Name => Driver_Name,
+ Options_2 => No_Argument_List);
+ Symbolic_Link_Needed :=
+ Lib_Dir & Directory_Separator & Lib_Version /= Lib_File;
+ end if;
+
+ if Symbolic_Link_Needed then
+ Create_Sym_Links
+ (Lib_Path, Lib_Version, Lib_Dir, Maj_Version);
+ end if;
+ end;
end if;
end Build_Dynamic_Library;
with MLib.Utl;
with Opt;
with Output; use Output;
-with System;
package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Lib_Version : String := "";
Auto_Init : Boolean := False)
is
- pragma Unreferenced (Foreign);
- pragma Unreferenced (Afiles);
pragma Unreferenced (Interfaces);
pragma Unreferenced (Symbol_Data);
pragma Unreferenced (Auto_Init);
Lib_File : constant String :=
- Lib_Dir & Directory_Separator & "lib" &
- MLib.Fil.Append_To (Lib_Filename, DLL_Ext);
+ "lib" & Fil.Append_To (Lib_Filename, DLL_Ext);
+
+ Lib_Path : constant String :=
+ Lib_Dir & Directory_Separator & Lib_File;
Version_Arg : String_Access;
Symbolic_Link_Needed : Boolean := False;
begin
if Opt.Verbose_Mode then
Write_Str ("building relocatable shared library ");
- Write_Line (Lib_File);
+ Write_Line (Lib_Path);
end if;
if Lib_Version = "" then
MLib.Utl.Gcc
- (Output_File => Lib_File,
+ (Output_File => Lib_Path,
Objects => Ofiles,
Options => Common_Options,
- Options_2 => Options_2,
+ Options_2 => No_Argument_List,
Driver_Name => Driver_Name);
else
- Version_Arg := new String'("-Wl,+h," & Lib_Version);
-
- if Is_Absolute_Path (Lib_Version) then
- MLib.Utl.Gcc
- (Output_File => Lib_Version,
- Objects => Ofiles,
- Options => Common_Options & Version_Arg,
- Options_2 => Options_2,
- Driver_Name => Driver_Name);
- Symbolic_Link_Needed := Lib_Version /= Lib_File;
-
- else
- MLib.Utl.Gcc
- (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
- Objects => Ofiles,
- Options => Common_Options & Version_Arg,
- Options_2 => Options_2,
- Driver_Name => Driver_Name);
- Symbolic_Link_Needed :=
- Lib_Dir & Directory_Separator & Lib_Version /= Lib_File;
- end if;
-
- if Symbolic_Link_Needed then
- declare
- Success : Boolean;
- Oldpath : String (1 .. Lib_Version'Length + 1);
- Newpath : String (1 .. Lib_File'Length + 1);
-
- Result : Integer;
- pragma Unreferenced (Result);
-
- function Symlink
- (Oldpath : System.Address;
- Newpath : System.Address) return Integer;
- pragma Import (C, Symlink, "__gnat_symlink");
-
- begin
- Oldpath (1 .. Lib_Version'Length) := Lib_Version;
- Oldpath (Oldpath'Last) := ASCII.NUL;
- Newpath (1 .. Lib_File'Length) := Lib_File;
- Newpath (Newpath'Last) := ASCII.NUL;
-
- Delete_File (Lib_File, Success);
-
- Result := Symlink (Oldpath'Address, Newpath'Address);
- end;
- end if;
+ declare
+ Maj_Version : constant String :=
+ Major_Id_Name (Lib_File, Lib_Version);
+ begin
+ if Maj_Version'Length /= 0 then
+ Version_Arg := new String'("-Wl,+h," & Maj_Version);
+
+ else
+ Version_Arg := new String'("-Wl,+h," & Lib_Version);
+ end if;
+
+ if Is_Absolute_Path (Lib_Version) then
+ MLib.Utl.Gcc
+ (Output_File => Lib_Version,
+ Objects => Ofiles,
+ Options => Common_Options & Version_Arg,
+ Options_2 => No_Argument_List,
+ Driver_Name => Driver_Name);
+ Symbolic_Link_Needed := Lib_Version /= Lib_Path;
+
+ else
+ MLib.Utl.Gcc
+ (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
+ Objects => Ofiles,
+ Options => Common_Options & Version_Arg,
+ Options_2 => No_Argument_List,
+ Driver_Name => Driver_Name);
+ Symbolic_Link_Needed :=
+ Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path;
+ end if;
+
+ if Symbolic_Link_Needed then
+ Create_Sym_Links
+ (Lib_Path, Lib_Version, Lib_Dir, Maj_Version);
+ end if;
+ end;
end if;
end Build_Dynamic_Library;
with MLib.Utl;
with Opt;
with Output; use Output;
-with System;
package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Lib_Version : String := "";
Auto_Init : Boolean := False)
is
- pragma Unreferenced (Foreign);
- pragma Unreferenced (Afiles);
pragma Unreferenced (Interfaces);
pragma Unreferenced (Symbol_Data);
pragma Unreferenced (Auto_Init);
Lib_File : constant String :=
- Lib_Dir & Directory_Separator & "lib" &
- MLib.Fil.Append_To (Lib_Filename, DLL_Ext);
+ "lib" & MLib.Fil.Append_To (Lib_Filename, DLL_Ext);
+
+ Lib_Path : constant String :=
+ Lib_Dir & Directory_Separator & Lib_File;
Version_Arg : String_Access;
Symbolic_Link_Needed : Boolean := False;
-- After moving -lxxx to Options_2, N_Options up to index Options_Last
-- will contain the Options to pass to MLib.Utl.Gcc.
- Real_Options_2 : Argument_List (1 .. Options'Length + Options_2'Length);
+ Real_Options_2 : Argument_List (1 .. Options'Length);
Real_Options_2_Last : Natural := 0;
-- Real_Options_2 up to index Real_Options_2_Last will contain the
-- Options_2 to pass to MLib.Utl.Gcc.
begin
if Opt.Verbose_Mode then
Write_Str ("building relocatable shared library ");
- Write_Line (Lib_File);
+ Write_Line (Lib_Path);
end if;
-- Move all -lxxx to Options_2
end loop;
end;
- -- Add to Real_Options_2 the argument Options_2
-
- Real_Options_2
- (Real_Options_2_Last + 1 .. Real_Options_2_Last + Options_2'Length) :=
- Options_2;
- Real_Options_2_Last := Real_Options_2_Last + Options_2'Length;
-
if Lib_Version = "" then
MLib.Utl.Gcc
- (Output_File => Lib_File,
+ (Output_File => Lib_Path,
Objects => Ofiles,
Options => N_Options (N_Options'First .. Options_Last),
Driver_Name => Driver_Name,
Options_2 => Real_Options_2 (1 .. Real_Options_2_Last));
else
- Version_Arg := new String'("-Wl,-soname," & Lib_Version);
-
- if Is_Absolute_Path (Lib_Version) then
- MLib.Utl.Gcc
- (Output_File => Lib_Version,
- Objects => Ofiles,
- Options => N_Options (N_Options'First .. Options_Last) &
- Version_Arg,
- Driver_Name => Driver_Name,
- Options_2 => Real_Options_2 (1 .. Real_Options_2_Last));
- Symbolic_Link_Needed := Lib_Version /= Lib_File;
-
- else
- MLib.Utl.Gcc
- (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
- Objects => Ofiles,
- Options => N_Options (N_Options'First .. Options_Last) &
- Version_Arg,
- Driver_Name => Driver_Name,
- Options_2 => Real_Options_2 (1 .. Real_Options_2_Last));
- Symbolic_Link_Needed :=
- Lib_Dir & Directory_Separator & Lib_Version /= Lib_File;
- end if;
-
- if Symbolic_Link_Needed then
- declare
- Success : Boolean;
- Oldpath : String (1 .. Lib_Version'Length + 1);
- Newpath : String (1 .. Lib_File'Length + 1);
-
- Result : Integer;
- pragma Unreferenced (Result);
-
- function Symlink
- (Oldpath : System.Address;
- Newpath : System.Address)
- return Integer;
- pragma Import (C, Symlink, "__gnat_symlink");
-
- begin
- Oldpath (1 .. Lib_Version'Length) := Lib_Version;
- Oldpath (Oldpath'Last) := ASCII.NUL;
- Newpath (1 .. Lib_File'Length) := Lib_File;
- Newpath (Newpath'Last) := ASCII.NUL;
-
- Delete_File (Lib_File, Success);
-
- Result := Symlink (Oldpath'Address, Newpath'Address);
- end;
- end if;
+ declare
+ Maj_Version : constant String :=
+ Major_Id_Name (Lib_File, Lib_Version);
+ begin
+ if Maj_Version'Length /= 0 then
+ Version_Arg := new String'("-Wl,-soname," & Maj_Version);
+
+ else
+ Version_Arg := new String'("-Wl,-soname," & Lib_Version);
+ end if;
+
+ if Is_Absolute_Path (Lib_Version) then
+ MLib.Utl.Gcc
+ (Output_File => Lib_Version,
+ Objects => Ofiles,
+ Options => N_Options (N_Options'First .. Options_Last) &
+ Version_Arg,
+ Driver_Name => Driver_Name,
+ Options_2 => Real_Options_2 (1 .. Real_Options_2_Last));
+ Symbolic_Link_Needed := Lib_Version /= Lib_Path;
+
+ else
+ MLib.Utl.Gcc
+ (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
+ Objects => Ofiles,
+ Options => N_Options (N_Options'First .. Options_Last) &
+ Version_Arg,
+ Driver_Name => Driver_Name,
+ Options_2 => Real_Options_2 (1 .. Real_Options_2_Last));
+ Symbolic_Link_Needed :=
+ Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path;
+ end if;
+
+ if Symbolic_Link_Needed then
+ Create_Sym_Links
+ (Lib_Path, Lib_Version, Lib_Dir, Maj_Version);
+ end if;
+ end;
end if;
end Build_Dynamic_Library;
with MLib.Utl;
with Opt;
with Output; use Output;
-with System;
package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Lib_Version : String := "";
Auto_Init : Boolean := False)
is
- pragma Unreferenced (Foreign);
- pragma Unreferenced (Afiles);
pragma Unreferenced (Interfaces);
pragma Unreferenced (Symbol_Data);
pragma Unreferenced (Auto_Init);
Objects => Ofiles,
Options => Options,
Driver_Name => Driver_Name,
- Options_2 => Options_2);
+ Options_2 => No_Argument_List);
else
declare
- Maj_Version : constant String := Lib_Version;
- Last_Maj : Positive := Maj_Version'Last;
- Last : Positive;
- Ok_Maj : Boolean := False;
+ Maj_Version : constant String :=
+ Major_Id_Name (Lib_File, Lib_Version);
begin
- 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 (1 .. Last) = Lib_File;
- end if;
-
- exit;
- end if;
- end loop;
- end if;
-
- if Ok_Maj then
- Version_Arg := new String'("-Wl,-soname," &
- Maj_Version (1 .. Last_Maj));
+ if Maj_Version'Length /= 0 then
+ Version_Arg := new String'("-Wl,-soname," & Maj_Version);
else
Version_Arg := new String'("-Wl,-soname," & Lib_Version);
Objects => Ofiles,
Options => Options & Version_Arg,
Driver_Name => Driver_Name,
- Options_2 => Options_2);
+ Options_2 => No_Argument_List);
Symbolic_Link_Needed := Lib_Version /= Lib_Path;
else
Objects => Ofiles,
Options => Options & Version_Arg,
Driver_Name => Driver_Name,
- Options_2 => Options_2);
+ Options_2 => No_Argument_List);
Symbolic_Link_Needed :=
Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path;
end if;
if Symbolic_Link_Needed then
- declare
- Success : Boolean;
- Oldpath : String (1 .. Lib_Version'Length + 1);
- Newpath : String (1 .. Lib_Path'Length + 1);
-
- Result : Integer;
- pragma Unreferenced (Result);
-
- function Symlink
- (Oldpath : System.Address;
- Newpath : System.Address) return Integer;
- pragma Import (C, Symlink, "__gnat_symlink");
-
- begin
- Oldpath (1 .. Lib_Version'Length) := Lib_Version;
- Oldpath (Oldpath'Last) := ASCII.NUL;
- Newpath (1 .. Lib_Path'Length) := Lib_Path;
- Newpath (Newpath'Last) := ASCII.NUL;
-
- Delete_File (Lib_Path, Success);
-
- Result := Symlink (Oldpath'Address, Newpath'Address);
- end;
-
- if Ok_Maj then
- declare
- Success : Boolean;
- Oldpath : String (1 .. Lib_Version'Length + 1);
- Maj_Path : constant String :=
- Lib_Dir & Directory_Separator &
- Maj_Version (1 .. Last_Maj);
- Newpath : String (1 .. Maj_Path'Length + 1);
-
- Result : Integer;
- pragma Unreferenced (Result);
-
- function Symlink
- (Oldpath : System.Address;
- Newpath : System.Address) return Integer;
- pragma Import (C, Symlink, "__gnat_symlink");
-
- begin
- Oldpath (1 .. Lib_Version'Length) := Lib_Version;
- Oldpath (Oldpath'Last) := ASCII.NUL;
- Newpath (1 .. Maj_Path'Length) := Maj_Path;
- Newpath (Newpath'Last) := ASCII.NUL;
-
- Delete_File (Maj_Path, Success);
-
- Result := Symlink (Oldpath'Address, Newpath'Address);
- end;
- end if;
-
+ Create_Sym_Links
+ (Lib_Path, Lib_Version, Lib_Dir, Maj_Version);
end if;
end;
end if;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
function PIC_Option return String;
+ function Library_Major_Minor_Id_Supported return Boolean;
+
function Standalone_Library_Auto_Init_Is_Supported return Boolean;
function Support_For_Libraries return Library_Support;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Auto_Init : Boolean := False)
is
pragma Unreferenced (Ofiles);
- pragma Unreferenced (Foreign);
- pragma Unreferenced (Afiles);
pragma Unreferenced (Options);
- pragma Unreferenced (Options_2);
pragma Unreferenced (Interfaces);
pragma Unreferenced (Lib_Filename);
pragma Unreferenced (Lib_Dir);
return "";
end Dynamic_Option;
+ --------------------------------------
+ -- Library_Major_Minor_Id_Supported --
+ --------------------------------------
+
+ function Library_Major_Minor_Id_Supported return Boolean is
+ begin
+ return False;
+ end Library_Major_Minor_Id_Supported;
+
----------------
-- PIC_Option --
----------------
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
DLL_Ext_Ptr := DLL_Ext'Access;
Dynamic_Option_Ptr := Dynamic_Option'Access;
+ Library_Major_Minor_Id_Supported_Ptr :=
+ Library_Major_Minor_Id_Supported'Access;
PIC_Option_Ptr := PIC_Option'Access;
Standalone_Library_Auto_Init_Is_Supported_Ptr :=
Standalone_Library_Auto_Init_Is_Supported'Access;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
function Is_Archive_Ext (Ext : String) return Boolean;
+ function Library_Major_Minor_Id_Supported return Boolean;
+
function PIC_Option return String;
No_Argument_List : constant String_List := (1 .. 0 => null);
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Lib_Version : String := "";
Auto_Init : Boolean := False)
is
- pragma Unreferenced (Foreign);
- pragma Unreferenced (Afiles);
pragma Unreferenced (Symbol_Data);
pragma Unreferenced (Interfaces);
pragma Unreferenced (Lib_Version);
Lib_File : constant String :=
Lib_Dir & Directory_Separator &
- Files.Append_To (Lib_Filename, DLL_Ext);
+ DLL_Prefix & Files.Append_To (Lib_Filename, DLL_Ext);
-- Start of processing for Build_Dynamic_Library
(Output_File => Lib_File,
Objects => Ofiles,
Options => No_Argument_List,
- Options_2 => Options & Options_2,
+ Options_2 => Options,
Driver_Name => Driver_Name);
end Build_Dynamic_Library;
function DLL_Prefix return String is
begin
- return "";
+ return "lib";
end DLL_Prefix;
--------------------
return Ext = ".a" or else Ext = ".dll";
end Is_Archive_Ext;
+ --------------------------------------
+ -- Library_Major_Minor_Id_Supported --
+ --------------------------------------
+
+ function Library_Major_Minor_Id_Supported return Boolean is
+ begin
+ return False;
+ end Library_Major_Minor_Id_Supported;
+
----------------
-- PIC_Option --
----------------
begin
Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
- DLL_Ext_Ptr := DLL_Ext'Access;
- DLL_Prefix_Ptr := DLL_Prefix'Access;
- Is_Archive_Ext_Ptr := Is_Archive_Ext'Access;
- PIC_Option_Ptr := PIC_Option'Access;
+ DLL_Ext_Ptr := DLL_Ext'Access;
+ DLL_Prefix_Ptr := DLL_Prefix'Access;
+ Is_Archive_Ext_Ptr := Is_Archive_Ext'Access;
+ PIC_Option_Ptr := PIC_Option'Access;
+ Library_Major_Minor_Id_Supported_Ptr :=
+ Library_Major_Minor_Id_Supported'Access;
end MLib.Tgt.Specific;
with MLib.Utl;
with Opt;
with Output; use Output;
-with System;
package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Lib_Version : String := "";
Auto_Init : Boolean := False)
is
- pragma Unreferenced (Foreign);
- pragma Unreferenced (Afiles);
pragma Unreferenced (Interfaces);
pragma Unreferenced (Symbol_Data);
pragma Unreferenced (Auto_Init);
Lib_File : constant String :=
- Lib_Dir & Directory_Separator & "lib" &
- Fil.Append_To (Lib_Filename, DLL_Ext);
+ "lib" & Fil.Append_To (Lib_Filename, DLL_Ext);
+
+ Lib_Path : constant String :=
+ Lib_Dir & Directory_Separator & Lib_File;
Version_Arg : String_Access;
Symbolic_Link_Needed : Boolean := False;
begin
if Opt.Verbose_Mode then
Write_Str ("building relocatable shared library ");
- Write_Line (Lib_File);
+ Write_Line (Lib_Path);
end if;
if Lib_Version = "" then
Utl.Gcc
- (Output_File => Lib_File,
+ (Output_File => Lib_Path,
Objects => Ofiles,
Options => Options,
- Options_2 => Options_2,
+ Options_2 => No_Argument_List,
Driver_Name => Driver_Name);
else
- Version_Arg := new String'("-Wl,-h," & Lib_Version);
-
- if Is_Absolute_Path (Lib_Version) then
- Utl.Gcc
- (Output_File => Lib_Version,
- Objects => Ofiles,
- Options => Options & Version_Arg,
- Options_2 => Options_2,
- Driver_Name => Driver_Name);
- Symbolic_Link_Needed := Lib_Version /= Lib_File;
-
- else
- Utl.Gcc
- (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
- Objects => Ofiles,
- Options => Options & Version_Arg,
- Options_2 => Options_2,
- Driver_Name => Driver_Name);
- Symbolic_Link_Needed :=
- Lib_Dir & Directory_Separator & Lib_Version /= Lib_File;
- end if;
-
- if Symbolic_Link_Needed then
- declare
- Success : Boolean;
- Oldpath : String (1 .. Lib_Version'Length + 1);
- Newpath : String (1 .. Lib_File'Length + 1);
-
- Result : Integer;
- pragma Unreferenced (Result);
-
- function Symlink
- (Oldpath : System.Address;
- Newpath : System.Address)
- return Integer;
- pragma Import (C, Symlink, "__gnat_symlink");
-
- begin
- Oldpath (1 .. Lib_Version'Length) := Lib_Version;
- Oldpath (Oldpath'Last) := ASCII.NUL;
- Newpath (1 .. Lib_File'Length) := Lib_File;
- Newpath (Newpath'Last) := ASCII.NUL;
-
- Delete_File (Lib_File, Success);
-
- Result := Symlink (Oldpath'Address, Newpath'Address);
- end;
- end if;
+ declare
+ Maj_Version : constant String :=
+ Major_Id_Name (Lib_File, Lib_Version);
+ begin
+ if Maj_Version'Length /= 0 then
+ Version_Arg := new String'("-Wl,-h," & Maj_Version);
+
+ else
+ Version_Arg := new String'("-Wl,-h," & Lib_Version);
+ end if;
+
+ if Is_Absolute_Path (Lib_Version) then
+ Utl.Gcc
+ (Output_File => Lib_Version,
+ Objects => Ofiles,
+ Options => Options & Version_Arg,
+ Options_2 => No_Argument_List,
+ Driver_Name => Driver_Name);
+ Symbolic_Link_Needed := Lib_Version /= Lib_Path;
+
+ else
+ Utl.Gcc
+ (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
+ Objects => Ofiles,
+ Options => Options & Version_Arg,
+ Options_2 => No_Argument_List,
+ Driver_Name => Driver_Name);
+ Symbolic_Link_Needed :=
+ Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path;
+ end if;
+
+ if Symbolic_Link_Needed then
+ Create_Sym_Links
+ (Lib_Path, Lib_Version, Lib_Dir, Maj_Version);
+ end if;
+ end;
end if;
end Build_Dynamic_Library;
with MLib.Utl;
with Opt;
with Output; use Output;
-with System;
package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Lib_Version : String := "";
Auto_Init : Boolean := False)
is
- pragma Unreferenced (Foreign);
- pragma Unreferenced (Afiles);
pragma Unreferenced (Interfaces);
pragma Unreferenced (Symbol_Data);
pragma Unreferenced (Auto_Init);
-- Initialization is done through the contructor mechanism
Lib_File : constant String :=
- Lib_Dir & Directory_Separator & "lib" &
- Fil.Append_To (Lib_Filename, DLL_Ext);
+ "lib" & Fil.Append_To (Lib_Filename, DLL_Ext);
+
+ Lib_Path : constant String :=
+ Lib_Dir & Directory_Separator & Lib_File;
Version_Arg : String_Access;
Symbolic_Link_Needed : Boolean := False;
begin
if Opt.Verbose_Mode then
Write_Str ("building relocatable shared library ");
- Write_Line (Lib_File);
+ Write_Line (Lib_Path);
end if;
-- If specified, add automatic elaboration/finalization
if Lib_Version = "" then
Utl.Gcc
- (Output_File => Lib_File,
+ (Output_File => Lib_Path,
Objects => Ofiles,
Options => Options & Expect_Unresolved'Access,
- Options_2 => Options_2,
+ Options_2 => No_Argument_List,
Driver_Name => Driver_Name);
else
- Version_Arg := new String'("-Wl,-soname," & Lib_Version);
-
- if Is_Absolute_Path (Lib_Version) then
- Utl.Gcc
- (Output_File => Lib_Version,
- Objects => Ofiles,
- Options =>
- Options & Version_Arg & Expect_Unresolved'Access,
- Options_2 => Options_2,
- Driver_Name => Driver_Name);
- Symbolic_Link_Needed := Lib_Version /= Lib_File;
-
- else
- Utl.Gcc
- (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
- Objects => Ofiles,
- Options =>
- Options & Version_Arg & Expect_Unresolved'Access,
- Options_2 => Options_2,
- Driver_Name => Driver_Name);
- Symbolic_Link_Needed :=
- Lib_Dir & Directory_Separator & Lib_Version /= Lib_File;
- end if;
-
- if Symbolic_Link_Needed then
- declare
- Success : Boolean;
- Oldpath : String (1 .. Lib_Version'Length + 1);
- Newpath : String (1 .. Lib_File'Length + 1);
-
- Result : Integer;
- pragma Unreferenced (Result);
-
- function Symlink
- (Oldpath : System.Address;
- Newpath : System.Address)
- return Integer;
- pragma Import (C, Symlink, "__gnat_symlink");
-
- begin
- Oldpath (1 .. Lib_Version'Length) := Lib_Version;
- Oldpath (Oldpath'Last) := ASCII.NUL;
- Newpath (1 .. Lib_File'Length) := Lib_File;
- Newpath (Newpath'Last) := ASCII.NUL;
-
- Delete_File (Lib_File, Success);
-
- Result := Symlink (Oldpath'Address, Newpath'Address);
- end;
- end if;
+ declare
+ Maj_Version : constant String :=
+ Major_Id_Name (Lib_File, Lib_Version);
+ begin
+ if Maj_Version'Length /= 0 then
+ Version_Arg := new String'("-Wl,-soname," & Maj_Version);
+
+ else
+ Version_Arg := new String'("-Wl,-soname," & Lib_Version);
+ end if;
+
+ if Is_Absolute_Path (Lib_Version) then
+ Utl.Gcc
+ (Output_File => Lib_Version,
+ Objects => Ofiles,
+ Options =>
+ Options & Version_Arg & Expect_Unresolved'Access,
+ Options_2 => No_Argument_List,
+ Driver_Name => Driver_Name);
+ Symbolic_Link_Needed := Lib_Version /= Lib_Path;
+
+ else
+ Utl.Gcc
+ (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
+ Objects => Ofiles,
+ Options =>
+ Options & Version_Arg & Expect_Unresolved'Access,
+ Options_2 => No_Argument_List,
+ Driver_Name => Driver_Name);
+ Symbolic_Link_Needed :=
+ Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path;
+ end if;
+
+ if Symbolic_Link_Needed then
+ Create_Sym_Links
+ (Lib_Path, Lib_Version, Lib_Dir, Maj_Version);
+ end if;
+ end;
end if;
end Build_Dynamic_Library;
pragma Warnings (Off, MLib.Tgt.VMS);
-- MLib.Tgt.VMS is with'ed only for elaboration purposes
-with Opt; use Opt;
-with Output; use Output;
+with Opt; use Opt;
+with Output; use Output;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Lib_Version : String := "";
Auto_Init : Boolean := False)
is
- pragma Unreferenced (Foreign);
- pragma Unreferenced (Afiles);
Lib_File : constant String :=
Lib_Dir & Directory_Separator & "lib" &
function Option_File_Name return String is
begin
- if Symbol_Data.Symbol_File = No_Name then
+ if Symbol_Data.Symbol_File = No_Path then
return "symvec.opt";
else
Get_Name_String (Symbol_Data.Symbol_File);
-- Reference Symbol File
- if Symbol_Data.Reference /= No_Name then
+ if Symbol_Data.Reference /= No_Path then
Last_Argument := Last_Argument + 1;
Arguments (Last_Argument) := new String'("-r");
Last_Argument := Last_Argument + 1;
Options => VMS_Options,
Options_2 => Shared_Libgcc_Switch &
Opts (Opts'First .. Last_Opt) &
- Opts2 (Opts2'First .. Last_Opt2) & Options_2,
+ Opts2 (Opts2'First .. Last_Opt2),
Driver_Name => Driver_Name);
-- The auto-init object file need to be deleted, so that it will not
pragma Warnings (Off, MLib.Tgt.VMS);
-- MLib.Tgt.VMS is with'ed only for elaboration purposes
-with Opt; use Opt;
-with Output; use Output;
+with Opt; use Opt;
+with Output; use Output;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
package body MLib.Tgt.Specific is
- -- Non default subprogram. See comment in mlib-tgt.ads
+ -- Non default subprogram. See comment in mlib-tgt.ads.
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Lib_Version : String := "";
Auto_Init : Boolean := False)
is
- pragma Unreferenced (Foreign);
- pragma Unreferenced (Afiles);
Lib_File : constant String :=
Lib_Dir & Directory_Separator & "lib" &
function Option_File_Name return String is
begin
- if Symbol_Data.Symbol_File = No_Name then
+ if Symbol_Data.Symbol_File = No_Path then
return "symvec.opt";
else
Get_Name_String (Symbol_Data.Symbol_File);
-- Reference Symbol File
- if Symbol_Data.Reference /= No_Name then
+ if Symbol_Data.Reference /= No_Path then
Last_Argument := Last_Argument + 1;
Arguments (Last_Argument) := new String'("-r");
Last_Argument := Last_Argument + 1;
Options => VMS_Options,
Options_2 => Shared_Libgcc_Switch &
Opts (Opts'First .. Last_Opt) &
- Opts2 (Opts2'First .. Last_Opt2) & Options_2,
+ Opts2 (Opts2'First .. Last_Opt2),
Driver_Name => Driver_Name);
-- The auto-init object file need to be deleted, so that it will not
function Object_Ext return String;
+ function Library_Major_Minor_Id_Supported return Boolean;
+
function PIC_Option return String;
-----------------
end if;
end Libgnat;
+ --------------------------------------
+ -- Library_Major_Minor_Id_Supported --
+ --------------------------------------
+
+ function Library_Major_Minor_Id_Supported return Boolean is
+ begin
+ return False;
+ end Library_Major_Minor_Id_Supported;
+
----------------
-- Object_Ext --
----------------
Libgnat_Ptr := Libgnat'Access;
Object_Ext_Ptr := Object_Ext'Access;
PIC_Option_Ptr := PIC_Option'Access;
+ Library_Major_Minor_Id_Supported_Ptr :=
+ Library_Major_Minor_Id_Supported'Access;
+
end MLib.Tgt.VMS;
-- This is the VxWorks version of the body
with Sdefault;
-with Types; use Types;
package body MLib.Tgt.Specific is
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
function Dynamic_Option return String;
+ function Library_Major_Minor_Id_Supported return Boolean;
+
function PIC_Option return String;
function Standalone_Library_Auto_Init_Is_Supported return Boolean;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Auto_Init : Boolean := False)
is
pragma Unreferenced (Ofiles);
- pragma Unreferenced (Foreign);
- pragma Unreferenced (Afiles);
pragma Unreferenced (Options);
- pragma Unreferenced (Options_2);
pragma Unreferenced (Interfaces);
pragma Unreferenced (Lib_Filename);
pragma Unreferenced (Lib_Dir);
-----------------------------
function Get_Target_Suffix return String is
- Target_Name : constant String_Ptr := Sdefault.Target_Name;
+ Target_Name : constant String := Sdefault.Target_Name.all;
Index : Positive := Target_Name'First;
begin
end if;
end Get_Target_Suffix;
+ --------------------------------------
+ -- Library_Major_Minor_Id_Supported --
+ --------------------------------------
+
+ function Library_Major_Minor_Id_Supported return Boolean is
+ begin
+ return False;
+ end Library_Major_Minor_Id_Supported;
+
----------------
-- PIC_Option --
----------------
DLL_Ext_Ptr := DLL_Ext'Access;
Dynamic_Option_Ptr := Dynamic_Option'Access;
PIC_Option_Ptr := PIC_Option'Access;
+ Library_Major_Minor_Id_Supported_Ptr :=
+ Library_Major_Minor_Id_Supported'Access;
Standalone_Library_Auto_Init_Is_Supported_Ptr :=
Standalone_Library_Auto_Init_Is_Supported'Access;
Support_For_Libraries_Ptr := Support_For_Libraries'Access;
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Symbol_Data : Symbol_Record;
- Driver_Name : Name_Id := No_Name;
- Lib_Version : String := "";
- Auto_Init : Boolean := False)
+ Driver_Name : Name_Id := No_Name;
+ Lib_Version : String := "";
+ Auto_Init : Boolean := False)
is
begin
Build_Dynamic_Library_Ptr
(Ofiles,
- Foreign,
- Afiles,
Options,
- Options_2,
Interfaces,
Lib_Filename,
Lib_Dir,
(In_Tree.Projects.Table (Project).Library_Name);
begin
- if In_Tree.Projects.Table (Project).Library_Kind = Static then
+ if In_Tree.Projects.Table (Project).Library_Kind =
+ Static
+ then
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
end if;
end Library_File_Name_For_Default;
+ --------------------------------------
+ -- Library_Major_Minor_Id_Supported --
+ --------------------------------------
+
+ function Library_Major_Minor_Id_Supported return Boolean is
+ begin
+ return Library_Major_Minor_Id_Supported_Ptr.all;
+ end Library_Major_Minor_Id_Supported;
+
+ ----------------------------------------------
+ -- Library_Major_Minor_Id_Supported_Default --
+ ----------------------------------------------
+
+ function Library_Major_Minor_Id_Supported_Default return Boolean is
+ begin
+ return True;
+ end Library_Major_Minor_Id_Supported_Default;
+
----------------
-- Object_Ext --
----------------
begin
return Full;
end Support_For_Libraries_Default;
-
end MLib.Tgt;
package MLib.Tgt is
- type Library_Support is (None, Static_Only, Full);
- -- Support for Library Project File.
- -- - None: Library Project Files are not supported at all
- -- - Static_Only: Library Project Files are only supported for static
- -- libraries.
- -- - Full: Library Project Files are supported for static and dynamic
- -- (shared) libraries.
-
function Support_For_Libraries return Library_Support;
-- Indicates how building libraries by gnatmake is supported by the GNAT
-- implementation for the platform.
procedure Build_Dynamic_Library
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Symbol_Data : Symbol_Record;
- Driver_Name : Name_Id := No_Name;
- Lib_Version : String := "";
- Auto_Init : Boolean := False);
+ Driver_Name : Name_Id := No_Name;
+ Lib_Version : String := "";
+ Auto_Init : Boolean := False);
-- Build a dynamic/relocatable library
--
-- Ofiles is the list of all object files in the library
--
- -- Foreign is the list of non Ada object files (also included in Ofiles)
- --
- -- Afiles is the list of ALI files for the Ada object files
- --
- -- Options and Options_2 are lists of options to be passed to the tool
- -- (gcc or other) that effectively builds the dynamic library. Options
- -- are passed before the object files, Options_2 are passed after the
- -- object files.
+ -- Options is a list of options to be passed to the tool
+ -- (gcc or other) that effectively builds the dynamic library.
--
-- Interfaces is the list of ALI files for the interfaces of a SAL.
-- It is empty if the library is not a SAL.
-- Symbol_Data is used for some patforms, including VMS, to generate
-- the symbols to be exported by the library.
--
- -- Note: Depending on the OS, some of the parameters may not be taken
- -- into account. For example, on Linux, Foreign, Afiles Lib_Address and
- -- Relocatable are ignored.
+ -- Note: Depending on the OS, some of the parameters may not be taken into
+ -- account. For example, on Linux, Interfaces, Symbol_Data and Auto_Init
+ -- are ignored.
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean;
-- Returns the file name of the library file of a library project.
-- This function can only be called for library projects.
+ function Library_Major_Minor_Id_Supported return Boolean;
+ -- Indicates if major and minor ids are supported for libraries.
+ -- If they are supported, then a Library_Version such as libtoto.so.1.2
+ -- will have a major id of 1 and a minor id of 2. Then litoto.so,
+ -- libtoto.so.1 and libtoto.so.1.2 will be created, all three designating
+ -- the same file.
+
private
+ No_Argument_List : constant Argument_List := (1 .. 0 => null);
+
-- Access to subprogram types for indirection
type String_Function is access function return String;
return String_List_Access;
type Build_Dynamic_Library_Function is access procedure
(Ofiles : Argument_List;
- Foreign : Argument_List;
- Afiles : Argument_List;
Options : Argument_List;
- Options_2 : Argument_List;
Interfaces : Argument_List;
Lib_Filename : String;
Lib_Dir : String;
Driver_Name : Name_Id := No_Name;
Lib_Version : String := "";
Auto_Init : Boolean := False);
-
type Library_Exists_For_Function is access function
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean;
-
type Library_File_Name_For_Function is access function
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return File_Name_Type;
-
type Boolean_Function is access function return Boolean;
-
type Library_Support_Function is access function return Library_Support;
function Archive_Builder_Default return String;
Archive_Builder_Options_Default'Access;
function Archive_Builder_Append_Options_Default return String_List_Access;
-
- Archive_Builder_Append_Options_Ptr :
- String_List_Access_Function :=
- Archive_Builder_Append_Options_Default'Access;
+ Archive_Builder_Append_Options_Ptr : String_List_Access_Function :=
+ Archive_Builder_Append_Options_Default'Access;
function Archive_Ext_Default return String;
Archive_Ext_Ptr : String_Function := Archive_Ext_Default'Access;
function Support_For_Libraries_Default return Library_Support;
Support_For_Libraries_Ptr : Library_Support_Function :=
Support_For_Libraries_Default'Access;
+
+ function Library_Major_Minor_Id_Supported_Default return Boolean;
+ Library_Major_Minor_Id_Supported_Ptr : Boolean_Function :=
+ Library_Major_Minor_Id_Supported_Default'Access;
end MLib.Tgt;
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...");
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);
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;
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");
+
+ 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 --
--------------------------------
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
package MLib is
+ No_Argument_List : aliased String_List := (1 .. 0 => null);
+ No_Argument : constant String_List_Access := No_Argument_List'Access;
+
Max_Characters_In_Library_Name : constant := 20;
-- Maximum number of characters in a library name.
-- Used by Check_Library_Name below.
procedure Build_Library
(Ofiles : Argument_List;
- Afiles : Argument_List;
Output_File : String;
Output_Dir : String);
-- Build a static library from a set of object files
-- Copy all ALI files Files to directory To.
-- Mark Interfaces ALI files as interfaces, if any.
+ procedure Create_Sym_Links
+ (Lib_Path : String;
+ Lib_Version : String;
+ Lib_Dir : String;
+ Maj_Version : String);
+
function Linker_Library_Path_Option return String_Access;
-- Linker option to specify to the linker the library directory path.
-- If non null, the library directory path is to be appended.
-- Should be deallocated by the caller, when no longer needed.
+ function Major_Id_Name
+ (Lib_Filename : String;
+ Lib_Version : String) return String;
+ -- Returns the major id library file name, if it exists.
+ -- For example, if Lib_Filename is "libtoto.so" and Lib_Version is
+ -- "libtoto.so.1.2", then "libtoto.so.1" is returned.
+
private
Preserve : Attribute := Time_Stamps;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
First : Boolean := True;
-- Flag used when Load_Project_File is called the first time,
-- to set Main_Source_File.
- -- The flag is reset to False at the first call to Load_Project_File
+ -- The flag is reset to False at the first call to Load_Project_File.
+ -- Calling Reset_First sets it back to True.
-----------------------
-- Load_Project_File --
return X;
end Load_Project_File;
+ -----------------
+ -- Reset_First --
+ -----------------
+
+ procedure Reset_First is
+ begin
+ First := True;
+ end Reset_First;
+
--------------------------------
-- Restore_Project_Scan_State --
--------------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2002, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
-- Load into memory the source of a project source file.
-- Initialize the Scans state.
+ procedure Reset_First;
+ -- Indicate that the next project loaded should be considered as the first
+ -- one, so that Sinput.Main_Source_File is set for this project file. This
+ -- is to get the correct number of lines when error finalization is called.
+
function Source_File_Is_Subunit (X : Source_File_Index) return Boolean;
-- This function determines if a source file represents a subunit. It
-- works by scanning for the first compilation unit token, and returning
projects / platform / upstream / linaro-gcc.git / commitdiff