Commit daa72421 by Arnaud Charlet

[multiple changes]

2009-09-17  Bob Duff  <duff@adacore.com>

	* gnat_rm.texi, s-oscons-tmplt.c: Minor typo

2009-09-17  Emmanuel Briot  <briot@adacore.com>

	* gnatcmd.adb, prj-proc.adb, make.adb, prj-ext.adb, prj-ext.ads,
	makeutl.adb, makeutl.ads, clean.adb, prj-pars.adb, prj-pars.ads,
	prj-conf.adb, prj-conf.ads, prj-tree.adb, prj-tree.ads, prj-proc.ads,
	prj-nmsc.ads (Add, Value_Of, Reset): new parameter Tree.
	Scenario variables are now specific to each project tree loaded in
	memory.
	Code clean ups.

2009-09-17  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Make_DT): Remove wrong line of code that was
	undocumented and probably added by mistake.

From-SVN: r151792
parent 15ac3c72
2009-09-17 Bob Duff <duff@adacore.com>
* gnat_rm.texi, s-oscons-tmplt.c: Minor typo
2009-09-17 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, prj-proc.adb, make.adb, prj-ext.adb, prj-ext.ads,
makeutl.adb, makeutl.ads, clean.adb, prj-pars.adb, prj-pars.ads,
prj-conf.adb, prj-conf.ads, prj-tree.adb, prj-tree.ads, prj-proc.ads,
prj-nmsc.ads (Add, Value_Of, Reset): new parameter Tree.
Scenario variables are now specific to each project tree loaded in
memory.
Code clean ups.
2009-09-17 Javier Miranda <miranda@adacore.com>
* exp_disp.adb (Make_DT): Remove wrong line of code that was
undocumented and probably added by mistake.
2009-09-16 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Size>: Strip
......
......@@ -35,6 +35,7 @@ with Prj; use Prj;
with Prj.Env;
with Prj.Ext;
with Prj.Pars;
with Prj.Tree; use Prj.Tree;
with Prj.Util; use Prj.Util;
with Snames;
with Switch; use Switch;
......@@ -90,7 +91,7 @@ package body Clean is
Project_File_Name : String_Access := null;
Project_Tree : constant Prj.Project_Tree_Ref := new Prj.Project_Tree_Data;
Project_Node_Tree : Project_Node_Tree_Ref;
Main_Project : Prj.Project_Id := Prj.No_Project;
......@@ -1402,6 +1403,7 @@ package body Clean is
Prj.Pars.Parse
(Project => Main_Project,
In_Tree => Project_Tree,
In_Node_Tree => Project_Node_Tree,
Project_File_Name => Project_File_Name.all,
Flags => Gnatmake_Flags,
Packages_To_Check => Packages_To_Check_By_Gnatmake);
......@@ -1556,6 +1558,10 @@ package body Clean is
Csets.Initialize;
Namet.Initialize;
Snames.Initialize;
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);
Prj.Initialize (Project_Tree);
-- Check if the platform is VMS and, if it is, change some variables
......@@ -1873,7 +1879,8 @@ package body Clean is
if OK then
Prj.Ext.Add
(External_Name =>
(Project_Node_Tree,
External_Name =>
Ext_Asgn (Start .. Equal_Pos - 1),
Value =>
Ext_Asgn (Equal_Pos + 1 .. Stop));
......
......@@ -5140,9 +5140,8 @@ package body Exp_Disp is
exit when Parent_Typ = Current_Typ;
if Is_CPP_Class (Parent_Typ)
or else Is_Interface (Typ)
then
if Is_CPP_Class (Parent_Typ) then
-- The tags defined in the C++ side will be inherited when
-- the object is constructed (Exp_Ch3.Build_Init_Procedure)
......
......@@ -7733,11 +7733,11 @@ Followed.
In addition to the implementation dependent pragmas and attributes, and
the implementation advice, there are a number of other Ada features
that are potentially implementation dependent. These are mentioned
throughout the Ada Reference Manual, and are summarized in annex M@.
throughout the Ada Reference Manual, and are summarized in Annex M@.
A requirement for conforming Ada compilers is that they provide
documentation describing how the implementation deals with each of these
issues. In this chapter, you will find each point in annex M listed
issues. In this chapter, you will find each point in Annex M listed
followed by a description in italic font of how GNAT
@c SGI info:
@ignore
......
......@@ -26,7 +26,7 @@
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with Csets;
with Makeutl;
with Makeutl; use Makeutl;
with MLib.Tgt; use MLib.Tgt;
with MLib.Utl;
with MLib.Fil;
......@@ -38,6 +38,7 @@ with Prj; use Prj;
with Prj.Env;
with Prj.Ext; use Prj.Ext;
with Prj.Pars;
with Prj.Tree; use Prj.Tree;
with Prj.Util; use Prj.Util;
with Sinput.P;
with Snames; use Snames;
......@@ -57,7 +58,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
with VMS_Conv; use VMS_Conv;
procedure GNATCmd is
Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data;
Project_Node_Tree : Project_Node_Tree_Ref;
Project_File : String_Access;
Project : Prj.Project_Id;
Current_Verbosity : Prj.Verbosity := Prj.Default;
......@@ -1268,6 +1269,9 @@ begin
Snames.Initialize;
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);
Prj.Initialize (Project_Tree);
Last_Switches.Init;
......@@ -1694,7 +1698,8 @@ begin
begin
if Equal_Pos >= Argv'First + 3 and then
Equal_Pos /= Argv'Last then
Add (External_Name =>
Add (Project_Node_Tree,
External_Name =>
Argv (Argv'First + 2 .. Equal_Pos - 1),
Value => Argv (Equal_Pos + 1 .. Argv'Last));
else
......@@ -1753,6 +1758,7 @@ begin
Prj.Pars.Parse
(Project => Project,
In_Tree => Project_Tree,
In_Node_Tree => Project_Node_Tree,
Project_File_Name => Project_File.all,
Flags => Gnatmake_Flags,
Packages_To_Check => Packages_To_Check);
......@@ -2114,7 +2120,7 @@ begin
-- arguments.
for J in 1 .. Last_Switches.Last loop
Test_If_Relative_Path
GNATCmd.Test_If_Relative_Path
(Last_Switches.Table (J), Current_Work_Dir);
end loop;
......@@ -2124,7 +2130,7 @@ begin
Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
begin
for J in 1 .. First_Switches.Last loop
Test_If_Relative_Path
GNATCmd.Test_If_Relative_Path
(First_Switches.Table (J), Project_Dir);
end loop;
end;
......
......@@ -447,7 +447,10 @@ package body Makeutl is
-- Is_External_Assignment --
----------------------------
function Is_External_Assignment (Argv : String) return Boolean is
function Is_External_Assignment
(Tree : Prj.Tree.Project_Node_Tree_Ref;
Argv : String) return Boolean
is
Start : Positive := 3;
Finish : Natural := Argv'Last;
Equal_Pos : Natural;
......@@ -478,7 +481,8 @@ package body Makeutl is
return False;
else
Prj.Ext.Add
(External_Name => Argv (Start .. Equal_Pos - 1),
(Tree => Tree,
External_Name => Argv (Start .. Equal_Pos - 1),
Value => Argv (Equal_Pos + 1 .. Finish));
return True;
end if;
......
......@@ -28,6 +28,7 @@ with Namet; use Namet;
with Opt;
with Osint;
with Prj; use Prj;
with Prj.Tree;
with Types; use Types;
with GNAT.OS_Lib; use GNAT.OS_Lib;
......@@ -83,7 +84,9 @@ package Makeutl is
-- source files are still associated with the same units). Return True
-- if everything is still valid
function Is_External_Assignment (Argv : String) return Boolean;
function Is_External_Assignment
(Tree : Prj.Tree.Project_Node_Tree_Ref;
Argv : String) return Boolean;
-- Verify that an external assignment switch is syntactically correct
--
-- Correct forms are:
......
......@@ -1000,7 +1000,6 @@ package body Prj.Conf is
begin
-- Parse the user project tree
Prj.Tree.Initialize (Project_Node_Tree);
Prj.Initialize (Project_Tree);
Main_Project := No_Project;
......
......@@ -59,6 +59,10 @@ package Prj.Conf is
-- Find the main configuration project and parse the project tree rooted at
-- this configuration project.
--
-- Project_Node_Tree must have been initialized first (and possibly the
-- value for external references and project path should also have been
-- set).
--
-- 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.
......
......@@ -26,11 +26,10 @@
with Hostparm;
with Makeutl; use Makeutl;
with Osint; use Osint;
with Prj.Tree; use Prj.Tree;
with Sdefault;
with Table;
with GNAT.HTable;
package body Prj.Ext is
Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
......@@ -52,19 +51,6 @@ package body Prj.Ext is
procedure Initialize_Project_Path;
-- Initialize Current_Project_Path
package Htable is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Name_Id,
No_Element => No_Name,
Key => Name_Id,
Hash => Hash,
Equal => "=");
-- External references are stored in this hash table, either by procedure
-- Add (directly or through a call to function Check) or by function
-- Value_Of when an environment variable is found non empty. Value_Of
-- first for external reference in this table, before checking the
-- environment. Htable is emptied (reset) by procedure Reset.
package Search_Directories is new Table.Table
(Table_Component_Type => Name_Id,
Table_Index_Type => Natural,
......@@ -79,7 +65,8 @@ package body Prj.Ext is
---------
procedure Add
(External_Name : String;
(Tree : Prj.Tree.Project_Node_Tree_Ref;
External_Name : String;
Value : String)
is
The_Key : Name_Id;
......@@ -92,7 +79,7 @@ package body Prj.Ext is
Name_Buffer (1 .. Name_Len) := External_Name;
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
The_Key := Name_Find;
Htable.Set (The_Key, The_Value);
Name_To_Name_HTable.Set (Tree.External_References, The_Key, The_Value);
end Add;
-----------
......@@ -110,16 +97,19 @@ package body Prj.Ext is
-- Check --
-----------
function Check (Declaration : String) return Boolean is
function Check
(Tree : Prj.Tree.Project_Node_Tree_Ref;
Declaration : String) return Boolean is
begin
for Equal_Pos in Declaration'Range loop
if Declaration (Equal_Pos) = '=' then
exit when Equal_Pos = Declaration'First;
exit when Equal_Pos = Declaration'Last;
Add
(External_Name =>
(Tree => Tree,
External_Name =>
Declaration (Declaration'First .. Equal_Pos - 1),
Value =>
Value =>
Declaration (Equal_Pos + 1 .. Declaration'Last));
return True;
end if;
......@@ -294,9 +284,9 @@ package body Prj.Ext is
-- Reset --
-----------
procedure Reset is
procedure Reset (Tree : Prj.Tree.Project_Node_Tree_Ref) is
begin
Htable.Reset;
Name_To_Name_HTable.Reset (Tree.External_References);
end Reset;
----------------------
......@@ -314,7 +304,8 @@ package body Prj.Ext is
--------------
function Value_Of
(External_Name : Name_Id;
(Tree : Prj.Tree.Project_Node_Tree_Ref;
External_Name : Name_Id;
With_Default : Name_Id := No_Name)
return Name_Id
is
......@@ -325,7 +316,8 @@ package body Prj.Ext is
Canonical_Case_File_Name (Name);
Name_Len := Name'Length;
Name_Buffer (1 .. Name_Len) := Name;
The_Value := Htable.Get (Name_Find);
The_Value :=
Name_To_Name_HTable.Get (Tree.External_References, Name_Find);
if The_Value /= No_Name then
return The_Value;
......@@ -341,7 +333,8 @@ package body Prj.Ext is
Name_Len := Env_Value'Length;
Name_Buffer (1 .. Name_Len) := Env_Value.all;
The_Value := Name_Find;
Htable.Set (External_Name, The_Value);
Name_To_Name_HTable.Set
(Tree.External_References, External_Name, The_Value);
Free (Env_Value);
return The_Value;
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
-- Copyright (C) 2000-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- --
......@@ -26,8 +26,14 @@
-- Subprograms to set, get and cache external references, to be used as
-- External functions in project files.
with Prj.Tree;
package Prj.Ext is
------------------
-- Project Path --
------------------
Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
-- Name of primary env. variable that contain path name(s) of directories
-- where project files may reside.
......@@ -48,22 +54,36 @@ package Prj.Ext is
-- always start with the current directory (".") and the path separators
-- should be the correct ones for the platform.
-------------------------
-- External References --
-------------------------
-- External references influence the way a project tree is processed (in
-- particular they provide the values for the typed string variables that
-- are then used in case constructions).
-- External references are project-tree specific, so that when multiple
-- trees are loaded in parallel we can have different scenarios (or even
-- load the same tree twice and see different views of it).
procedure Add
(External_Name : String;
(Tree : Prj.Tree.Project_Node_Tree_Ref;
External_Name : String;
Value : String);
-- Add an external reference (or modify an existing one)
function Value_Of
(External_Name : Name_Id;
(Tree : Prj.Tree.Project_Node_Tree_Ref;
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 (Declaration : String) return Boolean;
function Check
(Tree : Prj.Tree.Project_Node_Tree_Ref;
Declaration : String) return Boolean;
-- Check that an external declaration <external>=<value> is correct.
-- If it is correct, the external reference is Added.
procedure Reset;
procedure Reset (Tree : Prj.Tree.Project_Node_Tree_Ref);
-- Clear the internal data structure that stores the external references
-- and free any allocated memory.
......
......@@ -33,11 +33,10 @@ private package Prj.Nmsc is
Flags : Processing_Flags);
-- Perform consistency and semantic checks on all the projects in the tree.
-- This procedure interprets the various case statements in the project
-- based on the current environment variables (the "scenario"). After
-- checking the validity of the naming scheme, it searches for all the
-- source files of the project. The result of this procedure is a filled-in
-- data structure for Project_Id which contains all the information about
-- the project. This information is only valid while the scenario variables
-- are preserved.
-- based on the current external references. After checking the validity of
-- the naming scheme, it searches for all the source files of the project.
-- The result of this procedure is a filled-in data structure for
-- Project_Id which contains all the information about the project. This
-- information is only valid while the external references are preserved.
end Prj.Nmsc;
......@@ -45,18 +45,21 @@ package body Prj.Pars is
Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages;
Flags : Processing_Flags;
Reset_Tree : Boolean := True)
Reset_Tree : Boolean := True;
In_Node_Tree : Prj.Tree.Project_Node_Tree_Ref := null)
is
Project_Node : Project_Node_Id := Empty_Node;
The_Project : Project_Id := No_Project;
Success : Boolean := True;
Current_Dir : constant String := Get_Current_Dir;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref := In_Node_Tree;
Automatically_Generated : Boolean;
Config_File_Path : String_Access;
begin
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);
if Project_Node_Tree = null then
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);
end if;
-- Parse the main project file into a tree
......
......@@ -25,6 +25,8 @@
-- General wrapper for the parsing of project files
with Prj.Tree;
package Prj.Pars is
procedure Set_Verbosity (To : Verbosity);
......@@ -36,20 +38,21 @@ package Prj.Pars is
Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages;
Flags : Processing_Flags;
Reset_Tree : Boolean := True);
Reset_Tree : Boolean := True;
In_Node_Tree : Prj.Tree.Project_Node_Tree_Ref := null);
-- Parse and process a project files and all its imported project files, in
-- the project tree In_Tree.
-- All the project files are parsed (through Prj.Tree) to create a tree in
-- memory. That tree is then processed (through Prj.Proc) to create a
-- expanded representation of the tree based on the current scenario
-- variables. This function is only a convenient wrapper over other
-- expanded representation of the tree based on the current external
-- references. This function is only a convenient wrapper over other
-- services provided in the Prj.* package hierarchy.
--
-- If parsing is successful, Project is the project ID of the root project
-- file; otherwise, Project_Id is set to No_Project. Project_Node_Tree is
-- set to the tree (unprocessed) representation of the project file. This
-- tree is permanently correct, whereas Project will need to be recomputed
-- if the scenario variables change.
-- if the external references change.
--
-- Packages_To_Check indicates the packages where any unknown attribute
-- produces an error. For other packages, an unknown attribute produces a
......@@ -57,5 +60,9 @@ package Prj.Pars is
--
-- When Reset_Tree is True, all the project data are removed from the
-- project table before processing.
--
-- In_Node_Tree (if given) must have been Initialized. The main reason to
-- pass an existing tree, is to pass the external references that will then
-- be used to process the tree.
end Prj.Pars;
......@@ -1041,7 +1041,8 @@ package body Prj.Proc is
end if;
end if;
Value := Prj.Ext.Value_Of (Name, Default);
Value := Prj.Ext.Value_Of
(From_Project_Node_Tree, Name, Default);
if Value = No_Name then
if not Quiet_Output then
......
......@@ -40,7 +40,7 @@ package Prj.Proc is
Flags : Prj.Processing_Flags;
Reset_Tree : Boolean := True);
-- Process a project tree (ie the direct resulting of parsing a .gpr file)
-- based on the current scenario variables.
-- based on the current external references.
--
-- The result of this phase_1 is a partial project tree (Project) where
-- only a few fields have been initialized (in particular the list of
......
......@@ -983,6 +983,10 @@ package body Prj.Tree is
begin
Project_Node_Table.Init (Tree.Project_Nodes);
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);
end Initialize;
----------
......
......@@ -1001,7 +1001,6 @@ package Prj.Tree is
package Tree_Private_Part is
-- This is conceptually in the private part
-- However, for efficiency, some packages are accessing it directly
type Project_Node_Record is record
......@@ -1371,9 +1370,23 @@ package Prj.Tree is
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 => "=");
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 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;
-- The data for a project node tree
......
......@@ -58,7 +58,7 @@ pragma Style_Checks ("M32766");
** s-oscons-tmpl.s.
**
** The default one assumes that the template can be compiled by the newly-
** build cross compiler. It uses markup produced in the (pseudo-)assembly
** built cross compiler. It uses markup produced in the (pseudo-)assembly
** listing:
**
** xgcc -DTARGET=\"$target\" -C -E s-oscons-tmplt.c > s-oscons-tmplt.i
......
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