------------------------------------------------------------------------------ -- -- -- GPR TECHNOLOGY -- -- -- -- Copyright (C) 2011-2023, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. This software is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -- -- License for more details. You should have received a copy of the GNU -- -- General Public License distributed with GNAT; see file COPYING. If not, -- -- see . -- -- -- ------------------------------------------------------------------------------ with Ada.Command_Line; use Ada.Command_Line; with Ada.Directories; with Ada.Exceptions; use Ada.Exceptions; with Ada.Text_IO; use Ada.Text_IO; pragma Warnings (Off); with System; with GNAT.Case_Util; use GNAT.Case_Util; with System.Multiprocessors; use System.Multiprocessors; pragma Warnings (On); with GNAT.Command_Line; use GNAT.Command_Line; with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.OS_Lib; with Gpr_Build_Util; use Gpr_Build_Util; with Gprbuild.Compile; with Gprbuild.Link; with Gprbuild.Post_Compile; with GPR.Compilation.Process.Waiter; with GPR.Compilation.Slave; with GPR; use GPR; with GPR.Debug; use GPR.Debug; with GPR.Conf; use GPR.Conf; with GPR.Names; use GPR.Names; with GPR.Osint; use GPR.Osint; with GPR.Output; use GPR.Output; with GPR.Proc; use GPR.Proc; with GPR.Env; with GPR.Err; with GPR.Jobserver; with GPR.Opt; use GPR.Opt; with GPR.Script; use GPR.Script; with GPR.Snames; use GPR.Snames; with GPR.Tree; use GPR.Tree; with GPR.Util.Aux; use GPR.Util; procedure Gprbuild.Main is CodePeer_String : constant String := "codepeer"; -- Used in CopePeer mode for the target and the subdirs Dumpmachine : constant String := "--dumpmachine"; -- Switch to display the normalized hostname Dash_A_Warning : constant String := "warning: switch -a is ignored and no additional source is compiled"; -- Warning issued when gprbuild is invoked with switch -a Dash_A_Warning_Issued : Boolean := False; -- Flag used to avoid issuing the several times the warning for switch -a Subst_Switch_Present : Boolean := False; -- True if --compiler-subst=... or --compiler-pkg-subst=... appears on the -- command line. Used to detect switches that are incompatible with these. -- Also used to prevent passing builder args to the "compiler". These -- switches are used by ASIS-based tools such as gnatpp when the -- --incremental switch is given. Main_On_Command_Line : Boolean := False; -- True if there is at least one main specified on the command line Is_Unix : constant Boolean := GNAT.OS_Lib.Path_Separator = ':'; procedure Initialize; -- Do the necessary package intialization and process the command line -- arguments. procedure Usage; -- Display the usage function Add_Global_Switches (Switch : String; For_Lang : Name_Id; For_Builder : Boolean; Has_Global_Compilation_Switches : Boolean) return Boolean; -- Take into account a global switch (builder or global compilation switch) -- read from the project file. procedure Add_Mains_To_Queue; -- Check that each main is a single file name and that it is a source -- of a project from the tree. procedure Scan_Arg (Arg : String; Command_Line : Boolean; Language : Name_Id; Success : out Boolean); -- Process one gprbuild argument Arg. Command_Line is True if the argument -- is specified on the command line. procedure Add_Option (Arg : String; Command_Line : Boolean); -- Add a switch for a compiler or all compilers, or for the binder or for -- the linker. The table where this option is stored depends on the value -- of Current_Processor and other global variables. procedure Copyright; -- Output the Copyright notice type Sigint_Handler is access procedure; pragma Convention (C, Sigint_Handler); procedure Install_Int_Handler (Handler : Sigint_Handler); pragma Import (C, Install_Int_Handler, "__gnat_install_int_handler"); -- Called by Gnatmake to install the SIGINT handler below No_Object_Check_Switch : constant String := "--no-object-check"; Direct_Import_Only_Switch : constant String := "--direct-import-only"; Indirect_Imports_Switch : constant String := "--indirect-imports"; No_Indirect_Imports_Switch : constant String := "--no-indirect-imports"; Current_Working_Dir : constant String := Get_Current_Dir; -- The current working directory type Processor is (None, Linker, Binder, Compiler, Gprconfig); Current_Processor : Processor := None; -- This variable changes when switches -*args are used Current_Builder_Comp_Option_Table : String_Vector_Access := No_Builder_Comp_Option_Table; ------------------------------------------- -- Options specified on the command line -- ------------------------------------------- package Options is type Option_Type is (Force_Compilations_Option, Keep_Going_Option, Maximum_Compilers_Option, Maximum_Binders_Option, Maximum_Linkers_Option, Quiet_Output_Option, Check_Switches_Option, Verbose_Mode_Option, Verbose_Low_Mode_Option, Verbose_Medium_Mode_Option, Verbose_High_Mode_Option, Warnings_Treat_As_Error, Warnings_Normal, Warnings_Suppress, Indirect_Imports); subtype Maximum_Processes_Range is Option_Type range Maximum_Compilers_Option .. Maximum_Linkers_Option; procedure Register_Command_Line_Option (Option : Option_Type; Value : Natural := 0); -- Record a command line option procedure Process_Command_Line_Options; -- Reprocess the recorded command line options that have priority over -- the options in package Builder of the main project. end Options; use Options; ------------------------ -- Add_Mains_To_Queue -- ------------------------ procedure Add_Mains_To_Queue is Main_Id : Main_Info; begin Mains.Reset; loop Main_Id := Mains.Next_Main; exit when Main_Id = No_Main_Info; if Main_Id.Source /= No_Source then -- Fail if any main is declared as an excluded source file if Main_Id.Source.Locally_Removed then Fail_Program (Project_Tree, "main """ & Get_Name_String (Main_Id.Source.File) & """ cannot also be an excluded file", Exit_Code => E_General); end if; if Is_Allowed_Language (Main_Id.Source.Language.Name) then Queue.Insert (Source => (Tree => Main_Id.Tree, Id => Main_Id.Source, Closure => False), With_Roots => Builder_Data (Main_Id.Tree).Closure_Needed); -- If a non Ada main has no roots, then all sources need to be -- compiled, so no need to check for closure. if Main_Id.Source.Language.Config.Kind /= Unit_Based and then Main_Id.Source.Roots = null then Builder_Data (Main_Id.Tree).Closure_Needed := False; end if; end if; end if; end loop; if Total_Errors_Detected /= 0 then Fail_Program (Project_Tree, "cannot continue"); end if; -- If the main project is an aggregated project and there is at least -- one main on the command line, do not add the sources of the projects -- without mains to the queue. if Main_Project.Qualifier = Aggregate and then Main_On_Command_Line then Mains.Reset; loop Main_Id := Mains.Next_Main; exit when Main_Id = No_Main_Info; Queue.Insert_Project_Sources (Project => Main_Id.Project, Project_Tree => Main_Id.Tree, Unique_Compile => Unique_Compile, All_Projects => not Unique_Compile or else (Unique_Compile_All_Projects or Recursive)); end loop; else Queue.Insert_Project_Sources (Project => Main_Project, Project_Tree => Project_Tree, Unique_Compile => Unique_Compile, All_Projects => not Unique_Compile or else (Unique_Compile_All_Projects or Recursive)); end if; end Add_Mains_To_Queue; ------------------------- -- Add_Global_Switches -- ------------------------- function Add_Global_Switches (Switch : String; For_Lang : Name_Id; For_Builder : Boolean; Has_Global_Compilation_Switches : Boolean) return Boolean is Success : Boolean; begin if For_Builder then if Has_Global_Compilation_Switches then Builder_Switches_Lang := No_Name; else Builder_Switches_Lang := For_Lang; end if; Scan_Arg (Switch, Command_Line => False, Language => For_Lang, Success => Success); return Success; else Current_Processor := Compiler; Current_Builder_Comp_Option_Table := Builder_Compiling_Options_HTable.Get (For_Lang); if Current_Builder_Comp_Option_Table = No_Builder_Comp_Option_Table then Current_Builder_Comp_Option_Table := new String_Vectors.Vector' (String_Vectors.Empty_Vector); Builder_Compiling_Options_HTable.Set (For_Lang, Current_Builder_Comp_Option_Table); end if; Add_Option (Switch, Command_Line => False); Current_Processor := None; return True; end if; end Add_Global_Switches; ---------------- -- Add_Option -- ---------------- procedure Add_Option (Arg : String; Command_Line : Boolean) is Option : String_Access := new String'(Arg); begin case Current_Processor is when None => null; when Linker => -- Add option to the linker table if Command_Line then Test_If_Relative_Path (Switch => Option, Parent => Current_Working_Dir, Including_Switch => Dash_L); else Test_If_Relative_Path (Switch => Option, Parent => Main_Project_Dir.all, Including_Switch => Dash_L); end if; Command_Line_Linker_Options.Append (Option.all); when Binder => if Command_Line then Test_If_Relative_Path (Switch => Option, Parent => Current_Working_Dir, Including_Switch => No_Name); else Test_If_Relative_Path (Switch => Option, Parent => Main_Project_Dir.all, Including_Switch => No_Name); end if; if Current_Bind_Option_Table = No_Bind_Option_Table then -- Option for all binder All_Language_Binder_Options.Append (Option.all); else -- Option for a single binder Current_Bind_Option_Table.Append (Option.all); end if; when Compiler => if Command_Line then if Starts_With (Arg, "-gnatec=") then declare Key : String := GNAT.OS_Lib.Normalize_Pathname (Arg (Arg'First + 8 .. Arg'Last)); Value : constant Name_Id := Get_Name_Id (Key); begin Canonical_Case_File_Name (Key); Cmd_Line_Adc_Files.Include (Get_Name_Id (Key), Value); end; end if; if Current_Comp_Option_Table = No_Comp_Option_Table then -- Option for all compilers All_Language_Compiling_Options.Append (Arg); else -- Option for a single compiler Current_Comp_Option_Table.Append (Arg); end if; else if Current_Builder_Comp_Option_Table = No_Builder_Comp_Option_Table then -- Option for all compilers All_Language_Builder_Compiling_Options.Append (Arg); else -- Option for a single compiler Current_Builder_Comp_Option_Table.Append (Arg); end if; end if; when Gprconfig => Command_Line_Gprconfig_Options.Append (Option.all); end case; end Add_Option; --------------- -- Copyright -- --------------- procedure Copyright is begin -- Only output the Copyright notice once if not Copyright_Output then Copyright_Output := True; Display_Version ("GPRBUILD", "2004"); end if; end Copyright; ------------- -- Options -- ------------- package body Options is type Option_Data is record Option : Option_Type; Value : Natural := 0; end record; package Option_Data_Vectors is new Ada.Containers.Vectors (Positive, Option_Data); Command_Line_Options : Option_Data_Vectors.Vector; -- Table to store the command line options ---------------------------------- -- Process_Command_Line_Options -- ---------------------------------- procedure Process_Command_Line_Options is begin for Item of Command_Line_Options loop case Item.Option is when Force_Compilations_Option => Opt.Force_Compilations := True; when Keep_Going_Option => Opt.Keep_Going := True; when Maximum_Compilers_Option => Opt.Maximum_Compilers := Item.Value; when Maximum_Binders_Option => Opt.Maximum_Binders := Item.Value; when Maximum_Linkers_Option => Opt.Maximum_Linkers := Item.Value; when Quiet_Output_Option => Opt.Quiet_Output := True; Opt.Verbose_Mode := False; Opt.Verbosity_Level := Opt.None; when Check_Switches_Option => Opt.Check_Switches := True; when Verbose_Mode_Option => Opt.Verbose_Mode := True; Opt.Verbosity_Level := Opt.Low; Opt.Quiet_Output := False; when Verbose_Low_Mode_Option => Opt.Verbose_Mode := True; Opt.Verbosity_Level := Opt.Low; Opt.Quiet_Output := False; when Verbose_Medium_Mode_Option => Opt.Verbose_Mode := True; Opt.Verbosity_Level := Opt.Medium; Opt.Quiet_Output := False; when Verbose_High_Mode_Option => Opt.Verbose_Mode := True; Opt.Verbosity_Level := Opt.High; Opt.Quiet_Output := False; when Warnings_Treat_As_Error => Opt.Warning_Mode := Opt.Treat_As_Error; when Warnings_Normal => Opt.Warning_Mode := Opt.Normal; when Warnings_Suppress => Opt.Warning_Mode := Opt.Suppress; when Indirect_Imports => Gprbuild.Indirect_Imports := Item.Value /= 0; end case; end loop; end Process_Command_Line_Options; ---------------------------------- -- Register_Command_Line_Option -- ---------------------------------- procedure Register_Command_Line_Option (Option : Option_Type; Value : Natural := 0) is begin Command_Line_Options.Append (Option_Data'(Option => Option, Value => Value)); end Register_Command_Line_Option; end Options; -------------- -- Scan_Arg -- -------------- procedure Scan_Arg (Arg : String; Command_Line : Boolean; Language : Name_Id; Success : out Boolean) is Processed : Boolean := True; procedure Forbidden_In_Package_Builder; -- Fail if switch Arg is found in package Builder ---------------------------------- -- Forbidden_In_Package_Builder -- ---------------------------------- procedure Forbidden_In_Package_Builder is begin if not Command_Line then Fail_Program (Project_Tree, Arg & " can only be used on the command line", Exit_Code => E_General); end if; end Forbidden_In_Package_Builder; begin pragma Assert (Arg'First = 1); Success := True; if Arg'Length = 0 then return; end if; -- If preceding switch was -P, a project file name need to be -- specified, not a switch. if Project_File_Name_Expected then if Arg (1) = '-' then Fail_Program (Project_Tree, "project file name missing after -P", Exit_Code => E_General); else Project_File_Name_Expected := False; Project_File_Name := new String'(Arg); end if; -- If preceding switch was -o, an executable name need to be -- specified, not a switch. elsif Output_File_Name_Expected then if Arg (1) = '-' then Fail_Program (Project_Tree, "output file name missing after -o", Exit_Code => E_General); else Output_File_Name_Expected := False; Output_File_Name := new String'(Arg); end if; elsif Search_Project_Dir_Expected then if Arg (1) = '-' then Fail_Program (Project_Tree, "directory name missing after -aP", Exit_Code => E_General); else Search_Project_Dir_Expected := False; GPR.Env.Add_Directories (Root_Environment.Project_Path, Arg); end if; elsif Db_Directory_Expected then Db_Directory_Expected := False; Knowledge.Parse_Knowledge_Base (Project_Tree, Arg); Add_Db_Switch_Arg (Get_Name_Id (Arg)); -- Set the processor/language for the following switches -- -cargs all compiler arguments elsif Arg = "-cargs" then Current_Processor := Compiler; if Command_Line then Current_Comp_Option_Table := No_Comp_Option_Table; else Current_Builder_Comp_Option_Table := No_Builder_Comp_Option_Table; end if; -- -cargs:lang arguments for compiler of language lang elsif Arg'Length > 7 and then Arg (1 .. 7) = "-cargs:" then Current_Processor := Compiler; declare Lang : constant Name_Id := Get_Lower_Name_Id (Arg (8 .. Arg'Last)); begin if Command_Line then Current_Comp_Option_Table := Compiling_Options_HTable.Get (Lang); if Current_Comp_Option_Table = No_Comp_Option_Table then Current_Comp_Option_Table := new String_Vectors.Vector' (String_Vectors.Empty_Vector); Compiling_Options_HTable.Set (Lang, Current_Comp_Option_Table); end if; else Current_Builder_Comp_Option_Table := Builder_Compiling_Options_HTable.Get (Lang); if Current_Builder_Comp_Option_Table = No_Builder_Comp_Option_Table then Current_Builder_Comp_Option_Table := new String_Vectors.Vector'(String_Vectors.Empty_Vector); Builder_Compiling_Options_HTable.Set (Lang, Current_Builder_Comp_Option_Table); end if; end if; end; -- -bargs all binder arguments elsif Arg = "-bargs" then if Subst_Switch_Present then return; -- ignore switch incompatible with --compiler-subst end if; Current_Processor := Binder; Current_Bind_Option_Table := No_Bind_Option_Table; -- -bargs:lang arguments for binder of language lang elsif Arg'Length > 7 and then Arg (1 .. 7) = "-bargs:" then if Subst_Switch_Present then return; -- ignore switch incompatible with --compiler-subst end if; Current_Processor := Binder; declare Lang : constant Name_Id := Get_Lower_Name_Id (Arg (8 .. Arg'Last)); begin Current_Bind_Option_Table := Binder_Options_HTable.Get (Lang); if Current_Bind_Option_Table = No_Bind_Option_Table then Current_Bind_Option_Table := new String_Vectors.Vector'(String_Vectors.Empty_Vector); Binder_Options_HTable.Set (Lang, Current_Bind_Option_Table); end if; end; -- -largs linker arguments elsif Arg = "-largs" then if Subst_Switch_Present then return; -- ignore switch incompatible with --compiler-subst end if; Current_Processor := Linker; -- -gargs/margs options directly for gprbuild -- support -margs for compatibility with gnatmake elsif Arg = "-kargs" then Current_Processor := Gprconfig; elsif Arg = "-gargs" or else Arg = "-margs" then Current_Processor := None; -- A special test is needed for the -o switch within a -largs since -- that is another way to specify the name of the final executable. elsif Command_Line and then Current_Processor = Linker and then Arg = "-o" then Fail_Program (Project_Tree, "switch -o not allowed within a -largs. Use -o directly.", Exit_Code => E_General); -- If current processor is not gprbuild directly, store the option -- in the appropriate table. elsif Current_Processor /= None then Add_Option (Arg, Command_Line); -- Switches start with '-' elsif Arg (1) = '-' then if Arg = Keep_Temp_Files_Option then -- This is equivalent to switch -dn: Keep temporary files Set_Debug_Flag ('n'); Opt.Keep_Temporary_Files := True; elsif Arg = Complete_Output_Option then Forbidden_In_Package_Builder; if Distributed_Mode then Fail_Program (Project_Tree, "options " & Complete_Output_Option & Distributed_Option & " are not compatible", Exit_Code => E_General); end if; Complete_Output := True; No_Complete_Output := False; elsif Arg = No_Complete_Output_Option or else Arg = "-n" then Forbidden_In_Package_Builder; No_Complete_Output := True; Complete_Output := False; elsif Arg = No_Project_Option then Forbidden_In_Package_Builder; No_Project_File := True; if Project_File_Name /= null then Fail_Program (Project_Tree, "cannot specified --no-project with a project file", Exit_Code => E_General); end if; elsif Arg'Length >= Distributed_Option'Length and then Arg (1 .. Distributed_Option'Length) = Distributed_Option then if Subst_Switch_Present then return; -- ignore switch incompatible with --compiler-subst end if; if Complete_Output then Fail_Program (Project_Tree, "options " & Complete_Output_Option & Distributed_Option & " are not compatible", Exit_Code => E_General); end if; if Build_Script_Name /= null then Fail_Program (Project_Tree, "options " & Build_Script_Option & Distributed_Option & " are not compatible"); end if; Distributed_Mode := True; declare Hosts : constant String := Aux.Get_Slaves_Hosts (Project_Tree, Arg); begin if Hosts = "" then Fail_Program (Project_Tree, "missing hosts for distributed mode compilation", Exit_Code => E_General); else GPR.Compilation.Slave.Record_Slaves (Hosts); end if; end; elsif Arg'Length >= Hash_Option'Length and then Arg (1 .. Hash_Option'Length) = Hash_Option then if Subst_Switch_Present then return; -- ignore switch incompatible with --compiler-subst end if; Hash_Value := new String'(Arg (Hash_Option'Length + 2 .. Arg'Last)); elsif Arg'Length >= Slave_Env_Option'Length and then Arg (1 .. Slave_Env_Option'Length) = Slave_Env_Option then if Subst_Switch_Present then return; -- ignore switch incompatible with --compiler-subst end if; if Arg = Slave_Env_Option then -- Just --slave-env, it is up to gprbuild to build a sensible -- slave environment value. Slave_Env_Auto := True; else Slave_Env := new String'(Arg (Slave_Env_Option'Length + 2 .. Arg'Last)); end if; elsif Arg'Length >= Compiler_Subst_Option'Length and then Arg (1 .. Compiler_Subst_Option'Length) = Compiler_Subst_Option then Forbidden_In_Package_Builder; -- We should have Arg set to something like: -- "compiler-subst=ada,gnatpp". -- We need to pick out the "ada" and "gnatpp". declare function Scan_To_Comma (Start : Positive) return Positive; -- Scan forward from Start until we find a comma or end of -- string. Return the index just before the ",", or Arg'Last. function Scan_To_Comma (Start : Positive) return Positive is begin if Start >= Arg'Last then return Arg'Last; end if; return Result : Positive := Start do while Result < Arg'Last and then Arg (Result + 1) /= ',' loop Result := Result + 1; end loop; end return; end Scan_To_Comma; Lang_Start : constant Positive := Compiler_Subst_Option'Length + 1; Lang_End : constant Positive := Scan_To_Comma (Lang_Start); Comp_Start : constant Positive := Lang_End + 2; Comp_End : constant Positive := Scan_To_Comma (Comp_Start); Lang : String renames Arg (Lang_Start .. Lang_End); Comp : String renames Arg (Comp_Start .. Comp_End); begin if Lang = "" or else Comp = "" then Fail_Program (Project_Tree, "invalid switch " & Arg, Exit_Code => E_General); -- This switch is intended for internal use by ASIS tools, -- so a friendlier error message isn't needed here. end if; Compiler_Subst_HTable.Include (Get_Lower_Name_Id (Lang), Get_Name_Id (Comp)); end; elsif Arg'Length >= Compiler_Pkg_Subst_Option'Length and then Arg (1 .. Compiler_Pkg_Subst_Option'Length) = Compiler_Pkg_Subst_Option then Forbidden_In_Package_Builder; declare Package_Name : String renames Arg (Compiler_Pkg_Subst_Option'Length + 1 .. Arg'Last); begin if Package_Name = "" then Fail_Program (Project_Tree, "invalid switch " & Arg); -- This switch is intended for internal use by ASIS tools, -- so a friendly error message isn't needed here. -- No error if the package doesn't exist; gnatpp might pass -- --compiler-pkg-subst=pretty_printer even when there is no -- package Pretty_Printer in the project file. end if; Compiler_Pkg_Subst := Get_Lower_Name_Id (Package_Name); end; elsif Arg'Length > Build_Script_Option'Length and then Arg (1 .. Build_Script_Option'Length) = Build_Script_Option then Forbidden_In_Package_Builder; if Distributed_Mode then Fail_Program (Project_Tree, "options " & Build_Script_Option & Distributed_Option & " are not compatible", Exit_Code => E_General); end if; declare Script_Name : constant String := Arg (Build_Script_Option'Length + 1 .. Arg'Last); begin if Is_Absolute_Path (Script_Name) then Build_Script_Name := new String'(Script_Name); else Build_Script_Name := new String'(Get_Current_Dir & Script_Name); end if; end; elsif Arg = "--db-" then Forbidden_In_Package_Builder; Load_Standard_Base := False; elsif Arg = "--db" then Forbidden_In_Package_Builder; Db_Directory_Expected := True; elsif Arg = "--display-paths" then Forbidden_In_Package_Builder; Display_Paths := True; elsif Arg = "--no-split-units" then Opt.No_Split_Units := True; elsif Arg = Single_Compile_Per_Obj_Dir_Switch then Opt.One_Compilation_Per_Obj_Dir := True; elsif Arg'Length > Source_Info_Option'Length and then Arg (1 .. Source_Info_Option'Length) = Source_Info_Option then Forbidden_In_Package_Builder; Project_Tree.Source_Info_File_Name := new String'(Arg (Source_Info_Option'Length + 1 .. Arg'Last)); elsif Arg'Length > Config_Project_Option'Length and then Arg (1 .. Config_Project_Option'Length) = Config_Project_Option then if Config_Project_File_Name /= null and then Command_Line and then (Autoconf_Specified or else Config_Project_File_Name.all /= Arg (Config_Project_Option'Length + 1 .. Arg'Last)) then Fail_Program (Project_Tree, "several different configuration switches cannot be" & " specified", Exit_Code => E_General); else Autoconfiguration := False; Autoconf_Specified := False; Config_Project_File_Name := new String' (Arg (Config_Project_Option'Length + 1 .. Arg'Last)); end if; elsif Arg'Length > Autoconf_Project_Option'Length and then Arg (1 .. Autoconf_Project_Option'Length) = Autoconf_Project_Option then Forbidden_In_Package_Builder; if Config_Project_File_Name /= null and then (not Autoconf_Specified or else Config_Project_File_Name.all /= Arg (Autoconf_Project_Option'Length + 1 .. Arg'Last)) then Fail_Program (Project_Tree, "several different configuration switches cannot be" & " specified", Exit_Code => E_General); else Config_Project_File_Name := new String' (Arg (Autoconf_Project_Option'Length + 1 .. Arg'Last)); Autoconf_Specified := True; end if; elsif Arg'Length > Target_Project_Option'Length and then Arg (1 .. Target_Project_Option'Length) = Target_Project_Option then Forbidden_In_Package_Builder; if Target_Name /= null then if Target_Name.all /= Arg (Target_Project_Option'Length + 1 .. Arg'Last) then Fail_Program (Project_Tree, "several different target switches cannot be specified", Exit_Code => E_General); end if; else Target_Name := new String' (Arg (Target_Project_Option'Length + 1 .. Arg'Last)); end if; elsif Arg'Length > RTS_Option'Length and then Arg (1 .. RTS_Option'Length) = RTS_Option then declare Set : constant Boolean := Runtime_Name_Set_For (Name_Ada); Old : constant String := Runtime_Name_For (Name_Ada); RTS : constant String := Arg (RTS_Option'Length + 1 .. Arg'Last); begin if Command_Line then if Set and then Old /= RTS then Fail_Program (Project_Tree, "several different run-times cannot be specified", Exit_Code => E_General); end if; Set_Runtime_For (Name_Ada, RTS); Set_Default_Runtime_For (Name_Ada, RTS); end if; -- Ignore any --RTS= switch in package Builder. These are only -- taken into account to create the config file in -- auto-configuration. end; elsif Arg'Length > RTS_Language_Option'Length and then Arg (1 .. RTS_Language_Option'Length) = RTS_Language_Option then declare Language_Name : Name_Id := No_Name; RTS_Start : Natural := Arg'Last + 1; begin for J in RTS_Language_Option'Length + 2 .. Arg'Last loop if Arg (J) = '=' then Language_Name := Get_Lower_Name_Id (Arg (RTS_Language_Option'Length + 1 .. J - 1)); RTS_Start := J + 1; exit; end if; end loop; if Language_Name = No_Name then Fail_Program (Project_Tree, "illegal switch: " & Arg, Exit_Code => E_General); elsif Command_Line then -- Ignore any --RTS:= switch in package Builder. These -- are only taken into account to create the config file in -- auto-configuration. declare RTS : constant String := Arg (RTS_Start .. Arg'Last); Set : constant Boolean := Runtime_Name_Set_For (Language_Name); Old : constant String := Runtime_Name_For (Language_Name); begin if Set and then Old /= RTS then Fail_Program (Project_Tree, "several different run-times cannot be specified" & " for the same language"); else Set_Runtime_For (Language_Name, RTS); Set_Default_Runtime_For (Language_Name, RTS); end if; end; end if; end; elsif Arg'Length > Implicit_With_Option'Length and then Arg (Implicit_With_Option'Range) = Implicit_With_Option then Forbidden_In_Package_Builder; if Implicit_With /= null then Fail_Program (Project_Tree, "several " & Implicit_With_Option & " options cannot be specified", Exit_Code => E_General); end if; Implicit_With := new String' (Ensure_Suffix (Arg (Implicit_With_Option'Last + 1 .. Arg'Last), Project_File_Extension)); elsif Arg'Length > Subdirs_Option'Length and then Arg (1 .. Subdirs_Option'Length) = Subdirs_Option then Forbidden_In_Package_Builder; Subdirs := new String'(Arg (Subdirs_Option'Length + 1 .. Arg'Last)); elsif Is_Unix and then Arg'Length > Getrusage_Option'Length and then Arg (1 .. Getrusage_Option'Length) = Getrusage_Option then Forbidden_In_Package_Builder; Getrusage := new String' (GNAT.OS_Lib.Normalize_Pathname (Arg (Getrusage_Option'Length + 1 .. Arg'Last))); elsif Arg'Length > Src_Subdirs_Option'Length and then Arg (1 .. Src_Subdirs_Option'Length) = Src_Subdirs_Option then Forbidden_In_Package_Builder; Src_Subdirs := new String'(Arg (Src_Subdirs_Option'Length + 1 .. Arg'Last)); elsif Arg'Length >= Relocate_Build_Tree_Option'Length and then Arg (1 .. Relocate_Build_Tree_Option'Length) = Relocate_Build_Tree_Option then Forbidden_In_Package_Builder; if Arg'Length = Relocate_Build_Tree_Option'Length then Build_Tree_Dir := new String'(Current_Working_Dir); else Build_Tree_Dir := new String' (Normalize_Pathname (Arg (Relocate_Build_Tree_Option'Length + 2 .. Arg'Last), Current_Working_Dir, Resolve_Links => Opt.Follow_Links_For_Dirs) & Dir_Separator); end if; -- Out-of-tree compilation also imply -p (create missing dirs) Opt.Create_Dirs := Create_All_Dirs; elsif Arg'Length >= Root_Dir_Option'Length and then Arg (1 .. Root_Dir_Option'Length) = Root_Dir_Option then Forbidden_In_Package_Builder; Root_Dir := new String' (Normalize_Pathname (Arg (Root_Dir_Option'Length + 2 .. Arg'Last), Current_Working_Dir, Resolve_Links => Opt.Follow_Links_For_Dirs) & Dir_Separator); elsif Command_Line and then Arg = "--no-sal-binding" then No_SAL_Binding := True; elsif Command_Line and then Arg'Length > Restricted_To_Languages_Option'Length and then Arg (1 .. Restricted_To_Languages_Option'Length) = Restricted_To_Languages_Option then declare Start : Positive := Restricted_To_Languages_Option'Length + 1; Finish : Positive; begin Processed := False; while Start <= Arg'Last loop Finish := Start; loop exit when Finish > Arg'Last or else Arg (Finish) = ','; Finish := Finish + 1; end loop; if Finish > Start then Add_Restricted_Language (Arg (Start .. Finish - 1)); Processed := True; end if; Start := Finish + 1; end loop; end; elsif Arg = Indirect_Imports_Switch then Indirect_Imports := True; if Command_Line then Register_Command_Line_Option (Options.Indirect_Imports, 1); end if; elsif Arg in No_Indirect_Imports_Switch | Direct_Import_Only_Switch then Indirect_Imports := False; if Command_Line then Register_Command_Line_Option (Options.Indirect_Imports, 0); end if; elsif Arg = Gpr_Build_Util.Unchecked_Shared_Lib_Imports then Forbidden_In_Package_Builder; Opt.Unchecked_Shared_Lib_Imports := True; elsif Arg = No_Object_Check_Switch then Object_Checked := False; elsif Arg = No_Exit_Message_Option then Opt.No_Exit_Message := True; elsif Arg = "--codepeer" then Forbidden_In_Package_Builder; if not CodePeer_Mode then CodePeer_Mode := True; Object_Checked := False; if Target_Name = null then Target_Name := new String'(CodePeer_String); end if; if Subdirs = null then Subdirs := new String'(CodePeer_String); end if; end if; elsif Arg = "--gnatprove" then Forbidden_In_Package_Builder; if not GnatProve_Mode then GnatProve_Mode := True; end if; elsif Arg = Create_Map_File_Switch then if Subst_Switch_Present then return; -- ignore switch incompatible with --compiler-subst end if; Map_File := new String'(""); elsif Arg'Length > Create_Map_File_Switch'Length + 1 and then Arg (1 .. Create_Map_File_Switch'Length) = Create_Map_File_Switch and then Arg (Create_Map_File_Switch'Length + 1) = '=' then if Subst_Switch_Present then return; -- ignore switch incompatible with --compiler-subst end if; Map_File := new String'(Arg (Create_Map_File_Switch'Length + 2 .. Arg'Last)); elsif Arg'Length >= 3 and then Arg (1 .. 3) = "-aP" then Forbidden_In_Package_Builder; if Arg'Length = 3 then Search_Project_Dir_Expected := True; else GPR.Env.Add_Directories (Root_Environment.Project_Path, Arg (4 .. Arg'Last)); end if; elsif Arg = "-a" then if not Dash_A_Warning_Issued then Put_Line (Dash_A_Warning); Dash_A_Warning_Issued := True; end if; elsif Arg = "-b" then if Subst_Switch_Present then return; -- ignore switch incompatible with --compiler-subst end if; Opt.Bind_Only := True; elsif Arg = "-c" then Opt.Compile_Only := True; if Opt.Link_Only then Opt.Bind_Only := True; end if; elsif Arg = "-C" then -- This switch is only for upward compatibility null; elsif Arg = "-d" then Opt.Display_Compilation_Progress := True; elsif Arg'Length = 3 and then Arg (2) = 'd' then Set_Debug_Flag (Arg (3)); elsif Arg'Length > 3 and then Arg (1 .. 3) = "-eI" then if Subst_Switch_Present then return; -- ignore switch incompatible with --compiler-subst end if; Forbidden_In_Package_Builder; begin Main_Index := Int'Value (Arg (4 .. Arg'Last)); exception when Constraint_Error => Fail_Program (Project_Tree, "invalid switch " & Arg, Exit_Code => E_General); end; elsif Arg = "-eL" then Forbidden_In_Package_Builder; Opt.Follow_Links_For_Files := True; Opt.Follow_Links_For_Dirs := True; elsif Arg = "-eS" then Forbidden_In_Package_Builder; -- Accept switch for compatibility with gnatmake elsif Arg = "-f" then Opt.Force_Compilations := True; if Command_Line then Register_Command_Line_Option (Force_Compilations_Option); end if; elsif Arg = "-F" then Forbidden_In_Package_Builder; Opt.Full_Path_Name_For_Brief_Errors := True; elsif Arg = "-h" then Forbidden_In_Package_Builder; elsif Arg'Length > 2 and then Arg (2) = 'j' then if Opt.Use_GNU_Make_Jobserver then Put_Line ("warning: -j is ignored when using " & Use_GNU_Make_Jobserver_Option); return; end if; declare Max_Proc : Natural := 0; Phase : Character := 'a'; -- all by default First : Positive; Opts : constant array (Maximum_Processes_Range) of access Positive := (Maximum_Compilers_Option => Opt.Maximum_Compilers'Access, Maximum_Binders_Option => Opt.Maximum_Binders'Access, Maximum_Linkers_Option => Opt.Maximum_Linkers'Access); procedure Register (Opt : Maximum_Processes_Range); -------------- -- Register -- -------------- procedure Register (Opt : Maximum_Processes_Range) is begin if Command_Line then Register_Command_Line_Option (Opt, Max_Proc); end if; Opts (Opt).all := Max_Proc; end Register; begin if Arg'Length > 3 and then Arg (3) not in '0' .. '9' then Phase := Arg (3); First := 4; else First := 3; end if; Max_Proc := Natural'Value (Arg (First .. Arg'Last)); if Max_Proc = 0 then Max_Proc := Natural (Number_Of_CPUs); if Max_Proc = 0 then Max_Proc := 1; end if; end if; case Phase is when 'a' => for J in Maximum_Processes_Range loop Register (J); end loop; when 'c' => Register (Maximum_Compilers_Option); when 'b' => Register (Maximum_Binders_Option); when 'l' => Register (Maximum_Linkers_Option); when others => Processed := False; end case; exception when Constraint_Error => Processed := False; end; elsif Arg = Use_GNU_Make_Jobserver_Option then if Opt.Maximum_Compilers > 1 then Put_Line ("warning: -j is ignored when using " & Use_GNU_Make_Jobserver_Option); end if; Opt.Use_GNU_Make_Jobserver := True; begin GPR.Jobserver.Initialize; exception when E : GPR.Jobserver.JS_Initialize_Error => Fail_Program (Project_Tree, Ada.Exceptions.Exception_Name (E) & " - " & Ada.Exceptions.Exception_Message (E)); when GPR.Jobserver.JS_Makeflags_Parsing_Detects_Dry_Run => Finish_Program (Project_Tree, Exit_Code); end; elsif Arg = "-k" then Opt.Keep_Going := True; if Command_Line then Register_Command_Line_Option (Keep_Going_Option); end if; elsif Arg = "-l" then if Subst_Switch_Present then return; -- ignore switch incompatible with --compiler-subst end if; Opt.Link_Only := True; if Opt.Compile_Only then Opt.Bind_Only := True; end if; elsif Arg = "-m" then if Subst_Switch_Present then return; -- ignore switch incompatible with --compiler-subst end if; Opt.Minimal_Recompilation := True; elsif Arg = "-o" then Forbidden_In_Package_Builder; if Output_File_Name /= null then Fail_Program (Project_Tree, "cannot specify several -o switches"); else Output_File_Name_Expected := True; end if; elsif Arg = "-p" or else Arg = "--create-missing-dirs" then Forbidden_In_Package_Builder; Opt.Create_Dirs := Create_All_Dirs; elsif Arg'Length >= 2 and then Arg (2) = 'P' then Forbidden_In_Package_Builder; if No_Project_File then Fail_Program (Project_Tree, "cannot specify --no-project with a project file", Exit_Code => E_General); elsif Project_File_Name /= null then Fail_Program (Project_Tree, "cannot have several project files specified", Exit_Code => E_General); elsif Arg'Length = 2 then Project_File_Name_Expected := True; else Project_File_Name := new String'(Arg (3 .. Arg'Last)); end if; elsif Arg = "-q" then Opt.Quiet_Output := True; Opt.Verbose_Mode := False; Opt.Verbosity_Level := None; if Command_Line then Register_Command_Line_Option (Quiet_Output_Option); end if; elsif Arg = "-r" then Forbidden_In_Package_Builder; Recursive := True; elsif Arg = "-R" then if Subst_Switch_Present then return; -- ignore switch incompatible with --compiler-subst end if; Opt.Run_Path_Option := False; elsif Arg = "-s" then Opt.Check_Switches := True; if Command_Line then Register_Command_Line_Option (Check_Switches_Option); end if; elsif Arg = "-u" then Forbidden_In_Package_Builder; Unique_Compile := True; elsif Arg = "-U" then Forbidden_In_Package_Builder; Unique_Compile_All_Projects := True; Unique_Compile := True; elsif Arg = "-v" or else Arg = "-vl" then Opt.Verbose_Mode := True; Opt.Verbosity_Level := Opt.Low; Opt.Quiet_Output := False; if Command_Line then Register_Command_Line_Option (Verbose_Low_Mode_Option); end if; elsif Arg = "-vm" then Opt.Verbose_Mode := True; Opt.Verbosity_Level := Opt.Medium; Opt.Quiet_Output := False; if Command_Line then Register_Command_Line_Option (Verbose_Medium_Mode_Option); end if; elsif Arg = "-vh" then Opt.Verbose_Mode := True; Opt.Verbosity_Level := Opt.High; Opt.Quiet_Output := False; if Command_Line then Register_Command_Line_Option (Verbose_High_Mode_Option); end if; elsif Arg'Length >= 3 and then Arg (1 .. 3) = "-vP" then Forbidden_In_Package_Builder; if Arg'Length = 4 and then Arg (4) in '0' .. '2' then case Arg (4) is when '0' => Current_Verbosity := GPR.Default; when '1' => Current_Verbosity := GPR.Medium; when '2' => Current_Verbosity := GPR.High; when others => null; end case; else Fail_Program (Project_Tree, "invalid verbosity level " & Arg (4 .. Arg'Last), Exit_Code => E_General); end if; elsif Arg = "-we" then Opt.Warning_Mode := Opt.Treat_As_Error; if Command_Line then Register_Command_Line_Option (Warnings_Treat_As_Error); end if; elsif Arg = "-wn" then Opt.Warning_Mode := Opt.Normal; if Command_Line then Register_Command_Line_Option (Warnings_Normal); end if; elsif Arg = "-ws" then Opt.Warning_Mode := Opt.Suppress; if Command_Line then Register_Command_Line_Option (Warnings_Suppress); end if; elsif Arg = "-m2" then Opt.Checksum_Recompilation := True; elsif Arg = "-x" then Opt.Use_Include_Path_File := True; elsif Arg = "-z" then Opt.No_Main_Subprogram := True; elsif Arg'Length >= 3 and then Arg (2) = 'X' and then Is_External_Assignment (Root_Environment, Arg) then Forbidden_In_Package_Builder; -- Is_External_Assignment has side effects when it returns True null; elsif (Language = No_Name or else Language = Name_Ada) and then not Command_Line and then Arg = "-x" then -- For compatibility with gnatmake, ignore -x if found in the -- Builder switches. null; elsif (Language = No_Name or else Language = Name_Ada) and then not Subst_Switch_Present and then (Arg = "-fstack-check" or else Arg = "-fno-inline" or else (Arg'Length >= 2 and then (Arg (2) = 'O' or else Arg (2) = 'g'))) then -- For compatibility with gnatmake, use switch to compile Ada -- code. We don't do this if the --compiler-pkg-subst switch was -- given, because the tool won't understand normal compiler -- options. if Command_Line then Current_Comp_Option_Table := Compiling_Options_HTable.Get (Name_Ada); if Current_Comp_Option_Table = No_Comp_Option_Table then Current_Comp_Option_Table := new String_Vectors.Vector' (String_Vectors.Empty_Vector); Compiling_Options_HTable.Set (Name_Ada, Current_Comp_Option_Table); end if; else Current_Builder_Comp_Option_Table := Builder_Compiling_Options_HTable.Get (Name_Ada); if Current_Builder_Comp_Option_Table = No_Builder_Comp_Option_Table then Current_Builder_Comp_Option_Table := new String_Vectors.Vector'(String_Vectors.Empty_Vector); Builder_Compiling_Options_HTable.Set (Name_Ada, Current_Builder_Comp_Option_Table); end if; end if; Current_Processor := Compiler; Add_Option (Arg, Command_Line); Current_Processor := None; elsif (Language = No_Name or else Language = Name_Ada) and then (Arg = "-nostdlib" or else Arg = "-nostdinc") then -- For compatibility with gnatmake, use switch to bind Ada code -- code and for -nostdlib to link. Current_Bind_Option_Table := Binder_Options_HTable.Get (Name_Ada); if Current_Bind_Option_Table = No_Bind_Option_Table then Current_Bind_Option_Table := new String_Vectors.Vector'(String_Vectors.Empty_Vector); Binder_Options_HTable.Set (Name_Ada, Current_Bind_Option_Table); end if; Current_Processor := Binder; Add_Option (Arg, Command_Line); -- For -nostdlib, use the switch to link too if Arg = "-nostdlib" then Current_Processor := Linker; Add_Option (Arg, Command_Line); end if; Current_Processor := None; else Processed := False; end if; elsif Command_Line then -- The file name of a main or a project file declare File_Name : String := Arg; begin Canonical_Case_File_Name (File_Name); if File_Name'Length > Project_File_Extension'Length and then File_Name (File_Name'Last - Project_File_Extension'Length + 1 .. File_Name'Last) = Project_File_Extension then if No_Project_File then Fail_Program (Project_Tree, "cannot specify --no-project with a project file", Exit_Code => E_General); elsif Project_File_Name /= null then Fail_Program (Project_Tree, "cannot have several project files specified", Exit_Code => E_General); else Project_File_Name := new String'(File_Name); end if; else -- Not a project file, then it is a main Mains.Add_Main (Arg); Always_Compile := True; Main_On_Command_Line := True; end if; end; else Processed := False; end if; if not Processed then if Command_Line then Fail_Program (Project_Tree, "illegal option """ & Arg & """ on the command line", Exit_Code => E_General); else Success := False; end if; end if; end Scan_Arg; ---------------- -- Initialize -- ---------------- procedure Initialize is procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage); begin -- Do some necessary package initializations Snames.Initialize; Set_Program_Name ("gprbuild"); Set_Default_Verbosity; GPR.Tree.Initialize (Root_Environment, Gprbuild_Flags); GPR.Tree.Initialize (Project_Node_Tree); GPR.Initialize (Project_Tree); Mains.Delete; -- Get the name id for "-L"; Dash_L := Get_Name_Id ("-L"); -- Get the command line arguments, starting with --version and --help Check_Version_And_Help ("GPRBUILD", "2004"); -- Check for switch --dumpmachine and, if found, output the normalized -- hostname and exit. for Arg in 1 .. Argument_Count loop if Argument (Arg) = Dumpmachine then Knowledge.Parse_Knowledge_Base (Project_Tree); Put_Line (Knowledge.Normalized_Hostname); OS_Exit (0); end if; end loop; -- Check for switch -h an, if found, display usage and exit for Arg in 1 .. Argument_Count loop if Argument (Arg) = "-h" then Usage; OS_Exit (0); end if; end loop; -- By default, gprbuild should create artefact dirs if they are -- relative to the project directory Opt.Create_Dirs := Create_Relative_Dirs_Only; -- Now process the other options Autoconfiguration := True; Get_Command_Line_Arguments; declare Do_Not_Care : Boolean; begin for Next_Arg in 1 .. Last_Command_Line_Argument loop declare Arg : constant String := Command_Line_Argument (Next_Arg); begin if (Arg'Length >= Compiler_Subst_Option'Length and then Arg (1 .. Compiler_Subst_Option'Length) = Compiler_Subst_Option) or else (Arg'Length >= Compiler_Pkg_Subst_Option'Length and then Arg (1 .. Compiler_Pkg_Subst_Option'Length) = Compiler_Pkg_Subst_Option) then Subst_Switch_Present := True; end if; end; end loop; Scan_Args : for Next_Arg in 1 .. Last_Command_Line_Argument loop Scan_Arg (Command_Line_Argument (Next_Arg), Command_Line => True, Language => No_Name, Success => Do_Not_Care); end loop Scan_Args; end; if Debug.Debug_Flag_N then Opt.Keep_Temporary_Files := True; end if; if CodePeer_Mode then if Languages_Are_Restricted then Remove_All_Restricted_Languages; end if; Add_Restricted_Language ("ada"); Opt.Link_Only := False; if not Opt.Compile_Only and not Opt.Bind_Only then Opt.Compile_Only := True; Opt.Bind_Only := True; end if; elsif Languages_Are_Restricted then Opt.Compile_Only := True; Opt.Bind_Only := False; Opt.Link_Only := False; end if; Mains.Set_Multi_Unit_Index (Project_Tree, Main_Index); Current_Processor := None; GPR.Env.Initialize_Default_Project_Path (Root_Environment.Project_Path, Target_Name => "-"); -- If --display-paths was specified, display the config and the user -- project paths and exit. if Display_Paths then Put ('.'); declare Prefix_Path : constant String := Executable_Prefix_Path; begin if Prefix_Path'Length /= 0 then Put (Path_Separator); Put (Prefix_Path); Put ("share"); Put (Directory_Separator); Put ("gpr"); end if; New_Line; Put_Line (Env.Get_Path (Root_Environment.Project_Path)); Exit_Program (E_Success); end; end if; if Opt.Verbosity_Level > Opt.Low then Copyright; end if; -- Fail if command line ended with "-P" if Project_File_Name_Expected then Fail_Program (Project_Tree, "project file name missing after -P", Exit_Code => E_General); -- Or if it ended with "-o" elsif Output_File_Name_Expected then Fail_Program (Project_Tree, "output file name missing after -o", Exit_Code => E_General); -- Or if it ended with "-aP" elsif Search_Project_Dir_Expected then Fail_Program (Project_Tree, "directory name missing after -aP", Exit_Code => E_General); elsif Db_Directory_Expected then Fail_Program (Project_Tree, "directory name missing after --db", Exit_Code => E_General); elsif Slave_Env /= null and then not Distributed_Mode then Fail_Program (Project_Tree, "cannot use --slave-env in non distributed mode"); end if; if Load_Standard_Base then -- We need to parse the knowledge base so that we are able to -- normalize the target names. Unfortunately, if we have to spawn -- gprconfig, it will also have to parse that knowledge base on -- its own. Knowledge.Parse_Knowledge_Base (Project_Tree); end if; -- If no project file is specified, look for a default if Project_File_Name = null then Look_For_Default_Project; else No_Project_File_Found := False; end if; if Project_File_Name = null then Try_Help; Fail_Program (Project_Tree, "no project file specified and no default project file"); end if; -- Check consistency of out-of-tree build options. if Root_Dir /= null and then Build_Tree_Dir = null then Fail_Program (Project_Tree, "cannot use --root-dir without --relocate-build-tree option", Exit_Code => E_General); end if; end Initialize; ----------- -- Usage -- ----------- procedure Usage is begin if not Usage_Output then Usage_Output := True; Put ("Usage: "); Put ("gprbuild [-P] [.gpr] [opts] [name]"); New_Line; Put (" {[-cargs opts] [-cargs:lang opts] [-largs opts]" & " [-kargs opts] [-gargs opts]}"); New_Line; New_Line; Put (" name is zero or more file names"); New_Line; New_Line; -- GPRBUILD switches Put ("gprbuild switches:"); New_Line; Display_Usage_Version_And_Help; -- Line for --no-project Put_Line (" --no-project"); Put_Line (" Do not use project file"); -- Line for --distributed Put (" --distributed=slave1[,slave2]"); New_Line; Put (" Activate the remote/distributed compilations"); New_Line; -- Line for --hash Put (" --hash=string"); New_Line; Put (" Set an hash string to identified environment"); New_Line; -- Line for --slave-env Put (" --slave-env[=name]"); New_Line; Put (" Use a specific slave's environment"); New_Line; New_Line; -- Line for --complete-output Put (" --complete-output"); New_Line; Put (" Display all previous errors and warnings"); New_Line; -- Line for --no-complete-output Put (" --no-complete-output, -n"); New_Line; Put (" Do not store compilation outputs in files"); New_Line; New_Line; -- Line for Config_Project_Option Put (" "); Put (Config_Project_Option); Put ("file.cgpr"); New_Line; Put (" Specify the main config project file name"); New_Line; -- Line for Autoconf_Project_Option Put (" "); Put (Autoconf_Project_Option); Put ("file.cgpr"); New_Line; Put (" Specify/create the main config project file name"); New_Line; -- Line for Target_Project_Option Put (" "); Put (Target_Project_Option); Put ("targetname"); New_Line; Put (" Specify a target for cross platforms"); New_Line; -- Line for --db Put (" --db dir Parse dir as an additional knowledge base"); New_Line; -- Line for --db- Put (" --db- Do not load the standard knowledge base"); New_Line; Put (" --implicit-with=filename"); New_Line; Put (" Add the given projects as a dependency on all loaded" & " projects"); New_Line; -- Line for --relocate-build-tree= Put (" --relocate-build-tree[=dir]"); New_Line; Put (" Root obj/lib/exec dirs are current-directory" & " or dir"); New_Line; -- Line for --root-dir= Put (" --root-dir=dir"); New_Line; Put (" Root directory of obj/lib/exec to relocate"); New_Line; -- Line for --src-subdirs= Put (" --src-subdirs=dir"); New_Line; Put (" Prepend /dir to the list of source dirs" & " for each project"); New_Line; -- Line for --subdirs= Put (" --subdirs=dir"); New_Line; Put (" Use dir as suffix to obj/lib/exec directories"); New_Line; if Is_Unix then Put_Line (" --getrusage=file"); Put_Line (" Print getrusage call results into file"); end if; -- Line for --single-compile-per-obj-dir Put (" "); Put (Single_Compile_Per_Obj_Dir_Switch); New_Line; Put (" No simultaneous compilations for the same obj dir"); New_Line; -- Line for --build-script= Put (" "); Put (Build_Script_Option); Put_Line ("script_file"); Put (" Create build script script_file"); New_Line; Put (" "); Put (No_Indirect_Imports_Switch); New_Line; Put (" Sources can import only from directly imported " & "projects"); New_Line; Put (" "); Put (Indirect_Imports_Switch); New_Line; Put (" Sources can import from directly and indirectly " & "imported projects"); New_Line; Put (" --RTS="); New_Line; Put (" Use runtime for language Ada"); New_Line; Put (" --RTS:="); New_Line; Put (" Use runtime for language "); New_Line; Put (" "); Put (Gpr_Build_Util.Unchecked_Shared_Lib_Imports); New_Line; Put (" Shared lib projects may import any project"); New_Line; Put (" "); Put (No_Object_Check_Switch); New_Line; Put (" Do not check object files"); New_Line; Put (" --no-sal-binding"); New_Line; Put (" Reuse binder files when linking SALs"); New_Line; Put (" "); Put (Restricted_To_Languages_Option); Put (""); New_Line; Put (" Restrict the languages of the sources"); New_Line; New_Line; Put (" "); Put (Create_Map_File_Switch); New_Line; Put (" Create map file mainprog.map"); New_Line; Put (" "); Put (Create_Map_File_Switch); Put ("=mapfile"); New_Line; Put (" Create map file mapfile"); New_Line; Put (" "); Put (Source_Info_Option & ""); New_Line; Put (" Specify/create the project sources cache file"); New_Line; Put (" "); Put (Keep_Temp_Files_Option); New_Line; Put (" Do not delete temporary files"); New_Line; New_Line; Put (" "); Put (Use_GNU_Make_Jobserver_Option); New_Line; Put (" Share job slots with GNU make"); New_Line; New_Line; -- Line for -aP Put (" -aP dir Add directory dir to project search path"); New_Line; -- Line for -b Put (" -b Bind only"); New_Line; -- Line for -c Put (" -c Compile only"); New_Line; -- Line for -d Put (" -d Display compilation progress"); New_Line; -- Line for -eInn Put (" -eInn Index of main unit in multi-unit source file"); New_Line; -- Line for -eL Put (" -eL " & "Follow symbolic links when processing project files"); New_Line; -- Line for -eS Put (" -eS " & "(no action, for compatibility with gnatmake only)"); New_Line; -- Line for -f Put (" -f Force recompilations"); New_Line; -- Line for -F Put (" -F Full project path name in brief error messages"); New_Line; -- Line for -jnnn Put (" -j Use processes to compile, bind, and link"); New_Line; Put (" -jc Use processes to compile"); New_Line; Put (" -jb Use processes to bind"); New_Line; Put (" -jl Use processes to link"); New_Line; -- Line for -k Put (" -k Keep going after compilation errors"); New_Line; -- Line for -l Put (" -l Link only"); New_Line; -- Line for -m Put (" -m Minimum Ada recompilation"); New_Line; -- Line for -m2 Put (" -m2 Checksum based Ada recompilation"); New_Line; -- Line for -o Put (" -o name Choose an alternate executable name"); New_Line; -- Line for -p Put (" -p Create missing obj, lib and exec dirs"); New_Line; -- Line for -P Put (" -P proj Use Project File proj"); New_Line; -- Line for -q Put (" -q Be quiet/terse"); New_Line; -- Line for -r Put (" -r Recursive (default except when using -c)"); New_Line; -- Line for -R Put (" -R Do not use run path option"); New_Line; -- Line for -s Put (" -s Recompile if compiler switches have changed"); New_Line; -- Line for -u Put (" -u Unique compilation, only compile the given files"); New_Line; -- Line for -U Put (" -U Unique compilation for all sources of all projects"); New_Line; -- Line for -v Put (" -v Verbose output"); New_Line; -- Line for -vl Put (" -vl Verbose output (low verbosity)"); New_Line; -- Line for -vm Put (" -vm Verbose output (medium verbosity)"); New_Line; -- Line for -vh Put (" -vh Verbose output (high verbosity)"); New_Line; -- Line for -vPx Put (" -vPx Specify verbosity when parsing Project Files" & " (x = 0/1/2)"); New_Line; -- Line for -we Put (" -we Treat all warnings as errors"); New_Line; -- Line for -wn Put (" -wn Treat warnings as warnings"); New_Line; -- Line for -ws Put (" -ws Suppress all gprbuild-specific warnings"); New_Line; -- Line for -x Put (" -x Always create include path file"); New_Line; -- Line for -X Put (" -Xnm=val Specify an external reference for " & "Project Files"); New_Line; New_Line; -- Line for -z Put (" -z No main subprogram (zero main)"); New_Line; -- Line for --compiler-subst Put_Line (" --compiler-subst=lang,tool Specify alternate " & "compiler"); -- Line for --compiler-pkg-subst Put_Line (" --compiler-pkg-subst=pkg Specify alternate " & "package"); New_Line; New_Line; -- Line for -cargs Put_Line (" -cargs opts opts are passed to all compilers"); -- Line for -cargs:lang Put_Line (" -cargs: opts"); Put_Line (" opts are passed to the compiler " & "for language "); -- Line for -bargs Put_Line (" -bargs opts opts are passed to all binders"); -- Line for -cargs:lang Put_Line (" -bargs: opts"); Put_Line (" opts are passed to the binder " & "for language "); -- Line for -largs Put (" -largs opts opts are passed to the linker"); New_Line; -- Line for -kargs Put (" -kargs opts opts are passed to gprconfig"); New_Line; -- Line for -gargs Put (" -gargs opts opts directly interpreted by gprbuild"); New_Line; -- Line for -margs Put (" -margs opts equivalent to -gargs opts"); New_Line; New_Line; Put ("For compatibility with gnatmake, these switches are passed " & "to the Ada compiler:"); New_Line; Put (" -nostdlib"); New_Line; Put (" -nostdinc"); New_Line; Put (" -fstack-check"); New_Line; Put (" -fno-inline"); New_Line; Put (" -gxxx"); New_Line; Put (" -Oxx"); New_Line; New_Line; end if; end Usage; User_Project_Node : Project_Node_Id; procedure Do_Compute_Builder_Switches is new Compute_Builder_Switches (Add_Global_Switches); begin -- First initialize and read the command line arguments Initialize; -- And install Ctrl-C handler Install_Int_Handler (Gprbuild.Sigint_Intercepted'Access); -- Add the external variable GPR_TOOL (default value "gprbuild") Add_Gpr_Tool_External; -- Check command line arguments. These will be overridden when looking -- for the configuration file if Target_Name = null then Target_Name := new String'(""); end if; if Config_Project_File_Name = null then Config_Project_File_Name := new String'(""); elsif Autoconf_Specified then -- Check if path needs to be created declare Config_Path : constant String := Ada.Directories.Containing_Directory (Config_Project_File_Name.all); begin if not Ada.Directories.Exists (Config_Path) then Ada.Directories.Create_Path (Config_Path); end if; end; end if; -- Then, parse the user's project and the configuration file. Apply the -- configuration file to the project so that its settings are -- automatically inherited by the project. -- If either the project or the configuration file contains errors, the -- following call with call Fail_Program and never return begin Main_Project := No_Project; Parse_Project_And_Apply_Config (Main_Project => Main_Project, User_Project_Node => User_Project_Node, Config_File_Name => Config_Project_File_Name.all, Autoconf_Specified => Autoconf_Specified, Project_File_Name => Project_File_Name.all, Project_Tree => Project_Tree, Env => Root_Environment, Project_Node_Tree => Project_Node_Tree, Packages_To_Check => Packages_To_Check, Allow_Automatic_Generation => Autoconfiguration, Automatically_Generated => Delete_Autoconf_File, Config_File_Path => Configuration_Project_Path, Target_Name => Target_Name.all, Normalized_Hostname => Knowledge.Normalized_Hostname, Implicit_Project => No_Project_File_Found, Gprconfig_Options => Command_Line_Gprconfig_Options); exception when E : GPR.Conf.Invalid_Config => Fail_Program (Project_Tree, Exception_Message (E), Exit_Code => E_Project); end; if Main_Project = No_Project then -- Don't flush messages in case of parsing error. This has already -- been taken care when parsing the tree. Otherwise, it results in -- the same message being displayed twice. Fail_Program (Project_Tree, """" & Project_File_Name.all & """ processing failed", Flush_Messages => Present (User_Project_Node), Exit_Code => E_Project); end if; if Configuration_Project_Path /= null then Free (Config_Project_File_Name); Config_Project_File_Name := new String' (Base_Name (Configuration_Project_Path.all)); end if; if Total_Errors_Detected > 0 then GPR.Err.Finalize; Fail_Program (Project_Tree, "problems while getting the configuration", Flush_Messages => False); end if; -- Warn if there have been binder option specified on the command line -- and the main project is a Stand-Alone Library project. declare Options_Instance : constant Bind_Option_Table_Ref := Binder_Options_HTable.Get (Name_Ada); begin if not All_Language_Binder_Options.Is_Empty or else (Options_Instance /= No_Bind_Option_Table and then not Options_Instance.Is_Empty) then if Main_Project.Standalone_Library /= No then GPR.Err.Error_Msg ("?binding options on the command line are not taken " & "into account when the main project is a Stand-Alone " & "Library project", Main_Project.Location); end if; end if; end; Main_Project_Dir := new String'(Get_Name_String (Main_Project.Directory.Display_Name)); if Warnings_Detected > 0 then GPR.Err.Finalize; GPR.Err.Initialize; end if; -- Adjust switches for C and jvm targets: never perform the link phase declare No_Link : Boolean := False; Variable : Variable_Value; begin if No_Link_Target (Target_Name.all) then No_Link := True; else Variable := GPR.Util.Value_Of (Name_Target, Main_Project.Decl.Attributes, Project_Tree.Shared); if Variable /= Nil_Variable_Value and then No_Link_Target (Get_Name_String (Variable.Value)) then No_Link := True; -- Set Target_Name so that e.g. gprbuild-post_compile.adb knows -- that we have Target = c/ccg/jvm. Free (Target_Name); Target_Name := new String'(Get_Name_String (Variable.Value)); end if; end if; if No_Link then Opt.Link_Only := False; if not Opt.Compile_Only and not Opt.Bind_Only then Opt.Compile_Only := True; Opt.Bind_Only := True; end if; end if; end; Compute_All_Imported_Projects (Main_Project, Project_Tree); if Main_Project.Qualifier = Aggregate_Library then if Main_On_Command_Line then if (not Opt.Compile_Only or else Opt.Bind_Only) and then not Unique_Compile then Fail_Program (Project_Tree, "cannot specify a main program " & "on the command line for a library project file", Exit_Code => E_General); else Mains.Complete_Mains (Root_Environment.Flags, Main_Project, Project_Tree, Unique_Compile); end if; end if; else if Mains.Number_Of_Mains (Project_Tree) = 0 and then not Unique_Compile then -- Register the Main units from the projects. -- No need to waste time when we are going to compile all files -- anyway (Unique_Compile). Mains.Fill_From_Project (Main_Project, Project_Tree); end if; Mains.Complete_Mains (Root_Environment.Flags, Main_Project, Project_Tree, Unique_Compile); if not Unique_Compile and then Output_File_Name /= null and then Mains.Number_Of_Mains (null) > 1 then Fail_Program (Project_Tree, "cannot specify -o when there are several mains", Exit_Code => E_General); end if; end if; Do_Compute_Builder_Switches (Project_Tree => Project_Tree, Env => Root_Environment, Main_Project => Main_Project); Queue.Initialize (Opt.One_Compilation_Per_Obj_Dir); Compute_Compilation_Phases (Project_Tree, Main_Project, Option_Unique_Compile => Unique_Compile, Option_Compile_Only => Opt.Compile_Only, Option_Bind_Only => Opt.Bind_Only, Option_Link_Only => Opt.Link_Only); if Mains.Number_Of_Mains (Project_Tree) > 0 and then Main_Project.Library and then Builder_Data (Project_Tree).Need_Binding then Fail_Program (Project_Tree, "cannot specify a main program " & "on the command line for a library project file", Exit_Code => E_General); end if; Add_Mains_To_Queue; -- If no sources to compile, then there is nothing to do if Queue.Size = 0 then if not Opt.Quiet_Output and then not Main_Project.Externally_Built then Write_Program_Name; Write_Line ("no sources to compile"); end if; Finish_Program (Project_Tree, E_Success); end if; Always_Compile := Always_Compile and then Opt.Force_Compilations and then Unique_Compile and then not Unique_Compile_All_Projects; -- Reprocess recorded command line options that have priority over -- those in the main project file. Options.Process_Command_Line_Options; Check_Maximum_Processes; -- If a build script is declared, try to create the file. Fail if the file -- cannot be created. if Build_Script_Name /= null then begin Create (Build_Script_File, Out_File, Build_Script_Name.all); exception when others => Fail_Program (null, "build script """ & Build_Script_Name.all & """ could not be created"); end; end if; if Debug.Debug_Flag_M then Put_Line ("Maximum number of simultaneous compilations =" & Opt.Maximum_Compilers'Img); end if; -- Warn if --create-map-file is not supported if Map_File /= null and then Main_Project.Config.Map_File_Option = No_Name then Put ("warning: option "); Put (Create_Map_File_Switch); Put (" is not supported in this configuration"); New_Line; end if; -- Set slave-env if Distributed_Mode then if Slave_Env = null then Slave_Env := new String'(Aux.Compute_Slave_Env (Project_Tree, Slave_Env_Auto)); if Slave_Env_Auto and not Opt.Quiet_Output then Put ("slave environment is "); Put (Slave_Env.all); New_Line; end if; end if; end if; Compile.Run; -- If the build script file is opened, close it, so that it can be reopened -- by gprlib and gprbind. if Is_Open (Build_Script_File) then Close (Build_Script_File); Opt.Maximum_Binders := 1; Opt.Maximum_Linkers := 1; end if; Post_Compile.Run; Link.Run; if Warnings_Detected /= 0 then GPR.Err.Finalize; end if; if Getrusage /= null then Put_Resource_Usage (Getrusage.all); end if; Finish_Program (Project_Tree, Exit_Code); exception when C : Constraint_Error => if Distributed_Mode then GPR.Compilation.Slave.Unregister_Remote_Slaves (From_Signal => True); end if; Fail_Program (Project_Tree, Exception_Information (C)); when Project_Error => Fail_Program (Project_Tree, '"' & Project_File_Name.all & """ processing failed"); when E : others => Fail_Program (Project_Tree, Exception_Information (E)); end Gprbuild.Main;