Commit 804fe3c4 by Emmanuel Briot Committed by Arnaud Charlet

prj-proc.adb, [...] (Environment): new type.

2011-08-03  Emmanuel Briot  <briot@adacore.com>

	* prj-proc.adb, prj.ads, makeutl.adb, makeutl.ads, prj-conf.adb,
	prj-tree.adb, prj-tree.ads (Environment): new type.

From-SVN: r177247
parent c565bc66
2011-08-03 Emmanuel Briot <briot@adacore.com> 2011-08-03 Emmanuel Briot <briot@adacore.com>
* prj-proc.adb, prj.ads, makeutl.adb, makeutl.ads, prj-conf.adb,
prj-tree.adb, prj-tree.ads (Environment): new type.
2011-08-03 Emmanuel Briot <briot@adacore.com>
* prj-tree.ads: Remove unused variable. * prj-tree.ads: Remove unused variable.
2011-08-03 Yannick Moy <moy@adacore.com> 2011-08-03 Yannick Moy <moy@adacore.com>
......
...@@ -701,7 +701,7 @@ package body Makeutl is ...@@ -701,7 +701,7 @@ package body Makeutl is
---------------------------- ----------------------------
function Is_External_Assignment function Is_External_Assignment
(Tree : Prj.Tree.Project_Node_Tree_Ref; (Env : Prj.Tree.Environment;
Argv : String) return Boolean Argv : String) return Boolean
is is
Start : Positive := 3; Start : Positive := 3;
...@@ -724,7 +724,7 @@ package body Makeutl is ...@@ -724,7 +724,7 @@ package body Makeutl is
end if; end if;
return Prj.Ext.Check return Prj.Ext.Check
(Self => Tree.External, (Self => Env.External,
Declaration => Argv (Start .. Finish)); Declaration => Argv (Start .. Finish));
end Is_External_Assignment; end Is_External_Assignment;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2010, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -113,7 +113,7 @@ package Makeutl is ...@@ -113,7 +113,7 @@ package Makeutl is
-- if everything is still valid. -- if everything is still valid.
function Is_External_Assignment function Is_External_Assignment
(Tree : Prj.Tree.Project_Node_Tree_Ref; (Env : Prj.Tree.Environment;
Argv : String) return Boolean; Argv : String) return Boolean;
-- Verify that an external assignment switch is syntactically correct -- Verify that an external assignment switch is syntactically correct
-- --
......
...@@ -573,6 +573,7 @@ package body Prj.Conf is ...@@ -573,6 +573,7 @@ package body Prj.Conf is
(Project : Project_Id; (Project : Project_Id;
Project_Tree : Project_Tree_Ref; Project_Tree : Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref; Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : Prj.Tree.Environment;
Allow_Automatic_Generation : Boolean; Allow_Automatic_Generation : Boolean;
Config_File_Name : String := ""; Config_File_Name : String := "";
Autoconf_Specified : Boolean; Autoconf_Specified : Boolean;
...@@ -1061,7 +1062,7 @@ package body Prj.Conf is ...@@ -1061,7 +1062,7 @@ package body Prj.Conf is
Config_Project_Node : Project_Node_Id := Empty_Node; Config_Project_Node : Project_Node_Id := Empty_Node;
begin begin
pragma Assert (Prj.Env.Is_Initialized (Project_Node_Tree.Project_Path)); pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
Free (Config_File_Path); Free (Config_File_Path);
Config := No_Project; Config := No_Project;
......
...@@ -2814,8 +2814,7 @@ package body Prj.Proc is ...@@ -2814,8 +2814,7 @@ package body Prj.Proc is
Project => Project.Extends, Project => Project.Extends,
Flags => Flags, Flags => Flags,
From_Project_Node => Extended_Project_Of From_Project_Node => Extended_Project_Of
(Declaration_Node, (Declaration_Node, From_Project_Node_Tree),
From_Project_Node_Tree),
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Extended_By => Project); Extended_By => Project);
...@@ -2824,11 +2823,10 @@ package body Prj.Proc is ...@@ -2824,11 +2823,10 @@ package body Prj.Proc is
In_Tree => In_Tree, In_Tree => In_Tree,
Flags => Flags, Flags => Flags,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
Node_Tree => From_Project_Node_Tree, Node_Tree => From_Project_Node_Tree,
Pkg => No_Package, Pkg => No_Package,
Item => First_Declarative_Item_Of Item => First_Declarative_Item_Of
(Declaration_Node, (Declaration_Node, From_Project_Node_Tree));
From_Project_Node_Tree));
if Project.Extends /= No_Project then if Project.Extends /= No_Project then
Process_Extended_Project; Process_Extended_Project;
......
...@@ -982,17 +982,26 @@ package body Prj.Tree is ...@@ -982,17 +982,26 @@ package body Prj.Tree is
-- Initialize -- -- Initialize --
---------------- ----------------
procedure Initialize (Tree : Project_Node_Tree_Ref) is procedure Initialize
(Tree : Project_Node_Tree_Ref; Env : in out Environment) is
begin begin
Project_Node_Table.Init (Tree.Project_Nodes); Project_Node_Table.Init (Tree.Project_Nodes);
Projects_Htable.Reset (Tree.Projects_HT); Projects_Htable.Reset (Tree.Projects_HT);
Initialize (Env);
end Initialize;
----------------
-- Initialize --
----------------
procedure Initialize (Self : in out Environment) is
begin
-- Do not reset the external references, in case we are reloading a -- Do not reset the external references, in case we are reloading a
-- project, since we want to preserve the current environment. -- project, since we want to preserve the current environment.
-- But we still need to ensure that the external references are properly -- But we still need to ensure that the external references are properly
-- initialized. -- initialized.
Prj.Ext.Initialize (Tree.External); Prj.Ext.Initialize (Self.External);
-- Prj.Ext.Reset (Tree.External); -- Prj.Ext.Reset (Tree.External);
end Initialize; end Initialize;
...@@ -1000,17 +1009,29 @@ package body Prj.Tree is ...@@ -1000,17 +1009,29 @@ package body Prj.Tree is
-- Free -- -- Free --
---------- ----------
procedure Free (Proj : in out Project_Node_Tree_Ref) is procedure Free (Self : in out Environment) is
begin
Prj.Ext.Free (Self.External);
Free (Self.Project_Path);
end Free;
----------
-- Free --
----------
procedure Free
(Proj : in out Project_Node_Tree_Ref;
Env : in out Environment)
is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Project_Node_Tree_Data, Project_Node_Tree_Ref); (Project_Node_Tree_Data, Project_Node_Tree_Ref);
begin begin
if Proj /= null then if Proj /= null then
Project_Node_Table.Free (Proj.Project_Nodes); Project_Node_Table.Free (Proj.Project_Nodes);
Projects_Htable.Reset (Proj.Projects_HT); Projects_Htable.Reset (Proj.Projects_HT);
Prj.Ext.Free (Proj.External);
Free (Proj.Project_Path);
Unchecked_Free (Proj); Unchecked_Free (Proj);
end if; end if;
Free (Env);
end Free; end Free;
------------------------------- -------------------------------
......
...@@ -36,6 +36,36 @@ with Prj.Ext; ...@@ -36,6 +36,36 @@ with Prj.Ext;
package Prj.Tree is package Prj.Tree is
-----------------
-- Environment --
-----------------
type Environment is record
External : Prj.Ext.External_References;
-- External references are stored in this hash table (and manipulated
-- through subprograms in prj-ext.ads). External references are
-- project-tree specific so that one can load the same tree twice but
-- have two views of it, for instance.
Project_Path : aliased Prj.Env.Project_Search_Path;
-- The project path is tree specific, since we might want to load
-- simultaneously multiple projects, each with its own search path, in
-- particular when using different compilers with different default
-- search directories.
end record;
-- This record contains the context in which projects are parsed and
-- processed (finding importing project, resolving external values,...)
procedure Initialize (Self : in out Environment);
-- Initialize a new environment
procedure Free (Self : in out Environment);
-- Free the memory used by Self
-------------------
-- Project nodes --
-------------------
type Project_Node_Tree_Data; type Project_Node_Tree_Data;
type Project_Node_Tree_Ref is access all Project_Node_Tree_Data; type Project_Node_Tree_Ref is access all Project_Node_Tree_Data;
-- Type to designate a project node tree, so that several project node -- Type to designate a project node tree, so that several project node
...@@ -100,7 +130,8 @@ package Prj.Tree is ...@@ -100,7 +130,8 @@ package Prj.Tree is
pragma Inline (No); pragma Inline (No);
-- Return True if Node = Empty_Node -- Return True if Node = Empty_Node
procedure Initialize (Tree : Project_Node_Tree_Ref); procedure Initialize (Tree : Project_Node_Tree_Ref;
Env : in out Environment);
-- Initialize the Project File tree: empty the Project_Nodes table -- Initialize the Project File tree: empty the Project_Nodes table
-- and reset the Projects_Htable. -- and reset the Projects_Htable.
...@@ -1457,21 +1488,10 @@ package Prj.Tree is ...@@ -1457,21 +1488,10 @@ package Prj.Tree is
type Project_Node_Tree_Data is record type Project_Node_Tree_Data is record
Project_Nodes : Tree_Private_Part.Project_Node_Table.Instance; Project_Nodes : Tree_Private_Part.Project_Node_Table.Instance;
Projects_HT : Tree_Private_Part.Projects_Htable.Instance; Projects_HT : Tree_Private_Part.Projects_Htable.Instance;
External : Prj.Ext.External_References;
-- External references are stored in this hash table (and manipulated
-- through subprograms in prj-ext.ads). External references are
-- project-tree specific so that one can load the same tree twice but
-- have two views of it, for instance.
Project_Path : aliased Prj.Env.Project_Search_Path;
-- The project path is tree specific, since we might want to load
-- simultaneously multiple projects, each with its own search path, in
-- particular when using different compilers with different default
-- search directories.
end record; end record;
procedure Free (Proj : in out Project_Node_Tree_Ref); procedure Free (Proj : in out Project_Node_Tree_Ref;
Env : in out Environment);
-- Free memory used by Prj -- Free memory used by Prj
private private
......
...@@ -1321,6 +1321,8 @@ package Prj is ...@@ -1321,6 +1321,8 @@ package Prj is
case Qualifier is case Qualifier is
when Aggregate => when Aggregate =>
Aggregated_Projects : Aggregated_Project_List := null; Aggregated_Projects : Aggregated_Project_List := null;
-- List of aggregated projects (which could themselves be
-- aggregate projects).
when others => when others =>
null; null;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment