- procedure For_Every_Imported_Project is new For_Every_Project_Imported
- (State => Integer, Action => Add_Config_Switches_For_Project);
- -- Document this procedure ???
-
- -- Local variables
-
- Name : Name_Id;
- Count : Natural;
- Result : Argument_List_Access;
- Variable : Variable_Value;
- Dummy : Integer := 0;
-
- -- Start of processing for Get_Config_Switches
-
- begin
- For_Every_Imported_Project
- (By => Project,
- Tree => Project_Tree,
- With_State => Dummy,
- Include_Aggregated => True);
-
- Name := Language_Htable.Get_First;
- Count := 0;
- while Name /= No_Name loop
- Count := Count + 1;
- Name := Language_Htable.Get_Next;
- end loop;
-
- Result := new String_List (1 .. Count);
-
- Count := 1;
- Name := Language_Htable.Get_First;
- while Name /= No_Name loop
-
- -- Check if IDE'Compiler_Command is declared for the language.
- -- If it is, use its value to invoke gprconfig.
-
- Variable :=
- Value_Of
- (Name,
- Attribute_Or_Array_Name => Name_Compiler_Command,
- In_Package => IDE,
- Shared => Shared,
- Force_Lower_Case_Index => True);
-
- declare
- Config_Command : constant String :=
- "--config=" & Get_Name_String (Name);
-
- Runtime_Name : constant String :=
- Runtime_Name_For (Name);
-
- begin
- if Variable = Nil_Variable_Value
- or else Length_Of_Name (Variable.Value) = 0
- then
- Result (Count) :=
- new String'(Config_Command & ",," & Runtime_Name);
-
- else
- At_Least_One_Compiler_Command := True;
-
- declare
- Compiler_Command : constant String :=
- Get_Name_String (Variable.Value);
-
- begin
- if Is_Absolute_Path (Compiler_Command) then
- Result (Count) :=
- new String'
- (Config_Command & ",," & Runtime_Name & "," &
- Containing_Directory (Compiler_Command) & "," &
- Simple_Name (Compiler_Command));
- else
- Result (Count) :=
- new String'
- (Config_Command & ",," & Runtime_Name & ",," &
- Compiler_Command);
- end if;
- end;
- end if;
- end;
-
- Count := Count + 1;
- Name := Language_Htable.Get_Next;
- end loop;
-
- return Result;
- end Get_Config_Switches;
-
- -----------------
- -- Do_Autoconf --
- -----------------
-
- procedure Do_Autoconf is
- Obj_Dir : constant Variable_Value :=
- Value_Of
- (Name_Object_Dir,
- Project.Decl.Attributes,
- Shared);
-
- Gprconfig_Path : String_Access;
- Success : Boolean;
-
- begin
- Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
-
- if Gprconfig_Path = null then
- Raise_Invalid_Config
- ("could not locate gprconfig for auto-configuration");
- end if;
-
- -- First, find the object directory of the user's project
-
- if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
- Get_Name_String (Project.Directory.Display_Name);
-
- else
- if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
- Get_Name_String (Obj_Dir.Value);
-
- else
- Name_Len := 0;
- Add_Str_To_Name_Buffer
- (Get_Name_String (Project.Directory.Display_Name));
- Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
- end if;
- end if;
-
- if Subdirs /= null then
- Add_Char_To_Name_Buffer (Directory_Separator);
- Add_Str_To_Name_Buffer (Subdirs.all);
- end if;
-
- for J in 1 .. Name_Len loop
- if Name_Buffer (J) = '/' then
- Name_Buffer (J) := Directory_Separator;
- end if;
- end loop;
-
- -- Make sure that Obj_Dir ends with a directory separator
-
- if Name_Buffer (Name_Len) /= Directory_Separator then
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Directory_Separator;
- end if;
-
- declare
- Obj_Dir : constant String := Name_Buffer (1 .. Name_Len);
- Config_Switches : Argument_List_Access;
- Args : Argument_List (1 .. 5);
- Arg_Last : Positive;
- Obj_Dir_Exists : Boolean := True;
-
- begin
- -- Check if the object directory exists. If Setup_Projects is True
- -- (-p) and directory does not exist, attempt to create it.
- -- Otherwise, if directory does not exist, fail without calling
- -- gprconfig.
-
- if not Is_Directory (Obj_Dir)
- and then (Setup_Projects or else Subdirs /= null)
- then
- begin
- Create_Path (Obj_Dir);
-
- if not Quiet_Output then
- Write_Str ("object directory """);
- Write_Str (Obj_Dir);
- Write_Line (""" created");
- end if;
-
- exception
- when others =>
- Raise_Invalid_Config
- ("could not create object directory " & Obj_Dir);
- end;
- end if;
-
- if not Is_Directory (Obj_Dir) then
- case Env.Flags.Require_Obj_Dirs is
- when Error =>
- Raise_Invalid_Config
- ("object directory " & Obj_Dir & " does not exist");
-
- when Warning =>
- Prj.Err.Error_Msg
- (Env.Flags,
- "?object directory " & Obj_Dir & " does not exist");
- Obj_Dir_Exists := False;
-
- when Silent =>
- null;
- end case;
- end if;
-
- -- If no switch --RTS have been specified on the command line,
- -- look for --RTS switches in the Builder switches.
-
- if RTS_Languages.Get_First = No_Name then
- declare
- Builder : constant Package_Id :=
- Value_Of
- (Name_Builder, Project.Decl.Packages, Shared);
- Switch_Array_Id : Array_Element_Id;
-
- procedure Check_RTS_Switches;
- -- Take into account eventual switches --RTS in
- -- Switch_Array_Id.
-
- ------------------------
- -- Check_RTS_SWitches --
- ------------------------
-
- procedure Check_RTS_Switches is
- Switch_Array : Array_Element;
- Switch_List : String_List_Id := Nil_String;
- Switch : String_Element;
- Lang : Name_Id;
- Lang_Last : Positive;
-
- begin
- while Switch_Array_Id /= No_Array_Element loop
- Switch_Array :=
- Shared.Array_Elements.Table (Switch_Array_Id);
-
- Switch_List := Switch_Array.Value.Values;
- while Switch_List /= Nil_String loop
- Switch :=
- Shared.String_Elements.Table (Switch_List);
-
- if Switch.Value /= No_Name then
- Get_Name_String (Switch.Value);
-
- if Name_Len >= 7 and then
- Name_Buffer (1 .. 5) = "--RTS"
- then
- if Name_Buffer (6) = '=' then
- if not Runtime_Name_Set_For (Name_Ada) then
- Set_Runtime_For
- (Name_Ada,
- Name_Buffer (7 .. Name_Len));
- end if;
-
- elsif Name_Len > 7 and then
- Name_Buffer (6) = ':' and then
- Name_Buffer (7) /= '='
- then
- Lang_Last := 7;
- while Lang_Last < Name_Len and then
- Name_Buffer (Lang_Last + 1) /= '='
- loop
- Lang_Last := Lang_Last + 1;
- end loop;
-
- if Name_Buffer (Lang_Last + 1) = '=' then
- declare
- RTS : constant String :=
- Name_Buffer (Lang_Last + 2 ..
- Name_Len);
- begin
- Name_Buffer (1 .. Lang_Last - 6) :=
- Name_Buffer (7 .. Lang_Last);
- Name_Len := Lang_Last - 6;
- To_Lower
- (Name_Buffer (1 .. Name_Len));
- Lang := Name_Find;
-
- if not
- Runtime_Name_Set_For (Lang)
- then
- Set_Runtime_For (Lang, RTS);
- end if;
- end;
- end if;
- end if;
- end if;
- end if;
-
- Switch_List := Switch.Next;
- end loop;
-
- Switch_Array_Id := Switch_Array.Next;
- end loop;
- end Check_RTS_Switches;
-
- begin
- if Builder /= No_Package then
- Switch_Array_Id :=
- Value_Of
- (Name => Name_Switches,
- In_Arrays =>
- Shared.Packages.Table (Builder).Decl.Arrays,
- Shared => Shared);
- Check_RTS_Switches;
-
- Switch_Array_Id :=
- Value_Of
- (Name => Name_Default_Switches,
- In_Arrays =>
- Shared.Packages.Table (Builder).Decl.Arrays,
- Shared => Shared);
- Check_RTS_Switches;
- end if;
- end;
- end if;
-
- -- Get the config switches. This should be done only now, as some
- -- runtimes may have been found if the Builder switches.
-
- Config_Switches := Get_Config_Switches;
-
- -- Invoke gprconfig
-
- Args (1) := new String'("--batch");
- Args (2) := new String'("-o");