From patchwork Wed Aug 3 09:22:12 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 108071 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 0D3F7B71E3 for ; Wed, 3 Aug 2011 19:22:42 +1000 (EST) Received: (qmail 357 invoked by alias); 3 Aug 2011 09:22:40 -0000 Received: (qmail 32445 invoked by uid 22791); 3 Aug 2011 09:22:37 -0000 X-SWARE-Spam-Status: No, hits=-0.4 required=5.0 tests=AWL, BAYES_50, TW_PR, TW_RG X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 03 Aug 2011 09:22:14 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id E907F2BAE13; Wed, 3 Aug 2011 05:22:12 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id R2tTs3V6zDRb; Wed, 3 Aug 2011 05:22:12 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 2A4D92BADE0; Wed, 3 Aug 2011 05:22:12 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 2BBB83FEE8; Wed, 3 Aug 2011 05:22:12 -0400 (EDT) Date: Wed, 3 Aug 2011 05:22:12 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Emmanuel Briot Subject: [Ada] New type Prj.Ext.External_References Message-ID: <20110803092212.GA9698@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This type was introduced so that we can have two sets of environment variables when manipulating aggregate projects (one for the aggregate, one for the aggregated projects). But we can have more than two project trees, since we have one per aggregated project. So creating a new type makes it possible to share it between trees. Tested on x86_64-pc-linux-gnu, committed on trunk 2011-08-03 Emmanuel Briot * prj-proc.adb, prj-ext.adb, prj-ext.ads, makeutl.adb, prj-tree.adb, prj-tree.ads, gnatcmd.adb, clean.adb (External_References): New type. Index: prj-proc.adb =================================================================== --- prj-proc.adb (revision 177243) +++ prj-proc.adb (working copy) @@ -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 Index: prj-ext.adb =================================================================== --- prj-ext.adb (revision 176998) +++ prj-ext.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- 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- -- @@ -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; Index: prj-ext.ads =================================================================== --- prj-ext.ads (revision 176998) +++ prj-ext.ads (working copy) @@ -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- -- @@ -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 = 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; Index: makeutl.adb =================================================================== --- makeutl.adb (revision 177151) +++ makeutl.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- 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 -- -- 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; Index: prj-tree.adb =================================================================== --- prj-tree.adb (revision 176998) +++ prj-tree.adb (working copy) @@ -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- -- @@ -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; Index: prj-tree.ads =================================================================== --- prj-tree.ads (revision 176998) +++ prj-tree.ads (working copy) @@ -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- -- @@ -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 Index: gnatcmd.adb =================================================================== --- gnatcmd.adb (revision 177241) +++ gnatcmd.adb (working copy) @@ -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)); Index: clean.adb =================================================================== --- clean.adb (revision 177241) +++ clean.adb (working copy) @@ -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 =>