aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEmmanuel Briot <briot@adacore.com>2009-06-23 09:30:59 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2009-06-23 11:30:59 +0200
commitabe19d88066a6afdaf8c6917a631d21e30e4091c (patch)
treee3a126bf326b9b39704593163279da9adcebd89e
parentaf268547dec49c0356f622369582fe2e2d112586 (diff)
downloadgcc-abe19d88066a6afdaf8c6917a631d21e30e4091c.zip
gcc-abe19d88066a6afdaf8c6917a631d21e30e4091c.tar.gz
gcc-abe19d88066a6afdaf8c6917a631d21e30e4091c.tar.bz2
prj-conf.ads, [...]: New files part of the project manager.
2009-06-23 Emmanuel Briot <briot@adacore.com> * prj-conf.ads, prj-conf.adb: New files part of the project manager. From-SVN: r148835
-rw-r--r--gcc/ada/ChangeLog4
-rw-r--r--gcc/ada/prj-conf.adb1060
-rw-r--r--gcc/ada/prj-conf.ads140
3 files changed, 1204 insertions, 0 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 69ea312..baef841 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,7 @@
+2009-06-23 Emmanuel Briot <briot@adacore.com>
+
+ * prj-conf.ads, prj-conf.adb: New files part of the project manager.
+
2009-06-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Derive_Subprogram): If the inherited subprogram is a
diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb
new file mode 100644
index 0000000..8ae9f79
--- /dev/null
+++ b/gcc/ada/prj-conf.adb
@@ -0,0 +1,1060 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- P R J . C O N F --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2006-2009, 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- --
+-- 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. --
+-- --
+-- 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 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;
+
+package body Prj.Conf is
+
+ Auto_Cgpr : constant String := "auto.cgpr";
+
+ Default_Name : constant String := "default.cgpr";
+ -- Default configuration file that will be used if found
+
+ Config_Project_Env_Var : constant String := "GPR_CONFIG";
+ -- Name of the environment variable that provides the name of the
+ -- configuration file to use.
+
+ Gprconfig_Name : constant String := "gprconfig";
+
+ package RTS_Languages is new GNAT.HTable.Simple_HTable
+ (Header_Num => Prj.Header_Num,
+ Element => Name_Id,
+ No_Element => No_Name,
+ Key => Name_Id,
+ Hash => Prj.Hash,
+ Equal => "=");
+ -- Stores the runtime names for the various languages. This is in general
+ -- set from a --RTS command line option.
+
+ procedure Add_Attributes
+ (Project_Tree : Project_Tree_Ref;
+ Conf_Decl : Declarations;
+ User_Decl : in out Declarations);
+ -- Process the attributes in the config declarations.
+ -- For single string values, if the attribute is not declared in the user
+ -- declarations, declare it with the value in the config 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;
+ Autoconf_Specified : 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
+
+ --------------------
+ -- Add_Attributes --
+ --------------------
+
+ procedure Add_Attributes
+ (Project_Tree : Project_Tree_Ref;
+ Conf_Decl : Declarations;
+ User_Decl : in out Declarations)
+ is
+ Conf_Attr_Id : Variable_Id;
+ Conf_Attr : Variable;
+ Conf_Array_Id : Array_Id;
+ Conf_Array : Array_Data;
+ Conf_Array_Elem_Id : Array_Element_Id;
+ Conf_Array_Elem : Array_Element;
+ Conf_List : String_List_Id;
+ Conf_List_Elem : String_Element;
+
+ User_Attr_Id : Variable_Id;
+ User_Attr : Variable;
+ User_Array_Id : Array_Id;
+ User_Array : Array_Data;
+ User_Array_Elem_Id : Array_Element_Id;
+ User_Array_Elem : Array_Element;
+
+ 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);
+
+ if not Conf_Attr.Value.Default then
+ if User_Attr.Value.Default then
+
+ -- No attribute declared in user project file: just copy the
+ -- value of the configuration attribute.
+
+ User_Attr.Value := Conf_Attr.Value;
+ Project_Tree.Variable_Elements.Table (User_Attr_Id) :=
+ User_Attr;
+
+ 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;
+
+ begin
+
+ -- Create new list
+
+ String_Element_Table.Increment_Last
+ (Project_Tree.String_Elements);
+ New_List := String_Element_Table.Last
+ (Project_Tree.String_Elements);
+
+ -- Value of attribute is new list
+
+ User_Attr.Value.Values := New_List;
+ Project_Tree.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_List := Conf_Elem.Next;
+
+ if Conf_List = Nil_String then
+
+ -- If it is the last element in the list, connect to
+ -- first element of user list, and we are done.
+
+ New_Elem.Next := User_List;
+ Project_Tree.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);
+ New_Elem.Next :=
+ String_Element_Table.Last
+ (Project_Tree.String_Elements);
+ Project_Tree.String_Elements.Table
+ (New_List) := New_Elem;
+ New_List := New_Elem.Next;
+ end if;
+ end loop;
+ end;
+ end if;
+ end if;
+
+ Conf_Attr_Id := Conf_Attr.Next;
+ User_Attr_Id := User_Attr.Next;
+ end loop;
+
+ Conf_Array_Id := Conf_Decl.Arrays;
+ while Conf_Array_Id /= No_Array loop
+ Conf_Array := Project_Tree.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);
+ exit when User_Array.Name = Conf_Array.Name;
+ User_Array_Id := User_Array.Next;
+ end loop;
+
+ -- If this associative array does not exist in the user project file,
+ -- do a shallow copy of the full associative array.
+
+ if User_Array_Id = No_Array then
+ Array_Table.Increment_Last (Project_Tree.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;
+
+ else
+ -- Otherwise, check each array element
+
+ 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);
+
+ 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);
+ 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 User_Array_Elem_Id = No_Array_Element then
+ Array_Element_Table.Increment_Last
+ (Project_Tree.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) :=
+ User_Array_Elem;
+ Project_Tree.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.
+
+ 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;
+ Previous : String_List_Id := Nil_String;
+ Next : String_List_Id;
+ begin
+ loop
+ Conf_List_Elem :=
+ Project_Tree.String_Elements.Table
+ (Conf_List);
+ String_Element_Table.Increment_Last
+ (Project_Tree.String_Elements);
+ Next :=
+ String_Element_Table.Last
+ (Project_Tree.String_Elements);
+ Project_Tree.String_Elements.Table (Next) :=
+ Conf_List_Elem;
+
+ if Previous = Nil_String then
+ User_Array_Elem.Value.Values := Next;
+ Project_Tree.Array_Elements.Table
+ (User_Array_Elem_Id) := User_Array_Elem;
+
+ else
+ Project_Tree.String_Elements.Table
+ (Previous).Next := Next;
+ end if;
+
+ Previous := Next;
+
+ Conf_List := Conf_List_Elem.Next;
+
+ if Conf_List = Nil_String then
+ Project_Tree.String_Elements.Table
+ (Previous).Next := Link;
+ exit;
+ end if;
+ end loop;
+ end;
+ end if;
+ end if;
+
+ Conf_Array_Elem_Id := Conf_Array_Elem.Next;
+ end loop;
+ end if;
+
+ Conf_Array_Id := Conf_Array.Next;
+ end loop;
+ end Add_Attributes;
+
+ ------------------------
+ -- 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;
+
+ ------------------
+ -- Check_Target --
+ ------------------
+
+ function Check_Target
+ (Config_File : Project_Id;
+ Autoconf_Specified : 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);
+ 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;
+ else
+ OK := Tgt_Name /= No_Name
+ and then Target = Get_Name_String (Tgt_Name);
+ end if;
+
+ if not OK then
+ if Autoconf_Specified then
+ if Verbose_Mode then
+ Write_Line ("inconsistent targets, performing autoconf");
+ end if;
+
+ return False;
+
+ else
+ if Tgt_Name /= No_Name then
+ Osint.Fail ("invalid target name """ &
+ Get_Name_String (Tgt_Name) &
+ """ in configuration");
+
+ else
+ Osint.Fail ("no target specified in configuration file");
+ end if;
+ end if;
+ end if;
+
+ return True;
+ end Check_Target;
+
+ --------------------------------------
+ -- Get_Or_Create_Configuration_File --
+ --------------------------------------
+
+ procedure Get_Or_Create_Configuration_File
+ (Project : Project_Id;
+ Project_Tree : Project_Tree_Ref;
+ Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
+ Allow_Automatic_Generation : Boolean;
+ Config_File_Name : String := "";
+ Autoconf_Specified : Boolean;
+ Target_Name : String := "";
+ Normalized_Hostname : String;
+ Packages_To_Check : String_List_Access := null;
+ Config : out Prj.Project_Id;
+ Config_File_Path : out String_Access;
+ Automatically_Generated : out Boolean)
+ is
+ 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
+
+ function Get_Config_Switches return Argument_List_Access;
+ -- Return the --config switches to use for gprconfig
+
+ function Might_Have_Sources (Project : Project_Id) return Boolean;
+ -- True if the specified project might have sources (ie the user has not
+ -- explicitly specified it. We haven't checked the file system, nor do
+ -- we need to at this stage.
+
+ -----------------------
+ -- Default_File_Name --
+ -----------------------
+
+ function Default_File_Name return String is
+ Ada_RTS : constant String := Runtime_Name_For (Name_Ada);
+ Tmp : String_Access;
+ begin
+ if Target_Name /= "" then
+ if Ada_RTS /= "" then
+ return Target_Name & '-' & Ada_RTS
+ & Config_Project_File_Extension;
+ else
+ return Target_Name & Config_Project_File_Extension;
+ end if;
+
+ elsif Ada_RTS /= "" then
+ return Ada_RTS & Config_Project_File_Extension;
+
+ else
+ Tmp := Getenv (Config_Project_Env_Var);
+
+ declare
+ T : constant String := Tmp.all;
+ begin
+ Free (Tmp);
+
+ if T'Length = 0 then
+ return Default_Name;
+ else
+ return T;
+ end if;
+ end;
+ end if;
+ end Default_File_Name;
+
+ ------------------------
+ -- Might_Have_Sources --
+ ------------------------
+
+ 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);
+
+ if Variable = Nil_Variable_Value
+ or else Variable.Default
+ or else Variable.Values /= Nil_String
+ then
+ Variable :=
+ Value_Of
+ (Name_Source_Files,
+ Project.Decl.Attributes,
+ Project_Tree);
+ return Variable = Nil_Variable_Value
+ or else Variable.Default
+ or else Variable.Values /= Nil_String;
+ else
+ return False;
+ end if;
+ end Might_Have_Sources;
+
+ -------------------------
+ -- Get_Config_Switches --
+ -------------------------
+
+ 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,
+ No_Element => No_Name,
+ Key => Name_Id,
+ Hash => Prj.Hash,
+ 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;
+
+ begin
+ Prj_Iter := Project_Tree.Projects;
+ while Prj_Iter /= null loop
+ if Might_Have_Sources (Prj_Iter.Project) then
+ Variable :=
+ Value_Of
+ (Name_Languages,
+ Prj_Iter.Project.Decl.Attributes,
+ Project_Tree);
+
+ 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
+
+ if Prj_Iter.Project.Extends = No_Project then
+ Variable :=
+ Value_Of
+ (Name_Default_Language,
+ Prj_Iter.Project.Decl.Attributes,
+ Project_Tree);
+
+ 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
+
+ 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.
+
+ List := Variable.Values;
+ while List /= Nil_String loop
+ Elem := Project_Tree.String_Elements.Table (List);
+
+ Get_Name_String (Elem.Value);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Lang := Name_Find;
+ Language_Htable.Set (Lang, Lang);
+
+ List := Elem.Next;
+ end loop;
+ end if;
+ end if;
+
+ Prj_Iter := Prj_Iter.Next;
+ end loop;
+
+ 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,
+ In_Tree => Project_Tree,
+ 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
+ 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, Project_Tree);
+
+ 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");
+ 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);
+
+ 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.Name));
+ Add_Char_To_Name_Buffer (Directory_Separator);
+ 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;
+
+ 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;
+
+ 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 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 =>
+ Fail ("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");
+ end if;
+
+ -- Invoke gprconfig
+
+ Args (1) := new String'("--batch");
+ Args (2) := new String'("-o");
+
+ -- 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);
+ else
+ Args (3) := new String'(Config_File_Name);
+ end if;
+
+ if Target_Name = "" then
+ Args (4) := new String'("--target=" & Normalized_Hostname);
+ else
+ Args (4) := new String'("--target=" & Target_Name);
+ end if;
+
+ Arg_Last := 4;
+
+ if not Verbose_Mode then
+ Arg_Last := Arg_Last + 1;
+ Args (Arg_Last) := new String'("-q");
+ end if;
+
+ if Verbose_Mode then
+ Write_Str (Gprconfig_Name);
+
+ for J in 1 .. Arg_Last loop
+ Write_Char (' ');
+ Write_Str (Args (J).all);
+ end loop;
+
+ for J in Switches'Range loop
+ Write_Char (' ');
+ Write_Str (Switches (J).all);
+ end loop;
+
+ Write_Eol;
+
+ elsif not Quiet_Output then
+ Write_Str ("creating ");
+ Write_Str (Simple_Name (Args (3).all));
+ Write_Eol;
+ end if;
+
+ Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) & Switches.all,
+ Success);
+
+ Free (Switches);
+
+ Config_File_Path := Locate_Config_File (Args (3).all);
+
+ if Config_File_Path = null then
+ Fail ("could not create " & Args (3).all);
+ end if;
+
+ for F in Args'Range loop
+ Free (Args (F));
+ end loop;
+ end;
+ end Do_Autoconf;
+
+ Success : Boolean;
+ Config_Project_Node : Project_Node_Id := Empty_Node;
+
+ begin
+ Free (Config_File_Path);
+
+ if Config_File_Name /= "" then
+ Config_File_Path := Locate_Config_File (Config_File_Name);
+ else
+ Config_File_Path := Locate_Config_File (Default_File_Name);
+ end if;
+
+ if Config_File_Path = null then
+ if (not Allow_Automatic_Generation) and then
+ Config_File_Name /= ""
+ then
+ Osint.Fail
+ ("could not locate main configuration project " &
+ Config_File_Name);
+ end if;
+ end if;
+
+ Automatically_Generated :=
+ Allow_Automatic_Generation and then Config_File_Path = null;
+
+ <<Process_Config_File>>
+
+ if Automatically_Generated then
+ Do_Autoconf;
+ end if;
+
+ -- Parse the configuration file
+
+ if Verbose_Mode 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 Config_Project_Node /= Empty_Node then
+ Prj.Proc.Process_Project_Tree_Phase_1
+ (In_Tree => Project_Tree,
+ Project => Config,
+ Success => Success,
+ From_Project_Node => Config_Project_Node,
+ From_Project_Node_Tree => Project_Node_Tree,
+ Report_Error => null,
+ 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");
+ end if;
+
+ -- Check that the target of the configuration file is the one the user
+ -- specified on the command line. We do not need to check that when in
+ -- 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)
+ then
+ Automatically_Generated := True;
+ goto Process_Config_File;
+ end if;
+ end Get_Or_Create_Configuration_File;
+
+ ------------------------------------
+ -- Parse_Project_And_Apply_Config --
+ ------------------------------------
+
+ procedure Parse_Project_And_Apply_Config
+ (Main_Project : out Prj.Project_Id;
+ User_Project_Node : out Prj.Tree.Project_Node_Id;
+ Config_File_Name : String := "";
+ Autoconf_Specified : Boolean;
+ Project_File_Name : String;
+ Project_Tree : Prj.Project_Tree_Ref;
+ Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
+ 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)
+ is
+ Main_Config_Project : Project_Id;
+ Success : Boolean;
+
+ begin
+ -- Parse the user project tree
+
+ Prj.Initialize (Project_Tree);
+ Prj.Tree.Initialize (Project_Node_Tree);
+
+ 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);
+
+ if User_Project_Node = Empty_Node then
+ User_Project_Node := Empty_Node;
+ return;
+ end if;
+
+ Process_Project_Tree_Phase_1
+ (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);
+
+ if not Success then
+ Main_Project := No_Project;
+ return;
+ end if;
+
+ -- Find configuration file
+
+ Get_Or_Create_Configuration_File
+ (Config => Main_Config_Project,
+ Project => Main_Project,
+ Project_Tree => Project_Tree,
+ Project_Node_Tree => Project_Node_Tree,
+ Allow_Automatic_Generation => Allow_Automatic_Generation,
+ Config_File_Name => Config_File_Name,
+ Autoconf_Specified => Autoconf_Specified,
+ Target_Name => Target_Name,
+ 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;
+
+ 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;
+
+ -----------------------
+ -- Apply_Config_File --
+ -----------------------
+
+ 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;
+
+ User_Decl : Declarations;
+ User_Pack_Id : Package_Id;
+ User_Pack : Package_Element;
+ Proj : Project_List;
+
+ 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;
+
+ else
+ Add_Attributes
+ (Project_Tree => Project_Tree,
+ Conf_Decl => Conf_Pack.Decl,
+ User_Decl => Project_Tree.Packages.Table
+ (User_Pack_Id).Decl);
+ end if;
+
+ Conf_Pack_Id := Conf_Pack.Next;
+ end loop;
+
+ Proj.Project.Decl := User_Decl;
+ end if;
+
+ Proj := Proj.Next;
+ end loop;
+ end Apply_Config_File;
+
+ ---------------------
+ -- Set_Runtime_For --
+ ---------------------
+
+ procedure Set_Runtime_For (Language : Name_Id; RTS_Name : String) is
+ begin
+ Name_Len := RTS_Name'Length;
+ Name_Buffer (1 .. Name_Len) := RTS_Name;
+ 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;
diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads
new file mode 100644
index 0000000..773e3ba
--- /dev/null
+++ b/gcc/ada/prj-conf.ads
@@ -0,0 +1,140 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- P R J . C O N F --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2006-2009, 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- --
+-- 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. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- The following package manipulates the configuration files.
+
+with Prj.Tree;
+
+package Prj.Conf is
+
+ type Config_File_Hook is access procedure
+ (Config_File : Prj.Project_Id;
+ Project_Tree : Prj.Project_Tree_Ref);
+ -- Hook called after the config file has been parsed. This lets the
+ -- application do last minute changes to it (GPS uses this to add the
+ -- default naming schemes for instance). At that point, the config file has
+ -- not been applied to the project yet.
+
+ procedure Parse_Project_And_Apply_Config
+ (Main_Project : out Prj.Project_Id;
+ User_Project_Node : out Prj.Tree.Project_Node_Id;
+ Config_File_Name : String := "";
+ Autoconf_Specified : Boolean;
+ Project_File_Name : String;
+ Project_Tree : Prj.Project_Tree_Ref;
+ Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
+ 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);
+ -- Find the main configuration project and parse the project tree rooted at
+ -- this configuration project.
+ -- If the processing fails, Main_Project is set to No_Project. If the error
+ -- happend while parsing the project itself (ie creating the tree),
+ -- User_Project_Node is also set to Empty_Node
+ --
+ -- Autoconf_Specified indicates whether the user has specified --autoconf.
+ -- If this is the case, the config file might be (re)generated, as
+ -- appropriate, to match languages and target if the one specified doesn't
+ -- already match.
+ -- Normalized_Hostname is the host on which gprbuild is returned,
+ -- normalized so that we can more easily compare it with what is stored in
+ -- configuration files. It is used when the target is unspecified, although
+ -- we need to know the target specified by the user (Target_Name) when
+ -- computing the name of the default config file that should be used.
+ --
+ -- If specified, On_Load_Config is called just after the config file has
+ -- been created/loaded. You can then modify it before it is later applied
+ -- to the project itself.
+
+ procedure Get_Or_Create_Configuration_File
+ (Project : Prj.Project_Id;
+ Project_Tree : Prj.Project_Tree_Ref;
+ Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
+ Allow_Automatic_Generation : Boolean;
+ Config_File_Name : String := "";
+ Autoconf_Specified : Boolean;
+ Target_Name : String := "";
+ Normalized_Hostname : String;
+ Packages_To_Check : String_List_Access := null;
+ Config : out Prj.Project_Id;
+ Config_File_Path : out String_Access;
+ Automatically_Generated : out Boolean);
+ -- Compute the name of the configuration file that should be used. If no
+ -- default configuration file is found, a new one will be automatically
+ -- generated if Allow_Automatic_Generation is true (otherwise an error
+ -- reported to the user via Osint.Fail).
+ -- On exit, Configuration_Project_Path is never null (if none could be
+ -- found, Os.Fail was called and the program exited anyway).
+ -- The choice and generation of a configuration file depends on several
+ -- attributes of the user's project file (given by the Project argument),
+ -- like the list of languages that must be supported. Project must
+ -- therefore have been partially processed (phase one of the processing
+ -- only).
+ -- Config_File_Name should be set to the name of the config file specified
+ -- by the user (either through gprbuild's --config or --autoconf switches).
+ -- In the latter case, Autoconf_Specified should be set to true, to
+ -- indicate that the configuration file can be regenerated to match target
+ -- and languages. This name can either be an absolute path, or the a base
+ -- name that will be searched in the default config file directories (which
+ -- depends on the installation path for the tools).
+ -- Target_Name is used to chose among several possibilities
+ -- the configuration file that will be used.
+ --
+ -- If a project file could be found, it is automatically parsed and
+ -- processed (and Packages_To_Check is used to indicate which packages
+ -- should be processed)
+
+ 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.
+
+ --------------
+ -- Runtimes --
+ --------------
+
+ procedure Set_Runtime_For (Language : Name_Id; RTS_Name : String);
+ -- Specifies the runtime to use for a specific language. Most of the time
+ -- this should be used for Ada, but other languages can also specify their
+ -- own runtime. This is in general specified via the --RTS command line
+ -- switch, and results in a specific component passed to gprconfig's
+ -- --config switch then automatically generating a configuration file.
+
+ function Runtime_Name_For (Language : Name_Id) return String;
+ -- Returns the runtime name for a language. Returns an empty string if
+ -- no runtime was specified for the language using option --RTS.
+
+end Prj.Conf;