X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fmlib-prj.adb;h=83c74b948429fae6f1f3fd62bb3c1fd116943e1d;hb=c75a2739c2dd84336557e95cf655eceb163fc341;hp=97a4c16180fc7a55b578f8975967f1a9e7e62d82;hpb=10f7f083d5c72bdcc0c54d655458c1f00fc68818;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 97a4c16180f..83c74b94842 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2010, AdaCore -- +-- Copyright (C) 2001-2011, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -25,6 +25,7 @@ with ALI; use ALI; with Gnatvsn; use Gnatvsn; +with Makeutl; use Makeutl; with MLib.Fil; use MLib.Fil; with MLib.Tgt; use MLib.Tgt; with MLib.Utl; use MLib.Utl; @@ -69,27 +70,30 @@ package body MLib.Prj is S_Dec_Ads : File_Name_Type := No_File; -- Name_Id for "dec.ads" - G_Trasym_Ads : File_Name_Type := No_File; - -- Name_Id for "g-trasym.ads" - 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 - -- the ALI files to the library directory. + -- Used to accumulate arguments for the invocation of gnatbind and of the + -- compiler. Also used to collect the interface ALI when copying the ALI + -- files to the library directory. Argument_Number : Natural := 0; -- Index of the last argument in Arguments Initial_Argument_Max : constant := 10; + -- Where does the magic constant 10 come from??? + + No_Main_String : aliased String := "-n"; + No_Main : constant String_Access := No_Main_String'Access; - No_Main_String : aliased String := "-n"; - No_Main : constant String_Access := No_Main_String'Access; + Output_Switch_String : aliased String := "-o"; + Output_Switch : constant String_Access := + Output_Switch_String'Access; - Output_Switch_String : aliased String := "-o"; - Output_Switch : constant String_Access := Output_Switch_String'Access; + Compile_Switch_String : aliased String := "-c"; + Compile_Switch : constant String_Access := + Compile_Switch_String'Access; - Compile_Switch_String : aliased String := "-c"; - Compile_Switch : constant String_Access := Compile_Switch_String'Access; + No_Warning_String : aliased String := "-gnatws"; + No_Warning : constant String_Access := No_Warning_String'Access; Auto_Initialize : constant String := "-a"; @@ -293,27 +297,21 @@ package body MLib.Prj is is Maximum_Size : Integer; pragma Import (C, Maximum_Size, "__gnat_link_max"); - -- Maximum number of bytes to put in an invocation of the - -- gnatbind. + -- Maximum number of bytes to put in an invocation of gnatbind Size : Integer; - -- The number of bytes for the invocation of the gnatbind + -- The number of bytes for the invocation of gnatbind Warning_For_Library : Boolean := False; - -- Set to True for the first warning about a unit missing from the - -- interface set. + -- Set True for first warning for a unit missing from the interface set Current_Proj : Project_Id; Libgnarl_Needed : Yes_No_Unknown := For_Project.Libgnarl_Needed; - -- Set to True if library needs to be linked with libgnarl + -- Set True if library needs to be linked with libgnarl 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. + -- On OpenVMS, set True if library needs to be linked with libdecgnat Object_Directory_Path : constant String := Get_Name_String @@ -351,15 +349,14 @@ package body MLib.Prj is -- Initial size of Rpath, when first allocated Path_Option : String_Access := Linker_Library_Path_Option; - -- If null, Path Option is not supported. - -- Not a constant so that it can be deallocated. + -- If null, Path Option is not supported. Not a constant so that it can + -- be deallocated. First_ALI : File_Name_Type := No_File; -- 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 name of the ALI file corresponding to Source to the Arguments procedure Add_Rpath (Path : String); -- Add a path name to Rpath @@ -372,8 +369,7 @@ package body MLib.Prj is -- to link with -lgnarl (this is the case when there is a dependency -- on s-osinte.ads). On OpenVMS, set Libdecgnat_Needed if the ALI file -- indicates that there is a need to link with -ldecgnat (this is the - -- case when there is a dependency on dec.ads), and set - -- Gtrasymobj_Needed if there is a dependency on g-trasym.ads. + -- case when there is a dependency on dec.ads). procedure Process (The_ALI : File_Name_Type); -- Check if the closure of a library unit which is or should be in the @@ -510,8 +506,7 @@ package body MLib.Prj is if Libgnarl_Needed /= Yes or else (Main_Project - and then OpenVMS_On_Target - and then ((not Libdecgnat_Needed) or (not Gtrasymobj_Needed))) + and then OpenVMS_On_Target) then -- Scan the ALI file @@ -545,9 +540,6 @@ package body MLib.Prj is elsif OpenVMS_On_Target then if ALI.Sdep.Table (Index).Sfile = S_Dec_Ads then Libdecgnat_Needed := True; - - elsif ALI.Sdep.Table (Index).Sfile = G_Trasym_Ads then - Gtrasymobj_Needed := True; end if; end if; end loop; @@ -800,6 +792,9 @@ package body MLib.Prj is end loop; end Process_Imported_Libraries; + Path_FD : File_Descriptor := Invalid_FD; + -- Used for setting the source and object paths + -- Start of processing for Build_Library begin @@ -832,12 +827,6 @@ package body MLib.Prj is S_Dec_Ads := Name_Find; end if; - if G_Trasym_Ads = No_File then - Name_Len := 0; - Add_Str_To_Name_Buffer ("g-trasym.ads"); - G_Trasym_Ads := Name_Find; - end if; - -- We work in the object directory Change_Dir (Object_Directory_Path); @@ -862,7 +851,7 @@ package body MLib.Prj is Arguments := new String_List (1 .. Initial_Argument_Max); end if; - -- Add "-n -o b~.adb (b__.adb on VMS) -L" + -- Add "-n -o b~.adb (b__.adb on VMS) -L_" Argument_Number := 2; Arguments (1) := No_Main; @@ -875,7 +864,17 @@ package body MLib.Prj is Add_Argument (B_Start.all & Get_Name_String (For_Project.Library_Name) & ".adb"); - Add_Argument ("-L" & Get_Name_String (For_Project.Library_Name)); + + -- Make sure that the init procedure is never "adainit" + + Get_Name_String (For_Project.Library_Name); + + if Name_Buffer (1 .. Name_Len) = "ada" then + Add_Argument ("-Lada_"); + else + Add_Argument + ("-L" & Get_Name_String (For_Project.Library_Name)); + end if; if For_Project.Lib_Auto_Init and then SALs_Use_Constructors then Add_Argument (Auto_Initialize); @@ -889,7 +888,7 @@ package body MLib.Prj is Value_Of (Name => Name_Binder, In_Packages => For_Project.Decl.Packages, - In_Tree => In_Tree); + Shared => In_Tree.Shared); begin if Binder_Package /= No_Package then @@ -898,12 +897,12 @@ package body MLib.Prj is Value_Of (Name => Name_Default_Switches, In_Arrays => - In_Tree.Packages.Table + In_Tree.Shared.Packages.Table (Binder_Package).Decl.Arrays, - In_Tree => In_Tree); - Switches : Variable_Value := Nil_Variable_Value; + Shared => In_Tree.Shared); - Switch : String_List_Id := Nil_String; + Switches : Variable_Value := Nil_Variable_Value; + Switch : String_List_Id := Nil_String; begin if Defaults /= No_Array_Element then @@ -912,7 +911,7 @@ package body MLib.Prj is (Index => Name_Ada, Src_Index => 0, In_Array => Defaults, - In_Tree => In_Tree); + Shared => In_Tree.Shared); if not Switches.Default then Switch := Switches.Values; @@ -920,9 +919,9 @@ package body MLib.Prj is while Switch /= Nil_String loop Add_Argument (Get_Name_String - (In_Tree.String_Elements.Table + (In_Tree.Shared.String_Elements.Table (Switch).Value)); - Switch := In_Tree.String_Elements. + Switch := In_Tree.Shared.String_Elements. Table (Switch).Next; end loop; end if; @@ -950,16 +949,15 @@ package body MLib.Prj is then if Check_Project (Unit.File_Names (Impl).Project) then if Unit.File_Names (Spec) = null then - declare - Src_Ind : Source_File_Index; - begin - Src_Ind := Sinput.P.Load_Project_File - (Get_Name_String - (Unit.File_Names (Impl).Path.Name)); - - -- Add the ALI file only if it is not a subunit + -- Add the ALI file only if it is not a subunit + declare + Src_Ind : constant Source_File_Index := + Sinput.P.Load_Project_File + (Get_Name_String + (Unit.File_Names (Impl).Path.Name)); + begin if not Sinput.P.Source_File_Is_Subunit (Src_Ind) then @@ -1033,10 +1031,54 @@ package body MLib.Prj is -- Set the paths - Set_Ada_Paths - (Project => For_Project, - In_Tree => In_Tree, - Including_Libraries => True); + -- First the source path + + if For_Project.Include_Path_File = No_Path then + Get_Directories + (Project_Tree => In_Tree, + For_Project => For_Project, + Activity => Compilation, + Languages => Ada_Only); + + Create_New_Path_File + (In_Tree.Shared, Path_FD, For_Project.Include_Path_File); + + Write_Path_File (Path_FD); + Path_FD := Invalid_FD; + end if; + + if Current_Source_Path_File_Of (In_Tree.Shared) /= + For_Project.Include_Path_File + then + Set_Current_Source_Path_File_Of + (In_Tree.Shared, For_Project.Include_Path_File); + Set_Path_File_Var + (Project_Include_Path_File, + Get_Name_String (For_Project.Include_Path_File)); + end if; + + -- Then, the object path + + Get_Directories + (Project_Tree => In_Tree, + For_Project => For_Project, + Activity => SAL_Binding, + Languages => Ada_Only); + + declare + Path_File_Name : Path_Name_Type; + + begin + Create_New_Path_File (In_Tree.Shared, Path_FD, Path_File_Name); + + Write_Path_File (Path_FD); + Path_FD := Invalid_FD; + + Set_Path_File_Var + (Project_Objects_Path_File, Get_Name_String (Path_File_Name)); + Set_Current_Source_Path_File_Of + (In_Tree.Shared, Path_File_Name); + end; -- Display the gnatbind command, if not in quiet output @@ -1055,9 +1097,9 @@ package body MLib.Prj is Arguments (1 .. Argument_Number), Success); - else - -- Otherwise create a temporary response file + -- Otherwise create a temporary response file + else declare FD : File_Descriptor; Path : Path_Name_Type; @@ -1168,15 +1210,15 @@ package body MLib.Prj is -- Invoke -c b__.adb - -- Allocate Arguments, if it is the first time we see a standalone - -- library. + -- Allocate Arguments, if first time we see a standalone library if Arguments = No_Argument then Arguments := new String_List (1 .. Initial_Argument_Max); end if; - Argument_Number := 1; + Argument_Number := 2; Arguments (1) := Compile_Switch; + Arguments (2) := No_Warning; if OpenVMS_On_Target then B_Start := new String'("b__"); @@ -1234,8 +1276,7 @@ package body MLib.Prj is end; end if; - -- Now that all the arguments are set, compile the binder - -- generated file. + -- Now all the arguments are set, compile binder generated file Display (Gcc); Spawn @@ -1249,7 +1290,7 @@ package body MLib.Prj is -- Process binder generated file for pragmas Linker_Options - Process_Binder_File (Arguments (2).all & ASCII.NUL); + Process_Binder_File (Arguments (3).all & ASCII.NUL); end if; end if; @@ -1264,11 +1305,11 @@ package body MLib.Prj is Driver_Name := Name_Id (For_Project.Config.Shared_Lib_Driver); end if; - -- If attribute Library_Options was specified, add these additional - -- options. + -- If attribute Library_Options was specified, add these options Library_Options := Value_Of - (Name_Library_Options, For_Project.Decl.Attributes, In_Tree); + (Name_Library_Options, For_Project.Decl.Attributes, + In_Tree.Shared); if not Library_Options.Default then declare @@ -1278,7 +1319,7 @@ package body MLib.Prj is begin Current := Library_Options.Values; while Current /= Nil_String loop - Element := In_Tree.String_Elements.Table (Current); + Element := In_Tree.Shared.String_Elements.Table (Current); Get_Name_String (Element.Value); if Name_Len /= 0 then @@ -1294,8 +1335,8 @@ package body MLib.Prj is Lib_Dirpath := new String'(Get_Name_String (For_Project.Library_Dir.Display_Name)); - Lib_Filename := new String' - (Get_Name_String (For_Project.Library_Name)); + Lib_Filename := + new String'(Get_Name_String (For_Project.Library_Name)); case For_Project.Library_Kind is when Static => @@ -1340,7 +1381,7 @@ package body MLib.Prj is loop if Current_Proj.Object_Directory /= No_Path_Information then - -- The following code gets far too indented, I suggest some + -- The following code gets far too indented ... suggest some -- procedural abstraction here. How about making this declare -- block a named procedure??? @@ -1374,12 +1415,12 @@ package body MLib.Prj is (Object_Dir_Path & Directory_Separator & Filename (1 .. Last)); + Object_File : constant String := + Filename (1 .. Last); - C_Object_Path : String := Object_Path; - C_Filename : String := Filename (1 .. Last); + C_Filename : String := Object_File; begin - Canonical_Case_File_Name (C_Object_Path); Canonical_Case_File_Name (C_Filename); -- If in the object directory of an extended @@ -1390,20 +1431,17 @@ package body MLib.Prj is or else C_Filename (1 .. B_Start'Length) /= B_Start.all then - Name_Len := Last; - Name_Buffer (1 .. Name_Len) := - C_Filename (1 .. Last); + Name_Len := 0; + Add_Str_To_Name_Buffer (C_Filename); Id := Name_Find; if not Objects_Htable.Get (Id) then declare ALI_File : constant String := - Ext_To - (C_Filename - (1 .. Last), "ali"); + Ext_To (C_Filename, "ali"); ALI_Path : constant String := - Ext_To (C_Object_Path, "ali"); + Ext_To (Object_Path, "ali"); Add_It : Boolean; Fname : File_Name_Type; @@ -1501,8 +1539,7 @@ package body MLib.Prj is ALIs.Append (new String'(ALI_Path)); -- Find out if for this ALI file, - -- libgnarl or libdecgnat or - -- g-trasym.obj (on OpenVMS) is + -- libgnarl or libdecgnat is -- necessary. Check_Libs (ALI_Path, True); @@ -1547,8 +1584,7 @@ package body MLib.Prj is Opts.Increment_Last; Opts.Table (Opts.Last) := new String'("-L" & Lib_Directory); - -- If Path Option is supported, add libgnat directory path name to - -- Rpath. + -- If Path Option supported, add libgnat directory path name to Rpath if Path_Option /= null then declare @@ -1588,12 +1624,6 @@ package body MLib.Prj is end if; end if; - if Gtrasymobj_Needed then - Opts.Increment_Last; - Opts.Table (Opts.Last) := - new String'(Lib_Directory & "/g-trasym.obj"); - end if; - if Libdecgnat_Needed then Opts.Increment_Last; @@ -1751,12 +1781,12 @@ package body MLib.Prj is while Iface /= Nil_String loop ALI := File_Name_Type - (In_Tree.String_Elements.Table (Iface).Value); + (In_Tree.Shared.String_Elements.Table (Iface).Value); Interface_ALIs.Set (ALI, True); Get_Name_String - (In_Tree.String_Elements.Table (Iface).Value); + (In_Tree.Shared.String_Elements.Table (Iface).Value); Add_Argument (Name_Buffer (1 .. Name_Len)); - Iface := In_Tree.String_Elements.Table (Iface).Next; + Iface := In_Tree.Shared.String_Elements.Table (Iface).Next; end loop; Iface := For_Project.Lib_Interface_ALIs; @@ -1770,9 +1800,10 @@ package body MLib.Prj is while Iface /= Nil_String loop ALI := File_Name_Type - (In_Tree.String_Elements.Table (Iface).Value); + (In_Tree.Shared.String_Elements.Table (Iface).Value); Process (ALI); - Iface := In_Tree.String_Elements.Table (Iface).Next; + Iface := + In_Tree.Shared.String_Elements.Table (Iface).Next; end loop; end if; end; @@ -1801,7 +1832,7 @@ package body MLib.Prj is -- the library file and any ALI file of a source of the project. begin - Get_Name_String (For_Project.Library_Dir.Name); + Get_Name_String (For_Project.Library_Dir.Display_Name); Change_Dir (Name_Buffer (1 .. Name_Len)); exception @@ -1942,7 +1973,7 @@ package body MLib.Prj is Copy_ALI_Files (Files => Ali_Files.all, - To => For_Project.Library_ALI_Dir.Name, + To => For_Project.Library_ALI_Dir.Display_Name, Interfaces => Arguments (1 .. Argument_Number)); -- Copy interface sources if Library_Src_Dir specified @@ -1954,7 +1985,7 @@ package body MLib.Prj is -- could be a source of the project. begin - Get_Name_String (For_Project.Library_Src_Dir.Name); + Get_Name_String (For_Project.Library_Src_Dir.Display_Name); Change_Dir (Name_Buffer (1 .. Name_Len)); exception @@ -2085,7 +2116,8 @@ package body MLib.Prj is Lib_Name : constant File_Name_Type := Library_File_Name_For (For_Project, In_Tree); begin - Change_Dir (Get_Name_String (For_Project.Library_Dir.Name)); + Change_Dir + (Get_Name_String (For_Project.Library_Dir.Display_Name)); Lib_TS := File_Stamp (Lib_Name); For_Project.Library_TS := Lib_TS; end; @@ -2107,7 +2139,7 @@ package body MLib.Prj is -- be Empty_Time_Stamp, earlier than any other time stamp. Change_Dir - (Get_Name_String (For_Project.Object_Directory.Name)); + (Get_Name_String (For_Project.Object_Directory.Display_Name)); Open (Dir => Object_Dir, Dir_Name => "."); -- For all entries in the object directory @@ -2212,7 +2244,7 @@ package body MLib.Prj is begin -- Change the working directory to the object directory - Change_Dir (Get_Name_String (For_Project.Object_Directory.Name)); + Change_Dir (Get_Name_String (For_Project.Object_Directory.Display_Name)); for Index in Interfaces'Range loop