From f86eb278906f1cf6b948c0a26517f77f76ed1b4c Mon Sep 17 00:00:00 2001 From: Vincent Celier Date: Tue, 14 Aug 2007 10:48:16 +0200 Subject: [PATCH] gnatls.adb: (Corresponding_Sdep_Entry): Always return a value 2007-08-14 Vincent Celier * gnatls.adb: (Corresponding_Sdep_Entry): Always return a value (Output_Source): Do nothing if parameter is No_Sdep_Id * make.adb (Gnatmake): Do not rebuild an archive simply because a shared library it imports has a later time stamp. (Check): Resolve the symbolic links in the path name of the object directory. Check that the ALI file is in the correct object directory Check if a file name does not correspond to the mapping of units to file names. (Display_Version): New procedure (Initialize): Process switches --version and --help Use type Path_Name_Type for path name From-SVN: r127453 --- gcc/ada/gnatls.adb | 15 +- gcc/ada/make.adb | 520 ++++++++++++++++++++++++++++++++++----------- 2 files changed, 411 insertions(+), 124 deletions(-) diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index dcef59d3dd5..bd6af56f9c6 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -263,6 +263,7 @@ procedure Gnatls is Write_Eol; Error_Msg ("wrong ALI format, can't find dependency line for $ in {"); Exit_Program (E_Fatal); + return No_Sdep_Id; end Corresponding_Sdep_Entry; ------------------------- @@ -899,13 +900,21 @@ procedure Gnatls is ------------------- procedure Output_Source (Sdep_I : Sdep_Id) is - Stamp : constant Time_Stamp_Type := Sdep.Table (Sdep_I).Stamp; - Checksum : constant Word := Sdep.Table (Sdep_I).Checksum; - FS : File_Name_Type := Sdep.Table (Sdep_I).Sfile; + Stamp : Time_Stamp_Type; + Checksum : Word; + FS : File_Name_Type; Status : File_Status; Object_Name : String_Access; begin + if Sdep_I = No_Sdep_Id then + return; + end if; + + Stamp := Sdep.Table (Sdep_I).Stamp; + Checksum := Sdep.Table (Sdep_I).Checksum; + FS := Sdep.Table (Sdep_I).Sfile; + if Print_Source then Find_Status (FS, Stamp, Checksum, Status); Get_Name_String (FS); diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 7fe2d28d8c5..aa8e5f7d2f2 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -63,9 +63,9 @@ with Ada.Exceptions; use Ada.Exceptions; with Ada.Command_Line; use Ada.Command_Line; with GNAT.Directory_Operations; use GNAT.Directory_Operations; +with GNAT.Case_Util; use GNAT.Case_Util; +with GNAT.OS_Lib; use GNAT.OS_Lib; -with System.Case_Util; use System.Case_Util; -with System.OS_Lib; use System.OS_Lib; with System.HTable; package body Make is @@ -179,7 +179,7 @@ package body Make is package Q is new Table.Table ( Table_Component_Type => Q_Record, - Table_Index_Type => Integer, + Table_Index_Type => Natural, Table_Low_Bound => 0, Table_Initial => 4000, Table_Increment => 100, @@ -392,6 +392,8 @@ package body Make is Shared_String : aliased String := "-shared"; Force_Elab_Flags_String : aliased String := "-F"; + Version_Switch : constant String := "--version"; + Help_Switch : constant String := "--help"; No_Shared_Switch : aliased Argument_List := (1 .. 0 => null); Shared_Switch : aliased Argument_List := (1 => Shared_String'Access); @@ -466,6 +468,9 @@ package body Make is -- A table to keep dependencies, to be able to decide if an executable -- is obsolete. More explanation needed ??? +-- procedure Add_Dependency (S : File_Name_Type; On : File_Name_Type); +-- -- Add one entry in table Dependencies + ---------------------------- -- Arguments and Switches -- ---------------------------- @@ -483,7 +488,7 @@ package body Make is Arguments_Project : Project_Id; -- Project id, if any, of the source to be compiled - Arguments_Path_Name : File_Name_Type; + Arguments_Path_Name : Path_Name_Type; -- Full path of the source to be compiled, when Arguments_Project is not -- No_Project. @@ -504,6 +509,9 @@ package body Make is -- Misc Routines -- ------------------- + procedure Display_Version; + -- Display version when switch --version is used + procedure List_Depend; -- Prints to standard output the list of object dependencies. This list -- can be used directly in a Makefile. A call to Compile_Sources must @@ -512,11 +520,6 @@ package body Make is -- no additional ALI files should be scanned between the two calls (i.e. -- between the call to Compile_Sources and List_Depend.) - procedure Inform (N : Name_Id; Msg : String); - procedure Inform (N : File_Name_Type; Msg : String); - procedure Inform (Msg : String); - -- Prints out the program name followed by a colon, N (if present) and Msg - procedure List_Bad_Compilations; -- Prints out the list of all files for which the compilation failed @@ -650,11 +653,11 @@ package body Make is -- Given by the command line. Will be used, if non null Gcc_Path : String_Access := - System.OS_Lib.Locate_Exec_On_Path (Gcc.all); + GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all); Gnatbind_Path : String_Access := - System.OS_Lib.Locate_Exec_On_Path (Gnatbind.all); + GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all); Gnatlink_Path : String_Access := - System.OS_Lib.Locate_Exec_On_Path (Gnatlink.all); + GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all); -- Path for compiler, binder, linker programs, defaulted now for gnatdist. -- Changed later if overridden on command line. @@ -1018,6 +1021,16 @@ package body Make is Last_Argument := Last_Argument + Args'Length; end Add_Arguments; +-- -------------------- +-- -- Add_Dependency -- +-- -------------------- +-- +-- procedure Add_Dependency (S : File_Name_Type; On : File_Name_Type) is +-- begin +-- Dependencies.Increment_Last; +-- Dependencies.Table (Dependencies.Last) := (S, On); +-- end Add_Dependency; + ---------------------------- -- Add_Library_Search_Dir -- ---------------------------- @@ -1315,7 +1328,7 @@ package body Make is Bind_Last := Bind_Last + 1; Bind_Args (Bind_Last) := new String'(Name_Buffer (1 .. Name_Len)); - System.OS_Lib.Normalize_Arguments (Bind_Args (Args'First .. Bind_Last)); + GNAT.OS_Lib.Normalize_Arguments (Bind_Args (Args'First .. Bind_Last)); Display (Gnatbind.all, Bind_Args (Args'First .. Bind_Last)); @@ -1323,7 +1336,7 @@ package body Make is Make_Failed ("error, unable to locate ", Gnatbind.all); end if; - System.OS_Lib.Spawn + GNAT.OS_Lib.Spawn (Gnatbind_Path.all, Bind_Args (Args'First .. Bind_Last), Success); if not Success then @@ -1536,6 +1549,10 @@ package body Make is Switch_Found : Boolean; -- True if a given switch has been found + ALI_Project : Project_Id; + -- If the ALI file is in the object directory of a project, this is + -- the project id. + -- Start of processing for Check begin @@ -1779,6 +1796,228 @@ package body Make is Verbose_Msg (New_Spec, "old spec missing"); end if; end if; + + elsif Main_Project /= No_Project then + + -- Check if a file name does not correspond to the mapping of + -- units to file names. + + declare + WR : With_Record; + Unit_Name : Name_Id; + UID : Prj.Unit_Index; + U_Data : Unit_Data; + + begin + U_Chk : + for U in ALIs.Table (ALI).First_Unit .. + ALIs.Table (ALI).Last_Unit + loop + W_Check : + for W in Units.Table (U).First_With + .. + Units.Table (U).Last_With + loop + WR := Withs.Table (W); + + if WR.Sfile /= No_File then + Get_Name_String (WR.Uname); + Name_Len := Name_Len - 2; + Unit_Name := Name_Find; + + UID := Units_Htable.Get + (Project_Tree.Units_HT, Unit_Name); + + if UID /= Prj.No_Unit_Index then + U_Data := Project_Tree.Units.Table (UID); + + if U_Data.File_Names (Body_Part).Name /= WR.Sfile + and then + U_Data.File_Names (Specification).Name /= + WR.Sfile + then + ALI := No_ALI_Id; + + Verbose_Msg + (Unit_Name, " sources does not include ", + Name_Id (WR.Sfile)); + + return; + end if; + end if; + end if; + end loop W_Check; + end loop U_Chk; + end; + + -- Check that the ALI file is in the correct object directory. + -- If it is in the object directory of a project that is + -- extended and it depends on a source that is in one of its + -- extending projects, then the ALI file is not in the correct + -- object directory. + + -- First, find the project of this ALI file. As there may be + -- several projects with the same object directory, we first + -- need to find the project of the source. + + ALI_Project := No_Project; + + declare + Udata : Prj.Unit_Data; + + begin + for U in 1 .. Unit_Table.Last (Project_Tree.Units) loop + Udata := Project_Tree.Units.Table (U); + + if Udata.File_Names (Body_Part).Name = Source_File then + ALI_Project := Udata.File_Names (Body_Part).Project; + exit; + + elsif + Udata.File_Names (Specification).Name = Source_File + then + ALI_Project := + Udata.File_Names (Specification).Project; + exit; + end if; + end loop; + end; + + if ALI_Project = No_Project then + return; + end if; + + declare + Obj_Dir : Path_Name_Type; + Res_Obj_Dir : constant String := + Normalize_Pathname + (Dir_Name + (Get_Name_String (Full_Lib_File)), + Resolve_Links => True, + Case_Sensitive => False); + + begin + Name_Len := 0; + Add_Str_To_Name_Buffer (Res_Obj_Dir); + + if Name_Len > 1 and then + (Name_Buffer (Name_Len) = '/' or else + Name_Buffer (Name_Len) = Directory_Separator) + then + Name_Len := Name_Len - 1; + end if; + + Obj_Dir := Name_Find; + + while ALI_Project /= No_Project and then + Obj_Dir /= + Project_Tree.Projects.Table + (ALI_Project).Object_Directory + loop + ALI_Project := + Project_Tree.Projects.Table (ALI_Project).Extended_By; + end loop; + end; + + if ALI_Project = No_Project then + ALI := No_ALI_Id; + + Verbose_Msg + (Lib_File, " wrong object directory"); + return; + end if; + + -- If the ALI project is not extended, then it must be in + -- the correct object directory. + + if Project_Tree.Projects.Table (ALI_Project).Extended_By = + No_Project + then + return; + end if; + + -- Count the extending projects + + declare + Num_Ext : Natural; + Proj : Project_Id; + + begin + Num_Ext := 0; + Proj := ALI_Project; + loop + Proj := Project_Tree.Projects.Table (Proj).Extended_By; + exit when Proj = No_Project; + Num_Ext := Num_Ext + 1; + end loop; + + -- Make a list of the extending projects + + declare + Projects : array (1 .. Num_Ext) of Project_Id; + Dep : Sdep_Record; + OK : Boolean := True; + + begin + Proj := ALI_Project; + for J in Projects'Range loop + Proj := Project_Tree.Projects.Table (Proj).Extended_By; + Projects (J) := Proj; + end loop; + + -- Now check if any of the dependant sources are in + -- any of these extending projects. + + D_Chk : + for D in ALIs.Table (ALI).First_Sdep .. + ALIs.Table (ALI).Last_Sdep + loop + Dep := Sdep.Table (D); + + Proj := No_Project; + + Unit_Loop : + for + UID in 1 .. Unit_Table.Last (Project_Tree.Units) + loop + if Project_Tree.Units.Table (UID). + File_Names (Body_Part).Name = Dep.Sfile + then + Proj := Project_Tree.Units.Table (UID). + File_Names (Body_Part).Project; + + elsif Project_Tree.Units.Table (UID). + File_Names (Specification).Name = Dep.Sfile + then + Proj := Project_Tree.Units.Table (UID). + File_Names (Specification).Project; + end if; + + -- If a source is in a project, check if it is one + -- in the list. + + if Proj /= No_Project then + for J in Projects'Range loop + if Proj = Projects (J) then + OK := False; + exit D_Chk; + end if; + end loop; + + exit Unit_Loop; + end if; + end loop Unit_Loop; + end loop D_Chk; + + -- If one of the dependent sources is in one project of + -- the list, then we must recompile. + + if not OK then + ALI := No_ALI_Id; + Verbose_Msg (Lib_File, " wrong object directory"); + end if; + end; + end; end if; end if; end if; @@ -2033,7 +2272,7 @@ package body Make is Add_Arguments (The_Saved_Gcc_Switches.all); elsif not Project_Tree.Projects.Table - (Arguments_Project).Externally_Built + (Arguments_Project).Externally_Built then -- We get the project directory for the relative path -- switches and arguments. @@ -2570,7 +2809,7 @@ package body Make is Prj.Env.Set_Ada_Paths (Arguments_Project, Project_Tree, True); if not Unique_Compile - and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None + and then MLib.Tgt.Support_For_Libraries /= Prj.None then declare The_Data : Project_Data := @@ -2609,13 +2848,12 @@ package body Make is Change_To_Object_Directory (Arguments_Project); - Pid := Compile (Arguments_Path_Name, Lib_File, Source_Index, - Arguments (1 .. Last_Argument)); - - -- Register compiled unit into Full_Source_File as this is the - -- variable used to report errors. - - Full_Source_File := Arguments_Path_Name; + Pid := + Compile + (File_Name_Type (Arguments_Path_Name), + Lib_File, + Source_Index, + Arguments (1 .. Last_Argument)); Process_Created := True; end if; @@ -2817,8 +3055,7 @@ package body Make is Comp_Last := Comp_Last + 1; Comp_Args (Comp_Last) := new String'(Name_Buffer (1 .. Name_Len)); - System.OS_Lib.Normalize_Arguments - (Comp_Args (Args'First .. Comp_Last)); + GNAT.OS_Lib.Normalize_Arguments (Comp_Args (Args'First .. Comp_Last)); Comp_Last := Comp_Last + 1; Comp_Args (Comp_Last) := new String'("-gnatez"); @@ -2830,7 +3067,7 @@ package body Make is end if; return - System.OS_Lib.Non_Blocking_Spawn + GNAT.OS_Lib.Non_Blocking_Spawn (Gcc_Path.all, Comp_Args (Args'First .. Comp_Last)); end Compile; @@ -3150,7 +3387,6 @@ package body Make is if Process_Created then if Pid = Invalid_Pid then Record_Failure (Full_Source_File, Source_Unit); - else Add_Process (Pid, @@ -3309,7 +3545,7 @@ package body Make is if Main_Project /= No_Project then declare Unit_Name : Name_Id; - Uid : Prj.Unit_Id; + Uid : Prj.Unit_Index; Udata : Unit_Data; begin @@ -3320,7 +3556,7 @@ package body Make is Units_Htable.Get (Project_Tree.Units_HT, Unit_Name); - if Uid /= Prj.No_Unit then + if Uid /= Prj.No_Unit_Index then Udata := Project_Tree.Units.Table (Uid); if Udata.File_Names (Body_Part).Name /= @@ -3365,7 +3601,8 @@ package body Make is Debug_Msg ("Skipping internal file:", Sfile); else - Insert_Q (Sfile, Uname, Source_Index); + Insert_Q + (Sfile, Withs.Table (K).Uname, Source_Index); Mark (Sfile, Source_Index); end if; end if; @@ -3507,7 +3744,7 @@ package body Make is Last : Natural := 0; function Absolute_Path - (Path : File_Name_Type; + (Path : Path_Name_Type; Project : Project_Id) return String; -- Returns an absolute path for a configuration pragmas file @@ -3516,7 +3753,7 @@ package body Make is ------------------- function Absolute_Path - (Path : File_Name_Type; + (Path : Path_Name_Type; Project : Project_Id) return String is begin @@ -3597,9 +3834,8 @@ package body Make is declare Path : constant String := Absolute_Path - (File_Name_Type (Global_Attribute.Value), + (Path_Name_Type (Global_Attribute.Value), Global_Attribute.Project); - begin if not Is_Regular_File (Path) then Make_Failed @@ -3636,9 +3872,8 @@ package body Make is declare Path : constant String := Absolute_Path - (File_Name_Type (Local_Attribute.Value), + (Path_Name_Type (Local_Attribute.Value), Local_Attribute.Project); - begin if not Is_Regular_File (Path) then Make_Failed @@ -3825,6 +4060,26 @@ package body Make is Display_Executed_Programs := Display; end Display_Commands; + --------------------- + -- Display_Version -- + --------------------- + + procedure Display_Version is + begin + Write_Str ("GNATMAKE "); + Write_Str (Gnatvsn.Gnat_Version_String); + Write_Eol; + + Write_Str ("Copyright (C) 1995-"); + Write_Str (Gnatvsn.Current_Year); + Write_Str (", Free Software Foundation, Inc."); + Write_Eol; + + Write_Str (Gnatvsn.Gnat_Free_Software); + Write_Eol; + Write_Eol; + end Display_Version; + ------------- -- Empty_Q -- ------------- @@ -3870,6 +4125,7 @@ package body Make is Name_Len := 0; Add_Str_To_Name_Buffer (Name (First .. Name'Last)); F2 := Name_Find; + else F2 := F; end if; @@ -4019,15 +4275,13 @@ package body Make is Real_Path := Locate_Regular_File (Main & - Get_Name_String - (Data.Naming.Ada_Body_Suffix), + Body_Suffix_Of (Project_Tree, "ada", Data.Naming), ""); if Real_Path = null then Real_Path := Locate_Regular_File (Main & - Get_Name_String - (Data.Naming.Ada_Spec_Suffix), + Spec_Suffix_Of (Project_Tree, "ada", Data.Naming), ""); end if; @@ -4140,6 +4394,7 @@ package body Make is begin Tempdir.Create_Temp_File (Mapping_FD, Mapping_Path); + Record_Temp_File (Mapping_Path); if Mapping_FD /= Invalid_FD then @@ -4150,15 +4405,14 @@ package body Make is loop declare Unit : constant Unit_Data := Project_Tree.Units.Table (J); - begin if Unit.Name /= No_Name then -- If there is a body, put it in the mapping if Unit.File_Names (Body_Part).Name /= No_File - and then Unit.File_Names (Body_Part).Project - /= No_Project + and then Unit.File_Names (Body_Part).Project /= + No_Project then Get_Name_String (Unit.Name); Name_Buffer (Name_Len + 1 .. Name_Len + 2) := "%b"; @@ -4175,7 +4429,7 @@ package body Make is elsif Unit.File_Names (Specification).Name /= No_File and then Unit.File_Names (Specification).Project /= - No_Project + No_Project then Get_Name_String (Unit.Name); Name_Buffer (Name_Len + 1 .. Name_Len + 2) := "%s"; @@ -4183,7 +4437,7 @@ package body Make is ALI_Unit := Name_Find; ALI_Name := Lib_File_Name - (Unit.File_Names (Specification).Display_Name); + (Unit.File_Names (Specification).Display_Name); ALI_Project := Unit.File_Names (Specification).Project; @@ -4712,26 +4966,26 @@ package body Make is not Unique_Compile); The_Packages : constant Package_Id := - Project_Tree.Projects.Table - (Main_Project).Decl.Packages; + Project_Tree.Projects.Table + (Main_Project).Decl.Packages; Builder_Package : constant Prj.Package_Id := - Prj.Util.Value_Of - (Name => Name_Builder, - In_Packages => The_Packages, - In_Tree => Project_Tree); + Prj.Util.Value_Of + (Name => Name_Builder, + In_Packages => The_Packages, + In_Tree => Project_Tree); Binder_Package : constant Prj.Package_Id := - Prj.Util.Value_Of - (Name => Name_Binder, - In_Packages => The_Packages, - In_Tree => Project_Tree); + Prj.Util.Value_Of + (Name => Name_Binder, + In_Packages => The_Packages, + In_Tree => Project_Tree); Linker_Package : constant Prj.Package_Id := - Prj.Util.Value_Of - (Name => Name_Linker, - In_Packages => The_Packages, - In_Tree => Project_Tree); + Prj.Util.Value_Of + (Name => Name_Linker, + In_Packages => The_Packages, + In_Tree => Project_Tree); begin -- We fail if we cannot find the main source file @@ -4902,6 +5156,7 @@ package body Make is begin Targparm.Get_Target_Parameters; + exception when Unrecoverable_Error => Make_Failed ("*** make failed."); @@ -4943,7 +5198,7 @@ package body Make is -- so that the library is generated. if not Unique_Compile - and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None + and then MLib.Tgt.Support_For_Libraries /= Prj.None then for Proj in Project_Table.First .. Project_Table.Last (Project_Tree.Projects) @@ -5135,9 +5390,9 @@ package body Make is Gnatlink := Saved_Gnatlink; end if; - Gcc_Path := System.OS_Lib.Locate_Exec_On_Path (Gcc.all); - Gnatbind_Path := System.OS_Lib.Locate_Exec_On_Path (Gnatbind.all); - Gnatlink_Path := System.OS_Lib.Locate_Exec_On_Path (Gnatlink.all); + Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all); + Gnatbind_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all); + Gnatlink_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all); -- If we have specified -j switch both from the project file -- and on the command line, the one from the command line takes @@ -5325,7 +5580,7 @@ package body Make is -- have been regenerated. if Main_Project /= No_Project - and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None + and then MLib.Tgt.Support_For_Libraries /= Prj.None and then (Do_Bind_Step or Unique_Compile_All_Projects or not Compile_Only) @@ -5403,10 +5658,13 @@ package body Make is Project_Table.Last (Project_Tree.Projects) loop if Project_Tree.Projects.Table (Proj1).Library + and then + Project_Tree.Projects.Table (Proj1).Library_Kind /= + Static and then not Project_Tree.Projects.Table - (Proj1).Need_To_Build_Lib + (Proj1).Need_To_Build_Lib and then not Project_Tree.Projects.Table - (Proj1).Externally_Built + (Proj1).Externally_Built then declare List : Project_List; @@ -5416,7 +5674,7 @@ package body Make is Lib_Timestamp1 : constant Time_Stamp_Type := Project_Tree.Projects.Table - (Proj1). Library_TS; + (Proj1).Library_TS; begin List := Project_Tree.Projects.Table (Proj1). @@ -5593,11 +5851,13 @@ package body Make is end if; if Executable_Stamp (1) = ' ' then - Verbose_Msg (Executable, "missing.", Prefix => " "); + if not No_Main_Subprogram then + Verbose_Msg (Executable, "missing.", Prefix => " "); + end if; elsif Youngest_Obj_Stamp (1) = ' ' then Verbose_Msg - (Youngest_Obj_File, "missing.", Prefix => " "); + (Youngest_Obj_File, "missing.", Prefix => " "); elsif Youngest_Obj_Stamp > Executable_Stamp then Verbose_Msg @@ -5672,7 +5932,7 @@ package body Make is -- ensuring that the shared version of libgcc will be used. if Main_Project /= No_Project - and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None + and then MLib.Tgt.Support_For_Libraries /= Prj.None then for Proj in Project_Table.First .. Project_Table.Last (Project_Tree.Projects) @@ -5783,7 +6043,7 @@ package body Make is Library_Paths.Set_Last (0); Library_Projs.Init; - if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then + if MLib.Tgt.Support_For_Libraries /= Prj.None then -- Check for library projects for Proj1 in Project_Table.First .. @@ -6255,39 +6515,6 @@ package body Make is return (B and Ada_Lib_Dir) /= 0; end In_Ada_Lib_Dir; - ------------ - -- Inform -- - ------------ - - procedure Inform (N : Name_Id; 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; - - procedure Inform (N : File_Name_Type; Msg : String) is - begin - Inform (Name_Id (N), Msg); - end Inform; - - procedure Inform (Msg : String) is - begin - Osint.Write_Program_Name; - Write_Str (": "); - Write_Str (Msg); - Write_Eol; - end Inform; - ----------------------- -- Init_Mapping_File -- ----------------------- @@ -6322,8 +6549,14 @@ package body Make is (FD, The_Mapping_File_Names (No_Project, Last_Mapping_File_Names (No_Project))); + if FD = Invalid_FD then Make_Failed ("disk full"); + + else + Record_Temp_File + (The_Mapping_File_Names + (No_Project, Last_Mapping_File_Names (No_Project))); end if; Close (FD, Status); @@ -6355,6 +6588,8 @@ package body Make is procedure Initialize is begin + Prj.Set_Mode (Ada_Only); + -- Override default initialization of Check_Object_Consistency -- since this is normally False for GNATBIND, but is True for -- GNATMAKE since we do not need to check source consistency @@ -6428,9 +6663,49 @@ package body Make is -- Scan the switches and arguments - Scan_Args : for Next_Arg in 1 .. Argument_Count loop - Scan_Make_Arg (Argument (Next_Arg), And_Save => True); - end loop Scan_Args; + declare + Args : Argument_List (1 .. Argument_Count); + Version_Switch_Present : Boolean := False; + Help_Switch_Present : Boolean := False; + + begin + -- First, scan to detect --version and/or --help + + for Next_Arg in 1 .. Argument_Count loop + Args (Next_Arg) := new String'(Argument (Next_Arg)); + + if Args (Next_Arg).all = Version_Switch then + Version_Switch_Present := True; + elsif Args (Next_Arg).all = Help_Switch then + Help_Switch_Present := True; + end if; + end loop; + + -- If --version was used, display version and exit + + if Version_Switch_Present then + Set_Standard_Output; + Display_Version; + Exit_Program (E_Success); + end if; + + -- If --help was used, display help and exit + + if Help_Switch_Present then + Set_Standard_Output; + Makeusg; + Write_Eol; + Write_Line ("Report bugs to report@adacore.com"); + Exit_Program (E_Success); + end if; + + -- Scan again the switch and arguments, now that we are sure that + -- they do not include --version or --help. + + Scan_Args : for Next_Arg in Args'Range loop + Scan_Make_Arg (Args (Next_Arg).all, And_Save => True); + end loop Scan_Args; + end; if Commands_To_Stdout then Set_Standard_Output; @@ -6581,6 +6856,7 @@ package body Make is -- Make sure no project object directory is recorded Project_Of_Current_Object_Directory := No_Project; + end Initialize; ---------------------------- @@ -6810,6 +7086,7 @@ package body Make is Name_Len := 0; Add_Str_To_Name_Buffer (Name (First .. Name'Last)); F2 := Name_Find; + else F2 := F; end if; @@ -6837,7 +7114,7 @@ package body Make is Get_Name_String (Source_File); Saved_Verbosity : constant Verbosity := Current_Verbosity; Project : Project_Id := No_Project; - Path_Name : File_Name_Type := No_File; + Path_Name : Path_Name_Type := No_Path; Data : Project_Data; begin @@ -6917,7 +7194,7 @@ package body Make is Link_Args (2 .. Args'Length + 1) := Args; - System.OS_Lib.Normalize_Arguments (Link_Args); + GNAT.OS_Lib.Normalize_Arguments (Link_Args); Display (Gnatlink.all, Link_Args); @@ -6925,7 +7202,7 @@ package body Make is Make_Failed ("error, unable to locate ", Gnatlink.all); end if; - System.OS_Lib.Spawn (Gnatlink_Path.all, Link_Args, Success); + GNAT.OS_Lib.Spawn (Gnatlink_Path.all, Link_Args, Success); end Link; --------------------------- @@ -7056,9 +7333,10 @@ package body Make is declare Real_Path : constant String := Normalize_Pathname - (Dir, Get_Name_String + (Dir, + Get_Name_String (Project_Tree.Projects.Table - (Main_Project).Display_Directory)); + (Main_Project).Display_Directory)); begin if Real_Path'Length = 0 then @@ -7123,7 +7401,7 @@ package body Make is List := Project_Tree.Project_Lists.Table (List).Next; Recursive_Compute_Depth (Project => Proj, - Depth => Depth + 1); + Depth => Depth + 1); end loop; -- Visit a project being extended, if any @@ -7151,9 +7429,9 @@ package body Make is Exit_Program (E_Fatal); end Report_Compilation_Failed; - ----------------------- - -- Sigint_Intercpted -- - ----------------------- + ------------------------ + -- Sigint_Intercepted -- + ------------------------ procedure Sigint_Intercepted is begin @@ -7596,7 +7874,7 @@ package body Make is then Unique_Compile_All_Projects := True; Unique_Compile := True; - Compile_Only := True; + Compile_Only := True; Do_Bind_Step := False; Do_Link_Step := False; @@ -7680,8 +7958,8 @@ package body Make is Operating_Mode := Check_Semantics; Check_Object_Consistency := False; Compile_Only := True; - Do_Bind_Step := False; - Do_Link_Step := False; + Do_Bind_Step := False; + Do_Link_Step := False; elsif Argv (2 .. Argv'Last) = "nostdlib" then @@ -7764,9 +8042,9 @@ package body Make is Name : String (1 .. Source_File_Name'Length + 3); Last : Positive := Source_File_Name'Length; Spec_Suffix : constant String := - Get_Name_String (Naming.Ada_Spec_Suffix); + Spec_Suffix_Of (Project_Tree, "ada", Naming); Body_Suffix : constant String := - Get_Name_String (Naming.Ada_Body_Suffix); + Body_Suffix_Of (Project_Tree, "ada", Naming); Truncated : Boolean := False; begin -- 2.30.2