-- --
-- B o d y --
-- --
--- Copyright (C) 2006-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2006-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- 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, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-with Ada.Directories; use Ada.Directories;
-with GNAT.HTable; use GNAT.HTable;
-with Makeutl; use Makeutl;
-with Opt; use Opt;
-with Osint; use Osint;
-with Output; use Output;
-with Prj.Err; use Prj.Err;
+with Hostparm;
+with Makeutl; use Makeutl;
+with MLib.Tgt;
+with Opt; use Opt;
+with Output; use Output;
+with Prj.Env;
+with Prj.Err;
with Prj.Part;
-with Prj.Proc; use Prj.Proc;
-with Prj.Tree; use Prj.Tree;
-with Prj.Util; use Prj.Util;
-with Prj; use Prj;
-with Sinput.P;
-with Snames; use Snames;
-with System.Case_Util; use System.Case_Util;
-with System;
+with Prj.PP;
+with Prj.Proc; use Prj.Proc;
+with Prj.Tree; use Prj.Tree;
+with Prj.Util; use Prj.Util;
+with Prj; use Prj;
+with Snames; use Snames;
+
+with Ada.Directories; use Ada.Directories;
+with Ada.Exceptions; use Ada.Exceptions;
+
+with GNAT.Case_Util; use GNAT.Case_Util;
+with GNAT.HTable; use GNAT.HTable;
package body Prj.Conf is
-- Stores the runtime names for the various languages. This is in general
-- set from a --RTS command line option.
+ -----------------------
+ -- Local_Subprograms --
+ -----------------------
+
procedure Add_Attributes
(Project_Tree : Project_Tree_Ref;
Conf_Decl : Declarations;
-- For string list values, prepend the value in the user declarations with
-- the value in the config declarations.
- function Locate_Config_File (Name : String) return String_Access;
- -- Search for Name in the config files directory. Return full path if
- -- found, or null otherwise
-
function Check_Target
- (Config_File : Prj.Project_Id;
+ (Config_File : Prj.Project_Id;
Autoconf_Specified : Boolean;
- Project_Tree : Prj.Project_Tree_Ref;
- Target : String := "") return Boolean;
+ Project_Tree : Prj.Project_Tree_Ref;
+ Target : String := "") return Boolean;
-- Check that the config file's target matches Target.
-- Target should be set to the empty string when the user did not specify
- -- a target.
- -- If the target in the configuration file is invalid, this function will
- -- call Osint.Fail to report a fatal error message and stop the program.
- -- Autoconf_Specified should be set to True if the user has used --autoconf
+ -- a target. If the target in the configuration file is invalid, this
+ -- function will raise Invalid_Config with an appropriate message.
+ -- Autoconf_Specified should be set to True if the user has used
+ -- autoconf.
+
+ function Locate_Config_File (Name : String) return String_Access;
+ -- Search for Name in the config files directory. Return full path if
+ -- found, or null otherwise.
+
+ procedure Raise_Invalid_Config (Msg : String);
+ pragma No_Return (Raise_Invalid_Config);
+ -- Raises exception Invalid_Config with given message
+
+ procedure Apply_Config_File
+ (Config_File : Prj.Project_Id;
+ Project_Tree : Prj.Project_Tree_Ref);
+ -- Apply the configuration file settings to all the projects in the
+ -- project tree. The Project_Tree must have been parsed first, and
+ -- processed through the first phase so that all its projects are known.
+ --
+ -- Currently, this will add new attributes and packages in the various
+ -- projects, so that when the second phase of the processing is performed
+ -- these attributes are automatically taken into account.
--------------------
-- Add_Attributes --
Conf_Decl : Declarations;
User_Decl : in out Declarations)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
Conf_Attr_Id : Variable_Id;
Conf_Attr : Variable;
Conf_Array_Id : Array_Id;
begin
Conf_Attr_Id := Conf_Decl.Attributes;
User_Attr_Id := User_Decl.Attributes;
-
while Conf_Attr_Id /= No_Variable loop
- Conf_Attr :=
- Project_Tree.Variable_Elements.Table (Conf_Attr_Id);
- User_Attr :=
- Project_Tree.Variable_Elements.Table (User_Attr_Id);
+ Conf_Attr := Shared.Variable_Elements.Table (Conf_Attr_Id);
+ User_Attr := Shared.Variable_Elements.Table (User_Attr_Id);
if not Conf_Attr.Value.Default then
if User_Attr.Value.Default then
-- value of the configuration attribute.
User_Attr.Value := Conf_Attr.Value;
- Project_Tree.Variable_Elements.Table (User_Attr_Id) :=
- User_Attr;
+ Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr;
- elsif User_Attr.Value.Kind = List and then
- Conf_Attr.Value.Values /= Nil_String
+ elsif User_Attr.Value.Kind = List
+ and then Conf_Attr.Value.Values /= Nil_String
then
-
-- List attribute declared in both the user project and the
-- configuration project: prepend the user list with the
-- configuration list.
declare
- Conf_List : String_List_Id :=
- Conf_Attr.Value.Values;
- Conf_Elem : String_Element;
User_List : constant String_List_Id :=
- User_Attr.Value.Values;
- New_List : String_List_Id;
- New_Elem : String_Element;
+ User_Attr.Value.Values;
+ Conf_List : String_List_Id := Conf_Attr.Value.Values;
+ Conf_Elem : String_Element;
+ New_List : String_List_Id;
+ New_Elem : String_Element;
begin
-
-- Create new list
String_Element_Table.Increment_Last
- (Project_Tree.String_Elements);
- New_List := String_Element_Table.Last
- (Project_Tree.String_Elements);
+ (Shared.String_Elements);
+ New_List :=
+ String_Element_Table.Last (Shared.String_Elements);
-- Value of attribute is new list
User_Attr.Value.Values := New_List;
- Project_Tree.Variable_Elements.Table (User_Attr_Id) :=
- User_Attr;
+ Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr;
loop
-
-- Get each element of configuration list
- Conf_Elem :=
- Project_Tree.String_Elements.Table (Conf_List);
- New_Elem := Conf_Elem;
+ Conf_Elem := Shared.String_Elements.Table (Conf_List);
+ New_Elem := Conf_Elem;
Conf_List := Conf_Elem.Next;
if Conf_List = Nil_String then
-- first element of user list, and we are done.
New_Elem.Next := User_List;
- Project_Tree.String_Elements.Table
- (New_List) := New_Elem;
+ Shared.String_Elements.Table (New_List) := New_Elem;
exit;
else
-
-- If it is not the last element in the list, add to
-- new list.
String_Element_Table.Increment_Last
- (Project_Tree.String_Elements);
+ (Shared.String_Elements);
New_Elem.Next :=
- String_Element_Table.Last
- (Project_Tree.String_Elements);
- Project_Tree.String_Elements.Table
- (New_List) := New_Elem;
+ String_Element_Table.Last (Shared.String_Elements);
+ Shared.String_Elements.Table (New_List) := New_Elem;
New_List := New_Elem.Next;
end if;
end loop;
Conf_Array_Id := Conf_Decl.Arrays;
while Conf_Array_Id /= No_Array loop
- Conf_Array := Project_Tree.Arrays.Table (Conf_Array_Id);
+ Conf_Array := Shared.Arrays.Table (Conf_Array_Id);
User_Array_Id := User_Decl.Arrays;
while User_Array_Id /= No_Array loop
- User_Array := Project_Tree.Arrays.Table (User_Array_Id);
+ User_Array := Shared.Arrays.Table (User_Array_Id);
exit when User_Array.Name = Conf_Array.Name;
User_Array_Id := User_Array.Next;
end loop;
-- do a shallow copy of the full associative array.
if User_Array_Id = No_Array then
- Array_Table.Increment_Last (Project_Tree.Arrays);
+ Array_Table.Increment_Last (Shared.Arrays);
User_Array := Conf_Array;
User_Array.Next := User_Decl.Arrays;
- User_Decl.Arrays := Array_Table.Last (Project_Tree.Arrays);
- Project_Tree.Arrays.Table (User_Decl.Arrays) := User_Array;
+ User_Decl.Arrays := Array_Table.Last (Shared.Arrays);
+ Shared.Arrays.Table (User_Decl.Arrays) := User_Array;
- else
- -- Otherwise, check each array element
+ -- Otherwise, check each array element
+ else
Conf_Array_Elem_Id := Conf_Array.Value;
while Conf_Array_Elem_Id /= No_Array_Element loop
Conf_Array_Elem :=
- Project_Tree.Array_Elements.Table (Conf_Array_Elem_Id);
+ Shared.Array_Elements.Table (Conf_Array_Elem_Id);
User_Array_Elem_Id := User_Array.Value;
while User_Array_Elem_Id /= No_Array_Element loop
User_Array_Elem :=
- Project_Tree.Array_Elements.Table (User_Array_Elem_Id);
+ Shared.Array_Elements.Table (User_Array_Elem_Id);
exit when User_Array_Elem.Index = Conf_Array_Elem.Index;
User_Array_Elem_Id := User_Array_Elem.Next;
end loop;
- -- If the array element does not exist in the user array,
- -- insert a shallow copy of the conf array element in the
- -- user array.
+ -- If the array element doesn't exist in the user array, insert
+ -- a shallow copy of the conf array element in the user array.
if User_Array_Elem_Id = No_Array_Element then
- Array_Element_Table.Increment_Last
- (Project_Tree.Array_Elements);
+ Array_Element_Table.Increment_Last (Shared.Array_Elements);
User_Array_Elem := Conf_Array_Elem;
User_Array_Elem.Next := User_Array.Value;
User_Array.Value :=
- Array_Element_Table.Last (Project_Tree.Array_Elements);
- Project_Tree.Array_Elements.Table (User_Array.Value) :=
+ Array_Element_Table.Last (Shared.Array_Elements);
+ Shared.Array_Elements.Table (User_Array.Value) :=
User_Array_Elem;
- Project_Tree.Arrays.Table (User_Array_Id) := User_Array;
+ Shared.Arrays.Table (User_Array_Id) := User_Array;
- -- Otherwise, if the value is a string list, prepend the
- -- user array element with the conf array element value.
+ -- Otherwise, if the value is a string list, prepend the conf
+ -- array element value to the array element.
elsif Conf_Array_Elem.Value.Kind = List then
Conf_List := Conf_Array_Elem.Value.Values;
if Conf_List /= Nil_String then
declare
- Link : constant String_List_Id :=
- User_Array_Elem.Value.Values;
+ Link : constant String_List_Id :=
+ User_Array_Elem.Value.Values;
Previous : String_List_Id := Nil_String;
Next : String_List_Id;
+
begin
loop
Conf_List_Elem :=
- Project_Tree.String_Elements.Table
- (Conf_List);
+ Shared.String_Elements.Table (Conf_List);
String_Element_Table.Increment_Last
- (Project_Tree.String_Elements);
+ (Shared.String_Elements);
Next :=
String_Element_Table.Last
- (Project_Tree.String_Elements);
- Project_Tree.String_Elements.Table (Next) :=
+ (Shared.String_Elements);
+ Shared.String_Elements.Table (Next) :=
Conf_List_Elem;
if Previous = Nil_String then
User_Array_Elem.Value.Values := Next;
- Project_Tree.Array_Elements.Table
+ Shared.Array_Elements.Table
(User_Array_Elem_Id) := User_Array_Elem;
else
- Project_Tree.String_Elements.Table
+ Shared.String_Elements.Table
(Previous).Next := Next;
end if;
Conf_List := Conf_List_Elem.Next;
if Conf_List = Nil_String then
- Project_Tree.String_Elements.Table
- (Previous).Next := Link;
+ Shared.String_Elements.Table (Previous).Next :=
+ Link;
exit;
end if;
end loop;
end loop;
end Add_Attributes;
- ------------------------
- -- Locate_Config_File --
- ------------------------
+ ------------------------------------
+ -- Add_Default_GNAT_Naming_Scheme --
+ ------------------------------------
+
+ procedure Add_Default_GNAT_Naming_Scheme
+ (Config_File : in out Project_Node_Id;
+ Project_Tree : Project_Node_Tree_Ref)
+ is
+ procedure Create_Attribute
+ (Name : Name_Id;
+ Value : String;
+ Index : String := "";
+ Pkg : Project_Node_Id := Empty_Node);
+
+ ----------------------
+ -- Create_Attribute --
+ ----------------------
+
+ procedure Create_Attribute
+ (Name : Name_Id;
+ Value : String;
+ Index : String := "";
+ Pkg : Project_Node_Id := Empty_Node)
+ is
+ Attr : Project_Node_Id;
+ pragma Unreferenced (Attr);
+
+ Expr : Name_Id := No_Name;
+ Val : Name_Id := No_Name;
+ Parent : Project_Node_Id := Config_File;
+
+ begin
+ if Index /= "" then
+ Name_Len := Index'Length;
+ Name_Buffer (1 .. Name_Len) := Index;
+ Val := Name_Find;
+ end if;
+
+ if Pkg /= Empty_Node then
+ Parent := Pkg;
+ end if;
+
+ Name_Len := Value'Length;
+ Name_Buffer (1 .. Name_Len) := Value;
+ Expr := Name_Find;
+
+ Attr := Create_Attribute
+ (Tree => Project_Tree,
+ Prj_Or_Pkg => Parent,
+ Name => Name,
+ Index_Name => Val,
+ Kind => Prj.Single,
+ Value => Create_Literal_String (Expr, Project_Tree));
+ end Create_Attribute;
+
+ -- Local variables
+
+ Name : Name_Id;
+ Naming : Project_Node_Id;
+ Compiler : Project_Node_Id;
+
+ -- Start of processing for Add_Default_GNAT_Naming_Scheme
- function Locate_Config_File (Name : String) return String_Access is
- Prefix_Path : constant String := Executable_Prefix_Path;
begin
- if Prefix_Path'Length /= 0 then
- return Locate_Regular_File
- (Name,
- "." & Path_Separator &
- Prefix_Path & "share" & Directory_Separator & "gpr");
+ if Config_File = Empty_Node then
- else
- return Locate_Regular_File (Name, ".");
+ -- Create a dummy config file is none was found
+
+ Name_Len := Auto_Cgpr'Length;
+ Name_Buffer (1 .. Name_Len) := Auto_Cgpr;
+ Name := Name_Find;
+
+ -- An invalid project name to avoid conflicts with user-created ones
+
+ Name_Len := 5;
+ Name_Buffer (1 .. Name_Len) := "_auto";
+
+ Config_File :=
+ Create_Project
+ (In_Tree => Project_Tree,
+ Name => Name_Find,
+ Full_Path => Path_Name_Type (Name),
+ Is_Config_File => True);
+
+ -- Setup library support
+
+ case MLib.Tgt.Support_For_Libraries is
+ when None =>
+ null;
+
+ when Static_Only =>
+ Create_Attribute (Name_Library_Support, "static_only");
+
+ when Full =>
+ Create_Attribute (Name_Library_Support, "full");
+ end case;
+
+ if MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported then
+ Create_Attribute (Name_Library_Auto_Init_Supported, "true");
+ else
+ Create_Attribute (Name_Library_Auto_Init_Supported, "false");
+ end if;
+
+ -- Setup Ada support (Ada is the default language here, since this
+ -- is only called when no config file existed initially, ie for
+ -- gnatmake).
+
+ Create_Attribute (Name_Default_Language, "ada");
+
+ Compiler := Create_Package (Project_Tree, Config_File, "compiler");
+ Create_Attribute
+ (Name_Driver, "gcc", "ada", Pkg => Compiler);
+ Create_Attribute
+ (Name_Language_Kind, "unit_based", "ada", Pkg => Compiler);
+ Create_Attribute
+ (Name_Dependency_Kind, "ALI_File", "ada", Pkg => Compiler);
+
+ Naming := Create_Package (Project_Tree, Config_File, "naming");
+ Create_Attribute (Name_Spec_Suffix, ".ads", "ada", Pkg => Naming);
+ Create_Attribute (Name_Separate_Suffix, ".adb", "ada", Pkg => Naming);
+ Create_Attribute (Name_Body_Suffix, ".adb", "ada", Pkg => Naming);
+ Create_Attribute (Name_Dot_Replacement, "-", Pkg => Naming);
+ Create_Attribute (Name_Casing, "lowercase", Pkg => Naming);
+
+ if Current_Verbosity = High then
+ Write_Line ("Automatically generated (in-memory) config file");
+ Prj.PP.Pretty_Print
+ (Project => Config_File,
+ In_Tree => Project_Tree,
+ Backward_Compatibility => False);
+ end if;
end if;
- end Locate_Config_File;
+ end Add_Default_GNAT_Naming_Scheme;
+
+ -----------------------
+ -- Apply_Config_File --
+ -----------------------
+
+ procedure Apply_Config_File
+ (Config_File : Prj.Project_Id;
+ Project_Tree : Prj.Project_Tree_Ref)
+ is
+ Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
+
+ Conf_Decl : constant Declarations := Config_File.Decl;
+ Conf_Pack_Id : Package_Id;
+ Conf_Pack : Package_Element;
+
+ User_Decl : Declarations;
+ User_Pack_Id : Package_Id;
+ User_Pack : Package_Element;
+ Proj : Project_List;
+
+ begin
+ Debug_Output ("Applying config file to a project tree");
+
+ Proj := Project_Tree.Projects;
+ while Proj /= null loop
+ if Proj.Project /= Config_File then
+ User_Decl := Proj.Project.Decl;
+ Add_Attributes
+ (Project_Tree => Project_Tree,
+ Conf_Decl => Conf_Decl,
+ User_Decl => User_Decl);
+
+ Conf_Pack_Id := Conf_Decl.Packages;
+ while Conf_Pack_Id /= No_Package loop
+ Conf_Pack := Shared.Packages.Table (Conf_Pack_Id);
+
+ User_Pack_Id := User_Decl.Packages;
+ while User_Pack_Id /= No_Package loop
+ User_Pack := Shared.Packages.Table (User_Pack_Id);
+ exit when User_Pack.Name = Conf_Pack.Name;
+ User_Pack_Id := User_Pack.Next;
+ end loop;
+
+ if User_Pack_Id = No_Package then
+ Package_Table.Increment_Last (Shared.Packages);
+ User_Pack := Conf_Pack;
+ User_Pack.Next := User_Decl.Packages;
+ User_Decl.Packages := Package_Table.Last (Shared.Packages);
+ Shared.Packages.Table (User_Decl.Packages) := User_Pack;
+
+ else
+ Add_Attributes
+ (Project_Tree => Project_Tree,
+ Conf_Decl => Conf_Pack.Decl,
+ User_Decl => Shared.Packages.Table
+ (User_Pack_Id).Decl);
+ end if;
+
+ Conf_Pack_Id := Conf_Pack.Next;
+ end loop;
+
+ Proj.Project.Decl := User_Decl;
+
+ -- For aggregate projects, we need to apply the config to all
+ -- their aggregated trees as well.
+
+ if Proj.Project.Qualifier in Aggregate_Project then
+ declare
+ List : Aggregated_Project_List;
+ begin
+ List := Proj.Project.Aggregated_Projects;
+ while List /= null loop
+ Debug_Output
+ ("Recursively apply config to aggregated tree",
+ List.Project.Name);
+ Apply_Config_File
+ (Config_File, Project_Tree => List.Tree);
+ List := List.Next;
+ end loop;
+ end;
+ end if;
+ end if;
+
+ Proj := Proj.Next;
+ end loop;
+ end Apply_Config_File;
------------------
-- Check_Target --
------------------
function Check_Target
- (Config_File : Project_Id;
+ (Config_File : Project_Id;
Autoconf_Specified : Boolean;
- Project_Tree : Prj.Project_Tree_Ref;
- Target : String := "") return Boolean
+ Project_Tree : Prj.Project_Tree_Ref;
+ Target : String := "") return Boolean
is
- Variable : constant Variable_Value :=
- Value_Of (Name_Target, Config_File.Decl.Attributes, Project_Tree);
+ Shared : constant Shared_Project_Tree_Data_Access :=
+ Project_Tree.Shared;
+ Variable : constant Variable_Value :=
+ Value_Of
+ (Name_Target, Config_File.Decl.Attributes, Shared);
Tgt_Name : Name_Id := No_Name;
OK : Boolean;
+
begin
if Variable /= Nil_Variable_Value and then not Variable.Default then
Tgt_Name := Variable.Value;
end if;
if Target = "" then
- OK := not Autoconf_Specified or Tgt_Name = No_Name;
+ OK := not Autoconf_Specified or else Tgt_Name = No_Name;
else
OK := Tgt_Name /= No_Name
- and then Target = Get_Name_String (Tgt_Name);
+ and then Target = Get_Name_String (Tgt_Name);
end if;
if not OK then
else
if Tgt_Name /= No_Name then
- Osint.Fail ("invalid target name """ &
- Get_Name_String (Tgt_Name) &
- """ in configuration");
-
+ Raise_Invalid_Config
+ ("invalid target name """
+ & Get_Name_String (Tgt_Name) & """ in configuration");
else
- Osint.Fail ("no target specified in configuration file");
+ Raise_Invalid_Config
+ ("no target specified in configuration file");
end if;
end if;
end if;
(Project : Project_Id;
Project_Tree : Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
+ Env : in out Prj.Tree.Environment;
Allow_Automatic_Generation : Boolean;
Config_File_Name : String := "";
Autoconf_Specified : Boolean;
Packages_To_Check : String_List_Access := null;
Config : out Prj.Project_Id;
Config_File_Path : out String_Access;
- Automatically_Generated : out Boolean)
+ Automatically_Generated : out Boolean;
+ On_Load_Config : Config_File_Hook := null)
is
+ Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
+
+ At_Least_One_Compiler_Command : Boolean := False;
+ -- Set to True if at least one attribute Ide'Compiler_Command is
+ -- specified for one language of the system.
+
function Default_File_Name return String;
-- Return the name of the default config file that should be tested
procedure Do_Autoconf;
- -- Generate a new config file through gprconfig
+ -- Generate a new config file through gprconfig. In case of error, this
+ -- raises the Invalid_Config exception with an appropriate message
function Get_Config_Switches return Argument_List_Access;
-- Return the --config switches to use for gprconfig
function Default_File_Name return String is
Ada_RTS : constant String := Runtime_Name_For (Name_Ada);
- Tmp : String_Access;
+ Tmp : String_Access;
+
begin
if Target_Name /= "" then
if Ada_RTS /= "" then
declare
T : constant String := Tmp.all;
+
begin
Free (Tmp);
function Might_Have_Sources (Project : Project_Id) return Boolean is
Variable : Variable_Value;
+
begin
Variable :=
Value_Of
(Name_Source_Dirs,
Project.Decl.Attributes,
- Project_Tree);
+ Shared);
if Variable = Nil_Variable_Value
or else Variable.Default
Value_Of
(Name_Source_Files,
Project.Decl.Attributes,
- Project_Tree);
+ Shared);
return Variable = Nil_Variable_Value
or else Variable.Default
or else Variable.Values /= Nil_String;
+
else
return False;
end if;
-------------------------
function Get_Config_Switches return Argument_List_Access is
+
package Language_Htable is new GNAT.HTable.Simple_HTable
(Header_Num => Prj.Header_Num,
Element => Name_Id,
Equal => "=");
-- Hash table to keep the languages used in the project tree
- IDE : constant Package_Id :=
- Value_Of
- (Name_Ide,
- Project.Decl.Packages,
- Project_Tree);
-
- Prj_Iter : Project_List;
- List : String_List_Id;
- Elem : String_Element;
- Lang : Name_Id;
- Variable : Variable_Value;
- Name : Name_Id;
- Count : Natural;
- Result : Argument_List_Access;
+ IDE : constant Package_Id :=
+ Value_Of (Name_Ide, Project.Decl.Packages, Shared);
+
+ procedure Add_Config_Switches_For_Project
+ (Project : Project_Id;
+ Tree : Project_Tree_Ref;
+ In_Aggregate_Lib : Boolean;
+ With_State : in out Integer);
+ -- Add all --config switches for this project. This is also called
+ -- for aggregate projects.
+
+ -------------------------------------
+ -- Add_Config_Switches_For_Project --
+ -------------------------------------
+
+ procedure Add_Config_Switches_For_Project
+ (Project : Project_Id;
+ Tree : Project_Tree_Ref;
+ In_Aggregate_Lib : Boolean;
+ With_State : in out Integer)
+ is
+ pragma Unreferenced (With_State, In_Aggregate_Lib);
+
+ Shared : constant Shared_Project_Tree_Data_Access := Tree.Shared;
+
+ Variable : Variable_Value;
+ Check_Default : Boolean;
+ Lang : Name_Id;
+ List : String_List_Id;
+ Elem : String_Element;
- begin
- Prj_Iter := Project_Tree.Projects;
- while Prj_Iter /= null loop
- if Might_Have_Sources (Prj_Iter.Project) then
+ begin
+ if Might_Have_Sources (Project) then
Variable :=
- Value_Of
- (Name_Languages,
- Prj_Iter.Project.Decl.Attributes,
- Project_Tree);
+ Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
+
+ if Variable = Nil_Variable_Value or else Variable.Default then
- if Variable = Nil_Variable_Value
- or else Variable.Default
- then
-- Languages is not declared. If it is not an extending
- -- project, check for Default_Language
+ -- project, or if it extends a project with no Languages,
+ -- check for Default_Language.
+
+ Check_Default := Project.Extends = No_Project;
- if Prj_Iter.Project.Extends = No_Project then
+ if not Check_Default then
+ Variable :=
+ Value_Of
+ (Name_Languages,
+ Project.Extends.Decl.Attributes,
+ Shared);
+ Check_Default :=
+ Variable /= Nil_Variable_Value
+ and then Variable.Values = Nil_String;
+ end if;
+
+ if Check_Default then
Variable :=
Value_Of
(Name_Default_Language,
- Prj_Iter.Project.Decl.Attributes,
- Project_Tree);
+ Project.Decl.Attributes,
+ Shared);
- if Variable /= Nil_Variable_Value and then
- not Variable.Default
+ if Variable /= Nil_Variable_Value
+ and then not Variable.Default
then
Get_Name_String (Variable.Value);
To_Lower (Name_Buffer (1 .. Name_Len));
Lang := Name_Find;
Language_Htable.Set (Lang, Lang);
- else
- -- If no language is declared, default to Ada
+ -- If no default language is declared, default to Ada
+ else
Language_Htable.Set (Name_Ada, Name_Ada);
end if;
end if;
elsif Variable.Values /= Nil_String then
- -- Attribute Languages is declared with a non empty
- -- list: put all the languages in Language_HTable.
+ -- Attribute Languages is declared with a non empty list:
+ -- put all the languages in Language_HTable.
List := Variable.Values;
while List /= Nil_String loop
- Elem := Project_Tree.String_Elements.Table (List);
+ Elem := Shared.String_Elements.Table (List);
Get_Name_String (Elem.Value);
To_Lower (Name_Buffer (1 .. Name_Len));
end loop;
end if;
end if;
+ end Add_Config_Switches_For_Project;
- Prj_Iter := Prj_Iter.Next;
- end loop;
+ 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;
+ 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.
(Name,
Attribute_Or_Array_Name => Name_Compiler_Command,
In_Package => IDE,
- In_Tree => Project_Tree,
+ Shared => Shared,
Force_Lower_Case_Index => True);
declare
Config_Command : constant String :=
- "--config=" & Get_Name_String (Name);
+ "--config=" & Get_Name_String (Name);
Runtime_Name : constant String :=
- Runtime_Name_For (Name);
+ Runtime_Name_For (Name);
begin
if Variable = Nil_Variable_Value
new String'(Config_Command & ",," & Runtime_Name);
else
+ At_Least_One_Compiler_Command := True;
+
declare
Compiler_Command : constant String :=
- Get_Name_String (Variable.Value);
+ Get_Name_String (Variable.Value);
begin
if Is_Absolute_Path (Compiler_Command) then
procedure Do_Autoconf is
Obj_Dir : constant Variable_Value :=
- Value_Of (Name_Object_Dir, Project.Decl.Attributes, Project_Tree);
+ 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
- Fail ("could not locate gprconfig for auto-configuration");
+ 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.Name);
+ Get_Name_String (Project.Directory.Display_Name);
else
if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
else
Name_Len := 0;
Add_Str_To_Name_Buffer
- (Get_Name_String (Project.Directory.Name));
- Add_Char_To_Name_Buffer (Directory_Separator);
+ (Get_Name_String (Project.Directory.Display_Name));
Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
end if;
end if;
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);
- Switches : Argument_List_Access := Get_Config_Switches;
- Args : Argument_List (1 .. 5);
- Arg_Last : Positive;
+ 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
-- gprconfig.
if not Is_Directory (Obj_Dir)
- and then (Setup_Projects or Subdirs /= null)
+ and then (Setup_Projects or else Subdirs /= null)
then
begin
Create_Path (Obj_Dir);
exception
when others =>
- Fail ("could not create object directory " & Obj_Dir);
+ Raise_Invalid_Config
+ ("could not create object directory " & Obj_Dir);
end;
end if;
if not Is_Directory (Obj_Dir) then
- Fail ("object directory " & Obj_Dir & " does not exist");
+ 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");
-- If no config file was specified, set the auto.cgpr one
if Config_File_Name = "" then
- Args (3) := new String'
- (Obj_Dir & Directory_Separator & Auto_Cgpr);
+ if Obj_Dir_Exists then
+ Args (3) := new String'(Obj_Dir & Auto_Cgpr);
+
+ else
+ declare
+ Path_FD : File_Descriptor;
+ Path_Name : Path_Name_Type;
+
+ begin
+ Prj.Env.Create_Temp_File
+ (Shared => Project_Tree.Shared,
+ Path_FD => Path_FD,
+ Path_Name => Path_Name,
+ File_Use => "configuration file");
+
+ if Path_FD /= Invalid_FD then
+ declare
+ Temp_Dir : constant String :=
+ Containing_Directory
+ (Get_Name_String (Path_Name));
+ begin
+ GNAT.OS_Lib.Close (Path_FD);
+ Args (3) :=
+ new String'(Temp_Dir &
+ Directory_Separator &
+ Auto_Cgpr);
+ Delete_File (Get_Name_String (Path_Name));
+ end;
+
+ else
+ -- We'll have an error message later on
+
+ Args (3) := new String'(Obj_Dir & Auto_Cgpr);
+ end if;
+ end;
+ end if;
else
Args (3) := new String'(Config_File_Name);
end if;
- if Target_Name = "" then
- Args (4) := new String'("--target=" & Normalized_Hostname);
+ if Normalized_Hostname = "" then
+ Arg_Last := 3;
else
- Args (4) := new String'("--target=" & Target_Name);
- end if;
+ if Target_Name = "" then
+ if At_Least_One_Compiler_Command then
+ Args (4) := new String'("--target=all");
+
+ else
+ Args (4) :=
+ new String'("--target=" & Normalized_Hostname);
+ end if;
+
+ else
+ Args (4) := new String'("--target=" & Target_Name);
+ end if;
- Arg_Last := 4;
+ Arg_Last := 4;
+ end if;
if not Verbose_Mode then
Arg_Last := Arg_Last + 1;
Write_Str (Args (J).all);
end loop;
- for J in Switches'Range loop
+ for J in Config_Switches'Range loop
Write_Char (' ');
- Write_Str (Switches (J).all);
+ Write_Str (Config_Switches (J).all);
end loop;
Write_Eol;
elsif not Quiet_Output then
- Write_Str ("creating ");
- Write_Str (Simple_Name (Args (3).all));
- Write_Eol;
+ -- Display no message if we are creating auto.cgpr, unless in
+ -- verbose mode
+
+ if Config_File_Name /= ""
+ or else Verbose_Mode
+ then
+ Write_Str ("creating ");
+ Write_Str (Simple_Name (Args (3).all));
+ Write_Eol;
+ end if;
end if;
- Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) & Switches.all,
+ Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) &
+ Config_Switches.all,
Success);
- Free (Switches);
+ Free (Config_Switches);
Config_File_Path := Locate_Config_File (Args (3).all);
if Config_File_Path = null then
- Fail ("could not create " & Args (3).all);
+ Raise_Invalid_Config
+ ("could not create " & Args (3).all);
end if;
for F in Args'Range loop
Config_Project_Node : Project_Node_Id := Empty_Node;
begin
+ pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
+
Free (Config_File_Path);
+ Config := No_Project;
if Config_File_Name /= "" then
Config_File_Path := Locate_Config_File (Config_File_Name);
end if;
if Config_File_Path = null then
- if (not Allow_Automatic_Generation) and then
- Config_File_Name /= ""
+ if (not Allow_Automatic_Generation)
+ and then Config_File_Name /= ""
then
- Osint.Fail
- ("could not locate main configuration project " &
- Config_File_Name);
+ Raise_Invalid_Config
+ ("could not locate main configuration project "
+ & Config_File_Name);
end if;
end if;
<<Process_Config_File>>
if Automatically_Generated then
- Do_Autoconf;
+ if Hostparm.OpenVMS then
+
+ -- There is no gprconfig on VMS
+
+ Raise_Invalid_Config
+ ("could not locate any configuration project file");
+
+ else
+ -- This might raise an Invalid_Config exception
+
+ Do_Autoconf;
+ end if;
+
+ -- If the config file is not auto-generated, warn if there is any --RTS
+ -- switch on the command line.
+
+ elsif RTS_Languages.Get_First /= No_Name
+ and then Opt.Warning_Mode /= Opt.Suppress
+ then
+ Write_Line
+ ("warning: --RTS is taken into account only in auto-configuration");
end if;
-- Parse the configuration file
- if Verbose_Mode then
+ if Verbose_Mode and then Config_File_Path /= null then
Write_Str ("Checking configuration ");
Write_Line (Config_File_Path.all);
end if;
- Prj.Part.Parse
- (In_Tree => Project_Node_Tree,
- Project => Config_Project_Node,
- Project_File_Name => Config_File_Path.all,
- Always_Errout_Finalize => False,
- Packages_To_Check => Packages_To_Check,
- Current_Directory => Current_Directory,
- Is_Config_File => True);
+ if On_Load_Config /= null then
+ On_Load_Config
+ (Config_File => Config_Project_Node,
+ Project_Node_Tree => Project_Node_Tree);
+
+ elsif Config_File_Path /= null then
+ Prj.Part.Parse
+ (In_Tree => Project_Node_Tree,
+ Project => Config_Project_Node,
+ Project_File_Name => Config_File_Path.all,
+ Errout_Handling => Prj.Part.Finalize_If_Error,
+ Packages_To_Check => Packages_To_Check,
+ Current_Directory => Current_Directory,
+ Is_Config_File => True,
+ Env => Env);
+ else
+ Config_Project_Node := Empty_Node;
+ end if;
if Config_Project_Node /= Empty_Node then
Prj.Proc.Process_Project_Tree_Phase_1
(In_Tree => Project_Tree,
Project => Config,
+ Packages_To_Check => Packages_To_Check,
Success => Success,
From_Project_Node => Config_Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
- Report_Error => null,
+ Env => Env,
Reset_Tree => False);
end if;
if Config_Project_Node = Empty_Node
or else Config = No_Project
then
- Osint.Fail
- ("processing of configuration project """ &
- Config_File_Path.all & """ failed");
+ Raise_Invalid_Config
+ ("processing of configuration project """
+ & Config_File_Path.all & """ failed");
end if;
-- Check that the target of the configuration file is the one the user
-- auto-conf mode, since the appropriate target was passed to gprconfig.
if not Automatically_Generated
- and not Check_Target
- (Config, Autoconf_Specified, Project_Tree, Target_Name)
+ and then not
+ Check_Target (Config, Autoconf_Specified, Project_Tree, Target_Name)
then
Automatically_Generated := True;
goto Process_Config_File;
end if;
end Get_Or_Create_Configuration_File;
+ ------------------------
+ -- Locate_Config_File --
+ ------------------------
+
+ function Locate_Config_File (Name : String) return String_Access is
+ Prefix_Path : constant String := Executable_Prefix_Path;
+ begin
+ if Prefix_Path'Length /= 0 then
+ return Locate_Regular_File
+ (Name,
+ "." & Path_Separator &
+ Prefix_Path & "share" & Directory_Separator & "gpr");
+ else
+ return Locate_Regular_File (Name, ".");
+ end if;
+ end Locate_Config_File;
+
------------------------------------
-- Parse_Project_And_Apply_Config --
------------------------------------
Project_File_Name : String;
Project_Tree : Prj.Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
+ Env : in out Prj.Tree.Environment;
Packages_To_Check : String_List_Access;
Allow_Automatic_Generation : Boolean := True;
Automatically_Generated : out Boolean;
Normalized_Hostname : String;
On_Load_Config : Config_File_Hook := null)
is
- Main_Config_Project : Project_Id;
- Success : Boolean;
-
begin
+ pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
+
-- Parse the user project tree
Prj.Initialize (Project_Tree);
- Prj.Tree.Initialize (Project_Node_Tree);
- Main_Project := No_Project;
+ Main_Project := No_Project;
Automatically_Generated := False;
Prj.Part.Parse
- (In_Tree => Project_Node_Tree,
- Project => User_Project_Node,
- Project_File_Name => Project_File_Name,
- Always_Errout_Finalize => False,
- Packages_To_Check => Packages_To_Check,
- Current_Directory => Current_Directory,
- Is_Config_File => False);
+ (In_Tree => Project_Node_Tree,
+ Project => User_Project_Node,
+ Project_File_Name => Project_File_Name,
+ Errout_Handling => Prj.Part.Finalize_If_Error,
+ Packages_To_Check => Packages_To_Check,
+ Current_Directory => Current_Directory,
+ Is_Config_File => False,
+ Env => Env);
if User_Project_Node = Empty_Node then
User_Project_Node := Empty_Node;
return;
end if;
+ Process_Project_And_Apply_Config
+ (Main_Project => Main_Project,
+ User_Project_Node => User_Project_Node,
+ Config_File_Name => Config_File_Name,
+ Autoconf_Specified => Autoconf_Specified,
+ Project_Tree => Project_Tree,
+ Project_Node_Tree => Project_Node_Tree,
+ Env => Env,
+ Packages_To_Check => Packages_To_Check,
+ Allow_Automatic_Generation => Allow_Automatic_Generation,
+ Automatically_Generated => Automatically_Generated,
+ Config_File_Path => Config_File_Path,
+ Target_Name => Target_Name,
+ Normalized_Hostname => Normalized_Hostname,
+ On_Load_Config => On_Load_Config);
+ end Parse_Project_And_Apply_Config;
+
+ --------------------------------------
+ -- Process_Project_And_Apply_Config --
+ --------------------------------------
+
+ procedure Process_Project_And_Apply_Config
+ (Main_Project : out Prj.Project_Id;
+ User_Project_Node : Prj.Tree.Project_Node_Id;
+ Config_File_Name : String := "";
+ Autoconf_Specified : Boolean;
+ Project_Tree : Prj.Project_Tree_Ref;
+ Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
+ Env : in out Prj.Tree.Environment;
+ Packages_To_Check : String_List_Access;
+ Allow_Automatic_Generation : Boolean := True;
+ Automatically_Generated : out Boolean;
+ Config_File_Path : out String_Access;
+ Target_Name : String := "";
+ Normalized_Hostname : String;
+ On_Load_Config : Config_File_Hook := null;
+ Reset_Tree : Boolean := True)
+ is
+ Shared : constant Shared_Project_Tree_Data_Access :=
+ Project_Tree.Shared;
+ Main_Config_Project : Project_Id;
+ Success : Boolean;
+
+ begin
+ Main_Project := No_Project;
+ Automatically_Generated := False;
+
Process_Project_Tree_Phase_1
(In_Tree => Project_Tree,
Project => Main_Project,
+ Packages_To_Check => Packages_To_Check,
Success => Success,
From_Project_Node => User_Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
- Report_Error => null);
+ Env => Env,
+ Reset_Tree => Reset_Tree);
if not Success then
Main_Project := No_Project;
return;
end if;
+ if Project_Tree.Source_Info_File_Name /= null then
+ if not Is_Absolute_Path (Project_Tree.Source_Info_File_Name.all) then
+ declare
+ Obj_Dir : constant Variable_Value :=
+ Value_Of
+ (Name_Object_Dir,
+ Main_Project.Decl.Attributes,
+ Shared);
+
+ begin
+ if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
+ Get_Name_String (Main_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 (Main_Project.Directory.Display_Name));
+ Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
+ end if;
+ end if;
+
+ Add_Char_To_Name_Buffer (Directory_Separator);
+ Add_Str_To_Name_Buffer (Project_Tree.Source_Info_File_Name.all);
+ Free (Project_Tree.Source_Info_File_Name);
+ Project_Tree.Source_Info_File_Name :=
+ new String'(Name_Buffer (1 .. Name_Len));
+ end;
+ end if;
+
+ Read_Source_Info_File (Project_Tree);
+ end if;
+
-- Find configuration file
Get_Or_Create_Configuration_File
Project => Main_Project,
Project_Tree => Project_Tree,
Project_Node_Tree => Project_Node_Tree,
+ Env => Env,
Allow_Automatic_Generation => Allow_Automatic_Generation,
Config_File_Name => Config_File_Name,
Autoconf_Specified => Autoconf_Specified,
Normalized_Hostname => Normalized_Hostname,
Packages_To_Check => Packages_To_Check,
Config_File_Path => Config_File_Path,
- Automatically_Generated => Automatically_Generated);
-
- if On_Load_Config /= null then
- On_Load_Config
- (Config_File => Main_Config_Project,
- Project_Tree => Project_Tree);
- end if;
+ Automatically_Generated => Automatically_Generated,
+ On_Load_Config => On_Load_Config);
Apply_Config_File (Main_Config_Project, Project_Tree);
-- Finish processing the user's project
- Sinput.P.Reset_First;
-
Prj.Proc.Process_Project_Tree_Phase_2
(In_Tree => Project_Tree,
Project => Main_Project,
Success => Success,
From_Project_Node => User_Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
- Report_Error => null,
- Current_Dir => Current_Directory,
- When_No_Sources => Warning,
- Is_Config_File => False);
-
- if not Success then
- Prj.Err.Finalize;
- Osint.Fail ("""" & Project_File_Name & """ processing failed");
- end if;
- end Parse_Project_And_Apply_Config;
+ Env => Env);
- -----------------------
- -- Apply_Config_File --
- -----------------------
+ if Success then
+ if Project_Tree.Source_Info_File_Name /= null
+ and then not Project_Tree.Source_Info_File_Exists
+ then
+ Write_Source_Info_File (Project_Tree);
+ end if;
- procedure Apply_Config_File
- (Config_File : Prj.Project_Id;
- Project_Tree : Prj.Project_Tree_Ref)
- is
- Conf_Decl : constant Declarations := Config_File.Decl;
- Conf_Pack_Id : Package_Id;
- Conf_Pack : Package_Element;
+ else
+ Main_Project := No_Project;
+ end if;
+ end Process_Project_And_Apply_Config;
- User_Decl : Declarations;
- User_Pack_Id : Package_Id;
- User_Pack : Package_Element;
- Proj : Project_List;
+ --------------------------
+ -- Raise_Invalid_Config --
+ --------------------------
+ procedure Raise_Invalid_Config (Msg : String) is
begin
- Proj := Project_Tree.Projects;
-
- while Proj /= null loop
- if Proj.Project /= Config_File then
- User_Decl := Proj.Project.Decl;
- Add_Attributes
- (Project_Tree => Project_Tree,
- Conf_Decl => Conf_Decl,
- User_Decl => User_Decl);
-
- Conf_Pack_Id := Conf_Decl.Packages;
- while Conf_Pack_Id /= No_Package loop
- Conf_Pack := Project_Tree.Packages.Table (Conf_Pack_Id);
-
- User_Pack_Id := User_Decl.Packages;
- while User_Pack_Id /= No_Package loop
- User_Pack := Project_Tree.Packages.Table (User_Pack_Id);
- exit when User_Pack.Name = Conf_Pack.Name;
- User_Pack_Id := User_Pack.Next;
- end loop;
-
- if User_Pack_Id = No_Package then
- Package_Table.Increment_Last (Project_Tree.Packages);
- User_Pack := Conf_Pack;
- User_Pack.Next := User_Decl.Packages;
- User_Decl.Packages :=
- Package_Table.Last (Project_Tree.Packages);
- Project_Tree.Packages.Table (User_Decl.Packages) :=
- User_Pack;
+ Raise_Exception (Invalid_Config'Identity, Msg);
+ end Raise_Invalid_Config;
- else
- Add_Attributes
- (Project_Tree => Project_Tree,
- Conf_Decl => Conf_Pack.Decl,
- User_Decl => Project_Tree.Packages.Table
- (User_Pack_Id).Decl);
- end if;
+ ----------------------
+ -- Runtime_Name_For --
+ ----------------------
- Conf_Pack_Id := Conf_Pack.Next;
- end loop;
+ function Runtime_Name_For (Language : Name_Id) return String is
+ begin
+ if RTS_Languages.Get (Language) /= No_Name then
+ return Get_Name_String (RTS_Languages.Get (Language));
+ else
+ return "";
+ end if;
+ end Runtime_Name_For;
- Proj.Project.Decl := User_Decl;
- end if;
+ --------------------------
+ -- Runtime_Name_Set_For --
+ --------------------------
- Proj := Proj.Next;
- end loop;
- end Apply_Config_File;
+ function Runtime_Name_Set_For (Language : Name_Id) return Boolean is
+ begin
+ return RTS_Languages.Get (Language) /= No_Name;
+ end Runtime_Name_Set_For;
---------------------
-- Set_Runtime_For --
RTS_Languages.Set (Language, Name_Find);
end Set_Runtime_For;
- ----------------------
- -- Runtime_Name_For --
- ----------------------
-
- function Runtime_Name_For (Language : Name_Id) return String is
- begin
- if RTS_Languages.Get (Language) /= No_Name then
- return Get_Name_String (RTS_Languages.Get (Language));
- else
- return "";
- end if;
- end Runtime_Name_For;
-
end Prj.Conf;
OSDN Git Service
