From: Emmanuel Briot Date: Wed, 3 Aug 2011 08:28:47 +0000 (+0000) Subject: gnatcmd.adb, [...] (Prj.Env.Initialize_Default_Project_Path, [...]): new subprograms X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a96ca6001f1e6236b550e26c7459bfaa9deb57b0;p=gcc.git gnatcmd.adb, [...] (Prj.Env.Initialize_Default_Project_Path, [...]): new subprograms 2011-08-03 Emmanuel Briot * gnatcmd.adb, make.adb, prj-part.adb, prj-part.ads, prj-makr.adb, clean.adb, prj-nmsc.adb, prj-pars.adb, prj-conf.adb, prj-env.adb, prj-env.ads (Prj.Env.Initialize_Default_Project_Path, Prj.Env.Initialize_Empty): new subprograms (Get_Env, Find_Project): remove parameter Target_Name. From-SVN: r177241 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a572f6cde9e..ebd1b037ab9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2011-08-03 Emmanuel Briot + + * gnatcmd.adb, make.adb, prj-part.adb, prj-part.ads, prj-makr.adb, + clean.adb, prj-nmsc.adb, prj-pars.adb, prj-conf.adb, prj-env.adb, + prj-env.ads (Prj.Env.Initialize_Default_Project_Path, + Prj.Env.Initialize_Empty): new subprograms + (Get_Env, Find_Project): remove parameter Target_Name. + 2011-08-03 Gary Dismukes * sem_ch3.adb (Build_Derived_Record_Type): Test the Derive_Subps formal diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 8174e91e5ed..cb56697a582 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2003-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- -- @@ -1400,6 +1400,9 @@ package body Clean is -- Parse the project file. If there is an error, Main_Project -- will still be No_Project. + Prj.Env.Initialize_Default_Project_Path + (Project_Node_Tree.Project_Path, Target_Name => ""); + Prj.Pars.Parse (Project => Main_Project, In_Tree => Project_Tree, diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 8f22273725c..329f1b069e9 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-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- -- @@ -1365,6 +1365,9 @@ begin Snames.Initialize; Project_Node_Tree := new Project_Node_Tree_Data; + Prj.Env.Initialize_Default_Project_Path + (Project_Node_Tree.Project_Path, Target_Name => ""); + Prj.Tree.Initialize (Project_Node_Tree); Prj.Initialize (Project_Tree); diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 642281d2fd2..2de96c85b65 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-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- -- @@ -6636,6 +6636,9 @@ package body Make is -- the command line switches Project_Node_Tree := new Project_Node_Tree_Data; + Prj.Env.Initialize_Default_Project_Path + (Project_Node_Tree.Project_Path, Target_Name => ""); + Prj.Tree.Initialize (Project_Node_Tree); -- Override default initialization of Check_Object_Consistency since diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 57b9fcafcca..da1d9287fa4 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2006-2010, 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- -- @@ -1061,6 +1061,8 @@ package body Prj.Conf is Config_Project_Node : Project_Node_Id := Empty_Node; begin + pragma Assert (Prj.Env.Is_Initialized (Project_Node_Tree.Project_Path)); + Free (Config_File_Path); Config := No_Project; @@ -1121,8 +1123,7 @@ package body Prj.Conf is Packages_To_Check => Packages_To_Check, Current_Directory => Current_Directory, Is_Config_File => True, - Flags => Flags, - Target_Name => Target_Name); + Flags => Flags); else Config_Project_Node := Empty_Node; end if; @@ -1198,6 +1199,8 @@ package body Prj.Conf is On_Load_Config : Config_File_Hook := null) is begin + pragma Assert (Prj.Env.Is_Initialized (Project_Node_Tree.Project_Path)); + -- Parse the user project tree Prj.Initialize (Project_Tree); @@ -1213,8 +1216,7 @@ package body Prj.Conf is Packages_To_Check => Packages_To_Check, Current_Directory => Current_Directory, Is_Config_File => False, - Flags => Flags, - Target_Name => Target_Name); + Flags => Flags); if User_Project_Node = Empty_Node then User_Project_Node := Empty_Node; diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 4598a6958bf..52f6236e049 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -110,12 +110,6 @@ package body Prj.Env is -- Return a project that is either Project or an extended ancestor of -- Project that itself is not extended. - procedure Initialize_Project_Path - (Self : in out Project_Search_Path; - Target_Name : String); - -- Initialize Current_Project_Path. Does nothing if the path has already - -- been initialized properly. - ---------------------- -- Ada_Include_Path -- ---------------------- @@ -1782,13 +1776,33 @@ package body Prj.Env is end if; end Add_Directories; - ----------------------------- - -- Initialize_Project_Path -- - ----------------------------- + -------------------- + -- Is_Initialized -- + -------------------- + + function Is_Initialized (Self : Project_Search_Path) return Boolean is + begin + return Self.Path /= null + and then (Self.Path'Length = 0 + or else Self.Path (Self.Path'First) /= '#'); + end Is_Initialized; + + ---------------------- + -- Initialize_Empty -- + ---------------------- - procedure Initialize_Project_Path - (Self : in out Project_Search_Path; - Target_Name : String) + procedure Initialize_Empty (Self : in out Project_Search_Path) is + begin + Free (Self.Path); + Self.Path := new String'(""); + end Initialize_Empty; + + ------------------------------------- + -- Initialize_Default_Project_Path -- + ------------------------------------- + + procedure Initialize_Default_Project_Path + (Self : in out Project_Search_Path; Target_Name : String) is Add_Default_Dir : Boolean := True; First : Positive; @@ -1808,11 +1822,7 @@ package body Prj.Env is -- May be empty. begin - -- If already initialized, nothing else to do - - if Self.Path /= null - and then Self.Path (Self.Path'First) /= '#' - then + if Is_Initialized (Self) then return; end if; @@ -1968,19 +1978,17 @@ package body Prj.Env is if Self.Path = null then Self.Path := new String'(Name_Buffer (1 .. Name_Len)); end if; - end Initialize_Project_Path; + end Initialize_Default_Project_Path; -------------- -- Get_Path -- -------------- procedure Get_Path - (Self : in out Project_Search_Path; - Path : out String_Access; - Target_Name : String := "") - is + (Self : Project_Search_Path; + Path : out String_Access) is begin - Initialize_Project_Path (Self, Target_Name); + pragma Assert (Is_Initialized (Self)); Path := Self.Path; end Get_Path; @@ -2004,8 +2012,7 @@ package body Prj.Env is (Self : in out Project_Search_Path; Project_File_Name : String; Directory : String; - Path : out Namet.Path_Name_Type; - Target_Name : String) + Path : out Namet.Path_Name_Type) is File : constant String := Project_File_Name; -- Have to do a copy, in case the parameter is Name_Buffer, which we @@ -2092,7 +2099,7 @@ package body Prj.Env is -- Start of processing for Find_Project begin - Initialize_Project_Path (Self, Target_Name); + pragma Assert (Is_Initialized (Self)); if Current_Verbosity = High then Debug_Increase_Indent diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index b576e2d5412..aec975d859b 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -162,6 +162,21 @@ package Prj.Env is -- to search for projects on the path (and caches the results to improve -- efficiency). + procedure Initialize_Default_Project_Path + (Self : in out Project_Search_Path; Target_Name : String); + -- Initialize Self. + -- It will then contain the default project path on the given target + -- (including directories specified by the environment variables + -- ADA_PROJECT_PATH and GPR_PROJECT_PATH). + -- This does nothing if Self has already been initialized. + + procedure Initialize_Empty (Self : in out Project_Search_Path); + -- Initialize self with an empty list of directories. + -- If Self had already been set, it is reset. + + function Is_Initialized (Self : Project_Search_Path) return Boolean; + -- Whether Self has been initialized + procedure Free (Self : in out Project_Search_Path); -- Free the memory used by Self @@ -177,13 +192,13 @@ package Prj.Env is -- Find_Project below, or PATH will be added at the end of the search path. procedure Get_Path - (Self : in out Project_Search_Path; - Path : out String_Access; - Target_Name : String := ""); + (Self : Project_Search_Path; + Path : out String_Access); -- Return the current value of the project path, either the value set -- during elaboration of the package or, if procedure Set_Project_Path has -- been called, the value set by the last call to Set_Project_Path. The -- returned value must not be modified. + -- Self must have been initialized first. procedure Set_Path (Self : in out Project_Search_Path; Path : String); @@ -194,12 +209,13 @@ package Prj.Env is (Self : in out Project_Search_Path; Project_File_Name : String; Directory : String; - Path : out Namet.Path_Name_Type; - Target_Name : String); + Path : out Namet.Path_Name_Type); -- Search for a project with the given name either in Directory (which -- often will be the directory contain the project we are currently parsing -- and which we found a reference to another project), or in the project - -- path. Extra_Project_Path contains additional directories to search. + -- path Self. + -- + -- Self must have been initialized first. -- -- Project_File_Name can optionally contain directories, and the extension -- (.gpr) for the file name is optional. diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index 6518f2e1863..3e3210d71e9 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -29,6 +29,7 @@ with Output; with Osint; use Osint; with Prj; use Prj; with Prj.Com; +with Prj.Env; with Prj.Part; with Prj.PP; with Prj.Tree; use Prj.Tree; @@ -796,6 +797,8 @@ package body Prj.Makr is Snames.Initialize; Prj.Initialize (No_Project_Tree); Prj.Tree.Initialize (Tree); + Prj.Env.Initialize_Default_Project_Path + (Tree.Project_Path, Target_Name => ""); Sources.Set_Last (0); Source_Directories.Set_Last (0); @@ -865,8 +868,7 @@ package body Prj.Makr is Is_Config_File => False, Flags => Flags, Current_Directory => Get_Current_Dir, - Packages_To_Check => Packages_To_Check_By_Gnatname, - Target_Name => ""); + Packages_To_Check => Packages_To_Check_By_Gnatname); -- Fail if parsing was not successful diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 5b9ae4c0922..c045ab261d6 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -28,6 +28,7 @@ with Opt; use Opt; with Osint; use Osint; with Output; use Output; with Prj.Com; +with Prj.Env; use Prj.Env; with Prj.Err; use Prj.Err; with Prj.Util; use Prj.Util; with Sinput.P; @@ -936,6 +937,8 @@ package body Prj.Nmsc is Project.Decl.Attributes, Data.Tree); + Project_Path_For_Aggregate : Prj.Env.Project_Search_Path; + procedure Found_Project_File (Path : Path_Information; Rank : Natural); -- Called for each project file aggregated by Project @@ -951,9 +954,23 @@ package body Prj.Nmsc is procedure Found_Project_File (Path : Path_Information; Rank : Natural) is pragma Unreferenced (Rank); + Full_Path : Path_Name_Type; begin Debug_Output ("Aggregates: ", Name_Id (Path.Display_Name)); + -- For usual "with" statement, this phase will have been done when + -- parsing the project itself. However, for aggregate projects, we + -- can only do this when processing the aggregate project, since the + -- exact list of project files or project directories can depend on + -- scenario variables. + -- + -- ??? We might already have loaded the project + + Prj.Env.Find_Project + (Self => Project_Path_For_Aggregate, + Project_File_Name => Get_Name_String (Path.Name), + Directory => Get_Name_String (Project.Path.Name), + Path => Full_Path); end Found_Project_File; -- Start of processing for Check_Aggregate_Project @@ -968,6 +985,8 @@ package body Prj.Nmsc is return; end if; + Initialize_Empty (Project_Path_For_Aggregate); + -- Look for aggregated projects. For similarity with source files and -- dirs, the aggregated project files are not searched for on the -- project path, and are only found through the path specified in @@ -980,6 +999,8 @@ package body Prj.Nmsc is Ignore => Nil_String, Search_For => Search_Files, Resolve_Links => Opt.Follow_Links_For_Files); + + Free (Project_Path_For_Aggregate); end Check_Aggregate_Project; ---------------------------- diff --git a/gcc/ada/prj-pars.adb b/gcc/ada/prj-pars.adb index c25ff60e239..4811fc6c87f 100644 --- a/gcc/ada/prj-pars.adb +++ b/gcc/ada/prj-pars.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -28,6 +28,7 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations; with Output; use Output; with Prj.Conf; use Prj.Conf; +with Prj.Env; with Prj.Err; use Prj.Err; with Prj.Part; with Prj.Tree; use Prj.Tree; @@ -60,6 +61,8 @@ package body Prj.Pars is if Project_Node_Tree = null then Project_Node_Tree := new Project_Node_Tree_Data; Prj.Tree.Initialize (Project_Node_Tree); + Prj.Env.Initialize_Default_Project_Path + (Project_Node_Tree.Project_Path, Target_Name => ""); end if; -- Parse the main project file into a tree @@ -73,8 +76,7 @@ package body Prj.Pars is Packages_To_Check => Packages_To_Check, Current_Directory => Current_Dir, Flags => Flags, - Is_Config_File => False, - Target_Name => ""); + Is_Config_File => False); -- If there were no error, process the tree diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 385ba1d3351..5167da4a3f0 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -185,8 +185,7 @@ package body Prj.Part is Depth : Natural; Current_Dir : String; Is_Config_File : Boolean; - Flags : Processing_Flags; - Target_Name : String); + Flags : Processing_Flags); -- Parse a project file. This is a recursive procedure: it calls itself for -- imported and extended projects. When From_Extended is not None, if the -- project has already been parsed and is an extended project A, return the @@ -221,8 +220,7 @@ package body Prj.Part is Depth : Natural; Current_Dir : String; Is_Config_File : Boolean; - Flags : Processing_Flags; - Target_Name : String); + Flags : Processing_Flags); -- Parse the imported projects that have been stored in table Withs, if -- any. From_Extended is used for the call to Parse_Single_Project below. -- When In_Limited is True, the importing path includes at least one @@ -451,7 +449,7 @@ package body Prj.Part is Current_Directory : String := ""; Is_Config_File : Boolean; Flags : Processing_Flags; - Target_Name : String) + Target_Name : String := "") is Dummy : Boolean; pragma Warnings (Off, Dummy); @@ -462,6 +460,11 @@ package body Prj.Part is Path_Name_Id : Path_Name_Type; begin + if not Is_Initialized (In_Tree.Project_Path) then + Prj.Env.Initialize_Default_Project_Path + (In_Tree.Project_Path, Target_Name); + end if; + if Real_Project_File_Name = null then Real_Project_File_Name := new String'(Project_File_Name); end if; @@ -471,8 +474,7 @@ package body Prj.Part is Find_Project (In_Tree.Project_Path, Project_File_Name => Real_Project_File_Name.all, Directory => Current_Directory, - Path => Path_Name_Id, - Target_Name => Target_Name); + Path => Path_Name_Id); Free (Real_Project_File_Name); Prj.Err.Initialize; @@ -483,10 +485,7 @@ package body Prj.Part is declare P : String_Access; begin - Get_Path - (In_Tree.Project_Path, - Path => P, - Target_Name => Target_Name); + Get_Path (In_Tree.Project_Path, Path => P); Prj.Com.Fail ("project file """ @@ -513,8 +512,7 @@ package body Prj.Part is Depth => 0, Current_Dir => Current_Directory, Is_Config_File => Is_Config_File, - Flags => Flags, - Target_Name => Target_Name); + Flags => Flags); exception when Types.Unrecoverable_Error => @@ -745,8 +743,7 @@ package body Prj.Part is Depth : Natural; Current_Dir : String; Is_Config_File : Boolean; - Flags : Processing_Flags; - Target_Name : String) + Flags : Processing_Flags) is Current_With_Clause : With_Id := Context_Clause; @@ -782,8 +779,7 @@ package body Prj.Part is (In_Tree.Project_Path, Project_File_Name => Get_Name_String (Current_With.Path), Directory => Project_Directory_Path, - Path => Imported_Path_Name_Id, - Target_Name => Target_Name); + Path => Imported_Path_Name_Id); if Imported_Path_Name_Id = No_Path then @@ -887,8 +883,7 @@ package body Prj.Part is Depth => Depth, Current_Dir => Current_Dir, Is_Config_File => Is_Config_File, - Flags => Flags, - Target_Name => Target_Name); + Flags => Flags); else Extends_All := Is_Extending_All (Withed_Project, In_Tree); @@ -1131,8 +1126,7 @@ package body Prj.Part is Depth : Natural; Current_Dir : String; Is_Config_File : Boolean; - Flags : Processing_Flags; - Target_Name : String) + Flags : Processing_Flags) is Path_Name : constant String := Get_Name_String (Path_Name_Id); @@ -1495,8 +1489,7 @@ package body Prj.Part is Depth => Depth + 1, Current_Dir => Current_Dir, Is_Config_File => Is_Config_File, - Flags => Flags, - Target_Name => Target_Name); + Flags => Flags); Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); end; @@ -1557,8 +1550,7 @@ package body Prj.Part is (In_Tree.Project_Path, Project_File_Name => Original_Path_Name, Directory => Get_Name_String (Project_Directory), - Path => Extended_Project_Path_Name_Id, - Target_Name => Target_Name); + Path => Extended_Project_Path_Name_Id); if Extended_Project_Path_Name_Id = No_Path then @@ -1605,8 +1597,7 @@ package body Prj.Part is Depth => Depth + 1, Current_Dir => Current_Dir, Is_Config_File => Is_Config_File, - Flags => Flags, - Target_Name => Target_Name); + Flags => Flags); end; if Present (Extended_Project) then @@ -1856,8 +1847,7 @@ package body Prj.Part is Depth => Depth + 1, Current_Dir => Current_Dir, Is_Config_File => Is_Config_File, - Flags => Flags, - Target_Name => Target_Name); + Flags => Flags); Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); end; diff --git a/gcc/ada/prj-part.ads b/gcc/ada/prj-part.ads index 1efd44fe850..7f8be2147e8 100644 --- a/gcc/ada/prj-part.ads +++ b/gcc/ada/prj-part.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-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- -- @@ -39,7 +39,7 @@ package Prj.Part is Current_Directory : String := ""; Is_Config_File : Boolean; Flags : Processing_Flags; - Target_Name : String); + Target_Name : String := ""); -- Parse project file and all its imported project files and create a tree. -- Return the node for the project (or Empty_Node if parsing failed). If -- Always_Errout_Finalize is True, Errout.Finalize is called in all cases, @@ -54,5 +54,9 @@ package Prj.Part is -- -- Is_Config_File should be set to True if the project represents a config -- file (.cgpr) since some specific checks apply. + -- + -- Target_Name will be used to initialize the default project path, unless + -- In_Tree.Project_Path has already been initialized (which is the + -- recommended use). end Prj.Part;