===================================================================
@@ -1065,7 +1065,7 @@
if Ext_List then
Value :=
Prj.Ext.Value_Of
- (From_Project_Node_Tree, Name, No_Name);
+ (From_Project_Node_Tree.External, Name, No_Name);
if Value /= No_Name then
declare
@@ -1171,7 +1171,7 @@
Value :=
Prj.Ext.Value_Of
- (From_Project_Node_Tree, Name, Default);
+ (From_Project_Node_Tree.External, Name, Default);
if Value = No_Name then
if not Quiet_Output then
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- 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- --
@@ -23,31 +23,65 @@
-- --
------------------------------------------------------------------------------
+with Ada.Unchecked_Deallocation;
with Osint; use Osint;
-with Prj.Tree; use Prj.Tree;
package body Prj.Ext is
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize
+ (Self : out External_References;
+ Copy_From : External_References := No_External_Refs)
+ is
+ N : Name_To_Name_Ptr;
+ N2 : Name_To_Name_Ptr;
+ begin
+ if Self.Refs = null then
+ Self.Refs := new Name_To_Name_HTable.Instance;
+
+ if Copy_From.Refs /= null then
+ N := Name_To_Name_HTable.Get_First (Copy_From.Refs.all);
+ while N /= null loop
+ N2 := new Name_To_Name;
+ N2.Key := N.Key;
+ N2.Value := N.Value;
+ Name_To_Name_HTable.Set (Self.Refs.all, N2);
+ N := Name_To_Name_HTable.Get_Next (Copy_From.Refs.all);
+ end loop;
+ end if;
+ end if;
+ end Initialize;
+
---------
-- Add --
---------
procedure Add
- (Tree : Prj.Tree.Project_Node_Tree_Ref;
+ (Self : External_References;
External_Name : String;
Value : String)
is
- The_Key : Name_Id;
- The_Value : Name_Id;
+ N : Name_To_Name_Ptr;
begin
+ N := new Name_To_Name;
+
Name_Len := Value'Length;
Name_Buffer (1 .. Name_Len) := Value;
- The_Value := Name_Find;
+ N.Value := Name_Find;
+
Name_Len := External_Name'Length;
Name_Buffer (1 .. Name_Len) := External_Name;
Canonical_Case_Env_Var_Name (Name_Buffer (1 .. Name_Len));
- The_Key := Name_Find;
- Name_To_Name_HTable.Set (Tree.External_References, The_Key, The_Value);
+ N.Key := Name_Find;
+
+ if Current_Verbosity = High then
+ Debug_Output ("Add (" & External_Name & ") is", N.Value);
+ end if;
+
+ Name_To_Name_HTable.Set (Self.Refs.all, N);
end Add;
-----------
@@ -55,7 +89,7 @@
-----------
function Check
- (Tree : Prj.Tree.Project_Node_Tree_Ref;
+ (Self : External_References;
Declaration : String) return Boolean
is
begin
@@ -63,7 +97,7 @@
if Declaration (Equal_Pos) = '=' then
exit when Equal_Pos = Declaration'First;
Add
- (Tree => Tree,
+ (Self => Self,
External_Name =>
Declaration (Declaration'First .. Equal_Pos - 1),
Value =>
@@ -79,9 +113,12 @@
-- Reset --
-----------
- procedure Reset (Tree : Prj.Tree.Project_Node_Tree_Ref) is
+ procedure Reset (Self : External_References) is
begin
- Name_To_Name_HTable.Reset (Tree.External_References);
+ if Self.Refs /= null then
+ Debug_Output ("Reset external references");
+ Name_To_Name_HTable.Reset (Self.Refs.all);
+ end if;
end Reset;
--------------
@@ -89,23 +126,26 @@
--------------
function Value_Of
- (Tree : Prj.Tree.Project_Node_Tree_Ref;
+ (Self : External_References;
External_Name : Name_Id;
With_Default : Name_Id := No_Name)
return Name_Id
is
- The_Value : Name_Id;
- Name : String := Get_Name_String (External_Name);
+ Value : Name_To_Name_Ptr;
+ Val : Name_Id;
+ Name : String := Get_Name_String (External_Name);
begin
Canonical_Case_Env_Var_Name (Name);
- Name_Len := Name'Length;
- Name_Buffer (1 .. Name_Len) := Name;
- The_Value :=
- Name_To_Name_HTable.Get (Tree.External_References, Name_Find);
- if The_Value /= No_Name then
- return The_Value;
+ if Self.Refs /= null then
+ Name_Len := Name'Length;
+ Name_Buffer (1 .. Name_Len) := Name;
+ Value := Name_To_Name_HTable.Get (Self.Refs.all, Name_Find);
+
+ if Value /= null then
+ return Value.Value;
+ end if;
end if;
-- Find if it is an environment, if it is, put value in the hash table
@@ -117,17 +157,73 @@
if Env_Value /= null and then Env_Value'Length > 0 then
Name_Len := Env_Value'Length;
Name_Buffer (1 .. Name_Len) := Env_Value.all;
- The_Value := Name_Find;
- Name_To_Name_HTable.Set
- (Tree.External_References, External_Name, The_Value);
+ Val := Name_Find;
+
+ if Current_Verbosity = High then
+ Debug_Output ("Value_Of (" & Get_Name_String (External_Name)
+ & ") is", Val);
+ end if;
+
+ if Self.Refs /= null then
+ Value := new Name_To_Name;
+ Value.Key := External_Name;
+ Value.Value := Val;
+ Name_To_Name_HTable.Set (Self.Refs.all, Value);
+ end if;
+
Free (Env_Value);
- return The_Value;
+ return Val;
else
+ if Current_Verbosity = High then
+ Debug_Output ("Value_Of (" & Get_Name_String (External_Name)
+ & ") is default", With_Default);
+ end if;
Free (Env_Value);
return With_Default;
end if;
end;
end Value_Of;
+ ----------
+ -- Free --
+ ----------
+
+ procedure Free (Self : in out External_References) is
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (Name_To_Name_HTable.Instance, Instance_Access);
+ begin
+ if Self.Refs /= null then
+ Reset (Self);
+ Unchecked_Free (Self.Refs);
+ end if;
+ end Free;
+
+ --------------
+ -- Set_Next --
+ --------------
+
+ procedure Set_Next (E : Name_To_Name_Ptr; Next : Name_To_Name_Ptr) is
+ begin
+ E.Next := Next;
+ end Set_Next;
+
+ ----------
+ -- Next --
+ ----------
+
+ function Next (E : Name_To_Name_Ptr) return Name_To_Name_Ptr is
+ begin
+ return E.Next;
+ end Next;
+
+ -------------
+ -- Get_Key --
+ -------------
+
+ function Get_Key (E : Name_To_Name_Ptr) return Name_Id is
+ begin
+ return E.Key;
+ end Get_Key;
+
end Prj.Ext;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- 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- --
@@ -26,7 +26,7 @@
-- Subprograms to set, get and cache external references, to be used as
-- External functions in project files.
-with Prj.Tree;
+with GNAT.Dynamic_HTables;
package Prj.Ext is
@@ -42,27 +42,84 @@
-- trees are loaded in parallel we can have different scenarios (or even
-- load the same tree twice and see different views of it).
+ type External_References is private;
+ No_External_Refs : constant External_References;
+
+ procedure Initialize
+ (Self : out External_References;
+ Copy_From : External_References := No_External_Refs);
+ -- Initialize Self, and copy all values from Copy_From if needed.
+ -- This has no effect if Self was already initialized.
+
+ procedure Free (Self : in out External_References);
+ -- Free memory used by Self
+
procedure Add
- (Tree : Prj.Tree.Project_Node_Tree_Ref;
+ (Self : External_References;
External_Name : String;
Value : String);
-- Add an external reference (or modify an existing one)
function Value_Of
- (Tree : Prj.Tree.Project_Node_Tree_Ref;
+ (Self : External_References;
External_Name : Name_Id;
With_Default : Name_Id := No_Name)
return Name_Id;
-- Get the value of an external reference, and cache it for future uses
function Check
- (Tree : Prj.Tree.Project_Node_Tree_Ref;
+ (Self : External_References;
Declaration : String) return Boolean;
-- Check that an external declaration <external>=<value> is correct.
-- If it is correct, the external reference is Added.
- procedure Reset (Tree : Prj.Tree.Project_Node_Tree_Ref);
+ procedure Reset (Self : External_References);
-- Clear the internal data structure that stores the external references
-- and free any allocated memory.
+private
+
+ -- Use a Static_HTable, not a Simple_HTable.
+ -- The issue is that we need to be able to copy the contents of the table
+ -- (in Initialize), but this isn't doable for Simple_HTable for which
+ -- iterators do not return the key.
+
+ type Name_To_Name;
+ type Name_To_Name_Ptr is access all Name_To_Name;
+ type Name_To_Name is record
+ Key : Name_Id;
+ Value : Name_Id;
+ Next : Name_To_Name_Ptr;
+ end record;
+
+ procedure Set_Next (E : Name_To_Name_Ptr; Next : Name_To_Name_Ptr);
+ function Next (E : Name_To_Name_Ptr) return Name_To_Name_Ptr;
+ function Get_Key (E : Name_To_Name_Ptr) return Name_Id;
+
+ package Name_To_Name_HTable is new GNAT.Dynamic_HTables.Static_HTable
+ (Header_Num => Header_Num,
+ Element => Name_To_Name,
+ Elmt_Ptr => Name_To_Name_Ptr,
+ Null_Ptr => null,
+ Set_Next => Set_Next,
+ Next => Next,
+ Key => Name_Id,
+ Get_Key => Get_Key,
+ Hash => Hash,
+ Equal => "=");
+ -- General type for htables associating name_id to name_id. This is in
+ -- particular used to store the values of external references.
+
+ type Instance_Access is access all Name_To_Name_HTable.Instance;
+
+ type External_References is record
+ Refs : Instance_Access;
+ -- External references are stored in this hash table (and manipulated
+ -- through subprogrames 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.
+ end record;
+
+ No_External_Refs : constant External_References := (Refs => null);
+
end Prj.Ext;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 2004-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- --
@@ -724,7 +724,7 @@
end if;
return Prj.Ext.Check
- (Tree => Tree,
+ (Self => Tree.External,
Declaration => Argv (Start .. Finish));
end Is_External_Assignment;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- 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- --
@@ -988,8 +988,12 @@
Projects_Htable.Reset (Tree.Projects_HT);
-- Do not reset the external references, in case we are reloading a
- -- project, since we want to preserve the current environment
- -- Name_To_Name_HTable.Reset (Tree.External_References);
+ -- project, since we want to preserve the current environment.
+ -- But we still need to ensure that the external references are properly
+ -- initialized.
+
+ Prj.Ext.Initialize (Tree.External);
+ -- Prj.Ext.Reset (Tree.External);
end Initialize;
----------
@@ -1003,7 +1007,7 @@
if Proj /= null then
Project_Node_Table.Free (Proj.Project_Nodes);
Projects_Htable.Reset (Proj.Projects_HT);
- Name_To_Name_HTable.Reset (Proj.External_References);
+ Prj.Ext.Free (Proj.External);
Free (Proj.Project_Path);
Unchecked_Free (Proj);
end if;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- 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- --
@@ -32,6 +32,7 @@
with Prj.Attr; use Prj.Attr;
with Prj.Env;
+with Prj.Ext;
package Prj.Tree is
@@ -1453,21 +1454,11 @@
end Tree_Private_Part;
- package Name_To_Name_HTable is new GNAT.Dynamic_HTables.Simple_HTable
- (Header_Num => Header_Num,
- Element => Name_Id,
- No_Element => No_Name,
- Key => Name_Id,
- Hash => Hash,
- Equal => "=");
- -- General type for htables associating name_id to name_id. This is in
- -- particular used to store the values of external references.
-
type Project_Node_Tree_Data is record
Project_Nodes : Tree_Private_Part.Project_Node_Table.Instance;
Projects_HT : Tree_Private_Part.Projects_Htable.Instance;
- External_References : Name_To_Name_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
===================================================================
@@ -1822,7 +1822,7 @@
if Equal_Pos >= Argv'First + 3
and then Equal_Pos /= Argv'Last
then
- Add (Project_Node_Tree,
+ Add (Project_Node_Tree.External,
External_Name =>
Argv (Argv'First + 2 .. Equal_Pos - 1),
Value => Argv (Equal_Pos + 1 .. Argv'Last));
===================================================================
@@ -1886,7 +1886,7 @@
if OK then
Prj.Ext.Add
- (Project_Node_Tree,
+ (Project_Node_Tree.External,
External_Name =>
Ext_Asgn (Start .. Equal_Pos - 1),
Value =>