diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-03-15 15:46:57 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-03-15 15:46:57 +0000 |
| commit | d1a942e47088eb7fd10091a7aeb366d852e7d406 (patch) | |
| tree | cf1142dd403f99e75300ca6822d5c4d182a98b74 /gcc | |
| parent | 6938bdf83f5ac8a41e29d9416c447095002970d1 (diff) | |
| download | gcc-d1a942e47088eb7fd10091a7aeb366d852e7d406.tar.gz | |
2005-03-08 Vincent Celier <celier@adacore.com>
* mlib-tgt-tru64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb,
mlib-tgt-hpux.adb, mlib-tgt-linux.adb, mlib-tgt-solaris.adb,
mlib-tgt-vms-alpha.adb, mlib-tgt-vms-ia64.adb, mlib-tgt-mingw.adb,
mlib-tgt-vxworks.adb, mlib-tgt-lynxos.adb (Library_Exist_For,
Library_File_Name_For): Add new parameter In_Tree
to specify the project tree: needed by the project manager.
Adapt to changes in project manager using new parameter In_Tree.
Remove local imports, use functions in System.CRTL.
* make.adb, clean.adb, gnatcmd.adb (Project_Tree): New constant needed
to use the project manager.
* makeutl.ads, makeutl.adb (Linker_Options_Switches): New parameter
In_Tree to designate the project tree. Adapt to changes in the project
manager, using In_Tree.
* mlib-prj.ads, mlib-prj.adb (Build_Library, Check_Library,
Copy_Interface_Sources): Add new parameter In_Tree to specify the
project tree: needed by the project manager.
(Build_Library): Check that Arg'Length >= 6 before checking if it
contains "--RTS=...".
* mlib-tgt.ads, mlib-tgt.adb (Library_Exist_For,
Library_File_Name_For): Add new parameter In_Tree to specify the
project tree: needed by the project manager.
* prj.ads, prj.adb: Major modifications to allow several project trees
in memory at the same time.
Change tables to dynamic tables and hash tables to dynamic hash
tables. Move tables and hash tables from Prj.Com (in the visible part)
and Prj.Env (in the private part). Move some constants from the visible
part to the private part. Make other constants deferred.
(Project_Empty): Make it a variable, not a function
(Empty_Project): Add parameter Tree. Returns the data with the default
naming data of the project tree Tree.
(Initialize): After updating Std_Naming_Data, copy its value to the
component Naming of Project Empty.
(Register_Default_Naming_Scheme): Use and update the default naming
component of the project tree, instead of the global variable
Std_Naming_Data.
(Standard_Naming_Data): Add defaulted parameter Tree. If project tree
Tree is not defaulted, return the default naming data of the Tree.
(Initial_Buffer_Size): Constant moved from private part
(Default_Ada_Spec_Suffix_Id, Default_Ada_Body_Suffix_Id, Slash_Id); new
variables initialized in procedure Initialize.
(Add_To_Buffer): Add two in out parameters to replace global variables
Buffer and Buffer_Last.
(Default_Ada_Spec_Suffix, Default_Body_Spec_Suffix, Slash): New
functions.
Adapt to changes to use new type Project_Tree_Ref and dynamic tables and
hash tables.
(Initialize, Reset, register-Default_Namng-Scheme): Add a new parameter
for the project tree.
(Project_Tree_Data, Project_Tree_Ref, No_Project): Declare types and
constant at the beginning of the package spec, so that they cane be used
in subprograms before their full declarations.
(Standard_Naming_Data): Add defaulted parameter of type Project_Node_Ref
(Empty_Project): Add parameter of type Project_Node_Ref
(Private_Project_Tree_Data): Add component Default_Naming of type
Naming_Data.
(Buffer, Buffer_Last): remove global variables
(Add_To_Buffer): Add two in out parameters to replace global variables
Buffer and Buffer_Last.
(Current_Packages_To_Check): Remove global variable
(Empty_Name): Move to private part
(No-Symbols): Make it a constant
(Private_Project_Tree_Data): New type for the private part of the
project tree data.
(Project_Tree_Data): New type for the data of a project tree
(Project_Tree_Ref): New type to designate a project tree
(Initialize, Reset, register-Default_Namng-Scheme): Add a new parameter
for the project tree.
* prj-attr.ads: Add with Table; needed, as package Prj no longer
imports package Table.
* prj-com.adb: Remove empty, no longer needed body
* prj-com.ads: Move most of the content of this package to package Prj.
* prj-dect.ads, prj-dect.adb (Parse): New parameters In_Tree to
designate the project node tree and Packages_To_Check to replace
global variable Current_Packages_To_Check.
Add new parameters In_Tree and Packages_To_Check to local subprograms,
when needed. Adapt to changes in project manager with project node tree
In_Tree.
* prj-env.ads, prj-env.adb: Add new parameter In_Tree to designate the
project tree to most subprograms. Move tables and hash tables to
private part of package Prj.
Adapt to changes in project manager using project tree In_Tree.
* prj-makr.adb (Tree): New constant to designate the project node tree
Adapt to change in project manager using project node tree Tree
* prj-nmsc.ads, prj-nmsc.adb (Check_Stand_Alone_Library): Correctly
display the Library_Src_Dir and the Library_Dir.
Add new parameter In_Tree to designate the project node tree to most
subprograms. Adapt to changes in the project manager, using project tree
In_Tree.
(Check_Naming_Scheme): Do not alter the casing on platforms where
the casing of file names is not significant.
(Check): Add new parameter In_Tree to designate the
* prj-pars.ads, prj-pars.adb (Parse): Add new parameter In_Tree to
designate the project tree.
Declare a project node tree to call Prj.Part.Parse and Prj.Proc.Process
* prj-part.ads, prj-part.adb (Buffer, Buffer_Last): Global variables,
to replace those that were in the private part of package Prj.
Add new parameter In__Tree to designate the project node tree to most
subprograms. Adapt to change in Prj.Tree with project node tree In_Tree.
(Post_Parse_Context_Clause): When specifying the project node of a with
clause, indicate that it is a limited with only if there is "limited"
in the with clause, not necessarily when In_Limited is True.
(Parse): Add new parameter In_Tree to designate the project node tree
* prj-pp.ads, prj-pp.adb (Pretty_Print): Add new parameter In_Tree to
designate the project node tree. Adapt to change in Prj.Tree with
project node tree In_Tree.
* prj-proc.ads, prj-proc.adb (Recursive_Process): Specify the project
tree In_Tree in the call to function Empty_Process to give its initial
value to the project data Processed_Data.
Add new parameters In_Tree to designate the project tree and
From_Project_Node_Tree to designate the project node tree to several
subprograms. Adapt to change in project manager with project tree
In_Tree and project node tree From_Project_Node_Tree.
* prj-strt.ads, prj-strt.adb (Buffer, Buffer_Last): Global variables,
to replace those that were in the private part of package Prj.
Add new parameter In_Tree to designate the project node tree to most
subprograms. Adapt to change in Prj.Tree with project node tree In_Tree.
* prj-tree.ads, prj-tree.adb: Add new parameter of type
Project_Node_Tree_Ref to most subprograms.
Use this new parameter to store project nodes in the designated project
node tree.
(Project_Node_Tree_Ref): New type to designate a project node tree
(Tree_Private_Part): Change table to dynamic table and hash tables to
dynamic hash tables.
* prj-util.ads, prj-util.adb: Add new parameter In_Tree to designate
the project tree to most subprograms. Adapt to changes in project
manager using project tree In_Tree.
* makegpr.adb (Project_Tree): New constant needed to use project
manager.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@96481 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
47 files changed, 5507 insertions, 3557 deletions
diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index c0f6e16ffd7..6a53dbae671 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -37,7 +37,6 @@ with Opt; use Opt; with Osint; use Osint; with Osint.M; use Osint.M; with Prj; use Prj; -with Prj.Com; with Prj.Env; with Prj.Ext; with Prj.Pars; @@ -92,6 +91,8 @@ package body Clean is Project_File_Name : String_Access := null; + Project_Tree : constant Prj.Project_Tree_Ref := new Prj.Project_Tree_Data; + Main_Project : Prj.Project_Id := Prj.No_Project; All_Projects : Boolean := False; @@ -328,7 +329,8 @@ package body Clean is procedure Clean_Archive (Project : Project_Id) is Current_Dir : constant Dir_Name_Str := Get_Current_Dir; - Data : constant Project_Data := Projects.Table (Project); + Data : constant Project_Data := + Project_Tree.Projects.Table (Project); Archive_Name : constant String := "lib" & Get_Name_String (Data.Name) & '.' & Archive_Ext; @@ -560,8 +562,9 @@ package body Clean is -- Name of the executable file Current_Dir : constant Dir_Name_Str := Get_Current_Dir; - Data : constant Project_Data := Projects.Table (Project); - U_Data : Prj.Com.Unit_Data; + Data : constant Project_Data := + Project_Tree.Projects.Table (Project); + U_Data : Unit_Data; File_Name1 : Name_Id; Index1 : Int; File_Name2 : Name_Id; @@ -573,8 +576,6 @@ package body Clean is Global_Archive : Boolean := False; - use Prj.Com; - begin -- Check that we don't specify executable on the command line for -- a main library project. @@ -612,8 +613,10 @@ package body Clean is -- sources or inherited sources of the project. if Data.Languages (Ada_Language_Index) then - for Unit in 1 .. Prj.Com.Units.Last loop - U_Data := Prj.Com.Units.Table (Unit); + for Unit in Unit_Table.First .. + Unit_Table.Last (Project_Tree.Units) + loop + U_Data := Project_Tree.Units.Table (Unit); File_Name1 := No_Name; File_Name2 := No_Name; @@ -749,8 +752,12 @@ package body Clean is if Project = Main_Project and then not Data.Library then Global_Archive := False; - for Proj in 1 .. Projects.Last loop - if Projects.Table (Proj).Other_Sources_Present then + for Proj in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop + if Project_Tree.Projects.Table + (Proj).Other_Sources_Present + then Global_Archive := True; exit; end if; @@ -769,7 +776,8 @@ package body Clean is Source_Id := Data.First_Other_Source; while Source_Id /= No_Other_Source loop - Source := Other_Sources.Table (Source_Id); + Source := + Project_Tree.Other_Sources.Table (Source_Id); if Is_Regular_File (Get_Name_String (Source.Object_Name)) @@ -839,7 +847,7 @@ package body Clean is -- has not been processed already. while Imported /= Empty_Project_List loop - Element := Project_Lists.Table (Imported); + Element := Project_Tree.Project_Lists.Table (Imported); Imported := Element.Next; Process := True; @@ -887,6 +895,7 @@ package body Clean is Executable := Executable_Of (Main_Project, + Project_Tree, Main_Source_File, Current_File_Index); @@ -1099,13 +1108,14 @@ package body Clean is -- Set the project parsing verbosity to whatever was specified -- by a possible -vP switch. - Prj.Pars.Set_Verbosity (To => Prj.Com.Current_Verbosity); + Prj.Pars.Set_Verbosity (To => Current_Verbosity); -- Parse the project file. If there is an error, Main_Project -- will still be No_Project. Prj.Pars.Parse (Project => Main_Project, + In_Tree => Project_Tree, Project_File_Name => Project_File_Name.all, Packages_To_Check => Packages_To_Check_By_Gnatmake); @@ -1121,12 +1131,10 @@ package body Clean is New_Line; end if; - -- We add the source directories and the object directories - -- to the search paths. - - Add_Source_Directories (Main_Project); - Add_Object_Directories (Main_Project); + -- Add source directories and object directories to the search paths + Add_Source_Directories (Main_Project, Project_Tree); + Add_Object_Directories (Main_Project, Project_Tree); end if; Osint.Add_Default_Search_Dirs; @@ -1137,11 +1145,12 @@ package body Clean is if Main_Project /= No_Project and then Osint.Number_Of_Files = 0 then declare - Value : String_List_Id := Projects.Table (Main_Project).Mains; + Value : String_List_Id := + Project_Tree.Projects.Table (Main_Project).Mains; Main : String_Element; begin while Value /= Prj.Nil_String loop - Main := String_Elements.Table (Value); + Main := Project_Tree.String_Elements.Table (Value); Osint.Add_File (File_Name => Get_Name_String (Main.Value), Index => Main.Index); @@ -1211,24 +1220,24 @@ package body Clean is return True; end if; - Data := Projects.Table (Of_Project); + Data := Project_Tree.Projects.Table (Of_Project); while Data.Extends /= No_Project loop if Data.Extends = Prj then return True; end if; - Data := Projects.Table (Data.Extends); + Data := Project_Tree.Projects.Table (Data.Extends); end loop; - Data := Projects.Table (Prj); + Data := Project_Tree.Projects.Table (Prj); while Data.Extends /= No_Project loop if Data.Extends = Of_Project then return True; end if; - Data := Projects.Table (Data.Extends); + Data := Project_Tree.Projects.Table (Data.Extends); end loop; return False; @@ -1258,7 +1267,7 @@ package body Clean is Csets.Initialize; Namet.Initialize; Snames.Initialize; - Prj.Initialize; + Prj.Initialize (Project_Tree); end if; -- Reset global variables @@ -1480,13 +1489,13 @@ package body Clean is Verbose_Mode := True; elsif Arg = "-vP0" then - Prj.Com.Current_Verbosity := Prj.Default; + Current_Verbosity := Prj.Default; elsif Arg = "-vP1" then - Prj.Com.Current_Verbosity := Prj.Medium; + Current_Verbosity := Prj.Medium; elsif Arg = "-vP2" then - Prj.Com.Current_Verbosity := Prj.High; + Current_Verbosity := Prj.High; else Bad_Argument; diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 0a836043071..31646586e59 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2005 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- -- @@ -34,7 +34,6 @@ with Opt; use Opt; with Osint; use Osint; with Output; with Prj; use Prj; -with Prj.Com; with Prj.Env; with Prj.Ext; use Prj.Ext; with Prj.Pars; @@ -57,6 +56,7 @@ with Table; with VMS_Conv; use VMS_Conv; procedure GNATCmd is + Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data; Project_File : String_Access; Project : Prj.Project_Id; Current_Verbosity : Prj.Verbosity := Prj.Default; @@ -244,7 +244,7 @@ procedure GNATCmd is procedure Check_Files is Add_Sources : Boolean := True; - Unit_Data : Prj.Com.Unit_Data; + Unit_Data : Prj.Unit_Data; Subunit : Boolean := False; begin @@ -263,11 +263,11 @@ procedure GNATCmd is if Add_Sources then declare Current_Last : constant Integer := Last_Switches.Last; - use Prj.Com; - begin - for Unit in 1 .. Prj.Com.Units.Last loop - Unit_Data := Prj.Com.Units.Table (Unit); + for Unit in Unit_Table.First .. + Unit_Table.Last (Project_Tree.Units) + loop + Unit_Data := Project_Tree.Units.Table (Unit); -- For gnatls, we only need to put the library units, -- body or spec, but not the subunits. @@ -338,7 +338,7 @@ procedure GNATCmd is -- For gnatpp and gnatmetric, put all sources -- of the project. - for Kind in Prj.Com.Spec_Or_Body loop + for Kind in Spec_Or_Body loop -- Put only sources that belong to the main -- project. @@ -430,7 +430,8 @@ procedure GNATCmd is elsif The_Command = Metric then declare - Data : Project_Data := Projects.Table (Root_Project); + Data : Project_Data := + Project_Tree.Projects.Table (Root_Project); begin while Data.Extends /= No_Project loop @@ -438,7 +439,7 @@ procedure GNATCmd is return True; end if; - Data := Projects.Table (Data.Extends); + Data := Project_Tree.Projects.Table (Data.Extends); end loop; end; end if; @@ -464,7 +465,7 @@ procedure GNATCmd is end if; end loop; - Get_Name_String (Projects.Table + Get_Name_String (Project_Tree.Projects.Table (Project).Exec_Directory); if Name_Buffer (Name_Len) /= Directory_Separator then @@ -487,8 +488,8 @@ procedure GNATCmd is function Configuration_Pragmas_File return Name_Id is begin Prj.Env.Create_Config_Pragmas_File - (Project, Project, Include_Config_Files => False); - return Projects.Table (Project).Config_File_Name; + (Project, Project, Project_Tree, Include_Config_Files => False); + return Project_Tree.Projects.Table (Project).Config_File_Name; end Configuration_Pragmas_File; ------------------------------ @@ -501,19 +502,25 @@ procedure GNATCmd is begin if not Keep_Temporary_Files then if Project /= No_Project then - for Prj in 1 .. Projects.Last loop - if Projects.Table (Prj).Config_File_Temp then + for Prj in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop + if + Project_Tree.Projects.Table (Prj).Config_File_Temp + then if Verbose_Mode then Output.Write_Str ("Deleting temp configuration file """); Output.Write_Str (Get_Name_String - (Projects.Table (Prj).Config_File_Name)); + (Project_Tree.Projects.Table + (Prj).Config_File_Name)); Output.Write_Line (""""); end if; Delete_File (Name => Get_Name_String - (Projects.Table (Prj).Config_File_Name), + (Project_Tree.Projects.Table + (Prj).Config_File_Name), Success => Success); end if; end loop; @@ -568,7 +575,7 @@ procedure GNATCmd is -- Check if there are library project files if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then - Set_Libraries (Project, There_Are_Libraries); + Set_Libraries (Project, Project_Tree, There_Are_Libraries); end if; -- If there are, add the necessary additional switches @@ -729,8 +736,8 @@ procedure GNATCmd is declare Dir : constant String := Get_Name_String - (Projects.Table (Prj). - Object_Directory); + (Project_Tree.Projects.Table + (Prj).Object_Directory); begin if Is_Regular_File (Dir & @@ -754,7 +761,8 @@ procedure GNATCmd is -- Go to the project being extended, -- if any. - Prj := Projects.Table (Prj).Extends; + Prj := + Project_Tree.Projects.Table (Prj).Extends; exit Project_Loop when Prj = No_Project; end loop Project_Loop; end if; @@ -811,7 +819,8 @@ procedure GNATCmd is Last_Switches.Table (Last_Switches.Last) := new String'("-o"); Get_Name_String - (Projects.Table (Project).Exec_Directory); + (Project_Tree.Projects.Table + (Project).Exec_Directory); Last_Switches.Increment_Last; Last_Switches.Table (Last_Switches.Last) := new String'(Name_Buffer (1 .. Name_Len) & @@ -839,7 +848,7 @@ procedure GNATCmd is begin -- Case of library project - if Projects.Table (Project).Library then + if Project_Tree.Projects.Table (Project).Library then There_Are_Libraries := True; -- Add the -L switch @@ -848,7 +857,8 @@ procedure GNATCmd is Last_Switches.Table (Last_Switches.Last) := new String'("-L" & Get_Name_String - (Projects.Table (Project).Library_Dir)); + (Project_Tree.Projects.Table + (Project).Library_Dir)); -- Add the -l switch @@ -856,18 +866,21 @@ procedure GNATCmd is Last_Switches.Table (Last_Switches.Last) := new String'("-l" & Get_Name_String - (Projects.Table (Project).Library_Name)); + (Project_Tree.Projects.Table + (Project).Library_Name)); -- Add the directory to table Library_Paths, to be processed later -- if library is not static and if Path_Option is not null. - if Projects.Table (Project).Library_Kind /= Static + if Project_Tree.Projects.Table (Project).Library_Kind /= + Static and then Path_Option /= null then Library_Paths.Increment_Last; Library_Paths.Table (Library_Paths.Last) := new String'(Get_Name_String - (Projects.Table (Project).Library_Dir)); + (Project_Tree.Projects.Table + (Project).Library_Dir)); end if; end if; end Set_Library_For; @@ -988,7 +1001,7 @@ begin Snames.Initialize; - Prj.Initialize; + Prj.Initialize (Project_Tree); Last_Switches.Init; Last_Switches.Set_Last (0); @@ -1297,6 +1310,7 @@ begin Prj.Pars.Parse (Project => Project, + In_Tree => Project_Tree, Project_File_Name => Project_File.all, Packages_To_Check => All_Packages); @@ -1531,6 +1545,7 @@ begin Prj.Pars.Parse (Project => Project, + In_Tree => Project_Tree, Project_File_Name => Project_File.all, Packages_To_Check => Packages_To_Check); @@ -1543,12 +1558,13 @@ begin declare Data : constant Prj.Project_Data := - Prj.Projects.Table (Project); + Project_Tree.Projects.Table (Project); Pkg : constant Prj.Package_Id := Prj.Util.Value_Of (Name => Tool_Package_Name, - In_Packages => Data.Decl.Packages); + In_Packages => Data.Decl.Packages, + In_Tree => Project_Tree); Element : Package_Element; @@ -1560,7 +1576,7 @@ begin begin if Pkg /= No_Package then - Element := Packages.Table (Pkg); + Element := Project_Tree.Packages.Table (Pkg); -- Packages Gnatls has a single attribute Switches, that is -- not an associative array. @@ -1569,7 +1585,8 @@ begin The_Switches := Prj.Util.Value_Of (Variable_Name => Snames.Name_Switches, - In_Variables => Element.Decl.Attributes); + In_Variables => Element.Decl.Attributes, + In_Tree => Project_Tree); -- Packages Binder (for gnatbind), Cross_Reference (for -- gnatxref), Linker (for gnatlink) Finder (for gnatfind), @@ -1584,12 +1601,14 @@ begin if The_Switches.Kind = Prj.Undefined then Default_Switches_Array := Prj.Util.Value_Of - (Name => Name_Default_Switches, - In_Arrays => Element.Decl.Arrays); + (Name => Name_Default_Switches, + In_Arrays => Element.Decl.Arrays, + In_Tree => Project_Tree); The_Switches := Prj.Util.Value_Of (Index => Name_Ada, Src_Index => 0, - In_Array => Default_Switches_Array); + In_Array => Default_Switches_Array, + In_Tree => Project_Tree); end if; end if; @@ -1616,7 +1635,8 @@ begin when Prj.List => Current := The_Switches.Values; while Current /= Prj.Nil_String loop - The_String := String_Elements.Table (Current); + The_String := Project_Tree.String_Elements. + Table (Current); declare Switch : constant String := @@ -1642,12 +1662,14 @@ begin then Change_Dir (Get_Name_String - (Projects.Table (Project).Object_Directory)); + (Project_Tree.Projects.Table + (Project).Object_Directory)); end if; -- Set up the env vars for project path files - Prj.Env.Set_Ada_Paths (Project, Including_Libraries => False); + Prj.Env.Set_Ada_Paths + (Project, Project_Tree, Including_Libraries => False); -- For gnatstub, gnatmetric, gnatpp and gnatelim, create -- a configuration pragmas file, if necessary. @@ -1714,7 +1736,8 @@ begin (Last_Switches.Table (J), Current_Work_Dir); end loop; - Get_Name_String (Projects.Table (Project).Directory); + Get_Name_String + (Project_Tree.Projects.Table (Project).Directory); declare Project_Dir : constant String := Name_Buffer (1 .. Name_Len); @@ -1729,7 +1752,7 @@ begin elsif The_Command = Stub then declare Data : constant Prj.Project_Data := - Prj.Projects.Table (Project); + Project_Tree.Projects.Table (Project); File_Index : Integer := 0; Dir_Index : Integer := 0; Last : constant Integer := Last_Switches.Last; @@ -1815,7 +1838,8 @@ begin First_Switches.Table (1) := new String'("-d=" & Get_Name_String - (Projects.Table (Project).Object_Directory)); + (Project_Tree.Projects.Table + (Project).Object_Directory)); end if; -- For gnat pretty and gnat metric, if no file has been put on the @@ -1890,12 +1914,12 @@ begin exception when Error_Exit => - Prj.Env.Delete_All_Path_Files; + Prj.Env.Delete_All_Path_Files (Project_Tree); Delete_Temp_Config_Files; Set_Exit_Status (Failure); when Normal_Exit => - Prj.Env.Delete_All_Path_Files; + Prj.Env.Delete_All_Path_Files (Project_Tree); Delete_Temp_Config_Files; -- Since GNATCmd is normally called from DCL (the VMS shell), diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index e799e05d8da..71f95c495ca 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -275,6 +275,8 @@ package body Make is Current_Verbosity : Prj.Verbosity := Prj.Default; -- Verbosity to parse the project files + Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data; + Main_Project : Prj.Project_Id := No_Project; -- The project id of the main project file, if any @@ -943,7 +945,8 @@ package body Make is (Source_File => Name_Find, Source_File_Name => File_Name, Source_Index => Index, - Naming => Projects.Table (Main_Project).Naming, + Naming => Project_Tree.Projects.Table + (Main_Project).Naming, In_Package => The_Package, Allow_ALI => Program = Binder or else Program = Linker); @@ -958,7 +961,8 @@ package body Make is Switch_List := Switches.Values; while Switch_List /= Nil_String loop - Element := String_Elements.Table (Switch_List); + Element := + Project_Tree.String_Elements.Table (Switch_List); Get_Name_String (Element.Value); if Name_Len > 0 then @@ -1073,7 +1077,9 @@ package body Make is if Project /= No_Project then Change_Dir - (Get_Name_String (Projects.Table (Project).Object_Directory)); + (Get_Name_String + (Project_Tree.Projects.Table + (Project).Object_Directory)); -- Otherwise, for sources outside of any project, set the working -- directory to the object directory of the main project. @@ -1081,7 +1087,8 @@ package body Make is elsif Main_Project /= No_Project then Change_Dir (Get_Name_String - (Projects.Table (Main_Project).Object_Directory)); + (Project_Tree.Projects.Table + (Main_Project).Object_Directory)); end if; end if; end Change_To_Object_Directory; @@ -1716,7 +1723,8 @@ package body Make is Get_Reference (Source_File_Name => Source_File_Name, Project => Arguments_Project, - Path => Arguments_Path_Name); + Path => Arguments_Path_Name, + In_Tree => Project_Tree); -- If the source is not a source of a project file, check if -- this is allowed. @@ -1736,14 +1744,15 @@ package body Make is -- We get the project directory for the relative path -- switches and arguments. - Data := Projects.Table (Arguments_Project); + Data := Project_Tree.Projects.Table (Arguments_Project); -- If the source is in an extended project, we go to -- the ultimate extending project. while Data.Extended_By /= No_Project loop Arguments_Project := Data.Extended_By; - Data := Projects.Table (Arguments_Project); + Data := + Project_Tree.Projects.Table (Arguments_Project); end loop; -- If building a dynamic or relocatable library, compile with @@ -1763,7 +1772,8 @@ package body Make is if Data.Dir_Path = null then Data.Dir_Path := new String'(Get_Name_String (Data.Display_Directory)); - Projects.Table (Arguments_Project) := Data; + Project_Tree.Projects.Table (Arguments_Project) := + Data; end if; -- We now look for package Compiler @@ -1772,7 +1782,8 @@ package body Make is Compiler_Package := Prj.Util.Value_Of (Name => Name_Compiler, - In_Packages => Data.Decl.Packages); + In_Packages => Data.Decl.Packages, + In_Tree => Project_Tree); if Compiler_Package /= No_Package then @@ -1804,7 +1815,8 @@ package body Make is begin while Current /= Nil_String loop - Element := String_Elements.Table (Current); + Element := Project_Tree.String_Elements. + Table (Current); Number := Number + 1; Current := Element.Next; end loop; @@ -1816,7 +1828,8 @@ package body Make is Current := Switches.Values; for Index in New_Args'Range loop - Element := String_Elements.Table (Current); + Element := Project_Tree.String_Elements. + Table (Current); Get_Name_String (Element.Value); New_Args (Index) := new String'(Name_Buffer (1 .. Name_Len)); @@ -2221,22 +2234,26 @@ package body Make is -- check for an eventual library project, and use the full path. if Arguments_Project /= No_Project then - if not Projects.Table (Arguments_Project).Externally_Built then - Prj.Env.Set_Ada_Paths (Arguments_Project, True); + if not Project_Tree.Projects.Table + (Arguments_Project).Externally_Built + then + Prj.Env.Set_Ada_Paths + (Arguments_Project, Project_Tree, True); if not Unique_Compile and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then declare The_Data : Project_Data := - Projects.Table (Arguments_Project); + Project_Tree.Projects.Table + (Arguments_Project); Prj : Project_Id := Arguments_Project; begin while The_Data.Extended_By /= No_Project loop Prj := The_Data.Extended_By; - The_Data := Projects.Table (Prj); + The_Data := Project_Tree.Projects.Table (Prj); end loop; if The_Data.Library @@ -2252,7 +2269,8 @@ package body Make is -- Now mark the project as processed - Projects.Table (Prj).Need_To_Build_Lib := True; + Project_Tree.Projects.Table + (Prj).Need_To_Build_Lib := True; end if; end; end if; @@ -3006,7 +3024,9 @@ package body Make is else declare Parent_Directory : constant String := - Get_Name_String (Projects.Table (Project).Directory); + Get_Name_String + (Project_Tree.Projects.Table + (Project).Directory); begin if Parent_Directory (Parent_Directory'Last) = @@ -3025,17 +3045,21 @@ package body Make is -- Start of processing for Configuration_Pragmas_Switch begin - Prj.Env.Create_Config_Pragmas_File (For_Project, Main_Project); + Prj.Env.Create_Config_Pragmas_File + (For_Project, Main_Project, Project_Tree); - if Projects.Table (For_Project).Config_File_Name /= No_Name then + if Project_Tree.Projects.Table + (For_Project).Config_File_Name /= No_Name + then Temporary_Config_File := - Projects.Table (For_Project).Config_File_Temp; + Project_Tree.Projects.Table (For_Project).Config_File_Temp; Last := 1; Result (1) := new String' ("-gnatec=" & Get_Name_String - (Projects.Table (For_Project).Config_File_Name)); + (Project_Tree.Projects.Table + (For_Project).Config_File_Name)); else Temporary_Config_File := False; @@ -3043,16 +3067,20 @@ package body Make is -- Check for attribute Builder'Global_Configuration_Pragmas - The_Packages := Projects.Table (Main_Project).Decl.Packages; + The_Packages := Project_Tree.Projects.Table + (Main_Project).Decl.Packages; Gnatmake := Prj.Util.Value_Of (Name => Name_Builder, - In_Packages => The_Packages); + In_Packages => The_Packages, + In_Tree => Project_Tree); if Gnatmake /= No_Package then Global_Attribute := Prj.Util.Value_Of (Variable_Name => Name_Global_Configuration_Pragmas, - In_Variables => Packages.Table (Gnatmake).Decl.Attributes); + In_Variables => Project_Tree.Packages.Table + (Gnatmake).Decl.Attributes, + In_Tree => Project_Tree); Global_Attribute_Present := Global_Attribute /= Nil_Variable_Value and then Get_Name_String (Global_Attribute.Value) /= ""; @@ -3076,16 +3104,20 @@ package body Make is -- Check for attribute Compiler'Local_Configuration_Pragmas - The_Packages := Projects.Table (For_Project).Decl.Packages; + The_Packages := + Project_Tree.Projects.Table (For_Project).Decl.Packages; Compiler := Prj.Util.Value_Of (Name => Name_Compiler, - In_Packages => The_Packages); + In_Packages => The_Packages, + In_Tree => Project_Tree); if Compiler /= No_Package then Local_Attribute := Prj.Util.Value_Of (Variable_Name => Name_Local_Configuration_Pragmas, - In_Variables => Packages.Table (Compiler).Decl.Attributes); + In_Variables => Project_Tree.Packages.Table + (Compiler).Decl.Attributes, + In_Tree => Project_Tree); Local_Attribute_Present := Local_Attribute /= Nil_Variable_Value and then Get_Name_String (Local_Attribute.Value) /= ""; @@ -3134,7 +3166,7 @@ package body Make is if Gnatmake_Called and not Debug.Debug_Flag_N then Delete_Mapping_Files; Delete_Temp_Config_Files; - Prj.Env.Delete_All_Path_Files; + Prj.Env.Delete_All_Path_Files (Project_Tree); end if; end Delete_All_Temp_Files; @@ -3167,18 +3199,24 @@ package body Make is Success : Boolean; begin if (not Debug.Debug_Flag_N) and Main_Project /= No_Project then - for Project in 1 .. Projects.Last loop - if Projects.Table (Project).Config_File_Temp then + for Project in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop + if + Project_Tree.Projects.Table (Project).Config_File_Temp + then if Verbose_Mode then Write_Str ("Deleting temp configuration file """); Write_Str (Get_Name_String - (Projects.Table (Project).Config_File_Name)); + (Project_Tree.Projects.Table + (Project).Config_File_Name)); Write_Line (""""); end if; Delete_File (Name => Get_Name_String - (Projects.Table (Project).Config_File_Name), + (Project_Tree.Projects.Table + (Project).Config_File_Name), Success => Success); -- Make sure that we don't have a config file for this @@ -3186,9 +3224,12 @@ package body Make is -- In this case, we will recreate another config file: -- we cannot reuse the one that we just deleted! - Projects.Table (Project).Config_Checked := False; - Projects.Table (Project).Config_File_Name := No_Name; - Projects.Table (Project).Config_File_Temp := False; + Project_Tree.Projects.Table (Project). + Config_Checked := False; + Project_Tree.Projects.Table (Project). + Config_File_Name := No_Name; + Project_Tree.Projects.Table (Project). + Config_File_Temp := False; end if; end loop; end if; @@ -3446,7 +3487,8 @@ package body Make is -- Get the project of the current main - Proj := Prj.Env.Project_Of (File_Name, Main_Project); + Proj := Prj.Env.Project_Of + (File_Name, Main_Project, Project_Tree); -- Fail if the current main is not a source of a -- project. @@ -3462,7 +3504,8 @@ package body Make is -- is the actual path of a source of a project. if Main /= File_Name then - Data := Projects.Table (Main_Project); + Data := + Project_Tree.Projects.Table (Main_Project); Real_Path := Locate_Regular_File @@ -3496,6 +3539,7 @@ package body Make is Prj.Env.File_Name_Of_Library_Unit_Body (Name => File_Name, Project => Main_Project, + In_Tree => Project_Tree, Main_Project_Only => False, Full_Path => True); Normed_Path : constant String := @@ -3542,7 +3586,7 @@ package body Make is ("""" & Main & """ is not a source of project " & Get_Name_String - (Projects.Table + (Project_Tree.Projects.Table (Real_Main_Project).Name)); end if; end if; @@ -3591,12 +3635,12 @@ package body Make is -- Traverse all units - for J in Prj.Com.Units.First .. Prj.Com.Units.Last loop + for J in Unit_Table.First .. + Unit_Table.Last (Project_Tree.Units) + loop declare - Unit : constant Prj.Com.Unit_Data := - Prj.Com.Units.Table (J); - use Prj.Com; - + Unit : constant Unit_Data := + Project_Tree.Units.Table (J); begin if Unit.Name /= No_Name then @@ -3650,9 +3694,11 @@ package body Make is if ALI_Name /= No_Name and then - Projects.Table (ALI_Project).Extended_By = No_Project + Project_Tree.Projects.Table + (ALI_Project).Extended_By = No_Project and then - Projects.Table (ALI_Project).Extends = No_Project + Project_Tree.Projects.Table + (ALI_Project).Extends = No_Project then -- First line is the unit name @@ -3691,8 +3737,8 @@ package body Make is Get_Name_String (ALI_Name); begin Get_Name_String - (Projects.Table (ALI_Project). - Object_Directory); + (Project_Tree.Projects.Table + (ALI_Project).Object_Directory); if Name_Buffer (Name_Len) /= Directory_Separator @@ -3792,7 +3838,7 @@ package body Make is -- And the project file cannot be a library project file - elsif Projects.Table (Main_Project).Library then + elsif Project_Tree.Projects.Table (Main_Project).Library then Make_Failed ("-B cannot be used for a library project file"); else @@ -3832,7 +3878,7 @@ package body Make is -- cannot be specified on the command line. if Osint.Number_Of_Files /= 0 then - if Projects.Table (Main_Project).Library + if Project_Tree.Projects.Table (Main_Project).Library and then not Unique_Compile and then ((not Make_Steps) or else Bind_Only or else Link_Only) then @@ -3859,7 +3905,8 @@ package body Make is end if; declare - Value : String_List_Id := Projects.Table (Main_Project).Mains; + Value : String_List_Id := + Project_Tree.Projects.Table (Main_Project).Mains; begin -- The attribute Main is an empty list or not specified, @@ -3868,7 +3915,8 @@ package body Make is if Value = Prj.Nil_String or else Unique_Compile then if (not Make_Steps) or else Compile_Only - or else not Projects.Table (Main_Project).Library + or else not Project_Tree.Projects.Table + (Main_Project).Library then -- First make sure that the binder and the linker -- will not be invoked. @@ -3900,11 +3948,13 @@ package body Make is declare Data : constant Project_Data := - Projects.Table (Main_Project); + Project_Tree.Projects.Table (Main_Project); Languages : constant Variable_Value := Prj.Util.Value_Of - (Name_Languages, Data.Decl.Attributes); + (Name_Languages, + Data.Decl.Attributes, + Project_Tree); Current : String_List_Id; Element : String_Element; @@ -3921,7 +3971,8 @@ package body Make is Look_For_Foreign : while Current /= Nil_String loop - Element := String_Elements.Table (Current); + Element := Project_Tree.String_Elements. + Table (Current); Get_Name_String (Element.Value); To_Lower (Name_Buffer (1 .. Name_Len)); @@ -3938,7 +3989,9 @@ package body Make is -- language, all the Ada mains. while Value /= Prj.Nil_String loop - Get_Name_String (String_Elements.Table (Value).Value); + Get_Name_String + (Project_Tree.String_Elements.Table + (Value).Value); -- To know if a main is an Ada main, get its project. -- It should be the project specified on the command @@ -3946,17 +3999,23 @@ package body Make is if (not Foreign_Language) or else Prj.Env.Project_Of - (Name_Buffer (1 .. Name_Len), Main_Project) = + (Name_Buffer (1 .. Name_Len), + Main_Project, + Project_Tree) = Main_Project then At_Least_One_Main := True; Osint.Add_File (Get_Name_String - (String_Elements.Table (Value).Value), - Index => String_Elements.Table (Value).Index); + (Project_Tree.String_Elements.Table + (Value).Value), + Index => + Project_Tree.String_Elements.Table + (Value).Index); end if; - Value := String_Elements.Table (Value).Next; + Value := Project_Tree.String_Elements.Table + (Value).Next; end loop; -- If we did not get any main, it means that all mains @@ -3984,7 +4043,8 @@ package body Make is end if; if Main_Project /= No_Project - and then Projects.Table (Main_Project).Externally_Built + and then Project_Tree.Projects.Table + (Main_Project).Externally_Built then Make_Failed ("nothing to do for a main project that is externally built"); @@ -3992,10 +4052,11 @@ package body Make is if Osint.Number_Of_Files = 0 then if Main_Project /= No_Project - and then Projects.Table (Main_Project).Library + and then Project_Tree.Projects.Table (Main_Project).Library then if Do_Bind_Step - and then not Projects.Table (Main_Project).Standalone_Library + and then not Project_Tree.Projects.Table + (Main_Project).Standalone_Library then Make_Failed ("only stand-alone libraries may be bound"); end if; @@ -4008,6 +4069,7 @@ package body Make is MLib.Prj.Build_Library (For_Project => Main_Project, + In_Tree => Project_Tree, Gnatbind => Gnatbind.all, Gnatbind_Path => Gnatbind_Path, Gcc => Gcc.all, @@ -4079,10 +4141,10 @@ package body Make is if Main_Project /= No_Project then - if Projects.Table (Main_Project).Object_Directory /= No_Name then - - -- Change the current directory to the object directory of - -- the main project. + if Project_Tree.Projects.Table + (Main_Project).Object_Directory /= No_Name + then + -- Change current directory to object directory of main project begin Project_Object_Directory := No_Project; @@ -4098,7 +4160,7 @@ package body Make is Parent : constant Dir_Name_Str := Dir_Name (Get_Name_String - (Projects.Table + (Project_Tree.Projects.Table (Main_Project).Object_Directory)); Dir : Dir_Type; @@ -4134,7 +4196,8 @@ package body Make is Make_Failed ("unable to change working directory to """, Get_Name_String - (Projects.Table (Main_Project).Object_Directory), + (Project_Tree.Projects.Table + (Main_Project).Object_Directory), """"); end; end if; @@ -4153,26 +4216,30 @@ package body Make is Prj.Env.File_Name_Of_Library_Unit_Body (Name => Main_Source_File_Name, Project => Main_Project, + In_Tree => Project_Tree, Main_Project_Only => not Unique_Compile); The_Packages : constant Package_Id := - Projects.Table (Main_Project).Decl.Packages; + Project_Tree.Projects.Table (Main_Project).Decl.Packages; Builder_Package : constant Prj.Package_Id := Prj.Util.Value_Of (Name => Name_Builder, - In_Packages => The_Packages); + In_Packages => The_Packages, + In_Tree => Project_Tree); Binder_Package : constant Prj.Package_Id := Prj.Util.Value_Of (Name => Name_Binder, - In_Packages => The_Packages); + In_Packages => The_Packages, + In_Tree => Project_Tree); Linker_Package : constant Prj.Package_Id := Prj.Util.Value_Of - (Name => Name_Linker, - In_Packages => The_Packages); + (Name => Name_Linker, + In_Packages => The_Packages, + In_Tree => Project_Tree); begin -- We fail if we cannot find the main source file @@ -4250,13 +4317,16 @@ package body Make is (Name => Name_Ada, Index => 0, Attribute_Or_Array_Name => Name_Default_Switches, - In_Package => Builder_Package); + In_Package => Builder_Package, + In_Tree => Project_Tree); Switches : constant Array_Element_Id := Prj.Util.Value_Of (Name => Name_Switches, In_Arrays => - Packages.Table (Builder_Package).Decl.Arrays); + Project_Tree.Packages.Table + (Builder_Package).Decl.Arrays, + In_Tree => Project_Tree); begin if Defaults /= Nil_Variable_Value then @@ -4359,30 +4429,41 @@ package body Make is if not Unique_Compile and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then - for Proj in Projects.First .. Projects.Last loop - if Projects.Table (Proj).Library then - Projects.Table (Proj).Need_To_Build_Lib := - (not MLib.Tgt.Library_Exists_For (Proj)) - and then (not Projects.Table (Proj).Externally_Built); - - if Projects.Table (Proj).Need_To_Build_Lib then - + for Proj in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop + if Project_Tree.Projects.Table (Proj).Library then + Project_Tree.Projects.Table + (Proj).Need_To_Build_Lib := + (not MLib.Tgt.Library_Exists_For (Proj, Project_Tree)) + and then (not Project_Tree.Projects.Table + (Proj).Externally_Built); + + if Project_Tree.Projects.Table + (Proj).Need_To_Build_Lib + then -- If there is no object directory, then it will be -- impossible to build the library. So fail immediately. - if Projects.Table (Proj).Object_Directory = No_Name then + if Project_Tree.Projects.Table + (Proj).Object_Directory = No_Name + then Make_Failed ("no object files to build library for project """, - Get_Name_String (Projects.Table (Proj).Name), + Get_Name_String + (Project_Tree.Projects.Table (Proj).Name), """"); - Projects.Table (Proj).Need_To_Build_Lib := False; + Project_Tree.Projects.Table + (Proj).Need_To_Build_Lib := False; else if Verbose_Mode then Write_Str ("Library file does not exist for project """); Write_Str - (Get_Name_String (Projects.Table (Proj).Name)); + (Get_Name_String + (Project_Tree.Projects.Table + (Proj).Name)); Write_Line (""""); end if; @@ -4416,8 +4497,9 @@ package body Make is end if; end loop; - Get_Name_String (Projects.Table - (Main_Project).Exec_Directory); + Get_Name_String + (Project_Tree.Projects.Table + (Main_Project).Exec_Directory); if Name_Buffer (Name_Len) /= Directory_Separator then Name_Len := Name_Len + 1; @@ -4445,7 +4527,8 @@ package body Make is declare Dir_Path : constant String_Access := new String'(Get_Name_String - (Projects.Table (Main_Project).Directory)); + (Project_Tree.Projects.Table + (Main_Project).Directory)); begin for J in 1 .. Binder_Switches.Last loop Test_If_Relative_Path @@ -4481,10 +4564,10 @@ package body Make is end; end if; - -- We now put in the Binder_Switches and Linker_Switches tables, - -- the binder and linker switches of the command line that have been - -- put in the Saved_ tables. If a project file was used, then the - -- command line switches will follow the project file switches. + -- We now put in the Binder_Switches and Linker_Switches tables, the + -- binder and linker switches of the command line that have been put in + -- the Saved_ tables. If a project file was used, then the command line + -- switches will follow the project file switches. for J in 1 .. Saved_Binder_Switches.Last loop Add_Switch @@ -4563,15 +4646,20 @@ package body Make is The_Mapping_File_Names := new Temp_File_Names - (No_Project .. Projects.Last, 1 .. Saved_Maximum_Processes); + (No_Project .. Project_Table.Last (Project_Tree.Projects), + 1 .. Saved_Maximum_Processes); Last_Mapping_File_Names := - new Indices'(No_Project .. Projects.Last => 0); + new Indices' + (No_Project .. Project_Table.Last (Project_Tree.Projects) + => 0); The_Free_Mapping_File_Indices := new Free_File_Indices - (No_Project .. Projects.Last, 1 .. Saved_Maximum_Processes); + (No_Project .. Project_Table.Last (Project_Tree.Projects), + 1 .. Saved_Maximum_Processes); Last_Free_Indices := - new Indices'(No_Project .. Projects.Last => 0); + new Indices'(No_Project .. Project_Table.Last + (Project_Tree.Projects) => 0); Bad_Compilation.Init; @@ -4632,8 +4720,9 @@ package body Make is -- executable "main.2" for a main subprogram -- "main.2.ada", when the body termination is ".2.ada". - Executable := Prj.Util.Executable_Of - (Main_Project, Main_Source_File, Main_Index); + Executable := + Prj.Util.Executable_Of + (Main_Project, Project_Tree, Main_Source_File, Main_Index); end if; end if; @@ -4653,7 +4742,7 @@ package body Make is end if; end loop; - Get_Name_String (Projects.Table + Get_Name_String (Project_Tree.Projects.Table (Main_Project).Exec_Directory); if @@ -4752,23 +4841,31 @@ package body Make is -- Put in Library_Projs table all library project -- file ids when the library need to be rebuilt. - for Proj1 in Projects.First .. Projects.Last loop - - if Projects.Table (Proj1).Standalone_Library then + for Proj1 in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop + if Project_Tree.Projects.Table + (Proj1).Standalone_Library + then There_Are_Stand_Alone_Libraries := True; end if; - if Projects.Table (Proj1).Library - and then not Projects.Table (Proj1).Need_To_Build_Lib - and then not Projects.Table (Proj1).Externally_Built + if Project_Tree.Projects.Table (Proj1).Library + and then not Project_Tree.Projects.Table + (Proj1).Need_To_Build_Lib + and then not Project_Tree.Projects.Table + (Proj1).Externally_Built then - MLib.Prj.Check_Library (Proj1); + MLib.Prj.Check_Library (Proj1, Project_Tree); end if; - if Projects.Table (Proj1).Need_To_Build_Lib then + if Project_Tree.Projects.Table + (Proj1).Need_To_Build_Lib + then Library_Projs.Increment_Last; Current := Library_Projs.Last; - Depth := Projects.Table (Proj1).Depth; + Depth := Project_Tree.Projects.Table + (Proj1).Depth; -- Put the projects in decreasing depth order, -- so that if libA depends on libB, libB is first @@ -4776,13 +4873,15 @@ package body Make is while Current > 1 loop Proj2 := Library_Projs.Table (Current - 1); - exit when Projects.Table (Proj2).Depth >= Depth; + exit when Project_Tree.Projects.Table + (Proj2).Depth >= Depth; Library_Projs.Table (Current) := Proj2; Current := Current - 1; end loop; Library_Projs.Table (Current) := Proj1; - Projects.Table (Proj1).Need_To_Build_Lib := False; + Project_Tree.Projects.Table + (Proj1).Need_To_Build_Lib := False; end if; end loop; end; @@ -4793,6 +4892,7 @@ package body Make is Library_Rebuilt := True; MLib.Prj.Build_Library (For_Project => Library_Projs.Table (J), + In_Tree => Project_Tree, Gnatbind => Gnatbind.all, Gnatbind_Path => Gnatbind_Path, Gcc => Gcc.all, @@ -4994,9 +5094,12 @@ package body Make is if Main_Project /= No_Project and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then - for Proj in Projects.First .. Projects.Last loop - if Projects.Table (Proj).Library and then - Projects.Table (Proj).Library_Kind /= Static + for Proj in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop + if Project_Tree.Projects.Table (Proj).Library + and then Project_Tree.Projects.Table + (Proj).Library_Kind /= Static then Shared_Libs := True; Bind_Shared := Shared_Switch'Access; @@ -5039,7 +5142,7 @@ package body Make is -- Put all the source directories in ADA_INCLUDE_PATH, -- and all the object directories in ADA_OBJECTS_PATH - Prj.Env.Set_Ada_Paths (Main_Project, False); + Prj.Env.Set_Ada_Paths (Main_Project, Project_Tree, False); -- If switch -C was specified, create a binder mapping file @@ -5103,14 +5206,18 @@ package body Make is if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then -- Check for library projects - for Proj1 in 1 .. Projects.Last loop + for Proj1 in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop if Proj1 /= Main_Project - and then Projects.Table (Proj1).Library + and then + Project_Tree.Projects.Table (Proj1).Library then -- Add this project to table Library_Projs There_Are_Libraries := True; - Depth := Projects.Table (Proj1).Depth; + Depth := + Project_Tree.Projects.Table (Proj1).Depth; Library_Projs.Increment_Last; Current := Library_Projs.Last; @@ -5119,7 +5226,8 @@ package body Make is while Current > 1 loop Proj2 := Library_Projs.Table (Current - 1); - exit when Projects.Table (Proj2).Depth <= Depth; + exit when Project_Tree.Projects.Table + (Proj2).Depth <= Depth; Library_Projs.Table (Current) := Proj2; Current := Current - 1; end loop; @@ -5129,14 +5237,16 @@ package body Make is -- If it is not a static library and path option -- is set, add it to the Library_Paths table. - if Projects.Table (Proj1).Library_Kind /= Static + if Project_Tree.Projects.Table + (Proj1).Library_Kind /= Static and then Path_Option /= null then Library_Paths.Increment_Last; Library_Paths.Table (Library_Paths.Last) := new String' (Get_Name_String - (Projects.Table (Proj1).Library_Dir)); + (Project_Tree.Projects.Table + (Proj1).Library_Dir)); end if; end if; end loop; @@ -5148,7 +5258,7 @@ package body Make is Linker_Switches.Table (Linker_Switches.Last) := new String'("-L" & Get_Name_String - (Projects.Table + (Project_Tree.Projects.Table (Library_Projs.Table (Index)). Library_Dir)); @@ -5158,7 +5268,7 @@ package body Make is Linker_Switches.Table (Linker_Switches.Last) := new String'("-l" & Get_Name_String - (Projects.Table + (Project_Tree.Projects.Table (Library_Projs.Table (Index)). Library_Name)); end loop; @@ -5233,15 +5343,15 @@ package body Make is -- Put the object directories in ADA_OBJECTS_PATH - Prj.Env.Set_Ada_Paths (Main_Project, False); + Prj.Env.Set_Ada_Paths (Main_Project, Project_Tree, False); -- Check for attributes Linker'Linker_Options in projects -- other than the main project declare Linker_Options : constant String_List := - Linker_Options_Switches (Main_Project); - + Linker_Options_Switches + (Main_Project, Project_Tree); begin for Option in Linker_Options'Range loop Linker_Switches.Increment_Last; @@ -5340,21 +5450,25 @@ package body Make is File_Name_Of_Library_Unit_Body (Name => Main_Source_File_Name, Project => Main_Project, + In_Tree => Project_Tree, Main_Project_Only => not Unique_Compile); The_Packages : constant Package_Id := - Projects.Table (Main_Project).Decl.Packages; + Project_Tree.Projects.Table + (Main_Project).Decl.Packages; Binder_Package : constant Prj.Package_Id := Prj.Util.Value_Of (Name => Name_Binder, - In_Packages => The_Packages); + In_Packages => The_Packages, + In_Tree => Project_Tree); Linker_Package : constant Prj.Package_Id := Prj.Util.Value_Of - (Name => Name_Linker, - In_Packages => The_Packages); + (Name => Name_Linker, + In_Packages => The_Packages, + In_Tree => Project_Tree); begin -- We fail if we cannot find the main source file @@ -5442,7 +5556,8 @@ package body Make is declare Dir_Path : constant String_Access := new String'(Get_Name_String - (Projects.Table (Main_Project).Directory)); + (Project_Tree.Projects.Table + (Main_Project).Directory)); begin for J in Last_Binder_Switch + 1 .. Binder_Switches.Last @@ -5516,7 +5631,7 @@ package body Make is if not Debug.Debug_Flag_N then Delete_Mapping_Files; - Prj.Env.Delete_All_Path_Files; + Prj.Env.Delete_All_Path_Files (Project_Tree); end if; Exit_Program (E_Success); @@ -5528,7 +5643,7 @@ package body Make is when Compilation_Failed => if not Debug.Debug_Flag_N then Delete_Mapping_Files; - Prj.Env.Delete_All_Path_Files; + Prj.Env.Delete_All_Path_Files (Project_Tree); end if; Exit_Program (E_Fatal); @@ -5605,7 +5720,7 @@ package body Make is if Project /= No_Project then Prj.Env.Create_Mapping_File - (Project, + (Project, Project_Tree, The_Mapping_File_Names (Project, Last_Mapping_File_Names (Project))); @@ -5669,7 +5784,7 @@ package body Make is Snames.Initialize; - Prj.Initialize; + Prj.Initialize (Project_Tree); Dependencies.Init; @@ -5789,6 +5904,7 @@ package body Make is Prj.Pars.Parse (Project => Main_Project, + In_Tree => Project_Tree, Project_File_Name => Project_File_Name.all, Packages_To_Check => Packages_To_Check_By_Gnatmake); @@ -5807,14 +5923,16 @@ package body Make is -- We add the source directories and the object directories -- to the search paths. - Add_Source_Directories (Main_Project); - Add_Object_Directories (Main_Project); + Add_Source_Directories (Main_Project, Project_Tree); + Add_Object_Directories (Main_Project, Project_Tree); -- Compute depth of each project - for Proj in 1 .. Projects.Last loop - Projects.Table (Proj).Seen := False; - Projects.Table (Proj).Depth := 0; + for Proj in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop + Project_Tree.Projects.Table (Proj).Seen := False; + Project_Tree.Projects.Table (Proj).Depth := 0; end loop; Recursive_Compute_Depth @@ -5860,11 +5978,12 @@ package body Make is Into_Q : Boolean) is Put_In_Q : Boolean := Into_Q; - Unit : Com.Unit_Data; + Unit : Unit_Data; Sfile : Name_Id; Extending : constant Boolean := - Projects.Table (The_Project).Extends /= No_Project; + Project_Tree.Projects.Table + (The_Project).Extends /= No_Project; function Check_Project (P : Project_Id) return Boolean; -- Returns True if P is The_Project or a project extended by @@ -5880,7 +5999,8 @@ package body Make is return True; elsif Extending then declare - Data : Project_Data := Projects.Table (The_Project); + Data : Project_Data := + Project_Tree.Projects.Table (The_Project); begin loop @@ -5888,7 +6008,7 @@ package body Make is return True; end if; - Data := Projects.Table (Data.Extends); + Data := Project_Tree.Projects.Table (Data.Extends); exit when Data.Extends = No_Project; end loop; end; @@ -5897,30 +6017,31 @@ package body Make is return False; end Check_Project; - -- Start of processing of Insert_Project_Sources + -- Start of processing for Insert_Project_Sources begin -- For all the sources in the project files, - for Id in Com.Units.First .. Com.Units.Last loop - Unit := Com.Units.Table (Id); + for Id in Unit_Table.First .. + Unit_Table.Last (Project_Tree.Units) + loop + Unit := Project_Tree.Units.Table (Id); Sfile := No_Name; -- If there is a source for the body, and the body has not been -- locally removed, - if Unit.File_Names (Com.Body_Part).Name /= No_Name - and then Unit.File_Names (Com.Body_Part).Path /= Slash + if Unit.File_Names (Body_Part).Name /= No_Name + and then Unit.File_Names (Body_Part).Path /= Slash then - -- And it is a source for the specified project - if Check_Project (Unit.File_Names (Com.Body_Part).Project) then + if Check_Project (Unit.File_Names (Body_Part).Project) then -- If we don't have a spec, we cannot consider the source -- if it is a subunit - if Unit.File_Names (Com.Specification).Name = No_Name then + if Unit.File_Names (Specification).Name = No_Name then declare Src_Ind : Source_File_Index; @@ -5937,7 +6058,7 @@ package body Make is begin Src_Ind := Sinput.P.Load_Project_File (Get_Name_String - (Unit.File_Names (Com.Body_Part).Path)); + (Unit.File_Names (Body_Part).Path)); -- If it is a subunit, discard it @@ -5945,24 +6066,24 @@ package body Make is Sfile := No_Name; else - Sfile := Unit.File_Names (Com.Body_Part).Name; + Sfile := Unit.File_Names (Body_Part).Name; end if; end; else - Sfile := Unit.File_Names (Com.Body_Part).Name; + Sfile := Unit.File_Names (Body_Part).Name; end if; end if; - elsif Unit.File_Names (Com.Specification).Name /= No_Name - and then Unit.File_Names (Com.Specification).Path /= Slash - and then Check_Project (Unit.File_Names (Com.Specification).Project) + elsif Unit.File_Names (Specification).Name /= No_Name + and then Unit.File_Names (Specification).Path /= Slash + and then Check_Project (Unit.File_Names (Specification).Project) then -- If there is no source for the body, but there is a source -- for the spec which has not been locally removed, then we take -- this one. - Sfile := Unit.File_Names (Com.Specification).Name; + Sfile := Unit.File_Names (Specification).Name; end if; -- If Put_In_Q is True, we insert into the Q @@ -6090,7 +6211,7 @@ package body Make is declare Source_File_Name : constant String := Get_Name_String (Source_File); - Saved_Verbosity : constant Verbosity := Prj.Com.Current_Verbosity; + Saved_Verbosity : constant Verbosity := Current_Verbosity; Project : Project_Id := No_Project; Path_Name : Name_Id := No_Name; Data : Project_Data; @@ -6100,13 +6221,14 @@ package body Make is -- the source. Call it with verbosity default to avoid verbose -- messages. - Prj.Com.Current_Verbosity := Default; + Current_Verbosity := Default; Prj.Env. Get_Reference (Source_File_Name => Source_File_Name, Project => Project, + In_Tree => Project_Tree, Path => Path_Name); - Prj.Com.Current_Verbosity := Saved_Verbosity; + Current_Verbosity := Saved_Verbosity; -- If this source is in a project, check that the ALI file is -- in its object directory. If it is not, return False, so that @@ -6116,9 +6238,10 @@ package body Make is -- the general case and return True at the end of the function. if Project /= No_Project - and then Projects.Table (Project).Extends /= No_Project + and then Project_Tree.Projects.Table + (Project).Extends /= No_Project then - Data := Projects.Table (Project); + Data := Project_Tree.Projects.Table (Project); declare Object_Directory : constant String := @@ -6328,26 +6451,26 @@ package body Make is -- been seen or if the depth is large enough. if Project = No_Project - or else Projects.Table (Project).Seen - or else Projects.Table (Project).Depth >= Depth + or else Project_Tree.Projects.Table (Project).Seen + or else Project_Tree.Projects.Table (Project).Depth >= Depth then return; end if; - Projects.Table (Project).Depth := Depth; + Project_Tree.Projects.Table (Project).Depth := Depth; -- Mark the project as Seen to avoid endless loop caused by limited -- withs. - Projects.Table (Project).Seen := True; + Project_Tree.Projects.Table (Project).Seen := True; - List := Projects.Table (Project).Imported_Projects; + List := Project_Tree.Projects.Table (Project).Imported_Projects; -- Visit each imported project while List /= Empty_Project_List loop - Proj := Project_Lists.Table (List).Project; - List := Project_Lists.Table (List).Next; + Proj := Project_Tree.Project_Lists.Table (List).Project; + List := Project_Tree.Project_Lists.Table (List).Next; Recursive_Compute_Depth (Project => Proj, Depth => Depth + 1); @@ -6356,12 +6479,12 @@ package body Make is -- Visit a project being extended, if any Recursive_Compute_Depth - (Project => Projects.Table (Project).Extends, + (Project => Project_Tree.Projects.Table (Project).Extends, Depth => Depth + 1); -- Reset the Seen flag, as we leave this project - Projects.Table (Project).Seen := False; + Project_Tree.Projects.Table (Project).Seen := False; end Recursive_Compute_Depth; ----------------------- @@ -6976,20 +7099,25 @@ package body Make is Prj.Util.Value_Of (Name => Name_Default_Switches, In_Arrays => - Packages.Table (In_Package).Decl.Arrays); + Project_Tree.Packages.Table + (In_Package).Decl.Arrays, + In_Tree => Project_Tree); Switches_Array : constant Array_Element_Id := Prj.Util.Value_Of (Name => Name_Switches, In_Arrays => - Packages.Table (In_Package).Decl.Arrays); + Project_Tree.Packages.Table + (In_Package).Decl.Arrays, + In_Tree => Project_Tree); begin Switches := Prj.Util.Value_Of (Index => Source_File, Src_Index => Source_Index, - In_Array => Switches_Array); + In_Array => Switches_Array, + In_Tree => Project_Tree); if Switches = Nil_Variable_Value then declare @@ -7028,7 +7156,8 @@ package body Make is Prj.Util.Value_Of (Index => Name_Find, Src_Index => 0, - In_Array => Switches_Array); + In_Array => Switches_Array, + In_Tree => Project_Tree); if Switches = Nil_Variable_Value and then Allow_ALI @@ -7046,7 +7175,8 @@ package body Make is Prj.Util.Value_Of (Index => Name_Find, Src_Index => 0, - In_Array => Switches_Array); + In_Array => Switches_Array, + In_Tree => Project_Tree); end if; end if; end; @@ -7057,7 +7187,8 @@ package body Make is Prj.Util.Value_Of (Index => Name_Ada, Src_Index => 0, - In_Array => Defaults); + In_Array => Defaults, + In_Tree => Project_Tree); end if; return Switches; diff --git a/gcc/ada/makegpr.adb b/gcc/ada/makegpr.adb index 28b46704463..3cc8ad5e173 100644 --- a/gcc/ada/makegpr.adb +++ b/gcc/ada/makegpr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2005 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- -- @@ -46,7 +46,6 @@ with Output; use Output; with Opt; use Opt; with Osint; use Osint; with Prj; use Prj; -with Prj.Com; use Prj.Com; with Prj.Pars; with Prj.Util; use Prj.Util; with Snames; use Snames; @@ -168,6 +167,8 @@ package body Makegpr is Packages_To_Check : constant String_List_Access := List_Of_Packages'Access; -- List of the packages to be checked when parsing/processing project files + Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data; + Main_Project : Project_Id; -- The project id of the main project @@ -617,7 +618,7 @@ package body Makegpr is -- Nothing to do when there is no project specified if Project /= No_Project then - Data := Projects.Table (Project); + Data := Project_Tree.Projects.Table (Project); -- Nothing to do if the project has already been processed @@ -625,7 +626,7 @@ package body Makegpr is -- Mark the project as processed, to avoid processing it again - Projects.Table (Project).Seen := True; + Project_Tree.Projects.Table (Project).Seen := True; Recursive_Add_Archives (Data.Extends); @@ -634,17 +635,22 @@ package body Makegpr is -- Call itself recursively for all imported projects while Imported /= Empty_Project_List loop - Prj := Project_Lists.Table (Imported).Project; + Prj := Project_Tree.Project_Lists.Table + (Imported).Project; if Prj /= No_Project then - while Projects.Table (Prj).Extended_By /= No_Project loop - Prj := Projects.Table (Prj).Extended_By; + while Project_Tree.Projects.Table + (Prj).Extended_By /= No_Project + loop + Prj := Project_Tree.Projects.Table + (Prj).Extended_By; end loop; Recursive_Add_Archives (Prj); end if; - Imported := Project_Lists.Table (Imported).Next; + Imported := Project_Tree.Project_Lists.Table + (Imported).Next; end loop; -- If there is sources of language other than Ada in this @@ -664,8 +670,10 @@ package body Makegpr is begin -- First, mark all projects as not processed - for Project in 1 .. Projects.Last loop - Projects.Table (Project).Seen := False; + for Project in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop + Project_Tree.Projects.Table (Project).Seen := False; end loop; -- Take care of the run path option @@ -939,10 +947,10 @@ package body Makegpr is raise Program_Error; when Linker => - Pkg := Value_Of (Name_Linker, Data.Decl.Packages); + Pkg := Value_Of (Name_Linker, Data.Decl.Packages, Project_Tree); when Compiler => - Pkg := Value_Of (Name_Compiler, Data.Decl.Packages); + Pkg := Value_Of (Name_Compiler, Data.Decl.Packages, Project_Tree); end case; if Pkg /= No_Package then @@ -950,24 +958,30 @@ package body Makegpr is Switches_Array := Prj.Util.Value_Of (Name => Name_Switches, - In_Arrays => Packages.Table (Pkg).Decl.Arrays); + In_Arrays => Project_Tree.Packages.Table + (Pkg).Decl.Arrays, + In_Tree => Project_Tree); Switches := Prj.Util.Value_Of (Index => File_Name, Src_Index => 0, - In_Array => Switches_Array); + In_Array => Switches_Array, + In_Tree => Project_Tree); -- Otherwise, get the Default_Switches ("language"), if they exist if Switches = Nil_Variable_Value then Defaults := Prj.Util.Value_Of (Name => Name_Default_Switches, - In_Arrays => Packages.Table (Pkg).Decl.Arrays); + In_Arrays => Project_Tree.Packages.Table + (Pkg).Decl.Arrays, + In_Tree => Project_Tree); Switches := Prj.Util.Value_Of (Index => Language_Names.Table (Language), Src_Index => 0, - In_Array => Defaults); + In_Array => Defaults, + In_Tree => Project_Tree); end if; -- If there are switches, add them to Arguments @@ -975,7 +989,8 @@ package body Makegpr is if Switches /= Nil_Variable_Value then Element_Id := Switches.Values; while Element_Id /= Nil_String loop - Element := String_Elements.Table (Element_Id); + Element := Project_Tree.String_Elements.Table + (Element_Id); if Element.Value /= No_Name then Get_Name_String (Element.Value); @@ -1003,7 +1018,8 @@ package body Makegpr is -------------------------- procedure Build_Global_Archive is - Data : Project_Data := Projects.Table (Main_Project); + Data : Project_Data := + Project_Tree.Projects.Table (Main_Project); Source_Id : Other_Source_Id; Source : Other_Source; Success : Boolean; @@ -1072,8 +1088,10 @@ package body Makegpr is -- Put all sources of language other than Ada in -- Source_Indexes. - for Proj in 1 .. Projects.Last loop - Data := Projects.Table (Proj); + for Proj in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop + Data := Project_Tree.Projects.Table (Proj); if not Data.Library then Last_Source := 0; @@ -1081,7 +1099,8 @@ package body Makegpr is while Source_Id /= No_Other_Source loop Add_Source_Id (Proj, Source_Id); - Source_Id := Other_Sources.Table (Source_Id).Next; + Source_Id := Project_Tree.Other_Sources.Table + (Source_Id).Next; end loop; end if; end loop; @@ -1100,7 +1119,8 @@ package body Makegpr is for S in 1 .. Last_Source loop Source_Id := Source_Indexes (S).Id; - Source := Other_Sources.Table (Source_Id); + Source := Project_Tree.Other_Sources.Table + (Source_Id); if (not Source_Indexes (S).Found) and then Source.Object_Path = Object_Path @@ -1219,14 +1239,17 @@ package body Makegpr is -- Followed by all the object files of the non library projects - for Proj in 1 .. Projects.Last loop - Data := Projects.Table (Proj); + for Proj in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop + Data := Project_Tree.Projects.Table (Proj); if not Data.Library then Source_Id := Data.First_Other_Source; while Source_Id /= No_Other_Source loop - Source := Other_Sources.Table (Source_Id); + Source := + Project_Tree.Other_Sources.Table (Source_Id); -- Only include object file name that have not been -- overriden in extending projects. @@ -1345,7 +1368,8 @@ package body Makegpr is ------------------- procedure Build_Library (Project : Project_Id; Unconditionally : Boolean) is - Data : constant Project_Data := Projects.Table (Project); + Data : constant Project_Data := + Project_Tree.Projects.Table (Project); Source_Id : Other_Source_Id; Source : Other_Source; @@ -1366,7 +1390,7 @@ package body Makegpr is Time_Stamp : Time_Stamp_Type; Driver_Name : Name_Id := No_Name; - Lib_Opts : Argument_List_Access := No_Argument'Unrestricted_Access; + Lib_Opts : Argument_List_Access := No_Argument'Access; begin Check_Archive_Builder; @@ -1414,7 +1438,8 @@ package body Makegpr is while Source_Id /= No_Other_Source loop Add_Source_Id (Project, Source_Id); - Source_Id := Other_Sources.Table (Source_Id).Next; + Source_Id := Project_Tree.Other_Sources.Table + (Source_Id).Next; end loop; -- Read the dependency file, line by line @@ -1430,16 +1455,17 @@ package body Makegpr is -- Check if this object file is for a source of this project for S in 1 .. Last_Source loop - if (not Source_Indexes (S).Found) and then - Other_Sources.Table - (Source_Indexes (S).Id).Object_Name = - Object_Name + if (not Source_Indexes (S).Found) + and then + Project_Tree.Other_Sources.Table + (Source_Indexes (S).Id).Object_Name = Object_Name then -- We have found the object file: get the source -- data, and mark it as found. Source_Id := Source_Indexes (S).Id; - Source := Other_Sources.Table (Source_Id); + Source := Project_Tree.Other_Sources.Table + (Source_Id); Source_Indexes (S).Found := True; exit; end if; @@ -1526,7 +1552,8 @@ package body Makegpr is if Verbose_Mode then Source_Id := Source_Indexes (Index).Id; - Source := Other_Sources.Table (Source_Id); + Source := Project_Tree.Other_Sources.Table + (Source_Id); Write_Str (" -> "); Write_Str (Get_Name_String (Source.Object_Name)); Write_Str (" is not in the archive "); @@ -1566,7 +1593,7 @@ package body Makegpr is Source_Id := Data.First_Other_Source; while Source_Id /= No_Other_Source loop - Source := Other_Sources.Table (Source_Id); + Source := Project_Tree.Other_Sources.Table (Source_Id); Add_Argument (Get_Name_String (Source.Object_Name), Verbose_Mode); Source_Id := Source.Next; @@ -1605,7 +1632,8 @@ package body Makegpr is Library_Options : constant Variable_Value := Value_Of (Name_Library_Options, - Data.Decl.Attributes); + Data.Decl.Attributes, + Project_Tree); begin if not Library_Options.Default then @@ -1615,7 +1643,8 @@ package body Makegpr is begin while Current /= Nil_String loop - Element := String_Elements.Table (Current); + Element := Project_Tree.String_Elements. + Table (Current); Get_Name_String (Element.Value); if Name_Len /= 0 then @@ -2034,9 +2063,12 @@ package body Makegpr is begin C_Plus_Plus_Is_Used := False; - for Project in 1 .. Projects.Last loop + for Project in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop if - Projects.Table (Project).Languages (C_Plus_Plus_Language_Index) + Project_Tree.Projects.Table (Project).Languages + (C_Plus_Plus_Language_Index) then C_Plus_Plus_Is_Used := True; exit; @@ -2053,7 +2085,8 @@ package body Makegpr is Data : in Project_Data; Local_Errors : in out Boolean) is - Source : Other_Source := Other_Sources.Table (Source_Id); + Source : Other_Source := + Project_Tree.Other_Sources.Table (Source_Id); Success : Boolean; CPATH : String_Access := null; @@ -2283,7 +2316,7 @@ package body Makegpr is else -- Everything looks fine, update the Other_Sources table - Other_Sources.Table (Source_Id) := Source; + Project_Tree.Other_Sources.Table (Source_Id) := Source; end if; -- Compilation failed @@ -2302,7 +2335,8 @@ package body Makegpr is -------------------------------- procedure Compile_Individual_Sources is - Data : Project_Data := Projects.Table (Main_Project); + Data : Project_Data := + Project_Tree.Projects.Table (Main_Project); Source_Id : Other_Source_Id; Source : Other_Source; Source_Name : Name_Id; @@ -2318,7 +2352,7 @@ package body Makegpr is Compile_Only := True; Get_Imported_Directories (Main_Project, Data); - Projects.Table (Main_Project) := Data; + Project_Tree.Projects.Table (Main_Project) := Data; -- Compilation will occur in the object directory @@ -2361,7 +2395,8 @@ package body Makegpr is Source_Id := Data.First_Other_Source; while Source_Id /= No_Other_Source loop - Source := Other_Sources.Table (Source_Id); + Source := + Project_Tree.Other_Sources.Table (Source_Id); exit when Source.File_Name = Source_Name; Source_Id := Source.Next; end loop; @@ -2406,7 +2441,8 @@ package body Makegpr is -------------------------------- procedure Compile_Link_With_Gnatmake (Mains_Specified : Boolean) is - Data : constant Project_Data := Projects.Table (Main_Project); + Data : constant Project_Data := + Project_Tree.Projects.Table (Main_Project); Success : Boolean; begin @@ -2571,9 +2607,11 @@ package body Makegpr is begin -- Loop through project files - for Project in 1 .. Projects.Last loop + for Project in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop Local_Errors := False; - Data := Projects.Table (Project); + Data := Project_Tree.Projects.Table (Project); -- Nothing to do when no sources of language other than Ada @@ -2584,7 +2622,7 @@ package body Makegpr is if not Data.Include_Data_Set then Get_Imported_Directories (Project, Data); Data.Include_Data_Set := True; - Projects.Table (Project) := Data; + Project_Tree.Projects.Table (Project) := Data; end if; Need_To_Rebuild_Archive := Force_Compilations; @@ -2598,7 +2636,7 @@ package body Makegpr is -- Process each source one by one while Source_Id /= No_Other_Source loop - Source := Other_Sources.Table (Source_Id); + Source := Project_Tree.Other_Sources.Table (Source_Id); Need_To_Compile := Force_Compilations; -- Check if compilation is needed @@ -2679,7 +2717,7 @@ package body Makegpr is Create (Dep_File, Append_File, Name); while Source_Id /= No_Other_Source loop - Source := Other_Sources.Table (Source_Id); + Source := Project_Tree.Other_Sources.Table (Source_Id); Put_Line (Dep_File, Get_Name_String (Source.Object_Name)); Put_Line (Dep_File, String (Source.Object_TS)); Source_Id := Source.Next; @@ -2713,12 +2751,15 @@ package body Makegpr is -- Get all the object files of non-Ada sources in non-library projects - for Project in 1 .. Projects.Last loop - if not Projects.Table (Project).Library then - Source_Id := Projects.Table (Project).First_Other_Source; + for Project in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop + if not Project_Tree.Projects.Table (Project).Library then + Source_Id := + Project_Tree.Projects.Table (Project).First_Other_Source; while Source_Id /= No_Other_Source loop - Source := Other_Sources.Table (Source_Id); + Source := Project_Tree.Other_Sources.Table (Source_Id); -- Put only those object files that are in the global archive @@ -2791,10 +2832,14 @@ package body Makegpr is ------------------ procedure Get_Compiler (For_Language : First_Language_Indexes) is - Data : constant Project_Data := Projects.Table (Main_Project); + Data : constant Project_Data := + Project_Tree.Projects.Table (Main_Project); Ide : constant Package_Id := - Value_Of (Name_Ide, In_Packages => Data.Decl.Packages); + Value_Of + (Name_Ide, + In_Packages => Data.Decl.Packages, + In_Tree => Project_Tree); -- The id of the package IDE in the project file Compiler : constant Variable_Value := @@ -2802,7 +2847,8 @@ package body Makegpr is (Name => Language_Names.Table (For_Language), Index => 0, Attribute_Or_Array_Name => Name_Compiler_Command, - In_Package => Ide); + In_Package => Ide, + In_Tree => Project_Tree); -- The value of Compiler_Command ("language") in package IDE, if defined begin @@ -2902,7 +2948,7 @@ package body Makegpr is -- Add each source directory path name, preceded by "-I" to Arguments while Element_Id /= Nil_String loop - Element := String_Elements.Table (Element_Id); + Element := Project_Tree.String_Elements.Table (Element_Id); if Element.Value /= No_Name then Get_Name_String (Element.Value); @@ -2960,7 +3006,7 @@ package body Makegpr is -- Nothing to do if project is undefined if Prj /= No_Project then - Data := Projects.Table (Prj); + Data := Project_Tree.Projects.Table (Prj); -- Nothing to do if project has already been processed @@ -2969,7 +3015,7 @@ package body Makegpr is -- Mark the project as processed, to avoid multiple processing -- of the same project. - Projects.Table (Prj).Seen := True; + Project_Tree.Projects.Table (Prj).Seen := True; -- Add the source directories of this project @@ -2984,8 +3030,11 @@ package body Makegpr is -- Call itself for all imported projects, if any while Imported /= Empty_Project_List loop - Recursive_Get_Dirs (Project_Lists.Table (Imported).Project); - Imported := Project_Lists.Table (Imported).Next; + Recursive_Get_Dirs + (Project_Tree.Project_Lists.Table + (Imported).Project); + Imported := + Project_Tree.Project_Lists.Table (Imported).Next; end loop; end if; end if; @@ -2996,8 +3045,10 @@ package body Makegpr is begin -- First, mark all project as not processed - for J in 1 .. Projects.Last loop - Projects.Table (J).Seen := False; + for J in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop + Project_Tree.Projects.Table (J).Seen := False; end loop; -- Empty Arguments @@ -3006,15 +3057,18 @@ package body Makegpr is -- Process this project individually, project data are already known - Projects.Table (Project).Seen := True; + Project_Tree.Projects.Table (Project).Seen := True; Add (Data.Source_Dirs); Recursive_Get_Dirs (Data.Extends); while Imported_Projects /= Empty_Project_List loop - Recursive_Get_Dirs (Project_Lists.Table (Imported_Projects).Project); - Imported_Projects := Project_Lists.Table (Imported_Projects).Next; + Recursive_Get_Dirs + (Project_Tree.Project_Lists.Table + (Imported_Projects).Project); + Imported_Projects := Project_Tree.Project_Lists.Table + (Imported_Projects).Next; end loop; Data.Imported_Directories_Switches := @@ -3059,6 +3113,7 @@ package body Makegpr is Prj.Pars.Parse (Project => Main_Project, + In_Tree => Project_Tree, Project_File_Name => Project_File_Name.all, Packages_To_Check => Packages_To_Check); @@ -3092,7 +3147,8 @@ package body Makegpr is else declare - Data : constant Prj.Project_Data := Projects.Table (Main_Project); + Data : constant Prj.Project_Data := + Project_Tree.Projects.Table (Main_Project); begin if Data.Library and then Mains.Number_Of_Mains /= 0 then Osint.Fail @@ -3143,7 +3199,7 @@ package body Makegpr is Csets.Initialize; Namet.Initialize; Snames.Initialize; - Prj.Initialize; + Prj.Initialize (Project_Tree); Mains.Delete; -- Set Name_Ide and Name_Compiler_Command @@ -3198,19 +3254,22 @@ package body Makegpr is (Object_Name : Name_Id; Project : Project_Id) return Boolean is - Data : Project_Data := Projects.Table (Project); + Data : Project_Data := Project_Tree.Projects.Table (Project); Source : Other_Source_Id; begin while Data.Extended_By /= No_Project loop - Data := Projects.Table (Data.Extended_By); - Source := Data.First_Other_Source; + Data := Project_Tree.Projects.Table (Data.Extended_By); + Source := Data.First_Other_Source; while Source /= No_Other_Source loop - if Other_Sources.Table (Source).Object_Name = Object_Name then + if Project_Tree.Other_Sources.Table (Source).Object_Name = + Object_Name + then return False; else - Source := Other_Sources.Table (Source).Next; + Source := + Project_Tree.Other_Sources.Table (Source).Next; end if; end loop; end loop; @@ -3223,7 +3282,8 @@ package body Makegpr is ---------------------- procedure Link_Executables is - Data : constant Project_Data := Projects.Table (Main_Project); + Data : constant Project_Data := + Project_Tree.Projects.Table (Main_Project); Mains_Specified : constant Boolean := Mains.Number_Of_Mains /= 0; -- True if main sources were specified on the command line @@ -3288,8 +3348,10 @@ package body Makegpr is Prj_Data : Project_Data; begin - for Prj in 1 .. Projects.Last loop - Prj_Data := Projects.Table (Prj); + for Prj in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop + Prj_Data := Project_Tree.Projects.Table (Prj); -- There is an archive only in project -- files with sources other than Ada @@ -3381,10 +3443,11 @@ package body Makegpr is Executable_Name : constant String := Get_Name_String (Executable_Of - (Project => Main_Project, - Main => Main_Id, - Index => 0, - Ada_Main => False)); + (Project => Main_Project, + In_Tree => Project_Tree, + Main => Main_Id, + Index => 0, + Ada_Main => False)); -- File name of the executable Executable_Path : constant String := @@ -3453,6 +3516,7 @@ package body Makegpr is Get_Name_String (Executable_Of (Project => Main_Project, + In_Tree => Project_Tree, Main => Main_Id, Index => 0, Ada_Main => False)), @@ -3484,7 +3548,7 @@ package body Makegpr is if Link_Options_Switches = null then Link_Options_Switches := new Argument_List' - (Linker_Options_Switches (Main_Project)); + (Linker_Options_Switches (Main_Project, Project_Tree)); end if; Add_Arguments (Link_Options_Switches.all, True); @@ -3532,7 +3596,8 @@ package body Makegpr is begin while Element_Id /= Nil_String loop - Element := String_Elements.Table (Element_Id); + Element := Project_Tree.String_Elements.Table + (Element_Id); if Element.Value /= No_Name then Mains.Add_Main (Get_Name_String (Element.Value)); @@ -3629,7 +3694,8 @@ package body Makegpr is -- Check if it is a source of a language other than Ada while Source_Id /= No_Other_Source loop - Source := Other_Sources.Table (Source_Id); + Source := + Project_Tree.Other_Sources.Table (Source_Id); exit when Source.File_Name = Main_Id; Source_Id := Source.Next; end loop; @@ -3674,6 +3740,7 @@ package body Makegpr is (Get_Name_String (Executable_Of (Project => Main_Project, + In_Tree => Project_Tree, Main => Other_Mains.Table (Main).File_Name, Index => 0, Ada_Main => False)), @@ -3774,7 +3841,8 @@ package body Makegpr is -- Check if it is a source of the main project file while Source_Id /= No_Other_Source loop - Source := Other_Sources.Table (Source_Id); + Source := + Project_Tree.Other_Sources.Table (Source_Id); exit when Source.File_Name = Main_Id; Source_Id := Source.Next; end loop; @@ -3815,6 +3883,7 @@ package body Makegpr is (Get_Name_String (Executable_Of (Project => Main_Project, + In_Tree => Project_Tree, Main => Main_Id, Index => 0, Ada_Main => False))); diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 926affc54c7..de81c52674b 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2005 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- -- @@ -185,7 +185,8 @@ package body Makeutl is ----------------------------- function Linker_Options_Switches - (Project : Project_Id) return String_List + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return String_List is procedure Recursive_Add_Linker_Options (Proj : Project_Id); -- The recursive routine used to add linker options @@ -202,29 +203,33 @@ package body Makeutl is begin if Proj /= No_Project then - Data := Projects.Table (Proj); + Data := In_Tree.Projects.Table (Proj); if not Data.Seen then - Projects.Table (Proj).Seen := True; + In_Tree.Projects.Table (Proj).Seen := True; Imported := Data.Imported_Projects; while Imported /= Empty_Project_List loop Recursive_Add_Linker_Options - (Project_Lists.Table (Imported).Project); - Imported := Project_Lists.Table (Imported).Next; + (In_Tree.Project_Lists.Table + (Imported).Project); + Imported := In_Tree.Project_Lists.Table + (Imported).Next; end loop; if Proj /= Project then Linker_Package := Prj.Util.Value_Of - (Name => Name_Linker, - In_Packages => Data.Decl.Packages); + (Name => Name_Linker, + In_Packages => Data.Decl.Packages, + In_Tree => In_Tree); Options := Prj.Util.Value_Of - (Name => Name_Ada, - Index => 0, + (Name => Name_Ada, + Index => 0, Attribute_Or_Array_Name => Name_Linker_Options, - In_Package => Linker_Package); + In_Package => Linker_Package, + In_Tree => In_Tree); -- If attribute is present, add the project with -- the attribute to table Linker_Opts. @@ -244,8 +249,10 @@ package body Makeutl is begin Linker_Opts.Init; - for Index in 1 .. Projects.Last loop - Projects.Table (Index).Seen := False; + for Index in Project_Table.First .. + Project_Table.Last (In_Tree.Projects) + loop + In_Tree.Projects.Table (Index).Seen := False; end loop; Recursive_Add_Linker_Options (Project); @@ -262,15 +269,19 @@ package body Makeutl is begin -- If Dir_Path has not been computed for this project, do it now - if Projects.Table (Proj).Dir_Path = null then - Projects.Table (Proj).Dir_Path := + if In_Tree.Projects.Table (Proj).Dir_Path = null then + In_Tree.Projects.Table (Proj).Dir_Path := new String' - (Get_Name_String (Projects.Table (Proj). Directory)); + (Get_Name_String + (In_Tree.Projects.Table + (Proj). Directory)); end if; while Options /= Nil_String loop - Option := String_Elements.Table (Options).Value; - Options := String_Elements.Table (Options).Next; + Option := + In_Tree.String_Elements.Table (Options).Value; + Options := + In_Tree.String_Elements.Table (Options).Next; Add_Linker_Option (Get_Name_String (Option)); -- Object files and -L switches specified with @@ -280,7 +291,8 @@ package body Makeutl is Test_If_Relative_Path (Switch => Linker_Options_Buffer (Last_Linker_Option), - Parent => Projects.Table (Proj).Dir_Path, + Parent => + In_Tree.Projects.Table (Proj).Dir_Path, Including_L_Switch => True); end loop; end; @@ -326,7 +338,7 @@ package body Makeutl is procedure Delete is begin Names.Set_Last (0); - Reset; + Mains.Reset; end Delete; --------------- diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index 0a3f11a0aaf..2053e3ea3ca 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2005 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- -- @@ -56,8 +56,13 @@ package Makeutl is -- been entered by a call to Prj.Ext.Add, so that in a project -- file, External ("name") will return "value". - function Linker_Options_Switches (Project : Project_Id) return String_List; - -- Comment required ??? + function Linker_Options_Switches + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return String_List; + -- Collect the options specified in the Linker'Linker_Options attributes + -- of project Project, in project tree In_Tree, and in the projects that + -- it imports directly or indirectly, and returns the result. + -- Package Mains is used to store the mains specified on the command line -- and to retrieve them when a project file is used, to verify that the diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 03ca2d0ee96..541f485665b 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -224,6 +224,7 @@ package body MLib.Prj is procedure Copy_Interface_Sources (For_Project : Project_Id; + In_Tree : Project_Tree_Ref; Interfaces : Argument_List; To_Dir : Name_Id); -- Copy the interface sources of a SAL to directory To_Dir @@ -294,6 +295,7 @@ package body MLib.Prj is procedure Build_Library (For_Project : Project_Id; + In_Tree : Project_Tree_Ref; Gnatbind : String; Gnatbind_Path : String_Access; Gcc : String; @@ -315,7 +317,7 @@ package body MLib.Prj is -- On OpenVMS, set to True if library needs to be linked with -- g-trasym.obj. - Data : Project_Data := Projects.Table (For_Project); + Data : Project_Data := In_Tree.Projects.Table (For_Project); Object_Directory_Path : constant String := Get_Name_String (Data.Object_Directory); @@ -484,15 +486,15 @@ package body MLib.Prj is elsif P /= No_Project then declare - Data : Project_Data := Projects.Table (For_Project); - + Data : Project_Data := + In_Tree.Projects.Table (For_Project); begin while Data.Extends /= No_Project loop if P = Data.Extends then return True; end if; - Data := Projects.Table (Data.Extends); + Data := In_Tree.Projects.Table (Data.Extends); end loop; end; end if; @@ -668,7 +670,8 @@ package body MLib.Prj is --------------------- procedure Process_Project (Project : Project_Id) is - Data : constant Project_Data := Projects.Table (Project); + Data : constant Project_Data := + In_Tree.Projects.Table (Project); Imported : Project_List := Data.Imported_Projects; Element : Project_Element; @@ -683,7 +686,8 @@ package body MLib.Prj is -- we have a proper reverse order for the libraries. while Imported /= Empty_Project_List loop - Element := Project_Lists.Table (Imported); + Element := + In_Tree.Project_Lists.Table (Imported); if Element.Project /= No_Project then Process_Project (Element.Project); @@ -718,7 +722,8 @@ package body MLib.Prj is for Index in reverse 1 .. Library_Projs.Last loop Current := Library_Projs.Table (Index); - Get_Name_String (Projects.Table (Current).Library_Dir); + Get_Name_String + (In_Tree.Projects.Table (Current).Library_Dir); Opts.Increment_Last; Opts.Table (Opts.Last) := new String'("-L" & Name_Buffer (1 .. Name_Len)); @@ -732,7 +737,8 @@ package body MLib.Prj is new String' ("-l" & Get_Name_String - (Projects.Table (Current).Library_Name)); + (In_Tree.Projects.Table + (Current).Library_Name)); end loop; end Process_Imported_Libraries; @@ -812,7 +818,8 @@ package body MLib.Prj is Binder_Package : constant Package_Id := Value_Of (Name => Name_Binder, - In_Packages => Data.Decl.Packages); + In_Packages => Data.Decl.Packages, + In_Tree => In_Tree); begin if Binder_Package /= No_Package then @@ -821,8 +828,9 @@ package body MLib.Prj is Value_Of (Name => Name_Default_Switches, In_Arrays => - Packages.Table - (Binder_Package).Decl.Arrays); + In_Tree.Packages.Table + (Binder_Package).Decl.Arrays, + In_Tree => In_Tree); Switches : Variable_Value := Nil_Variable_Value; Switch : String_List_Id := Nil_String; @@ -833,7 +841,8 @@ package body MLib.Prj is Value_Of (Index => Name_Ada, Src_Index => 0, - In_Array => Defaults); + In_Array => Defaults, + In_Tree => In_Tree); if not Switches.Default then Switch := Switches.Values; @@ -841,8 +850,10 @@ package body MLib.Prj is while Switch /= Nil_String loop Add_Argument (Get_Name_String - (String_Elements.Table (Switch).Value)); - Switch := String_Elements.Table (Switch).Next; + (In_Tree.String_Elements.Table + (Switch).Value)); + Switch := In_Tree.String_Elements. + Table (Switch).Next; end loop; end if; end if; @@ -862,8 +873,10 @@ package body MLib.Prj is Interface_ALIs.Reset; Processed_ALIs.Reset; - for Source in 1 .. Com.Units.Last loop - Unit := Com.Units.Table (Source); + for Source in Unit_Table.First .. + Unit_Table.Last (In_Tree.Units) + loop + Unit := In_Tree.Units.Table (Source); if Unit.File_Names (Body_Part).Name /= No_Name and then Unit.File_Names (Body_Part).Path /= Slash @@ -944,8 +957,8 @@ package body MLib.Prj is declare Arg : String_Ptr renames Args.Table (Index); begin - if - Arg (Arg'First + 2 .. Arg'First + 5) = "RTS=" + if Arg'Length >= 6 and then + Arg (Arg'First + 2 .. Arg'First + 5) = "RTS=" then Add_Argument (Arg.all); exit; @@ -959,7 +972,9 @@ package body MLib.Prj is -- Set the paths Set_Ada_Paths - (Project => For_Project, Including_Libraries => True); + (Project => For_Project, + In_Tree => In_Tree, + Including_Libraries => True); -- Display the gnatbind command, if not in quiet output @@ -982,7 +997,9 @@ package body MLib.Prj is -- Set the paths Set_Ada_Paths - (Project => For_Project, Including_Libraries => True); + (Project => For_Project, + In_Tree => In_Tree, + Including_Libraries => True); -- Invoke <gcc> -c b$$<lib>.adb @@ -1076,7 +1093,8 @@ package body MLib.Prj is if Link then -- If attribute Library_GCC was specified, get the driver name - Library_GCC := Value_Of (Name_Library_GCC, Data.Decl.Attributes); + Library_GCC := + Value_Of (Name_Library_GCC, Data.Decl.Attributes, In_Tree); if not Library_GCC.Default then Driver_Name := Library_GCC.Value; @@ -1086,7 +1104,7 @@ package body MLib.Prj is -- options. Library_Options := - Value_Of (Name_Library_Options, Data.Decl.Attributes); + Value_Of (Name_Library_Options, Data.Decl.Attributes, In_Tree); if not Library_Options.Default then declare @@ -1095,7 +1113,8 @@ package body MLib.Prj is begin while Current /= Nil_String loop - Element := String_Elements.Table (Current); + Element := + In_Tree.String_Elements.Table (Current); Get_Name_String (Element.Value); if Name_Len /= 0 then @@ -1240,7 +1259,7 @@ package body MLib.Prj is exit when Data.Extends = No_Project; In_Main_Object_Directory := False; - Data := Projects.Table (Data.Extends); + Data := In_Tree.Projects.Table (Data.Extends); end loop; -- Add the -L and -l switches for the imported Library Project Files, @@ -1416,7 +1435,7 @@ package body MLib.Prj is -- the library directory (by Copy_ALI_Files, below). if Standalone then - Data := Projects.Table (For_Project); + Data := In_Tree.Projects.Table (For_Project); declare Iface : String_List_Id := Data.Lib_Interface_ALIs; @@ -1424,11 +1443,14 @@ package body MLib.Prj is begin while Iface /= Nil_String loop - ALI := String_Elements.Table (Iface).Value; + ALI := + In_Tree.String_Elements.Table (Iface).Value; Interface_ALIs.Set (ALI, True); - Get_Name_String (String_Elements.Table (Iface).Value); + Get_Name_String + (In_Tree.String_Elements.Table (Iface).Value); Add_Argument (Name_Buffer (1 .. Name_Len)); - Iface := String_Elements.Table (Iface).Next; + Iface := + In_Tree.String_Elements.Table (Iface).Next; end loop; Iface := Data.Lib_Interface_ALIs; @@ -1440,9 +1462,11 @@ package body MLib.Prj is -- interface. If it is not the case, output a warning. while Iface /= Nil_String loop - ALI := String_Elements.Table (Iface).Value; + ALI := In_Tree.String_Elements.Table + (Iface).Value; Process (ALI); - Iface := String_Elements.Table (Iface).Next; + Iface := + In_Tree.String_Elements.Table (Iface).Next; end loop; end if; end; @@ -1453,7 +1477,8 @@ package body MLib.Prj is -- copy directory or because the interface copy directory is the -- same as the library directory. - Copy_Dir := Projects.Table (For_Project).Library_Dir; + Copy_Dir := + In_Tree.Projects.Table (For_Project).Library_Dir; Clean (Copy_Dir); -- Call procedure to build the library, depending on the build mode @@ -1502,21 +1527,26 @@ package body MLib.Prj is -- Copy interface sources if Library_Src_Dir specified if Standalone - and then Projects.Table (For_Project).Library_Src_Dir /= No_Name + and then In_Tree.Projects.Table + (For_Project).Library_Src_Dir /= No_Name then -- Clean the interface copy directory, if it is not also the -- library directory. If it is also the library directory, it -- has already been cleaned before generation of the library. - if Projects.Table (For_Project).Library_Src_Dir /= Copy_Dir then - Copy_Dir := Projects.Table (For_Project).Library_Src_Dir; + if In_Tree.Projects.Table + (For_Project).Library_Src_Dir /= Copy_Dir + then + Copy_Dir := In_Tree.Projects.Table + (For_Project).Library_Src_Dir; Clean (Copy_Dir); end if; Copy_Interface_Sources (For_Project => For_Project, - Interfaces => Arguments (1 .. Argument_Number), - To_Dir => Copy_Dir); + In_Tree => In_Tree, + Interfaces => Arguments (1 .. Argument_Number), + To_Dir => Copy_Dir); end if; end if; @@ -1553,8 +1583,11 @@ package body MLib.Prj is -- Check_Library -- ------------------- - procedure Check_Library (For_Project : Project_Id) is - Data : constant Project_Data := Projects.Table (For_Project); + procedure Check_Library + (For_Project : Project_Id; In_Tree : Project_Tree_Ref) + is + Data : constant Project_Data := + In_Tree.Projects.Table (For_Project); begin -- No need to build the library if there is no object directory, @@ -1566,7 +1599,8 @@ package body MLib.Prj is then declare Current : constant Dir_Name_Str := Get_Current_Dir; - Lib_Name : constant Name_Id := Library_File_Name_For (For_Project); + Lib_Name : constant Name_Id := + Library_File_Name_For (For_Project, In_Tree); Lib_TS : Time_Stamp_Type; Obj_TS : Time_Stamp_Type; @@ -1613,7 +1647,8 @@ package body MLib.Prj is -- Library must be rebuilt - Projects.Table (For_Project).Need_To_Build_Lib := True; + In_Tree.Projects.Table + (For_Project).Need_To_Build_Lib := True; exit; end if; end if; @@ -1682,6 +1717,7 @@ package body MLib.Prj is procedure Copy_Interface_Sources (For_Project : Project_Id; + In_Tree : Project_Tree_Ref; Interfaces : Argument_List; To_Dir : Name_Id) is @@ -1711,8 +1747,10 @@ package body MLib.Prj is begin Unit_Loop : - for Index in 1 .. Com.Units.Last loop - Data := Com.Units.Table (Index); + for Index in Unit_Table.First .. + Unit_Table.Last (In_Tree.Units) + loop + Data := In_Tree.Units.Table (Index); for J in Data.File_Names'Range loop if Data.File_Names (J).Project = For_Project @@ -1738,7 +1776,9 @@ package body MLib.Prj is -- Change the working directory to the object directory Change_Dir - (Get_Name_String (Projects.Table (For_Project).Object_Directory)); + (Get_Name_String + (In_Tree.Projects.Table + (For_Project).Object_Directory)); for Index in Interfaces'Range loop diff --git a/gcc/ada/mlib-prj.ads b/gcc/ada/mlib-prj.ads index 7f8ac59ec24..dac5df9cc06 100644 --- a/gcc/ada/mlib-prj.ads +++ b/gcc/ada/mlib-prj.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2003, Ada Core Technologies, Inc. -- +-- Copyright (C) 2001-2005, Ada Core Technologies, 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 @@ package MLib.Prj is procedure Build_Library (For_Project : Project_Id; + In_Tree : Project_Tree_Ref; Gnatbind : String; Gnatbind_Path : String_Access; Gcc : String; @@ -45,7 +46,8 @@ package MLib.Prj is -- files. If Bind is False the binding of a stand-alone library is skipped. -- If Link is False, the library is not linked/built. - procedure Check_Library (For_Project : Project_Id); + procedure Check_Library + (For_Project : Project_Id; In_Tree : Project_Tree_Ref); -- Check if the library of a library project needs to be rebuilt, -- because its time-stamp is earlier than the time stamp of one of its -- object files. diff --git a/gcc/ada/mlib-tgt-aix.adb b/gcc/ada/mlib-tgt-aix.adb index 004cab8b9ad..6c2d443b756 100644 --- a/gcc/ada/mlib-tgt-aix.adb +++ b/gcc/ada/mlib-tgt-aix.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2004, Ada Core Technologies, Inc. -- +-- Copyright (C) 2003-2005, Ada Core Technologies, 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- -- @@ -286,9 +286,11 @@ package body MLib.Tgt is -- Library_Exists_For -- ------------------------ - function Library_Exists_For (Project : Project_Id) return Boolean is + function Library_Exists_For + (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " & "for non library project"); return False; @@ -296,14 +298,17 @@ package body MLib.Tgt is else declare Lib_Dir : constant String := - Get_Name_String - (Projects.Table (Project).Library_Dir); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Dir); + Lib_Name : constant String := - Get_Name_String - (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then return Is_Regular_File (Lib_Dir & Directory_Separator & "lib" & Fil.Ext_To (Lib_Name, Archive_Ext)); @@ -321,9 +326,12 @@ package body MLib.Tgt is -- Library_File_Name_For -- --------------------------- - function Library_File_Name_For (Project : Project_Id) return Name_Id is + function Library_File_Name_For + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return Name_Id + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " & "for non library project"); return No_Name; @@ -331,13 +339,16 @@ package body MLib.Tgt is else declare Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin Name_Len := 3; Name_Buffer (1 .. Name_Len) := "lib"; - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext)); else @@ -382,7 +393,7 @@ package body MLib.Tgt is function Support_For_Libraries return Library_Support is begin - return Full; + return Static_Only; end Support_For_Libraries; end MLib.Tgt; diff --git a/gcc/ada/mlib-tgt-hpux.adb b/gcc/ada/mlib-tgt-hpux.adb index d10becf04cb..ce4b2615b42 100644 --- a/gcc/ada/mlib-tgt-hpux.adb +++ b/gcc/ada/mlib-tgt-hpux.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2004, Ada Core Technologies, Inc. -- +-- Copyright (C) 2003-2005, Ada Core Technologies, 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- -- @@ -269,9 +269,11 @@ package body MLib.Tgt is -- Library_Exists_For -- ------------------------ - function Library_Exists_For (Project : Project_Id) return Boolean is + function Library_Exists_For + (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " & "for non library project"); return False; @@ -279,12 +281,16 @@ package body MLib.Tgt is else declare Lib_Dir : constant String := - Get_Name_String (Projects.Table (Project).Library_Dir); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Dir); Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then return Is_Regular_File (Lib_Dir & Directory_Separator & "lib" & Fil.Ext_To (Lib_Name, Archive_Ext)); @@ -302,9 +308,12 @@ package body MLib.Tgt is -- Library_File_Name_For -- --------------------------- - function Library_File_Name_For (Project : Project_Id) return Name_Id is + function Library_File_Name_For + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return Name_Id + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " & "for non library project"); return No_Name; @@ -312,13 +321,16 @@ package body MLib.Tgt is else declare Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin Name_Len := 3; Name_Buffer (1 .. Name_Len) := "lib"; - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext)); else diff --git a/gcc/ada/mlib-tgt-irix.adb b/gcc/ada/mlib-tgt-irix.adb index eee46a1feba..b3b103e502d 100644 --- a/gcc/ada/mlib-tgt-irix.adb +++ b/gcc/ada/mlib-tgt-irix.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2004, Ada Core Technologies, Inc. -- +-- Copyright (C) 2003-2005, Ada Core Technologies, 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- -- @@ -309,9 +309,11 @@ package body MLib.Tgt is -- Library_Exists_For -- ------------------------ - function Library_Exists_For (Project : Project_Id) return Boolean is + function Library_Exists_For + (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " & "for non library project"); return False; @@ -319,12 +321,16 @@ package body MLib.Tgt is else declare Lib_Dir : constant String := - Get_Name_String (Projects.Table (Project).Library_Dir); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Dir); Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then return Is_Regular_File (Lib_Dir & Directory_Separator & "lib" & Fil.Ext_To (Lib_Name, Archive_Ext)); @@ -342,9 +348,12 @@ package body MLib.Tgt is -- Library_File_Name_For -- --------------------------- - function Library_File_Name_For (Project : Project_Id) return Name_Id is + function Library_File_Name_For + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return Name_Id + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " & "for non library project"); return No_Name; @@ -352,13 +361,16 @@ package body MLib.Tgt is else declare Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin Name_Len := 3; Name_Buffer (1 .. Name_Len) := "lib"; - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext)); else diff --git a/gcc/ada/mlib-tgt-linux.adb b/gcc/ada/mlib-tgt-linux.adb index 71584f26a3a..762d1362810 100644 --- a/gcc/ada/mlib-tgt-linux.adb +++ b/gcc/ada/mlib-tgt-linux.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005, 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- -- @@ -266,9 +266,11 @@ package body MLib.Tgt is -- Library_Exists_For -- ------------------------ - function Library_Exists_For (Project : Project_Id) return Boolean is + function Library_Exists_For + (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " & "for non library project"); return False; @@ -276,12 +278,16 @@ package body MLib.Tgt is else declare Lib_Dir : constant String := - Get_Name_String (Projects.Table (Project).Library_Dir); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Dir); Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then return Is_Regular_File (Lib_Dir & Directory_Separator & "lib" & Fil.Ext_To (Lib_Name, Archive_Ext)); @@ -299,9 +305,12 @@ package body MLib.Tgt is -- Library_File_Name_For -- --------------------------- - function Library_File_Name_For (Project : Project_Id) return Name_Id is + function Library_File_Name_For + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return Name_Id + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " & "for non library project"); return No_Name; @@ -309,13 +318,16 @@ package body MLib.Tgt is else declare Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin Name_Len := 3; Name_Buffer (1 .. Name_Len) := "lib"; - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext)); else diff --git a/gcc/ada/mlib-tgt-lynxos.adb b/gcc/ada/mlib-tgt-lynxos.adb index 0f1be1fe97f..4827e6a18bf 100644 --- a/gcc/ada/mlib-tgt-lynxos.adb +++ b/gcc/ada/mlib-tgt-lynxos.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2005 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- -- @@ -174,9 +174,11 @@ package body MLib.Tgt is -- Library_Exists_For -- ------------------------ - function Library_Exists_For (Project : Project_Id) return Boolean is + function Library_Exists_For + (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " & "for non library project"); return False; @@ -184,12 +186,16 @@ package body MLib.Tgt is else declare Lib_Dir : constant String := - Get_Name_String (Projects.Table (Project).Library_Dir); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Dir); Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then return Is_Regular_File (Lib_Dir & Directory_Separator & "lib" & Fil.Ext_To (Lib_Name, Archive_Ext)); @@ -207,9 +213,12 @@ package body MLib.Tgt is -- Library_File_Name_For -- --------------------------- - function Library_File_Name_For (Project : Project_Id) return Name_Id is + function Library_File_Name_For + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return Name_Id + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " & "for non library project"); return No_Name; @@ -217,13 +226,16 @@ package body MLib.Tgt is else declare Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin Name_Len := 3; Name_Buffer (1 .. Name_Len) := "lib"; - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext)); else diff --git a/gcc/ada/mlib-tgt-mingw.adb b/gcc/ada/mlib-tgt-mingw.adb index 140bbccff99..9bd970ba701 100644 --- a/gcc/ada/mlib-tgt-mingw.adb +++ b/gcc/ada/mlib-tgt-mingw.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2004, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2005, 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- -- @@ -194,9 +194,11 @@ package body MLib.Tgt is -- Library_Exists_For -- ------------------------ - function Library_Exists_For (Project : Project_Id) return Boolean is + function Library_Exists_For + (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " & "for non library project"); return False; @@ -204,14 +206,16 @@ package body MLib.Tgt is else declare Lib_Dir : constant String := - Get_Name_String - (Projects.Table (Project).Library_Dir); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Dir); Lib_Name : constant String := - Get_Name_String - (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then return Is_Regular_File (Lib_Dir & Directory_Separator & "lib" & MLib.Fil.Ext_To (Lib_Name, Archive_Ext)); @@ -229,9 +233,12 @@ package body MLib.Tgt is -- Library_File_Name_For -- --------------------------- - function Library_File_Name_For (Project : Project_Id) return Name_Id is + function Library_File_Name_For + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return Name_Id + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " & "for non library project"); return No_Name; @@ -239,10 +246,13 @@ package body MLib.Tgt is else declare Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then Name_Len := 3; Name_Buffer (1 .. Name_Len) := "lib"; Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext)); diff --git a/gcc/ada/mlib-tgt-solaris.adb b/gcc/ada/mlib-tgt-solaris.adb index 7f588dd8b6a..dd942b74e94 100644 --- a/gcc/ada/mlib-tgt-solaris.adb +++ b/gcc/ada/mlib-tgt-solaris.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2005 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- -- @@ -263,9 +263,11 @@ package body MLib.Tgt is -- Library_Exists_For -- ------------------------ - function Library_Exists_For (Project : Project_Id) return Boolean is + function Library_Exists_For + (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " & "for non library project"); return False; @@ -273,12 +275,16 @@ package body MLib.Tgt is else declare Lib_Dir : constant String := - Get_Name_String (Projects.Table (Project).Library_Dir); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Dir); Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then return Is_Regular_File (Lib_Dir & Directory_Separator & "lib" & Fil.Ext_To (Lib_Name, Archive_Ext)); @@ -296,9 +302,12 @@ package body MLib.Tgt is -- Library_File_Name_For -- --------------------------- - function Library_File_Name_For (Project : Project_Id) return Name_Id is + function Library_File_Name_For + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return Name_Id + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " & "for non library project"); return No_Name; @@ -306,13 +315,16 @@ package body MLib.Tgt is else declare Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin Name_Len := 3; Name_Buffer (1 .. Name_Len) := "lib"; - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext)); else diff --git a/gcc/ada/mlib-tgt-tru64.adb b/gcc/ada/mlib-tgt-tru64.adb index 37f961ad485..699f022c504 100644 --- a/gcc/ada/mlib-tgt-tru64.adb +++ b/gcc/ada/mlib-tgt-tru64.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2005 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- -- @@ -280,9 +280,11 @@ package body MLib.Tgt is -- Library_Exists_For -- ------------------------ - function Library_Exists_For (Project : Project_Id) return Boolean is + function Library_Exists_For + (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " & "for non library project"); return False; @@ -290,12 +292,16 @@ package body MLib.Tgt is else declare Lib_Dir : constant String := - Get_Name_String (Projects.Table (Project).Library_Dir); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Dir); Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then return Is_Regular_File (Lib_Dir & Directory_Separator & "lib" & Fil.Ext_To (Lib_Name, Archive_Ext)); @@ -313,9 +319,12 @@ package body MLib.Tgt is -- Library_File_Name_For -- --------------------------- - function Library_File_Name_For (Project : Project_Id) return Name_Id is + function Library_File_Name_For + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return Name_Id + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " & "for non library project"); return No_Name; @@ -323,13 +332,16 @@ package body MLib.Tgt is else declare Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin Name_Len := 3; Name_Buffer (1 .. Name_Len) := "lib"; - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext)); else diff --git a/gcc/ada/mlib-tgt-vms-alpha.adb b/gcc/ada/mlib-tgt-vms-alpha.adb index bf96371c515..ca7596b22f9 100644 --- a/gcc/ada/mlib-tgt-vms-alpha.adb +++ b/gcc/ada/mlib-tgt-vms-alpha.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2004, Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2005, 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,17 +29,19 @@ with Ada.Characters.Handling; use Ada.Characters.Handling; -with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with GNAT.OS_Lib; use GNAT.OS_Lib; +with GNAT.Directory_Operations; use GNAT.Directory_Operations; +with GNAT.OS_Lib; use GNAT.OS_Lib; with MLib.Fil; with MLib.Utl; -with Namet; use Namet; -with Opt; use Opt; -with Output; use Output; +with Namet; use Namet; +with Opt; use Opt; +with Output; use Output; with Prj.Com; -with System; use System; -with System.Case_Util; use System.Case_Util; + +with System; use System; +with System.Case_Util; use System.Case_Util; +with System.CRTL; use System.CRTL; package body MLib.Tgt is @@ -50,7 +52,7 @@ package body MLib.Tgt is -- Used to add the generated auto-init object files for auto-initializing -- stand-alone libraries. - Macro_Name : constant String := "mcr gnu:[bin]gcc -c -x assembler"; + Macro_Name : constant String := "mcr gnu:[bin]gcc -c -x assembler"; -- The name of the command to invoke the macro-assembler VMS_Options : Argument_List := (1 .. 1 => null); @@ -72,16 +74,6 @@ package body MLib.Tgt is Link_With_Shared_Libgcc : Argument_List_Access := No_Shared_Libgcc_Switch'Access; - ------------------------------ - -- Target dependent section -- - ------------------------------ - - function Popen (Command, Mode : System.Address) return System.Address; - pragma Import (C, Popen); - - function Pclose (File : System.Address) return Integer; - pragma Import (C, Pclose); - --------------------- -- Archive_Builder -- --------------------- @@ -302,12 +294,12 @@ package body MLib.Tgt is Len : Natural; OK : Boolean := True; - Command : constant String := + command : constant String := Macro_Name & " " & Macro_File_Name & ASCII.NUL; -- The command to invoke the assembler on the generated auto-init -- assembly file. - Mode : constant String := "r" & ASCII.NUL; + mode : constant String := "r" & ASCII.NUL; -- The mode for the invocation of Popen begin @@ -365,8 +357,8 @@ package body MLib.Tgt is Write_Line (""""); end if; - Popen_Result := Popen (Command (Command'First)'Address, - Mode (Mode'First)'Address); + Popen_Result := popen (command (command'First)'Address, + mode (mode'First)'Address); if Popen_Result = Null_Address then Fail ("assembly of auto-init assembly file """, @@ -375,7 +367,7 @@ package body MLib.Tgt is -- Wait for the end of execution of the macro-assembler - Pclose_Result := Pclose (Popen_Result); + Pclose_Result := pclose (Popen_Result); if Pclose_Result < 0 then Fail ("assembly of auto init assembly file """, @@ -604,9 +596,11 @@ package body MLib.Tgt is -- Library_Exists_For -- ------------------------ - function Library_Exists_For (Project : Project_Id) return Boolean is + function Library_Exists_For + (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Fail ("INTERNAL ERROR: Library_Exists_For called " & "for non library project"); return False; @@ -614,12 +608,16 @@ package body MLib.Tgt is else declare Lib_Dir : constant String := - Get_Name_String (Projects.Table (Project).Library_Dir); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Dir); Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then return Is_Regular_File (Lib_Dir & Directory_Separator & "lib" & Fil.Ext_To (Lib_Name, Archive_Ext)); @@ -637,9 +635,12 @@ package body MLib.Tgt is -- Library_File_Name_For -- --------------------------- - function Library_File_Name_For (Project : Project_Id) return Name_Id is + function Library_File_Name_For + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return Name_Id + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " & "for non library project"); return No_Name; @@ -647,13 +648,16 @@ package body MLib.Tgt is else declare Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin Name_Len := 3; Name_Buffer (1 .. Name_Len) := "lib"; - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext)); else diff --git a/gcc/ada/mlib-tgt-vms-ia64.adb b/gcc/ada/mlib-tgt-vms-ia64.adb index e921566473c..d3fba7e708f 100644 --- a/gcc/ada/mlib-tgt-vms-ia64.adb +++ b/gcc/ada/mlib-tgt-vms-ia64.adb @@ -29,17 +29,19 @@ with Ada.Characters.Handling; use Ada.Characters.Handling; -with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with GNAT.OS_Lib; use GNAT.OS_Lib; +with GNAT.Directory_Operations; use GNAT.Directory_Operations; +with GNAT.OS_Lib; use GNAT.OS_Lib; with MLib.Fil; with MLib.Utl; -with Namet; use Namet; -with Opt; use Opt; -with Output; use Output; +with Namet; use Namet; +with Opt; use Opt; +with Output; use Output; with Prj.Com; -with System; use System; -with System.Case_Util; use System.Case_Util; + +with System; use System; +with System.Case_Util; use System.Case_Util; +with System.CRTL; use System.CRTL; package body MLib.Tgt is @@ -72,16 +74,6 @@ package body MLib.Tgt is Link_With_Shared_Libgcc : Argument_List_Access := No_Shared_Libgcc_Switch'Access; - ------------------------------ - -- Target dependent section -- - ------------------------------ - - function Popen (Command, Mode : System.Address) return System.Address; - pragma Import (C, Popen, "decc$popen"); - - function Pclose (File : System.Address) return Integer; - pragma Import (C, Pclose, "decc$pclose"); - --------------------- -- Archive_Builder -- --------------------- @@ -300,12 +292,12 @@ package body MLib.Tgt is Len : Natural; OK : Boolean := True; - Command : constant String := + command : constant String := Macro_Name & " " & Macro_File_Name & ASCII.NUL; -- The command to invoke the assembler on the generated auto-init -- assembly file. - Mode : constant String := "r" & ASCII.NUL; + mode : constant String := "r" & ASCII.NUL; -- The mode for the invocation of Popen begin @@ -398,8 +390,8 @@ package body MLib.Tgt is Write_Line (""""); end if; - Popen_Result := Popen (Command (Command'First)'Address, - Mode (Mode'First)'Address); + Popen_Result := popen (command (command'First)'Address, + mode (mode'First)'Address); if Popen_Result = Null_Address then Fail ("assembly of auto-init assembly file """, @@ -408,7 +400,7 @@ package body MLib.Tgt is -- Wait for the end of execution of the macro-assembler - Pclose_Result := Pclose (Popen_Result); + Pclose_Result := pclose (Popen_Result); if Pclose_Result < 0 then Fail ("assembly of auto init assembly file """, @@ -637,9 +629,11 @@ package body MLib.Tgt is -- Library_Exists_For -- ------------------------ - function Library_Exists_For (Project : Project_Id) return Boolean is + function Library_Exists_For + (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Fail ("INTERNAL ERROR: Library_Exists_For called " & "for non library project"); return False; @@ -647,12 +641,16 @@ package body MLib.Tgt is else declare Lib_Dir : constant String := - Get_Name_String (Projects.Table (Project).Library_Dir); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Dir); Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then return Is_Regular_File (Lib_Dir & Directory_Separator & "lib" & Fil.Ext_To (Lib_Name, Archive_Ext)); @@ -670,9 +668,12 @@ package body MLib.Tgt is -- Library_File_Name_For -- --------------------------- - function Library_File_Name_For (Project : Project_Id) return Name_Id is + function Library_File_Name_For + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return Name_Id + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " & "for non library project"); return No_Name; @@ -680,13 +681,15 @@ package body MLib.Tgt is else declare Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin Name_Len := 3; Name_Buffer (1 .. Name_Len) := "lib"; - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static then Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext)); else diff --git a/gcc/ada/mlib-tgt-vxworks.adb b/gcc/ada/mlib-tgt-vxworks.adb index 51b911afde5..21c47995640 100644 --- a/gcc/ada/mlib-tgt-vxworks.adb +++ b/gcc/ada/mlib-tgt-vxworks.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2005 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- -- @@ -215,9 +215,11 @@ package body MLib.Tgt is -- Library_Exists_For -- ------------------------ - function Library_Exists_For (Project : Project_Id) return Boolean is + function Library_Exists_For + (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " & "for non library project"); return False; @@ -225,12 +227,16 @@ package body MLib.Tgt is else declare Lib_Dir : constant String := - Get_Name_String (Projects.Table (Project).Library_Dir); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Dir); Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then return Is_Regular_File (Lib_Dir & Directory_Separator & "lib" & Fil.Ext_To (Lib_Name, Archive_Ext)); @@ -248,9 +254,12 @@ package body MLib.Tgt is -- Library_File_Name_For -- --------------------------- - function Library_File_Name_For (Project : Project_Id) return Name_Id is + function Library_File_Name_For + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return Name_Id + is begin - if not Projects.Table (Project).Library then + if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " & "for non library project"); return No_Name; @@ -258,13 +267,16 @@ package body MLib.Tgt is else declare Lib_Name : constant String := - Get_Name_String (Projects.Table (Project).Library_Name); + Get_Name_String + (In_Tree.Projects.Table (Project).Library_Name); begin Name_Len := 3; Name_Buffer (1 .. Name_Len) := "lib"; - if Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext)); else diff --git a/gcc/ada/mlib-tgt.adb b/gcc/ada/mlib-tgt.adb index 267177ba91c..0f278105e13 100644 --- a/gcc/ada/mlib-tgt.adb +++ b/gcc/ada/mlib-tgt.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004, Ada Core Technologies, Inc. -- +-- Copyright (C) 2001-2005, Ada Core Technologies, 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- -- @@ -172,8 +172,11 @@ package body MLib.Tgt is -- Library_Exists_For -- ------------------------ - function Library_Exists_For (Project : Project_Id) return Boolean is + function Library_Exists_For + (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean + is pragma Unreferenced (Project); + pragma Unreferenced (In_Tree); begin return False; end Library_Exists_For; @@ -182,8 +185,12 @@ package body MLib.Tgt is -- Library_File_Name_For -- --------------------------- - function Library_File_Name_For (Project : Project_Id) return Name_Id is + function Library_File_Name_For + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return Name_Id + is pragma Unreferenced (Project); + pragma Unreferenced (In_Tree); begin return No_Name; end Library_File_Name_For; diff --git a/gcc/ada/mlib-tgt.ads b/gcc/ada/mlib-tgt.ads index 4373dee439d..b4c656ef25b 100644 --- a/gcc/ada/mlib-tgt.ads +++ b/gcc/ada/mlib-tgt.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2004, Ada Core Technologies, Inc. -- +-- Copyright (C) 2001-2005, Ada Core Technologies, 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- -- @@ -147,11 +147,14 @@ package MLib.Tgt is -- into account. For example, on Linux, Foreign, Afiles Lib_Address and -- Relocatable are ignored. - function Library_Exists_For (Project : Project_Id) return Boolean; + function Library_Exists_For + (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean; -- Return True if the library file for a library project already exists. -- This function can only be called for library projects. - function Library_File_Name_For (Project : Project_Id) return Name_Id; + function Library_File_Name_For + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return Name_Id; -- Returns the file name of the library file of a library project. -- This function can only be called for library projects. diff --git a/gcc/ada/prj-attr.ads b/gcc/ada/prj-attr.ads index 31042989601..94d73c06a77 100644 --- a/gcc/ada/prj-attr.ads +++ b/gcc/ada/prj-attr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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 @@ -- There are predefined packages and attributes. -- It is also possible to define new packages with their attributes. +with Table; with Types; use Types; package Prj.Attr is diff --git a/gcc/ada/prj-com.adb b/gcc/ada/prj-com.adb deleted file mode 100644 index bc2583fc007..00000000000 --- a/gcc/ada/prj-com.adb +++ /dev/null @@ -1,42 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- P R J . C O M -- --- -- --- B o d y -- --- -- --- Copyright (C) 2000-2004 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- -- --- ware Foundation; either version 2, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Namet; use Namet; -with Stringt; use Stringt; - -package body Prj.Com is - - ---------- - -- Hash -- - ---------- - - function Hash (Name : String_Id) return Header_Num is - begin - String_To_Name_Buffer (Name); - return Hash (Name_Buffer (1 .. Name_Len)); - end Hash; - -end Prj.Com; diff --git a/gcc/ada/prj-com.ads b/gcc/ada/prj-com.ads index f5f692fc5bf..11b7c5af85c 100644 --- a/gcc/ada/prj-com.ads +++ b/gcc/ada/prj-com.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2005 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- -- @@ -27,88 +27,18 @@ -- The following package declares data types for GNAT project. -- These data types are used in the bodies of the Prj hierarchy. -with GNAT.HTable; with Osint; -with Table; -with Types; use Types; package Prj.Com is - -- At one point, this package was private. - -- It cannot be private, because it is used outside of - -- the Prj hierarchy. - type Fail_Proc is access procedure - (S1 : String; S2 : String := ""; S3 : String := ""); + (S1 : String; + S2 : String := ""; + S3 : String := ""); Fail : Fail_Proc := Osint.Fail'Access; - -- This procedure is used in the project facility, instead of - -- directly calling Osint.Fail. - -- It may be specified by tools to do clean up before calling - -- Osint.Fail, or to simply report an error and return. - - Tool_Name : Name_Id := No_Name; - - Current_Verbosity : Verbosity := Default; - - type Spec_Or_Body is - (Specification, Body_Part); - - type File_Name_Data is record - Name : Name_Id := No_Name; - Index : Int := 0; - Display_Name : Name_Id := No_Name; - Path : Name_Id := No_Name; - Display_Path : Name_Id := No_Name; - Project : Project_Id := No_Project; - Needs_Pragma : Boolean := False; - end record; - -- File and Path name of a spec or body. - - type File_Names_Data is array (Spec_Or_Body) of File_Name_Data; - - type Unit_Id is new Nat; - No_Unit : constant Unit_Id := 0; - type Unit_Data is record - Name : Name_Id := No_Name; - File_Names : File_Names_Data; - end record; - -- File and Path names of a unit, with a reference to its - -- GNAT Project File. - - package Units is new Table.Table - (Table_Component_Type => Unit_Data, - Table_Index_Type => Unit_Id, - Table_Low_Bound => 1, - Table_Initial => 100, - Table_Increment => 100, - Table_Name => "Prj.Com.Units"); - - function Hash (Name : String_Id) return Header_Num; - - package Units_Htable is new GNAT.HTable.Simple_HTable - (Header_Num => Header_Num, - Element => Unit_Id, - No_Element => No_Unit, - Key => Name_Id, - Hash => Hash, - Equal => "="); - -- Mapping of unit names to indexes in the Units table - - type Unit_Project is record - Unit : Unit_Id := No_Unit; - Project : Project_Id := No_Project; - end record; - - No_Unit_Project : constant Unit_Project := (No_Unit, No_Project); - - package Files_Htable is new GNAT.HTable.Simple_HTable - (Header_Num => Header_Num, - Element => Unit_Project, - No_Element => No_Unit_Project, - Key => Name_Id, - Hash => Hash, - Equal => "="); - -- Mapping of file names to indexes in the Units table + -- This procedure is used in the project facility, instead of directly + -- calling Osint.Fail. It may be specified by tools to do clean up before + -- calling Osint.Fail, or to simply report an error and return. end Prj.Com; diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb index e030236afe8..0b64d9b4b2c 100644 --- a/gcc/ada/prj-dect.adb +++ b/gcc/ada/prj-dect.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc -- +-- Copyright (C) 2001-2005 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- -- @@ -45,40 +45,50 @@ package body Prj.Dect is -- (In_Project). procedure Parse_Attribute_Declaration - (Attribute : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Attribute : out Project_Node_Id; First_Attribute : Attribute_Node_Id; Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id); + Current_Package : Project_Node_Id; + Packages_To_Check : String_List_Access); -- Parse an attribute declaration. procedure Parse_Case_Construction - (Case_Construction : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Case_Construction : out Project_Node_Id; First_Attribute : Attribute_Node_Id; Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id); + Current_Package : Project_Node_Id; + Packages_To_Check : String_List_Access); -- Parse a case construction procedure Parse_Declarative_Items - (Declarations : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Declarations : out Project_Node_Id; In_Zone : Zone; First_Attribute : Attribute_Node_Id; Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id); + Current_Package : Project_Node_Id; + Packages_To_Check : String_List_Access); -- Parse declarative items. Depending on In_Zone, some declarative -- items may be forbiden. procedure Parse_Package_Declaration - (Package_Declaration : out Project_Node_Id; - Current_Project : Project_Node_Id); + (In_Tree : Project_Node_Tree_Ref; + Package_Declaration : out Project_Node_Id; + Current_Project : Project_Node_Id; + Packages_To_Check : String_List_Access); -- Parse a package declaration procedure Parse_String_Type_Declaration - (String_Type : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + String_Type : out Project_Node_Id; Current_Project : Project_Node_Id); -- type <name> is ( <literal_string> { , <literal_string> } ) ; procedure Parse_Variable_Declaration - (Variable : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Variable : out Project_Node_Id; Current_Project : Project_Node_Id; Current_Package : Project_Node_Id); -- Parse a variable assignment @@ -90,25 +100,31 @@ package body Prj.Dect is ----------- procedure Parse - (Declarations : out Project_Node_Id; - Current_Project : Project_Node_Id; - Extends : Project_Node_Id) + (In_Tree : Project_Node_Tree_Ref; + Declarations : out Project_Node_Id; + Current_Project : Project_Node_Id; + Extends : Project_Node_Id; + Packages_To_Check : String_List_Access) is First_Declarative_Item : Project_Node_Id := Empty_Node; begin - Declarations := Default_Project_Node (Of_Kind => N_Project_Declaration); - Set_Location_Of (Declarations, To => Token_Ptr); - Set_Extended_Project_Of (Declarations, To => Extends); - Set_Project_Declaration_Of (Current_Project, Declarations); + Declarations := + Default_Project_Node + (Of_Kind => N_Project_Declaration, In_Tree => In_Tree); + Set_Location_Of (Declarations, In_Tree, To => Token_Ptr); + Set_Extended_Project_Of (Declarations, In_Tree, To => Extends); + Set_Project_Declaration_Of (Current_Project, In_Tree, Declarations); Parse_Declarative_Items - (Declarations => First_Declarative_Item, - In_Zone => In_Project, - First_Attribute => Prj.Attr.Attribute_First, - Current_Project => Current_Project, - Current_Package => Empty_Node); + (Declarations => First_Declarative_Item, + In_Tree => In_Tree, + In_Zone => In_Project, + First_Attribute => Prj.Attr.Attribute_First, + Current_Project => Current_Project, + Current_Package => Empty_Node, + Packages_To_Check => Packages_To_Check); Set_First_Declarative_Item_Of - (Declarations, To => First_Declarative_Item); + (Declarations, In_Tree, To => First_Declarative_Item); end Parse; --------------------------------- @@ -116,10 +132,12 @@ package body Prj.Dect is --------------------------------- procedure Parse_Attribute_Declaration - (Attribute : out Project_Node_Id; - First_Attribute : Attribute_Node_Id; - Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id) + (In_Tree : Project_Node_Tree_Ref; + Attribute : out Project_Node_Id; + First_Attribute : Attribute_Node_Id; + Current_Project : Project_Node_Id; + Current_Package : Project_Node_Id; + Packages_To_Check : String_List_Access) is Current_Attribute : Attribute_Node_Id := First_Attribute; Full_Associative_Array : Boolean := False; @@ -129,13 +147,15 @@ package body Prj.Dect is Warning : Boolean := False; begin - Attribute := Default_Project_Node (Of_Kind => N_Attribute_Declaration); - Set_Location_Of (Attribute, To => Token_Ptr); + Attribute := + Default_Project_Node + (Of_Kind => N_Attribute_Declaration, In_Tree => In_Tree); + Set_Location_Of (Attribute, In_Tree, To => Token_Ptr); Set_Previous_Line_Node (Attribute); -- Scan past "for" - Scan; + Scan (In_Tree); -- Body may be an attribute name @@ -148,8 +168,8 @@ package body Prj.Dect is if Token = Tok_Identifier then Attribute_Name := Token_Name; - Set_Name_Of (Attribute, To => Token_Name); - Set_Location_Of (Attribute, To => Token_Ptr); + Set_Name_Of (Attribute, In_Tree, To => Token_Name); + Set_Location_Of (Attribute, In_Tree, To => Token_Ptr); -- Find the attribute @@ -161,9 +181,9 @@ package body Prj.Dect is if Current_Attribute = Empty_Attribute then if Current_Package /= Empty_Node - and then Expression_Kind_Of (Current_Package) = Ignored + and then Expression_Kind_Of (Current_Package, In_Tree) = Ignored then - Pkg_Id := Package_Id_Of (Current_Package); + Pkg_Id := Package_Id_Of (Current_Package, In_Tree); Add_Attribute (Pkg_Id, Token_Name, Current_Attribute); Error_Msg_Name_1 := Token_Name; Error_Msg ("?unknown attribute {", Token_Ptr); @@ -173,17 +193,17 @@ package body Prj.Dect is -- if inside a package that does not need to be checked. Warning := Current_Package /= Empty_Node and then - Current_Packages_To_Check /= All_Packages; + Packages_To_Check /= All_Packages; if Warning then -- Check that we are not in a package to check - Get_Name_String (Name_Of (Current_Package)); + Get_Name_String (Name_Of (Current_Package, In_Tree)); - for Index in Current_Packages_To_Check'Range loop + for Index in Packages_To_Check'Range loop if Name_Buffer (1 .. Name_Len) = - Current_Packages_To_Check (Index).all + Packages_To_Check (Index).all then Warning := False; exit; @@ -207,29 +227,29 @@ package body Prj.Dect is Case_Insensitive_Associative_Array .. Optional_Index_Case_Insensitive_Associative_Array then - Set_Case_Insensitive (Attribute, To => True); + Set_Case_Insensitive (Attribute, In_Tree, To => True); end if; - Scan; -- past the attribute name + Scan (In_Tree); -- past the attribute name end if; -- Change obsolete names of attributes to the new names if Current_Package /= Empty_Node - and then Expression_Kind_Of (Current_Package) /= Ignored + and then Expression_Kind_Of (Current_Package, In_Tree) /= Ignored then - case Name_Of (Attribute) is + case Name_Of (Attribute, In_Tree) is when Snames.Name_Specification => - Set_Name_Of (Attribute, To => Snames.Name_Spec); + Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec); when Snames.Name_Specification_Suffix => - Set_Name_Of (Attribute, To => Snames.Name_Spec_Suffix); + Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec_Suffix); when Snames.Name_Implementation => - Set_Name_Of (Attribute, To => Snames.Name_Body); + Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body); when Snames.Name_Implementation_Suffix => - Set_Name_Of (Attribute, To => Snames.Name_Body_Suffix); + Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body_Suffix); when others => null; @@ -251,24 +271,24 @@ package body Prj.Dect is Get_Name_String (Attribute_Name_Of (Current_Attribute)) & """ cannot be an associative array", - Location_Of (Attribute)); + Location_Of (Attribute, In_Tree)); elsif Attribute_Kind_Of (Current_Attribute) = Unknown then Set_Attribute_Kind_Of (Current_Attribute, To => Associative_Array); end if; - Scan; -- past the left parenthesis + Scan (In_Tree); -- past the left parenthesis Expect (Tok_String_Literal, "literal string"); if Token = Tok_String_Literal then - Set_Associative_Array_Index_Of (Attribute, Token_Name); - Scan; -- past the literal string index + Set_Associative_Array_Index_Of (Attribute, In_Tree, Token_Name); + Scan (In_Tree); -- past the literal string index if Token = Tok_At then case Attribute_Kind_Of (Current_Attribute) is when Optional_Index_Associative_Array | Optional_Index_Case_Insensitive_Associative_Array => - Scan; + Scan (In_Tree); Expect (Tok_Integer_Literal, "integer literal"); if Token = Tok_Integer_Literal then @@ -282,19 +302,20 @@ package body Prj.Dect is if Index = 0 then Error_Msg ("index cannot be zero", Token_Ptr); else - Set_Source_Index_Of (Attribute, To => Index); + Set_Source_Index_Of + (Attribute, In_Tree, To => Index); end if; end; - Scan; + Scan (In_Tree); end if; when others => Error_Msg ("index not allowed here", Token_Ptr); - Scan; + Scan (In_Tree); if Token = Tok_Integer_Literal then - Scan; + Scan (In_Tree); end if; end case; end if; @@ -303,7 +324,7 @@ package body Prj.Dect is Expect (Tok_Right_Paren, "`)`"); if Token = Tok_Right_Paren then - Scan; -- past the right parenthesis + Scan (In_Tree); -- past the right parenthesis end if; else @@ -328,14 +349,14 @@ package body Prj.Dect is if Current_Attribute /= Empty_Attribute then Set_Expression_Kind_Of - (Attribute, To => Variable_Kind_Of (Current_Attribute)); + (Attribute, In_Tree, To => Variable_Kind_Of (Current_Attribute)); Optional_Index := Optional_Index_Of (Current_Attribute); end if; Expect (Tok_Use, "USE"); if Token = Tok_Use then - Scan; + Scan (In_Tree); if Full_Associative_Array then @@ -368,15 +389,15 @@ package body Prj.Dect is -- in the project being extended. The_Project := Imported_Or_Extended_Project_Of - (Current_Project, Token_Name); + (Current_Project, In_Tree, Token_Name); if The_Project = Empty_Node then Error_Msg ("unknown project", Location); - Scan; -- past the project name + Scan (In_Tree); -- past the project name else Project_Name := Token_Name; - Scan; -- past the project name + Scan (In_Tree); -- past the project name -- If this is inside a package, a dot followed by the -- name of the package must followed the project name. @@ -388,7 +409,7 @@ package body Prj.Dect is The_Project := Empty_Node; else - Scan; -- past the dot + Scan (In_Tree); -- past the dot Expect (Tok_Identifier, "identifier"); if Token /= Tok_Identifier then @@ -396,23 +417,29 @@ package body Prj.Dect is -- If it is not the same package name, issue error - elsif Token_Name /= Name_Of (Current_Package) then + elsif + Token_Name /= Name_Of (Current_Package, In_Tree) + then The_Project := Empty_Node; Error_Msg ("not the same package as " & - Get_Name_String (Name_Of (Current_Package)), + Get_Name_String + (Name_Of (Current_Package, In_Tree)), Token_Ptr); else - The_Package := First_Package_Of (The_Project); + The_Package := + First_Package_Of (The_Project, In_Tree); -- Look for the package node while The_Package /= Empty_Node - and then Name_Of (The_Package) /= Token_Name + and then + Name_Of (The_Package, In_Tree) /= Token_Name loop The_Package := - Next_Package_In_Project (The_Package); + Next_Package_In_Project + (The_Package, In_Tree); end loop; -- If the package cannot be found in the @@ -427,7 +454,7 @@ package body Prj.Dect is Token_Ptr); end if; - Scan; -- past the package name + Scan (In_Tree); -- past the package name end if; end if; end if; @@ -444,7 +471,7 @@ package body Prj.Dect is The_Project := Empty_Node; else - Scan; -- past the apostrophe + Scan (In_Tree); -- past the apostrophe Expect (Tok_Identifier, "identifier"); if Token /= Tok_Identifier then @@ -459,7 +486,7 @@ package body Prj.Dect is Error_Msg ("invalid name, should be %", Token_Ptr); end if; - Scan; -- past the attribute name + Scan (In_Tree); -- past the attribute name end if; end if; end if; @@ -477,8 +504,8 @@ package body Prj.Dect is -- characterizes full associative array attribute -- declarations. - Set_Associative_Project_Of (Attribute, The_Project); - Set_Associative_Package_Of (Attribute, The_Package); + Set_Associative_Project_Of (Attribute, In_Tree, The_Project); + Set_Associative_Package_Of (Attribute, In_Tree, The_Package); end if; end; @@ -496,11 +523,12 @@ package body Prj.Dect is -- Get the expression value and set it in the attribute node Parse_Expression - (Expression => Expression, + (In_Tree => In_Tree, + Expression => Expression, Current_Project => Current_Project, Current_Package => Current_Package, Optional_Index => Optional_Index); - Set_Expression_Of (Attribute, To => Expression); + Set_Expression_Of (Attribute, In_Tree, To => Expression); -- If the expression is legal, but not of the right kind -- for the attribute, issue an error. @@ -508,12 +536,12 @@ package body Prj.Dect is if Current_Attribute /= Empty_Attribute and then Expression /= Empty_Node and then Variable_Kind_Of (Current_Attribute) /= - Expression_Kind_Of (Expression) + Expression_Kind_Of (Expression, In_Tree) then if Variable_Kind_Of (Current_Attribute) = Undefined then Set_Variable_Kind_Of (Current_Attribute, - To => Expression_Kind_Of (Expression)); + To => Expression_Kind_Of (Expression, In_Tree)); else Error_Msg @@ -545,10 +573,12 @@ package body Prj.Dect is ----------------------------- procedure Parse_Case_Construction - (Case_Construction : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Case_Construction : out Project_Node_Id; First_Attribute : Attribute_Node_Id; Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id) + Current_Package : Project_Node_Id; + Packages_To_Check : String_List_Access) is Current_Item : Project_Node_Id := Empty_Node; Next_Item : Project_Node_Id := Empty_Node; @@ -569,12 +599,13 @@ package body Prj.Dect is begin Case_Construction := - Default_Project_Node (Of_Kind => N_Case_Construction); - Set_Location_Of (Case_Construction, To => Token_Ptr); + Default_Project_Node + (Of_Kind => N_Case_Construction, In_Tree => In_Tree); + Set_Location_Of (Case_Construction, In_Tree, To => Token_Ptr); -- Scan past "case" - Scan; + Scan (In_Tree); -- Get the switch variable @@ -583,24 +614,25 @@ package body Prj.Dect is if Token = Tok_Identifier then Variable_Location := Token_Ptr; Parse_Variable_Reference - (Variable => Case_Variable, + (In_Tree => In_Tree, + Variable => Case_Variable, Current_Project => Current_Project, Current_Package => Current_Package); Set_Case_Variable_Reference_Of - (Case_Construction, To => Case_Variable); + (Case_Construction, In_Tree, To => Case_Variable); else if Token /= Tok_Is then - Scan; + Scan (In_Tree); end if; end if; if Case_Variable /= Empty_Node then - String_Type := String_Type_Of (Case_Variable); + String_Type := String_Type_Of (Case_Variable, In_Tree); if String_Type = Empty_Node then Error_Msg ("variable """ & - Get_Name_String (Name_Of (Case_Variable)) & + Get_Name_String (Name_Of (Case_Variable, In_Tree)) & """ is not typed", Variable_Location); end if; @@ -615,38 +647,43 @@ package body Prj.Dect is -- Scan past "is" - Scan; + Scan (In_Tree); end if; - Start_New_Case_Construction (String_Type); + Start_New_Case_Construction (In_Tree, String_Type); When_Loop : while Token = Tok_When loop if First_Case_Item then - Current_Item := Default_Project_Node (Of_Kind => N_Case_Item); - Set_First_Case_Item_Of (Case_Construction, To => Current_Item); + Current_Item := + Default_Project_Node + (Of_Kind => N_Case_Item, In_Tree => In_Tree); + Set_First_Case_Item_Of + (Case_Construction, In_Tree, To => Current_Item); First_Case_Item := False; else - Next_Item := Default_Project_Node (Of_Kind => N_Case_Item); - Set_Next_Case_Item (Current_Item, To => Next_Item); + Next_Item := + Default_Project_Node + (Of_Kind => N_Case_Item, In_Tree => In_Tree); + Set_Next_Case_Item (Current_Item, In_Tree, To => Next_Item); Current_Item := Next_Item; end if; - Set_Location_Of (Current_Item, To => Token_Ptr); + Set_Location_Of (Current_Item, In_Tree, To => Token_Ptr); -- Scan past "when" - Scan; + Scan (In_Tree); if Token = Tok_Others then When_Others := True; -- Scan past "others" - Scan; + Scan (In_Tree); Expect (Tok_Arrow, "`=>`"); Set_End_Of_Line (Current_Item); @@ -655,46 +692,52 @@ package body Prj.Dect is -- Empty_Node in Field1 of a Case_Item indicates -- the "when others =>" branch. - Set_First_Choice_Of (Current_Item, To => Empty_Node); + Set_First_Choice_Of (Current_Item, In_Tree, To => Empty_Node); Parse_Declarative_Items - (Declarations => First_Declarative_Item, - In_Zone => In_Case_Construction, - First_Attribute => First_Attribute, - Current_Project => Current_Project, - Current_Package => Current_Package); + (In_Tree => In_Tree, + Declarations => First_Declarative_Item, + In_Zone => In_Case_Construction, + First_Attribute => First_Attribute, + Current_Project => Current_Project, + Current_Package => Current_Package, + Packages_To_Check => Packages_To_Check); -- "when others =>" must be the last branch, so save the -- Case_Item and exit Set_First_Declarative_Item_Of - (Current_Item, To => First_Declarative_Item); + (Current_Item, In_Tree, To => First_Declarative_Item); exit When_Loop; else - Parse_Choice_List (First_Choice => First_Choice); - Set_First_Choice_Of (Current_Item, To => First_Choice); + Parse_Choice_List + (In_Tree => In_Tree, + First_Choice => First_Choice); + Set_First_Choice_Of (Current_Item, In_Tree, To => First_Choice); Expect (Tok_Arrow, "`=>`"); Set_End_Of_Line (Current_Item); Set_Previous_Line_Node (Current_Item); Parse_Declarative_Items - (Declarations => First_Declarative_Item, - In_Zone => In_Case_Construction, - First_Attribute => First_Attribute, - Current_Project => Current_Project, - Current_Package => Current_Package); + (In_Tree => In_Tree, + Declarations => First_Declarative_Item, + In_Zone => In_Case_Construction, + First_Attribute => First_Attribute, + Current_Project => Current_Project, + Current_Package => Current_Package, + Packages_To_Check => Packages_To_Check); Set_First_Declarative_Item_Of - (Current_Item, To => First_Declarative_Item); + (Current_Item, In_Tree, To => First_Declarative_Item); end if; end loop When_Loop; End_Case_Construction (Check_All_Labels => not When_Others and not Quiet_Output, - Case_Location => Location_Of (Case_Construction)); + Case_Location => Location_Of (Case_Construction, In_Tree)); Expect (Tok_End, "`END CASE`"); Remove_Next_End_Node; @@ -703,7 +746,7 @@ package body Prj.Dect is -- Scan past "end" - Scan; + Scan (In_Tree); Expect (Tok_Case, "CASE"); @@ -711,7 +754,7 @@ package body Prj.Dect is -- Scan past "case" - Scan; + Scan (In_Tree); Expect (Tok_Semicolon, "`;`"); Set_Previous_End_Node (Case_Construction); @@ -723,11 +766,13 @@ package body Prj.Dect is ----------------------------- procedure Parse_Declarative_Items - (Declarations : out Project_Node_Id; - In_Zone : Zone; - First_Attribute : Attribute_Node_Id; - Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id) + (In_Tree : Project_Node_Tree_Ref; + Declarations : out Project_Node_Id; + In_Zone : Zone; + First_Attribute : Attribute_Node_Id; + Current_Project : Project_Node_Id; + Current_Package : Project_Node_Id; + Packages_To_Check : String_List_Access) is Current_Declarative_Item : Project_Node_Id := Empty_Node; Next_Declarative_Item : Project_Node_Id := Empty_Node; @@ -742,7 +787,7 @@ package body Prj.Dect is -- the first token of the declarative element. -- Scan past it - Scan; + Scan (In_Tree); Item_Location := Token_Ptr; @@ -755,7 +800,8 @@ package body Prj.Dect is end if; Parse_Variable_Declaration - (Current_Declaration, + (In_Tree, + Current_Declaration, Current_Project => Current_Project, Current_Package => Current_Package); @@ -765,17 +811,19 @@ package body Prj.Dect is when Tok_For => Parse_Attribute_Declaration - (Attribute => Current_Declaration, - First_Attribute => First_Attribute, - Current_Project => Current_Project, - Current_Package => Current_Package); + (In_Tree => In_Tree, + Attribute => Current_Declaration, + First_Attribute => First_Attribute, + Current_Project => Current_Project, + Current_Package => Current_Package, + Packages_To_Check => Packages_To_Check); Set_End_Of_Line (Current_Declaration); Set_Previous_Line_Node (Current_Declaration); when Tok_Null => - Scan; -- past "null" + Scan (In_Tree); -- past "null" when Tok_Package => @@ -786,8 +834,10 @@ package body Prj.Dect is end if; Parse_Package_Declaration - (Package_Declaration => Current_Declaration, - Current_Project => Current_Project); + (In_Tree => In_Tree, + Package_Declaration => Current_Declaration, + Current_Project => Current_Project, + Packages_To_Check => Packages_To_Check); Set_Previous_End_Node (Current_Declaration); @@ -801,7 +851,8 @@ package body Prj.Dect is end if; Parse_String_Type_Declaration - (String_Type => Current_Declaration, + (In_Tree => In_Tree, + String_Type => Current_Declaration, Current_Project => Current_Project); Set_End_Of_Line (Current_Declaration); @@ -812,10 +863,12 @@ package body Prj.Dect is -- Case construction Parse_Case_Construction - (Case_Construction => Current_Declaration, + (In_Tree => In_Tree, + Case_Construction => Current_Declaration, First_Attribute => First_Attribute, Current_Project => Current_Project, - Current_Package => Current_Package); + Current_Package => Current_Package, + Packages_To_Check => Packages_To_Check); Set_Previous_End_Node (Current_Declaration); @@ -837,24 +890,27 @@ package body Prj.Dect is if Current_Declaration /= Empty_Node then if Current_Declarative_Item = Empty_Node then Current_Declarative_Item := - Default_Project_Node (Of_Kind => N_Declarative_Item); + Default_Project_Node + (Of_Kind => N_Declarative_Item, In_Tree => In_Tree); Declarations := Current_Declarative_Item; else Next_Declarative_Item := - Default_Project_Node (Of_Kind => N_Declarative_Item); + Default_Project_Node + (Of_Kind => N_Declarative_Item, In_Tree => In_Tree); Set_Next_Declarative_Item - (Current_Declarative_Item, To => Next_Declarative_Item); + (Current_Declarative_Item, In_Tree, + To => Next_Declarative_Item); Current_Declarative_Item := Next_Declarative_Item; end if; Set_Current_Item_Node - (Current_Declarative_Item, To => Current_Declaration); - Set_Location_Of (Current_Declarative_Item, To => Item_Location); + (Current_Declarative_Item, In_Tree, + To => Current_Declaration); + Set_Location_Of + (Current_Declarative_Item, In_Tree, To => Item_Location); end if; - end loop; - end Parse_Declarative_Items; ------------------------------- @@ -862,8 +918,10 @@ package body Prj.Dect is ------------------------------- procedure Parse_Package_Declaration - (Package_Declaration : out Project_Node_Id; - Current_Project : Project_Node_Id) + (In_Tree : Project_Node_Tree_Ref; + Package_Declaration : out Project_Node_Id; + Current_Project : Project_Node_Id; + Packages_To_Check : String_List_Access) is First_Attribute : Attribute_Node_Id := Empty_Attribute; Current_Package : Package_Node_Id := Empty_Package; @@ -871,17 +929,17 @@ package body Prj.Dect is begin Package_Declaration := - Default_Project_Node (Of_Kind => N_Package_Declaration); - Set_Location_Of (Package_Declaration, To => Token_Ptr); + Default_Project_Node + (Of_Kind => N_Package_Declaration, In_Tree => In_Tree); + Set_Location_Of (Package_Declaration, In_Tree, To => Token_Ptr); -- Scan past "package" - Scan; + Scan (In_Tree); Expect (Tok_Identifier, "identifier"); if Token = Tok_Identifier then - - Set_Name_Of (Package_Declaration, To => Token_Name); + Set_Name_Of (Package_Declaration, In_Tree, To => Token_Name); Current_Package := Package_Node_Id_Of (Token_Name); @@ -890,36 +948,39 @@ package body Prj.Dect is else Error_Msg ("?""" & - Get_Name_String (Name_Of (Package_Declaration)) & + Get_Name_String + (Name_Of (Package_Declaration, In_Tree)) & """ is not a known package name", Token_Ptr); -- Set the package declaration to "ignored" so that it is not -- processed by Prj.Proc.Process. - Set_Expression_Kind_Of (Package_Declaration, Ignored); + Set_Expression_Kind_Of (Package_Declaration, In_Tree, Ignored); -- Add the unknown package in the list of packages Add_Unknown_Package (Token_Name, Current_Package); end if; - Set_Package_Id_Of (Package_Declaration, To => Current_Package); + Set_Package_Id_Of + (Package_Declaration, In_Tree, To => Current_Package); declare - Current : Project_Node_Id := First_Package_Of (Current_Project); + Current : Project_Node_Id := + First_Package_Of (Current_Project, In_Tree); begin while Current /= Empty_Node - and then Name_Of (Current) /= Token_Name + and then Name_Of (Current, In_Tree) /= Token_Name loop - Current := Next_Package_In_Project (Current); + Current := Next_Package_In_Project (Current, In_Tree); end loop; if Current /= Empty_Node then Error_Msg ("package """ & - Get_Name_String (Name_Of (Package_Declaration)) & + Get_Name_String (Name_Of (Package_Declaration, In_Tree)) & """ is declared twice in the same project", Token_Ptr); @@ -927,23 +988,23 @@ package body Prj.Dect is -- Add the package to the project list Set_Next_Package_In_Project - (Package_Declaration, - To => First_Package_Of (Current_Project)); + (Package_Declaration, In_Tree, + To => First_Package_Of (Current_Project, In_Tree)); Set_First_Package_Of - (Current_Project, To => Package_Declaration); + (Current_Project, In_Tree, To => Package_Declaration); end if; end; -- Scan past the package name - Scan; + Scan (In_Tree); end if; if Token = Tok_Renames then -- Scan past "renames" - Scan; + Scan (In_Tree); Expect (Tok_Identifier, "identifier"); @@ -951,20 +1012,23 @@ package body Prj.Dect is declare Project_Name : constant Name_Id := Token_Name; Clause : Project_Node_Id := - First_With_Clause_Of (Current_Project); + First_With_Clause_Of (Current_Project, In_Tree); The_Project : Project_Node_Id := Empty_Node; Extended : constant Project_Node_Id := Extended_Project_Of - (Project_Declaration_Of (Current_Project)); + (Project_Declaration_Of + (Current_Project, In_Tree), + In_Tree); begin while Clause /= Empty_Node loop - -- Only non limited imported projects may be used - -- in a renames declaration. + -- Only non limited imported projects may be used in a + -- renames declaration. - The_Project := Non_Limited_Project_Node_Of (Clause); + The_Project := + Non_Limited_Project_Node_Of (Clause, In_Tree); exit when The_Project /= Empty_Node - and then Name_Of (The_Project) = Project_Name; - Clause := Next_With_Clause_Of (Clause); + and then Name_Of (The_Project, In_Tree) = Project_Name; + Clause := Next_With_Clause_Of (Clause, In_Tree); end loop; if Clause = Empty_Node then @@ -972,9 +1036,10 @@ package body Prj.Dect is -- if it's the name of an eventual extended project. if Extended /= Empty_Node - and then Name_Of (Extended) = Project_Name then + and then Name_Of (Extended, In_Tree) = Project_Name + then Set_Project_Of_Renamed_Package_Of - (Package_Declaration, To => Extended); + (Package_Declaration, In_Tree, To => Extended); else Error_Msg_Name_1 := Project_Name; Error_Msg @@ -982,35 +1047,37 @@ package body Prj.Dect is end if; else Set_Project_Of_Renamed_Package_Of - (Package_Declaration, To => The_Project); + (Package_Declaration, In_Tree, To => The_Project); end if; end; - Scan; + Scan (In_Tree); Expect (Tok_Dot, "`.`"); if Token = Tok_Dot then - Scan; + Scan (In_Tree); Expect (Tok_Identifier, "identifier"); if Token = Tok_Identifier then - if Name_Of (Package_Declaration) /= Token_Name then + if Name_Of (Package_Declaration, In_Tree) /= Token_Name then Error_Msg ("not the same package name", Token_Ptr); elsif - Project_Of_Renamed_Package_Of (Package_Declaration) - /= Empty_Node + Project_Of_Renamed_Package_Of + (Package_Declaration, In_Tree) /= Empty_Node then declare Current : Project_Node_Id := First_Package_Of (Project_Of_Renamed_Package_Of - (Package_Declaration)); + (Package_Declaration, In_Tree), + In_Tree); begin while Current /= Empty_Node - and then Name_Of (Current) /= Token_Name + and then Name_Of (Current, In_Tree) /= Token_Name loop - Current := Next_Package_In_Project (Current); + Current := + Next_Package_In_Project (Current, In_Tree); end loop; if Current = Empty_Node then @@ -1023,7 +1090,7 @@ package body Prj.Dect is end; end if; - Scan; + Scan (In_Tree); end if; end if; end if; @@ -1038,14 +1105,16 @@ package body Prj.Dect is Set_Next_End_Node (Package_Declaration); Parse_Declarative_Items - (Declarations => First_Declarative_Item, - In_Zone => In_Package, - First_Attribute => First_Attribute, - Current_Project => Current_Project, - Current_Package => Package_Declaration); + (In_Tree => In_Tree, + Declarations => First_Declarative_Item, + In_Zone => In_Package, + First_Attribute => First_Attribute, + Current_Project => Current_Project, + Current_Package => Package_Declaration, + Packages_To_Check => Packages_To_Check); Set_First_Declarative_Item_Of - (Package_Declaration, To => First_Declarative_Item); + (Package_Declaration, In_Tree, To => First_Declarative_Item); Expect (Tok_End, "END"); @@ -1053,7 +1122,7 @@ package body Prj.Dect is -- Scan past "end" - Scan; + Scan (In_Tree); end if; -- We should have the name of the package after "end" @@ -1061,10 +1130,10 @@ package body Prj.Dect is Expect (Tok_Identifier, "identifier"); if Token = Tok_Identifier - and then Name_Of (Package_Declaration) /= No_Name - and then Token_Name /= Name_Of (Package_Declaration) + and then Name_Of (Package_Declaration, In_Tree) /= No_Name + and then Token_Name /= Name_Of (Package_Declaration, In_Tree) then - Error_Msg_Name_1 := Name_Of (Package_Declaration); + Error_Msg_Name_1 := Name_Of (Package_Declaration, In_Tree); Error_Msg ("expected {", Token_Ptr); end if; @@ -1072,7 +1141,7 @@ package body Prj.Dect is -- Scan past the package name - Scan; + Scan (In_Tree); end if; Expect (Tok_Semicolon, "`;`"); @@ -1089,7 +1158,8 @@ package body Prj.Dect is ----------------------------------- procedure Parse_String_Type_Declaration - (String_Type : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + String_Type : out Project_Node_Id; Current_Project : Project_Node_Id) is Current : Project_Node_Id := Empty_Node; @@ -1097,25 +1167,26 @@ package body Prj.Dect is begin String_Type := - Default_Project_Node (Of_Kind => N_String_Type_Declaration); + Default_Project_Node + (Of_Kind => N_String_Type_Declaration, In_Tree => In_Tree); - Set_Location_Of (String_Type, To => Token_Ptr); + Set_Location_Of (String_Type, In_Tree, To => Token_Ptr); -- Scan past "type" - Scan; + Scan (In_Tree); Expect (Tok_Identifier, "identifier"); if Token = Tok_Identifier then - Set_Name_Of (String_Type, To => Token_Name); + Set_Name_Of (String_Type, In_Tree, To => Token_Name); - Current := First_String_Type_Of (Current_Project); + Current := First_String_Type_Of (Current_Project, In_Tree); while Current /= Empty_Node and then - Name_Of (Current) /= Token_Name + Name_Of (Current, In_Tree) /= Token_Name loop - Current := Next_String_Type (Current); + Current := Next_String_Type (Current, In_Tree); end loop; if Current /= Empty_Node then @@ -1124,11 +1195,11 @@ package body Prj.Dect is """", Token_Ptr); else - Current := First_Variable_Of (Current_Project); + Current := First_Variable_Of (Current_Project, In_Tree); while Current /= Empty_Node - and then Name_Of (Current) /= Token_Name + and then Name_Of (Current, In_Tree) /= Token_Name loop - Current := Next_Variable (Current); + Current := Next_Variable (Current, In_Tree); end loop; if Current /= Empty_Node then @@ -1137,35 +1208,38 @@ package body Prj.Dect is """ is already a variable name", Token_Ptr); else Set_Next_String_Type - (String_Type, To => First_String_Type_Of (Current_Project)); - Set_First_String_Type_Of (Current_Project, To => String_Type); + (String_Type, In_Tree, + To => First_String_Type_Of (Current_Project, In_Tree)); + Set_First_String_Type_Of + (Current_Project, In_Tree, To => String_Type); end if; end if; -- Scan past the name - Scan; + Scan (In_Tree); end if; Expect (Tok_Is, "IS"); if Token = Tok_Is then - Scan; + Scan (In_Tree); end if; Expect (Tok_Left_Paren, "`(`"); if Token = Tok_Left_Paren then - Scan; + Scan (In_Tree); end if; - Parse_String_Type_List (First_String => First_String); - Set_First_Literal_String (String_Type, To => First_String); + Parse_String_Type_List + (In_Tree => In_Tree, First_String => First_String); + Set_First_Literal_String (String_Type, In_Tree, To => First_String); Expect (Tok_Right_Paren, "`)`"); if Token = Tok_Right_Paren then - Scan; + Scan (In_Tree); end if; end Parse_String_Type_Declaration; @@ -1175,7 +1249,8 @@ package body Prj.Dect is -------------------------------- procedure Parse_Variable_Declaration - (Variable : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Variable : out Project_Node_Id; Current_Project : Project_Node_Id; Current_Package : Project_Node_Id) is @@ -1190,20 +1265,21 @@ package body Prj.Dect is begin Variable := - Default_Project_Node (Of_Kind => N_Variable_Declaration); - Set_Name_Of (Variable, To => Variable_Name); - Set_Location_Of (Variable, To => Token_Ptr); + Default_Project_Node + (Of_Kind => N_Variable_Declaration, In_Tree => In_Tree); + Set_Name_Of (Variable, In_Tree, To => Variable_Name); + Set_Location_Of (Variable, In_Tree, To => Token_Ptr); -- Scan past the variable name - Scan; + Scan (In_Tree); if Token = Tok_Colon then -- Typed string variable declaration - Scan; - Set_Kind_Of (Variable, N_Typed_Variable_Declaration); + Scan (In_Tree); + Set_Kind_Of (Variable, In_Tree, N_Typed_Variable_Declaration); Expect (Tok_Identifier, "identifier"); OK := Token = Tok_Identifier; @@ -1211,7 +1287,7 @@ package body Prj.Dect is if OK then String_Type_Name := Token_Name; Type_Location := Token_Ptr; - Scan; + Scan (In_Tree); if Token = Tok_Dot then Project_String_Type_Name := String_Type_Name; @@ -1219,13 +1295,13 @@ package body Prj.Dect is -- Scan past the dot - Scan; + Scan (In_Tree); Expect (Tok_Identifier, "identifier"); if Token = Tok_Identifier then String_Type_Name := Token_Name; Type_Location := Token_Ptr; - Scan; + Scan (In_Tree); else OK := False; end if; @@ -1234,7 +1310,7 @@ package body Prj.Dect is if OK then declare Current : Project_Node_Id := - First_String_Type_Of (Current_Project); + First_String_Type_Of (Current_Project, In_Tree); begin if Project_String_Type_Name /= No_Name then @@ -1242,7 +1318,7 @@ package body Prj.Dect is The_Project_Name_And_Node : constant Tree_Private_Part.Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get - (Project_String_Type_Name); + (In_Tree.Projects_HT, Project_String_Type_Name); use Tree_Private_Part; @@ -1259,15 +1335,15 @@ package body Prj.Dect is else Current := First_String_Type_Of - (The_Project_Name_And_Node.Node); + (The_Project_Name_And_Node.Node, In_Tree); end if; end; end if; while Current /= Empty_Node - and then Name_Of (Current) /= String_Type_Name + and then Name_Of (Current, In_Tree) /= String_Type_Name loop - Current := Next_String_Type (Current); + Current := Next_String_Type (Current, In_Tree); end loop; if Current = Empty_Node then @@ -1278,7 +1354,7 @@ package body Prj.Dect is OK := False; else Set_String_Type_Of - (Variable, To => Current); + (Variable, In_Tree, To => Current); end if; end; end if; @@ -1290,7 +1366,7 @@ package body Prj.Dect is OK := OK and (Token = Tok_Colon_Equal); if Token = Tok_Colon_Equal then - Scan; + Scan (In_Tree); end if; -- Get the single string or string list value @@ -1298,24 +1374,26 @@ package body Prj.Dect is Expression_Location := Token_Ptr; Parse_Expression - (Expression => Expression, + (In_Tree => In_Tree, + Expression => Expression, Current_Project => Current_Project, Current_Package => Current_Package, Optional_Index => False); - Set_Expression_Of (Variable, To => Expression); + Set_Expression_Of (Variable, In_Tree, To => Expression); if Expression /= Empty_Node then -- A typed string must have a single string value, not a list - if Kind_Of (Variable) = N_Typed_Variable_Declaration - and then Expression_Kind_Of (Expression) = List + if Kind_Of (Variable, In_Tree) = N_Typed_Variable_Declaration + and then Expression_Kind_Of (Expression, In_Tree) = List then Error_Msg ("expression must be a single string", Expression_Location); end if; Set_Expression_Kind_Of - (Variable, To => Expression_Kind_Of (Expression)); + (Variable, In_Tree, + To => Expression_Kind_Of (Expression, In_Tree)); end if; if OK then @@ -1324,41 +1402,49 @@ package body Prj.Dect is begin if Current_Package /= Empty_Node then - The_Variable := First_Variable_Of (Current_Package); + The_Variable := First_Variable_Of (Current_Package, In_Tree); elsif Current_Project /= Empty_Node then - The_Variable := First_Variable_Of (Current_Project); + The_Variable := First_Variable_Of (Current_Project, In_Tree); end if; while The_Variable /= Empty_Node - and then Name_Of (The_Variable) /= Variable_Name + and then Name_Of (The_Variable, In_Tree) /= Variable_Name loop - The_Variable := Next_Variable (The_Variable); + The_Variable := Next_Variable (The_Variable, In_Tree); end loop; if The_Variable = Empty_Node then if Current_Package /= Empty_Node then Set_Next_Variable - (Variable, To => First_Variable_Of (Current_Package)); - Set_First_Variable_Of (Current_Package, To => Variable); + (Variable, In_Tree, + To => First_Variable_Of (Current_Package, In_Tree)); + Set_First_Variable_Of + (Current_Package, In_Tree, To => Variable); elsif Current_Project /= Empty_Node then Set_Next_Variable - (Variable, To => First_Variable_Of (Current_Project)); - Set_First_Variable_Of (Current_Project, To => Variable); + (Variable, In_Tree, + To => First_Variable_Of (Current_Project, In_Tree)); + Set_First_Variable_Of + (Current_Project, In_Tree, To => Variable); end if; else - if Expression_Kind_Of (Variable) /= Undefined then - if Expression_Kind_Of (The_Variable) = Undefined then + if Expression_Kind_Of (Variable, In_Tree) /= Undefined then + if + Expression_Kind_Of (The_Variable, In_Tree) = Undefined + then Set_Expression_Kind_Of - (The_Variable, To => Expression_Kind_Of (Variable)); + (The_Variable, In_Tree, + To => Expression_Kind_Of (Variable, In_Tree)); else - if Expression_Kind_Of (The_Variable) /= - Expression_Kind_Of (Variable) + if Expression_Kind_Of (The_Variable, In_Tree) /= + Expression_Kind_Of (Variable, In_Tree) then Error_Msg ("wrong expression kind for variable """ & - Get_Name_String (Name_Of (The_Variable)) & + Get_Name_String + (Name_Of (The_Variable, In_Tree)) & """", Expression_Location); end if; diff --git a/gcc/ada/prj-dect.ads b/gcc/ada/prj-dect.ads index 487fbeb7c5b..ade2e43bc94 100644 --- a/gcc/ada/prj-dect.ads +++ b/gcc/ada/prj-dect.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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- -- @@ -31,9 +31,27 @@ with Prj.Tree; private package Prj.Dect is procedure Parse - (Declarations : out Prj.Tree.Project_Node_Id; - Current_Project : Prj.Tree.Project_Node_Id; - Extends : Prj.Tree.Project_Node_Id); - -- Parse project declarative items. What are parameters ??? + (In_Tree : Prj.Tree.Project_Node_Tree_Ref; + Declarations : out Prj.Tree.Project_Node_Id; + Current_Project : Prj.Tree.Project_Node_Id; + Extends : Prj.Tree.Project_Node_Id; + Packages_To_Check : String_List_Access); + -- Parse project declarative items + -- + -- In_Tree is the project node tree + -- + -- Declarations is the resulting project node + -- + -- Current_Project is the project node of the project for which the + -- declarative items are parsed. + -- + -- Extends is the project node of the project that project Current_Project + -- extends. If project Current-Project does not extend any project, + -- Extends has the value Empty_Node. + -- + -- Packages_To_Check is the list of packages that needs to be checked. + -- For legal packages declared in project Current_Project that are not in + -- Packages_To_Check, only the syntax of the declarations are checked, not + -- the attribute names and kinds. end Prj.Dect; diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 1ce1209b82b..02a602e1e56 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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,7 +29,6 @@ with Opt; with Osint; use Osint; with Output; use Output; with Prj.Com; use Prj.Com; -with Table; with Tempdir; with GNAT.Directory_Operations; use GNAT.Directory_Operations; @@ -37,8 +36,6 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; package body Prj.Env is - type Naming_Id is new Nat; - Current_Source_Path_File : Name_Id := No_Name; -- Current value of project source path file env var. -- Used to avoid setting the env var to the same value. @@ -62,63 +59,33 @@ package body Prj.Env is -- platforms, except on VMS where the logical names are deassigned, thus -- avoiding the pollution of the environment of the caller. - package Namings is new Table.Table - (Table_Component_Type => Naming_Data, - Table_Index_Type => Naming_Id, - Table_Low_Bound => 1, - Table_Initial => 5, - Table_Increment => 100, - Table_Name => "Prj.Env.Namings"); - - Default_Naming : constant Naming_Id := Namings.First; + Default_Naming : constant Naming_Id := Naming_Table.First; Fill_Mapping_File : Boolean := True; - package Path_Files is new Table.Table - (Table_Component_Type => Name_Id, - Table_Index_Type => Natural, - Table_Low_Bound => 1, - Table_Initial => 50, - Table_Increment => 50, - Table_Name => "Prj.Env.Path_Files"); - -- Table storing all the temp path file names. - -- Used by Delete_All_Path_Files. - type Project_Flags is array (Project_Id range <>) of Boolean; -- A Boolean array type used in Create_Mapping_File to select the projects -- in the closure of a specific project. - package Source_Paths is new Table.Table - (Table_Component_Type => Name_Id, - Table_Index_Type => Natural, - Table_Low_Bound => 1, - Table_Initial => 50, - Table_Increment => 50, - Table_Name => "Prj.Env.Source_Paths"); - -- A table to store the source dirs before creating the source path file - - package Object_Paths is new Table.Table - (Table_Component_Type => Name_Id, - Table_Index_Type => Natural, - Table_Low_Bound => 1, - Table_Initial => 50, - Table_Increment => 50, - Table_Name => "Prj.Env.Source_Paths"); - -- A table to store the object dirs, before creating the object path file - ----------------------- -- Local Subprograms -- ----------------------- - function Body_Path_Name_Of (Unit : Unit_Id) return String; + function Body_Path_Name_Of + (Unit : Unit_Id; + In_Tree : Project_Tree_Ref) return String; -- Returns the path name of the body of a unit. -- Compute it first, if necessary. - function Spec_Path_Name_Of (Unit : Unit_Id) return String; + function Spec_Path_Name_Of + (Unit : Unit_Id; + In_Tree : Project_Tree_Ref) return String; -- Returns the path name of the spec of a unit. -- Compute it first, if necessary. - procedure Add_To_Path (Source_Dirs : String_List_Id); + procedure Add_To_Path + (Source_Dirs : String_List_Id; + In_Tree : Project_Tree_Ref); -- Add to Ada_Path_Buffer all the source directories in string list -- Source_Dirs, if any. Increment Ada_Path_Length. @@ -128,11 +95,14 @@ package body Prj.Env is -- If Ada_Path_Length /= 0, prepend a Path_Separator character to -- Path. - procedure Add_To_Source_Path (Source_Dirs : String_List_Id); + procedure Add_To_Source_Path + (Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref); -- Add to Ada_Path_B all the source directories in string list -- Source_Dirs, if any. Increment Ada_Path_Length. - procedure Add_To_Object_Path (Object_Dir : Name_Id); + procedure Add_To_Object_Path + (Object_Dir : Name_Id; + In_Tree : Project_Tree_Ref); -- Add Object_Dir to object path table. Make sure it is not duplicate -- and it is the last one in the current table. @@ -140,7 +110,8 @@ package body Prj.Env is -- Return True if there is at least one ALI file in the directory Dir procedure Create_New_Path_File - (Path_FD : out File_Descriptor; + (In_Tree : Project_Tree_Ref; + Path_FD : out File_Descriptor; Path_Name : out Name_Id); -- Create a new temporary path file. Get the file name in Path_Name. -- The name is normally obtained by increasing the number in @@ -149,7 +120,8 @@ package body Prj.Env is procedure Set_Path_File_Var (Name : String; Value : String); -- Call Setenv, after calling To_Host_File_Spec - function Ultimate_Extension_Of (Project : in Project_Id) return Project_Id; + function Ultimate_Extension_Of + (Project : in Project_Id; In_Tree : Project_Tree_Ref) return Project_Id; -- Return a project that is either Project or an extended ancestor of -- Project that itself is not extended. @@ -157,7 +129,9 @@ package body Prj.Env is -- Ada_Include_Path -- ---------------------- - function Ada_Include_Path (Project : Project_Id) return String_Access is + function Ada_Include_Path + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return String_Access is procedure Add (Project : Project_Id); -- Add all the source directories of a project to the path only if @@ -173,17 +147,18 @@ package body Prj.Env is begin -- If Seen is empty, then the project cannot have been visited - if not Projects.Table (Project).Seen then - Projects.Table (Project).Seen := True; + if not In_Tree.Projects.Table (Project).Seen then + In_Tree.Projects.Table (Project).Seen := True; declare - Data : constant Project_Data := Projects.Table (Project); + Data : constant Project_Data := + In_Tree.Projects.Table (Project); List : Project_List := Data.Imported_Projects; begin -- Add to path all source directories of this project - Add_To_Path (Data.Source_Dirs); + Add_To_Path (Data.Source_Dirs, In_Tree); -- Call Add to the project being extended, if any @@ -194,8 +169,9 @@ package body Prj.Env is -- Call Add for each imported project, if any while List /= Empty_Project_List loop - Add (Project_Lists.Table (List).Project); - List := Project_Lists.Table (List).Next; + Add + (In_Tree.Project_Lists.Table (List).Project); + List := In_Tree.Project_Lists.Table (List).Next; end loop; end; end if; @@ -207,19 +183,23 @@ package body Prj.Env is -- If it is the first time we call this function for -- this project, compute the source path - if Projects.Table (Project).Ada_Include_Path = null then + if + In_Tree.Projects.Table (Project).Ada_Include_Path = null + then Ada_Path_Length := 0; - for Index in 1 .. Projects.Last loop - Projects.Table (Index).Seen := False; + for Index in Project_Table.First .. + Project_Table.Last (In_Tree.Projects) + loop + In_Tree.Projects.Table (Index).Seen := False; end loop; Add (Project); - Projects.Table (Project).Ada_Include_Path := + In_Tree.Projects.Table (Project).Ada_Include_Path := new String'(Ada_Path_Buffer (1 .. Ada_Path_Length)); end if; - return Projects.Table (Project).Ada_Include_Path; + return In_Tree.Projects.Table (Project).Ada_Include_Path; end Ada_Include_Path; ---------------------- @@ -228,14 +208,16 @@ package body Prj.Env is function Ada_Include_Path (Project : Project_Id; + In_Tree : Project_Tree_Ref; Recursive : Boolean) return String is begin if Recursive then - return Ada_Include_Path (Project).all; + return Ada_Include_Path (Project, In_Tree).all; else Ada_Path_Length := 0; - Add_To_Path (Projects.Table (Project).Source_Dirs); + Add_To_Path + (In_Tree.Projects.Table (Project).Source_Dirs, In_Tree); return Ada_Path_Buffer (1 .. Ada_Path_Length); end if; end Ada_Include_Path; @@ -246,6 +228,7 @@ package body Prj.Env is function Ada_Objects_Path (Project : Project_Id; + In_Tree : Project_Tree_Ref; Including_Libraries : Boolean := True) return String_Access is procedure Add (Project : Project_Id); @@ -262,11 +245,12 @@ package body Prj.Env is begin -- If this project has not been seen yet - if not Projects.Table (Project).Seen then - Projects.Table (Project).Seen := True; + if not In_Tree.Projects.Table (Project).Seen then + In_Tree.Projects.Table (Project).Seen := True; declare - Data : constant Project_Data := Projects.Table (Project); + Data : constant Project_Data := + In_Tree.Projects.Table (Project); List : Project_List := Data.Imported_Projects; begin @@ -286,7 +270,8 @@ package body Prj.Env is if Data.Library then if Data.Object_Directory = No_Name - or else Contains_ALI_Files (Data.Library_Dir) + or else + Contains_ALI_Files (Data.Library_Dir) then Add_To_Path (Get_Name_String (Data.Library_Dir)); else @@ -309,8 +294,9 @@ package body Prj.Env is -- Call Add for each imported project, if any while List /= Empty_Project_List loop - Add (Project_Lists.Table (List).Project); - List := Project_Lists.Table (List).Next; + Add + (In_Tree.Project_Lists.Table (List).Project); + List := In_Tree.Project_Lists.Table (List).Next; end loop; end; @@ -323,60 +309,78 @@ package body Prj.Env is -- If it is the first time we call this function for -- this project, compute the objects path - if Projects.Table (Project).Ada_Objects_Path = null then + if + In_Tree.Projects.Table (Project).Ada_Objects_Path = null + then Ada_Path_Length := 0; - for Index in 1 .. Projects.Last loop - Projects.Table (Index).Seen := False; + for Index in Project_Table.First .. + Project_Table.Last (In_Tree.Projects) + loop + In_Tree.Projects.Table (Index).Seen := False; end loop; Add (Project); - Projects.Table (Project).Ada_Objects_Path := + In_Tree.Projects.Table (Project).Ada_Objects_Path := new String'(Ada_Path_Buffer (1 .. Ada_Path_Length)); end if; - return Projects.Table (Project).Ada_Objects_Path; + return In_Tree.Projects.Table (Project).Ada_Objects_Path; end Ada_Objects_Path; ------------------------ -- Add_To_Object_Path -- ------------------------ - procedure Add_To_Object_Path (Object_Dir : Name_Id) is + procedure Add_To_Object_Path + (Object_Dir : Name_Id; In_Tree : Project_Tree_Ref) + is begin -- Check if the directory is already in the table - for Index in 1 .. Object_Paths.Last loop + for Index in Object_Path_Table.First .. + Object_Path_Table.Last (In_Tree.Private_Part.Object_Paths) + loop -- If it is, remove it, and add it as the last one - if Object_Paths.Table (Index) = Object_Dir then - for Index2 in Index + 1 .. Object_Paths.Last loop - Object_Paths.Table (Index2 - 1) := - Object_Paths.Table (Index2); + if In_Tree.Private_Part.Object_Paths.Table (Index) = Object_Dir then + for Index2 in Index + 1 .. + Object_Path_Table.Last + (In_Tree.Private_Part.Object_Paths) + loop + In_Tree.Private_Part.Object_Paths.Table (Index2 - 1) := + In_Tree.Private_Part.Object_Paths.Table (Index2); end loop; - Object_Paths.Table (Object_Paths.Last) := Object_Dir; + In_Tree.Private_Part.Object_Paths.Table + (Object_Path_Table.Last (In_Tree.Private_Part.Object_Paths)) := + Object_Dir; return; end if; end loop; -- The directory is not already in the table, add it - Object_Paths.Increment_Last; - Object_Paths.Table (Object_Paths.Last) := Object_Dir; + Object_Path_Table.Increment_Last (In_Tree.Private_Part.Object_Paths); + In_Tree.Private_Part.Object_Paths.Table + (Object_Path_Table.Last (In_Tree.Private_Part.Object_Paths)) := + Object_Dir; end Add_To_Object_Path; ----------------- -- Add_To_Path -- ----------------- - procedure Add_To_Path (Source_Dirs : String_List_Id) is + procedure Add_To_Path + (Source_Dirs : String_List_Id; + In_Tree : Project_Tree_Ref) + is Current : String_List_Id := Source_Dirs; Source_Dir : String_Element; begin while Current /= Nil_String loop - Source_Dir := String_Elements.Table (Current); + Source_Dir := In_Tree.String_Elements.Table (Current); Add_To_Path (Get_Name_String (Source_Dir.Display_Value)); Current := Source_Dir.Next; end loop; @@ -467,7 +471,9 @@ package body Prj.Env is -- Add_To_Source_Path -- ------------------------ - procedure Add_To_Source_Path (Source_Dirs : String_List_Id) is + procedure Add_To_Source_Path + (Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref) + is Current : String_List_Id := Source_Dirs; Source_Dir : String_Element; Add_It : Boolean; @@ -476,23 +482,31 @@ package body Prj.Env is -- Add each source directory while Current /= Nil_String loop - Source_Dir := String_Elements.Table (Current); + Source_Dir := In_Tree.String_Elements.Table (Current); Add_It := True; -- Check if the source directory is already in the table - for Index in 1 .. Source_Paths.Last loop + for Index in Source_Path_Table.First .. + Source_Path_Table.Last + (In_Tree.Private_Part.Source_Paths) + loop -- If it is already, no need to add it - if Source_Paths.Table (Index) = Source_Dir.Value then + if In_Tree.Private_Part.Source_Paths.Table (Index) = + Source_Dir.Value + then Add_It := False; exit; end if; end loop; if Add_It then - Source_Paths.Increment_Last; - Source_Paths.Table (Source_Paths.Last) := Source_Dir.Value; + Source_Path_Table.Increment_Last + (In_Tree.Private_Part.Source_Paths); + In_Tree.Private_Part.Source_Paths.Table + (Source_Path_Table.Last (In_Tree.Private_Part.Source_Paths)) := + Source_Dir.Value; end if; -- Next source directory @@ -505,8 +519,10 @@ package body Prj.Env is -- Body_Path_Name_Of -- ----------------------- - function Body_Path_Name_Of (Unit : Unit_Id) return String is - Data : Unit_Data := Units.Table (Unit); + function Body_Path_Name_Of + (Unit : Unit_Id; In_Tree : Project_Tree_Ref) return String + is + Data : Unit_Data := In_Tree.Units.Table (Unit); begin -- If we don't know the path name of the body of this unit, @@ -515,7 +531,8 @@ package body Prj.Env is if Data.File_Names (Body_Part).Path = No_Name then declare Current_Source : String_List_Id := - Projects.Table (Data.File_Names (Body_Part).Project).Sources; + In_Tree.Projects.Table + (Data.File_Names (Body_Part).Project).Sources; Path : GNAT.OS_Lib.String_Access; begin @@ -532,10 +549,11 @@ package body Prj.Env is (Namet.Get_Name_String (Data.File_Names (Body_Part).Name), Namet.Get_Name_String - (String_Elements.Table (Current_Source).Value)); + (In_Tree.String_Elements.Table + (Current_Source).Value)); - -- If the file is in this directory, - -- then we store the path, and we are done. + -- If the file is in this directory, then we store the path, + -- and we are done. if Path /= null then Name_Len := Path'Length; @@ -545,11 +563,12 @@ package body Prj.Env is else Current_Source := - String_Elements.Table (Current_Source).Next; + In_Tree.String_Elements.Table + (Current_Source).Next; end if; end loop; - Units.Table (Unit) := Data; + In_Tree.Units.Table (Unit) := Data; end; end if; @@ -604,6 +623,7 @@ package body Prj.Env is procedure Create_Config_Pragmas_File (For_Project : Project_Id; Main_Project : Project_Id; + In_Tree : Project_Tree_Ref; Include_Config_Files : Boolean := True) is pragma Unreferenced (Main_Project); @@ -612,7 +632,7 @@ package body Prj.Env is File_Name : Name_Id := No_Name; File : File_Descriptor := Invalid_FD; - Current_Unit : Unit_Id := Units.First; + Current_Unit : Unit_Id := Unit_Table.First; First_Project : Project_List := Empty_Project_List; @@ -648,7 +668,8 @@ package body Prj.Env is ----------- procedure Check (Project : Project_Id) is - Data : constant Project_Data := Projects.Table (Project); + Data : constant Project_Data := + In_Tree.Projects.Table (Project); begin if Current_Verbosity = High then @@ -662,34 +683,44 @@ package body Prj.Env is Current_Project := First_Project; while Current_Project /= Empty_Project_List - and then Project_Lists.Table (Current_Project).Project /= Project + and then In_Tree.Project_Lists.Table + (Current_Project).Project /= Project loop - Current_Project := Project_Lists.Table (Current_Project).Next; + Current_Project := + In_Tree.Project_Lists.Table (Current_Project).Next; end loop; -- If it is not, put it in the list, and visit it if Current_Project = Empty_Project_List then - Project_Lists.Increment_Last; - Project_Lists.Table (Project_Lists.Last) := - (Project => Project, Next => First_Project); - First_Project := Project_Lists.Last; + Project_List_Table.Increment_Last + (In_Tree.Project_Lists); + In_Tree.Project_Lists.Table + (Project_List_Table.Last (In_Tree.Project_Lists)) := + (Project => Project, Next => First_Project); + First_Project := + Project_List_Table.Last (In_Tree.Project_Lists); -- Is the naming scheme of this project one that we know? Current_Naming := Default_Naming; - while Current_Naming <= Namings.Last and then - not Same_Naming_Scheme - (Left => Namings.Table (Current_Naming), + while Current_Naming <= + Naming_Table.Last (In_Tree.Private_Part.Namings) + and then not Same_Naming_Scheme + (Left => In_Tree.Private_Part.Namings.Table (Current_Naming), Right => Data.Naming) loop Current_Naming := Current_Naming + 1; end loop; -- If we don't know it, add it - if Current_Naming > Namings.Last then - Namings.Increment_Last; - Namings.Table (Namings.Last) := Data.Naming; + if Current_Naming > + Naming_Table.Last (In_Tree.Private_Part.Namings) + then + Naming_Table.Increment_Last (In_Tree.Private_Part.Namings); + In_Tree.Private_Part.Namings.Table + (Naming_Table.Last (In_Tree.Private_Part.Namings)) := + Data.Naming; -- We need a temporary file to be created @@ -760,8 +791,11 @@ package body Prj.Env is begin while Current /= Empty_Project_List loop - Check (Project_Lists.Table (Current).Project); - Current := Project_Lists.Table (Current).Next; + Check + (In_Tree.Project_Lists.Table + (Current).Project); + Current := In_Tree.Project_Lists.Table + (Current).Next; end loop; end; end if; @@ -870,11 +904,13 @@ package body Prj.Env is -- Start of processing for Create_Config_Pragmas_File begin - if not Projects.Table (For_Project).Config_Checked then + if not + In_Tree.Projects.Table (For_Project).Config_Checked + then -- Remove any memory of processed naming schemes, if any - Namings.Set_Last (Default_Naming); + Naming_Table.Set_Last (In_Tree.Private_Part.Namings, Default_Naming); -- Check the naming schemes @@ -882,10 +918,12 @@ package body Prj.Env is -- Visit all the units and process those that need an SFN pragma - while Current_Unit <= Units.Last loop + while + Current_Unit <= Unit_Table.Last (In_Tree.Units) + loop declare Unit : constant Unit_Data := - Units.Table (Current_Unit); + In_Tree.Units.Table (Current_Unit); begin if Unit.File_Names (Specification).Needs_Pragma then @@ -938,10 +976,13 @@ package body Prj.Env is Write_Line (""""); end if; - Projects.Table (For_Project).Config_File_Name := File_Name; - Projects.Table (For_Project).Config_File_Temp := True; + In_Tree.Projects.Table (For_Project).Config_File_Name := + File_Name; + In_Tree.Projects.Table (For_Project).Config_File_Temp := + True; - Projects.Table (For_Project).Config_Checked := True; + In_Tree.Projects.Table (For_Project).Config_Checked := + True; end if; end Create_Config_Pragmas_File; @@ -951,6 +992,7 @@ package body Prj.Env is procedure Create_Mapping_File (Project : Project_Id; + In_Tree : Project_Tree_Ref; Name : out Name_Id) is File : File_Descriptor := Invalid_FD; @@ -960,7 +1002,8 @@ package body Prj.Env is Status : Boolean; -- For call to Close - Present : Project_Flags (No_Project .. Projects.Last) := + Present : Project_Flags + (No_Project .. Project_Table.Last (In_Tree.Projects)) := (others => False); -- For each project in the closure of Project, the corresponding flag -- will be set to True; @@ -1045,19 +1088,22 @@ package body Prj.Env is -- Flag the current project Present (Prj) := True; - Imported := Projects.Table (Prj).Imported_Projects; + Imported := + In_Tree.Projects.Table (Prj).Imported_Projects; -- Call itself for each project directly imported while Imported /= Empty_Project_List loop - Proj := Project_Lists.Table (Imported).Project; - Imported := Project_Lists.Table (Imported).Next; + Proj := + In_Tree.Project_Lists.Table (Imported).Project; + Imported := + In_Tree.Project_Lists.Table (Imported).Next; Recursive_Flag (Proj); end loop; -- Call itself for an eventual project being extended - Recursive_Flag (Projects.Table (Prj).Extends); + Recursive_Flag (In_Tree.Projects.Table (Prj).Extends); end Recursive_Flag; -- Start of processing for Create_Mapping_File @@ -1081,10 +1127,11 @@ package body Prj.Env is end if; if Fill_Mapping_File then + -- For all units in table Units - for Unit in 1 .. Units.Last loop - The_Unit_Data := Units.Table (Unit); + for Unit in 1 .. Unit_Table.Last (In_Tree.Units) loop + The_Unit_Data := In_Tree.Units.Table (Unit); -- If the unit has a valid name @@ -1123,7 +1170,8 @@ package body Prj.Env is -------------------------- procedure Create_New_Path_File - (Path_FD : out File_Descriptor; + (In_Tree : Project_Tree_Ref; + Path_FD : out File_Descriptor; Path_Name : out Name_Id) is begin @@ -1134,8 +1182,10 @@ package body Prj.Env is -- Record the name, so that the temp path file will be deleted -- at the end of the program. - Path_Files.Increment_Last; - Path_Files.Table (Path_Files.Last) := Path_Name; + Path_File_Table.Increment_Last (In_Tree.Private_Part.Path_Files); + In_Tree.Private_Part.Path_Files.Table + (Path_File_Table.Last (In_Tree.Private_Part.Path_Files)) := + Path_Name; end if; end Create_New_Path_File; @@ -1143,14 +1193,18 @@ package body Prj.Env is -- Delete_All_Path_Files -- --------------------------- - procedure Delete_All_Path_Files is + procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref) is Disregard : Boolean := True; begin - for Index in 1 .. Path_Files.Last loop - if Path_Files.Table (Index) /= No_Name then + for Index in Path_File_Table.First .. + Path_File_Table.Last (In_Tree.Private_Part.Path_Files) + loop + if In_Tree.Private_Part.Path_Files.Table (Index) /= No_Name then Delete_File - (Get_Name_String (Path_Files.Table (Index)), Disregard); + (Get_Name_String + (In_Tree.Private_Part.Path_Files.Table (Index)), + Disregard); end if; end loop; @@ -1177,11 +1231,13 @@ package body Prj.Env is function File_Name_Of_Library_Unit_Body (Name : String; Project : Project_Id; + In_Tree : Project_Tree_Ref; Main_Project_Only : Boolean := True; Full_Path : Boolean := False) return String is The_Project : Project_Id := Project; - Data : Project_Data := Projects.Table (Project); + Data : Project_Data := + In_Tree.Projects.Table (Project); Original_Name : String := Name; Extended_Spec_Name : String := @@ -1236,8 +1292,10 @@ package body Prj.Env is -- Loop through units -- Should have comment explaining reverse ??? - for Current in reverse Units.First .. Units.Last loop - Unit := Units.Table (Current); + for Current in reverse Unit_Table.First .. + Unit_Table.Last (In_Tree.Units) + loop + Unit := In_Tree.Units.Table (Current); -- Check for body @@ -1370,7 +1428,7 @@ package body Prj.Env is -- Otherwise, look in the project we are extending The_Project := Data.Extends; - Data := Projects.Table (The_Project); + Data := In_Tree.Projects.Table (The_Project); end loop; -- We don't know this file name, return an empty string @@ -1382,7 +1440,10 @@ package body Prj.Env is -- For_All_Object_Dirs -- ------------------------- - procedure For_All_Object_Dirs (Project : Project_Id) is + procedure For_All_Object_Dirs + (Project : Project_Id; + In_Tree : Project_Tree_Ref) + is Seen : Project_List := Empty_Project_List; procedure Add (Project : Project_Id); @@ -1395,7 +1456,8 @@ package body Prj.Env is --------- procedure Add (Project : Project_Id) is - Data : constant Project_Data := Projects.Table (Project); + Data : constant Project_Data := + In_Tree.Projects.Table (Project); List : Project_List := Data.Imported_Projects; begin @@ -1403,9 +1465,11 @@ package body Prj.Env is -- for sure we never visited this project. if Seen = Empty_Project_List then - Project_Lists.Increment_Last; - Seen := Project_Lists.Last; - Project_Lists.Table (Seen) := + Project_List_Table.Increment_Last + (In_Tree.Project_Lists); + Seen := + Project_List_Table.Last (In_Tree.Project_Lists); + In_Tree.Project_Lists.Table (Seen) := (Project => Project, Next => Empty_Project_List); else @@ -1418,21 +1482,29 @@ package body Prj.Env is loop -- If it is, then there is nothing else to do - if Project_Lists.Table (Current).Project = Project then + if In_Tree.Project_Lists.Table + (Current).Project = Project + then return; end if; - exit when Project_Lists.Table (Current).Next = - Empty_Project_List; - Current := Project_Lists.Table (Current).Next; + exit when + In_Tree.Project_Lists.Table (Current).Next = + Empty_Project_List; + Current := + In_Tree.Project_Lists.Table (Current).Next; end loop; -- This project has never been visited, add it -- to the list. - Project_Lists.Increment_Last; - Project_Lists.Table (Current).Next := Project_Lists.Last; - Project_Lists.Table (Project_Lists.Last) := + Project_List_Table.Increment_Last + (In_Tree.Project_Lists); + In_Tree.Project_Lists.Table (Current).Next := + Project_List_Table.Last (In_Tree.Project_Lists); + In_Tree.Project_Lists.Table + (Project_List_Table.Last + (In_Tree.Project_Lists)) := (Project => Project, Next => Empty_Project_List); end; end if; @@ -1454,8 +1526,8 @@ package body Prj.Env is -- And visit all imported projects while List /= Empty_Project_List loop - Add (Project_Lists.Table (List).Project); - List := Project_Lists.Table (List).Next; + Add (In_Tree.Project_Lists.Table (List).Project); + List := In_Tree.Project_Lists.Table (List).Next; end loop; end Add; @@ -1472,7 +1544,10 @@ package body Prj.Env is -- For_All_Source_Dirs -- ------------------------- - procedure For_All_Source_Dirs (Project : Project_Id) is + procedure For_All_Source_Dirs + (Project : Project_Id; + In_Tree : Project_Tree_Ref) + is Seen : Project_List := Empty_Project_List; procedure Add (Project : Project_Id); @@ -1485,7 +1560,8 @@ package body Prj.Env is --------- procedure Add (Project : Project_Id) is - Data : constant Project_Data := Projects.Table (Project); + Data : constant Project_Data := + In_Tree.Projects.Table (Project); List : Project_List := Data.Imported_Projects; begin @@ -1493,9 +1569,11 @@ package body Prj.Env is -- for sure we never visited this project. if Seen = Empty_Project_List then - Project_Lists.Increment_Last; - Seen := Project_Lists.Last; - Project_Lists.Table (Seen) := + Project_List_Table.Increment_Last + (In_Tree.Project_Lists); + Seen := Project_List_Table.Last + (In_Tree.Project_Lists); + In_Tree.Project_Lists.Table (Seen) := (Project => Project, Next => Empty_Project_List); else @@ -1508,21 +1586,29 @@ package body Prj.Env is loop -- If it is, then there is nothing else to do - if Project_Lists.Table (Current).Project = Project then + if In_Tree.Project_Lists.Table + (Current).Project = Project + then return; end if; - exit when Project_Lists.Table (Current).Next = - Empty_Project_List; - Current := Project_Lists.Table (Current).Next; + exit when + In_Tree.Project_Lists.Table (Current).Next = + Empty_Project_List; + Current := + In_Tree.Project_Lists.Table (Current).Next; end loop; -- This project has never been visited, add it -- to the list. - Project_Lists.Increment_Last; - Project_Lists.Table (Current).Next := Project_Lists.Last; - Project_Lists.Table (Project_Lists.Last) := + Project_List_Table.Increment_Last + (In_Tree.Project_Lists); + In_Tree.Project_Lists.Table (Current).Next := + Project_List_Table.Last (In_Tree.Project_Lists); + In_Tree.Project_Lists.Table + (Project_List_Table.Last + (In_Tree.Project_Lists)) := (Project => Project, Next => Empty_Project_List); end; end if; @@ -1535,9 +1621,12 @@ package body Prj.Env is -- If there are Ada sources, call action with the name of every -- source directory. - if Projects.Table (Project).Ada_Sources_Present then + if + In_Tree.Projects.Table (Project).Ada_Sources_Present + then while Current /= Nil_String loop - The_String := String_Elements.Table (Current); + The_String := + In_Tree.String_Elements.Table (Current); Action (Get_Name_String (The_String.Value)); Current := The_String.Next; end loop; @@ -1553,8 +1642,8 @@ package body Prj.Env is -- And visit all imported projects while List /= Empty_Project_List loop - Add (Project_Lists.Table (List).Project); - List := Project_Lists.Table (List).Next; + Add (In_Tree.Project_Lists.Table (List).Project); + List := In_Tree.Project_Lists.Table (List).Next; end loop; end Add; @@ -1572,6 +1661,7 @@ package body Prj.Env is procedure Get_Reference (Source_File_Name : String; + In_Tree : Project_Tree_Ref; Project : out Project_Id; Path : out Name_Id) is @@ -1591,8 +1681,10 @@ package body Prj.Env is begin Canonical_Case_File_Name (Original_Name); - for Id in Units.First .. Units.Last loop - Unit := Units.Table (Id); + for Id in Unit_Table.First .. + Unit_Table.Last (In_Tree.Units) + loop + Unit := In_Tree.Units.Table (Id); if (Unit.File_Names (Specification).Name /= No_Name and then @@ -1605,7 +1697,8 @@ package body Prj.Env is Original_Name) then Project := Ultimate_Extension_Of - (Unit.File_Names (Specification).Project); + (Project => Unit.File_Names (Specification).Project, + In_Tree => In_Tree); Path := Unit.File_Names (Specification).Display_Path; if Current_Verbosity > Default then @@ -1625,7 +1718,8 @@ package body Prj.Env is Original_Name) then Project := Ultimate_Extension_Of - (Unit.File_Names (Body_Part).Project); + (Project => Unit.File_Names (Body_Part).Project, + In_Tree => In_Tree); Path := Unit.File_Names (Body_Part).Display_Path; if Current_Verbosity > Default then @@ -1651,12 +1745,9 @@ package body Prj.Env is -- Initialize -- ---------------- - -- This is a place holder for possible required initialization in - -- the future. In the current version no initialization is required. - procedure Initialize is begin - null; + Fill_Mapping_File := True; end Initialize; ------------------------------------ @@ -1667,9 +1758,11 @@ package body Prj.Env is function Path_Name_Of_Library_Unit_Body (Name : String; - Project : Project_Id) return String + Project : Project_Id; + In_Tree : Project_Tree_Ref) return String is - Data : constant Project_Data := Projects.Table (Project); + Data : constant Project_Data := + In_Tree.Projects.Table (Project); Original_Name : String := Name; Extended_Spec_Name : String := @@ -1679,7 +1772,7 @@ package body Prj.Env is Name & Namet.Get_Name_String (Data.Naming.Ada_Body_Suffix); - First : Unit_Id := Units.First; + First : Unit_Id := Unit_Table.First; Current : Unit_Id; Unit : Unit_Data; @@ -1703,15 +1796,16 @@ package body Prj.Env is Write_Eol; end if; - while First <= Units.Last - and then Units.Table (First).File_Names (Body_Part).Project /= Project + while First <= Unit_Table.Last (In_Tree.Units) + and then In_Tree.Units.Table + (First).File_Names (Body_Part).Project /= Project loop First := First + 1; end loop; Current := First; - while Current <= Units.Last loop - Unit := Units.Table (Current); + while Current <= Unit_Table.Last (In_Tree.Units) loop + Unit := In_Tree.Units.Table (Current); if Unit.File_Names (Body_Part).Project = Project and then Unit.File_Names (Body_Part).Name /= No_Name @@ -1732,14 +1826,14 @@ package body Prj.Env is Write_Line (" OK"); end if; - return Body_Path_Name_Of (Current); + return Body_Path_Name_Of (Current, In_Tree); elsif Current_Name = Extended_Body_Name then if Current_Verbosity = High then Write_Line (" OK"); end if; - return Body_Path_Name_Of (Current); + return Body_Path_Name_Of (Current, In_Tree); else if Current_Verbosity = High then @@ -1767,14 +1861,14 @@ package body Prj.Env is Write_Line (" OK"); end if; - return Spec_Path_Name_Of (Current); + return Spec_Path_Name_Of (Current, In_Tree); elsif Current_Name = Extended_Spec_Name then if Current_Verbosity = High then Write_Line (" OK"); end if; - return Spec_Path_Name_Of (Current); + return Spec_Path_Name_Of (Current, In_Tree); else if Current_Verbosity = High then @@ -1795,14 +1889,16 @@ package body Prj.Env is -- Could use some comments in this body ??? - procedure Print_Sources is + procedure Print_Sources (In_Tree : Project_Tree_Ref) is Unit : Unit_Data; begin Write_Line ("List of Sources:"); - for Id in Units.First .. Units.Last loop - Unit := Units.Table (Id); + for Id in Unit_Table.First .. + Unit_Table.Last (In_Tree.Units) + loop + Unit := In_Tree.Units.Table (Id); Write_Str (" "); Write_Line (Namet.Get_Name_String (Unit.Name)); @@ -1813,7 +1909,7 @@ package body Prj.Env is else Write_Str (" Project: "); Get_Name_String - (Projects.Table + (In_Tree.Projects.Table (Unit.File_Names (Specification).Project).Path_Name); Write_Line (Name_Buffer (1 .. Name_Len)); end if; @@ -1831,7 +1927,7 @@ package body Prj.Env is else Write_Str (" Project: "); Get_Name_String - (Projects.Table + (In_Tree.Projects.Table (Unit.File_Names (Body_Part).Project).Path_Name); Write_Line (Name_Buffer (1 .. Name_Len)); end if; @@ -1852,13 +1948,15 @@ package body Prj.Env is function Project_Of (Name : String; - Main_Project : Project_Id) return Project_Id + Main_Project : Project_Id; + In_Tree : Project_Tree_Ref) return Project_Id is Result : Project_Id := No_Project; Original_Name : String := Name; - Data : constant Project_Data := Projects.Table (Main_Project); + Data : constant Project_Data := + In_Tree.Projects.Table (Main_Project); Extended_Spec_Name : String := Name & Namet.Get_Name_String @@ -1891,8 +1989,10 @@ package body Prj.Env is Name_Buffer (1 .. Name_Len) := Extended_Body_Name; The_Body_Name := Name_Find; - for Current in reverse Units.First .. Units.Last loop - Unit := Units.Table (Current); + for Current in reverse Unit_Table.First .. + Unit_Table.Last (In_Tree.Units) + loop + Unit := In_Tree.Units.Table (Current); -- Check for body @@ -1936,8 +2036,10 @@ package body Prj.Env is -- Get the ultimate extending project if Result /= No_Project then - while Projects.Table (Result).Extended_By /= No_Project loop - Result := Projects.Table (Result).Extended_By; + while In_Tree.Projects.Table (Result).Extended_By /= + No_Project + loop + Result := In_Tree.Projects.Table (Result).Extended_By; end loop; end if; @@ -1950,6 +2052,7 @@ package body Prj.Env is procedure Set_Ada_Paths (Project : Project_Id; + In_Tree : Project_Tree_Ref; Including_Libraries : Boolean) is Source_FD : File_Descriptor := Invalid_FD; @@ -1986,11 +2089,12 @@ package body Prj.Env is begin -- If Seen is False, then the project has not yet been visited - if not Projects.Table (Project).Seen then - Projects.Table (Project).Seen := True; + if not In_Tree.Projects.Table (Project).Seen then + In_Tree.Projects.Table (Project).Seen := True; declare - Data : constant Project_Data := Projects.Table (Project); + Data : constant Project_Data := + In_Tree.Projects.Table (Project); List : Project_List := Data.Imported_Projects; begin @@ -1999,8 +2103,10 @@ package body Prj.Env is -- Add to path all source directories of this project -- if there are Ada sources. - if Projects.Table (Project).Ada_Sources_Present then - Add_To_Source_Path (Data.Source_Dirs); + if In_Tree.Projects.Table + (Project).Ada_Sources_Present + then + Add_To_Source_Path (Data.Source_Dirs, In_Tree); end if; end if; @@ -2025,16 +2131,18 @@ package body Prj.Env is if Data.Object_Directory = No_Name or else Contains_ALI_Files (Data.Library_Dir) then - Add_To_Object_Path (Data.Library_Dir); + Add_To_Object_Path (Data.Library_Dir, In_Tree); else - Add_To_Object_Path (Data.Object_Directory); + Add_To_Object_Path + (Data.Object_Directory, In_Tree); end if; -- For a non-library project, add the object -- directory, if it is not a virtual project. elsif not Data.Virtual then - Add_To_Object_Path (Data.Object_Directory); + Add_To_Object_Path + (Data.Object_Directory, In_Tree); end if; end if; end if; @@ -2048,19 +2156,24 @@ package body Prj.Env is -- Call Add for each imported project, if any while List /= Empty_Project_List loop - Recursive_Add (Project_Lists.Table (List).Project); - List := Project_Lists.Table (List).Next; + Recursive_Add + (In_Tree.Project_Lists.Table + (List).Project); + List := + In_Tree.Project_Lists.Table (List).Next; end loop; end; end if; end Recursive_Add; begin - Source_Paths.Set_Last (0); - Object_Paths.Set_Last (0); + Source_Path_Table.Set_Last (In_Tree.Private_Part.Source_Paths, 0); + Object_Path_Table.Set_Last (In_Tree.Private_Part.Object_Paths, 0); - for Index in 1 .. Projects.Last loop - Projects.Table (Index).Seen := False; + for Index in Project_Table.First .. + Project_Table.Last (In_Tree.Projects) + loop + In_Tree.Projects.Table (Index).Seen := False; end loop; Recursive_Add (Proj); @@ -2072,30 +2185,35 @@ package body Prj.Env is -- If it is the first time we call this procedure for -- this project, compute the source path and/or the object path. - if Projects.Table (Project).Include_Path_File = No_Name then + if In_Tree.Projects.Table (Project).Include_Path_File = + No_Name + then Process_Source_Dirs := True; Create_New_Path_File - (Source_FD, Projects.Table (Project).Include_Path_File); + (In_Tree, Source_FD, + In_Tree.Projects.Table (Project).Include_Path_File); end if; -- For the object path, we make a distinction depending on -- Including_Libraries. if Including_Libraries then - if Projects.Table (Project).Objects_Path_File_With_Libs = No_Name then + if In_Tree.Projects.Table + (Project).Objects_Path_File_With_Libs = No_Name + then Process_Object_Dirs := True; Create_New_Path_File - (Object_FD, Projects.Table (Project). + (In_Tree, Object_FD, In_Tree.Projects.Table (Project). Objects_Path_File_With_Libs); end if; else - if - Projects.Table (Project).Objects_Path_File_Without_Libs = No_Name + if In_Tree.Projects.Table + (Project).Objects_Path_File_Without_Libs = No_Name then Process_Object_Dirs := True; Create_New_Path_File - (Object_FD, Projects.Table (Project). + (In_Tree, Object_FD, In_Tree.Projects.Table (Project). Objects_Path_File_Without_Libs); end if; end if; @@ -2110,8 +2228,11 @@ package body Prj.Env is -- Write and close any file that has been created. if Source_FD /= Invalid_FD then - for Index in 1 .. Source_Paths.Last loop - Get_Name_String (Source_Paths.Table (Index)); + for Index in Source_Path_Table.First .. + Source_Path_Table.Last + (In_Tree.Private_Part.Source_Paths) + loop + Get_Name_String (In_Tree.Private_Part.Source_Paths.Table (Index)); Name_Len := Name_Len + 1; Name_Buffer (Name_Len) := ASCII.LF; Len := Write (Source_FD, Name_Buffer (1)'Address, Name_Len); @@ -2129,8 +2250,11 @@ package body Prj.Env is end if; if Object_FD /= Invalid_FD then - for Index in 1 .. Object_Paths.Last loop - Get_Name_String (Object_Paths.Table (Index)); + for Index in Object_Path_Table.First .. + Object_Path_Table.Last + (In_Tree.Private_Part.Object_Paths) + loop + Get_Name_String (In_Tree.Private_Part.Object_Paths.Table (Index)); Name_Len := Name_Len + 1; Name_Buffer (Name_Len) := ASCII.LF; Len := Write (Object_FD, Name_Buffer (1)'Address, Name_Len); @@ -2151,10 +2275,10 @@ package body Prj.Env is -- corresponding flags. if Current_Source_Path_File /= - Projects.Table (Project).Include_Path_File + In_Tree.Projects.Table (Project).Include_Path_File then Current_Source_Path_File := - Projects.Table (Project).Include_Path_File; + In_Tree.Projects.Table (Project).Include_Path_File; Set_Path_File_Var (Project_Include_Path_File, Get_Name_String (Current_Source_Path_File)); @@ -2163,10 +2287,12 @@ package body Prj.Env is if Including_Libraries then if Current_Object_Path_File - /= Projects.Table (Project).Objects_Path_File_With_Libs + /= In_Tree.Projects.Table + (Project).Objects_Path_File_With_Libs then Current_Object_Path_File := - Projects.Table (Project).Objects_Path_File_With_Libs; + In_Tree.Projects.Table + (Project).Objects_Path_File_With_Libs; Set_Path_File_Var (Project_Objects_Path_File, Get_Name_String (Current_Object_Path_File)); @@ -2174,11 +2300,13 @@ package body Prj.Env is end if; else - if Current_Object_Path_File - /= Projects.Table (Project).Objects_Path_File_Without_Libs + if Current_Object_Path_File /= + In_Tree.Projects.Table + (Project).Objects_Path_File_Without_Libs then Current_Object_Path_File := - Projects.Table (Project).Objects_Path_File_Without_Libs; + In_Tree.Projects.Table + (Project).Objects_Path_File_Without_Libs; Set_Path_File_Var (Project_Objects_Path_File, Get_Name_String (Current_Object_Path_File)); @@ -2217,14 +2345,17 @@ package body Prj.Env is -- Spec_Path_Name_Of -- ----------------------- - function Spec_Path_Name_Of (Unit : Unit_Id) return String is - Data : Unit_Data := Units.Table (Unit); + function Spec_Path_Name_Of + (Unit : Unit_Id; In_Tree : Project_Tree_Ref) return String + is + Data : Unit_Data := In_Tree.Units.Table (Unit); begin if Data.File_Names (Specification).Path = No_Name then declare Current_Source : String_List_Id := - Projects.Table (Data.File_Names (Specification).Project).Sources; + In_Tree.Projects.Table + (Data.File_Names (Specification).Project).Sources; Path : GNAT.OS_Lib.String_Access; begin @@ -2236,7 +2367,8 @@ package body Prj.Env is (Namet.Get_Name_String (Data.File_Names (Specification).Name), Namet.Get_Name_String - (String_Elements.Table (Current_Source).Value)); + (In_Tree.String_Elements.Table + (Current_Source).Value)); if Path /= null then Name_Len := Path'Length; @@ -2245,11 +2377,12 @@ package body Prj.Env is exit; else Current_Source := - String_Elements.Table (Current_Source).Next; + In_Tree.String_Elements.Table + (Current_Source).Next; end if; end loop; - Units.Table (Unit) := Data; + In_Tree.Units.Table (Unit) := Data; end; end if; @@ -2260,21 +2393,19 @@ package body Prj.Env is -- Ultimate_Extension_Of -- --------------------------- - function Ultimate_Extension_Of (Project : in Project_Id) return Project_Id + function Ultimate_Extension_Of + (Project : Project_Id; In_Tree : Project_Tree_Ref) return Project_Id is Result : Project_Id := Project; begin - while Projects.Table (Result).Extended_By /= No_Project loop - Result := Projects.Table (Result).Extended_By; + while In_Tree.Projects.Table (Result).Extended_By /= + No_Project + loop + Result := In_Tree.Projects.Table (Result).Extended_By; end loop; return Result; end Ultimate_Extension_Of; --- Package initialization --- What is relationshiop to procedure Initialize - -begin - Path_Files.Set_Last (0); end Prj.Env; diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index 32dd37674a8..905e8d0d1ca 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc -- +-- Copyright (C) 2001-2005 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,14 +32,15 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; package Prj.Env is procedure Initialize; - -- Called by Prj.Initialize to perform required initialization - -- steps for this package. + -- Called by Prj.Initialize to perform required initialization steps for + -- this package. - procedure Print_Sources; + procedure Print_Sources (In_Tree : Project_Tree_Ref); -- Output the list of sources, after Project files have been scanned procedure Create_Mapping_File (Project : Project_Id; + In_Tree : Project_Tree_Ref; Name : out Name_Id); -- Create a temporary mapping file for project Project. For each unit -- in the closure of immediate sources of Project, put the mapping of @@ -52,6 +53,7 @@ package Prj.Env is procedure Create_Config_Pragmas_File (For_Project : Project_Id; Main_Project : Project_Id; + In_Tree : Project_Tree_Ref; Include_Config_Files : Boolean := True); -- If there needs to have SFN pragmas, either for non standard naming -- schemes or for individual units, or (when Include_Config_Files is True) @@ -61,12 +63,15 @@ package Prj.Env is -- a temporary file that contains all configuration pragmas, and specify -- the configuration pragmas file in the project data. - function Ada_Include_Path (Project : Project_Id) return String_Access; + function Ada_Include_Path + (Project : Project_Id; + In_Tree : Project_Tree_Ref) return String_Access; -- Get the ADA_INCLUDE_PATH of a Project file. For the first call, compute -- it and cache it. function Ada_Include_Path (Project : Project_Id; + In_Tree : Project_Tree_Ref; Recursive : Boolean) return String; -- Get the ADA_INCLUDE_PATH of a Project file. If Recursive it True, -- get all the source directories of the imported and modified project @@ -76,6 +81,7 @@ package Prj.Env is function Ada_Objects_Path (Project : Project_Id; + In_Tree : Project_Tree_Ref; Including_Libraries : Boolean := True) return String_Access; -- Get the ADA_OBJECTS_PATH of a Project file. For the first call, compute -- it and cache it. When Including_Libraries is False, do not include the @@ -83,22 +89,25 @@ package Prj.Env is procedure Set_Ada_Paths (Project : Project_Id; + In_Tree : Project_Tree_Ref; Including_Libraries : Boolean); -- Set the env vars for additional project path files, after -- creating the path files if necessary. - procedure Delete_All_Path_Files; + procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref); -- Delete all temporary path files that have been created by -- calls to Set_Ada_Paths. function Path_Name_Of_Library_Unit_Body (Name : String; - Project : Project_Id) return String; + Project : Project_Id; + In_Tree : Project_Tree_Ref) return String; -- Returns the Path of a library unit function File_Name_Of_Library_Unit_Body (Name : String; Project : Project_Id; + In_Tree : Project_Tree_Ref; Main_Project_Only : Boolean := True; Full_Path : Boolean := False) return String; -- Returns the file name of a library unit, in canonical case. Name may or @@ -117,7 +126,8 @@ package Prj.Env is function Project_Of (Name : String; - Main_Project : Project_Id) return Project_Id; + Main_Project : Project_Id; + In_Tree : Project_Tree_Ref) return Project_Id; -- Get the project of a source. The source file name may be truncated -- (".adb" or ".ads" may be missing). If the source is in a project being -- extended, return the ultimate extending project. If it is not a source @@ -125,20 +135,25 @@ package Prj.Env is procedure Get_Reference (Source_File_Name : String; + In_Tree : Project_Tree_Ref; Project : out Project_Id; Path : out Name_Id); -- Returns the project of a source and its path in displayable form generic with procedure Action (Path : String); - procedure For_All_Source_Dirs (Project : Project_Id); - -- Iterate through all the source directories of a project, - -- including those of imported or modified projects. + procedure For_All_Source_Dirs + (Project : Project_Id; + In_Tree : Project_Tree_Ref); + -- Iterate through all the source directories of a project, including + -- those of imported or modified projects. generic with procedure Action (Path : String); - procedure For_All_Object_Dirs (Project : Project_Id); - -- Iterate through all the object directories of a project, - -- including those of imported or modified projects. + procedure For_All_Object_Dirs + (Project : Project_Id; + In_Tree : Project_Tree_Ref); + -- Iterate through all the object directories of a project, including + -- those of imported or modified projects. end Prj.Env; diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index 22f94aeae4c..d04ab20bd6f 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -117,6 +117,10 @@ package body Prj.Makr is Preproc_Switches : Argument_List; Very_Verbose : Boolean) is + Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data; + + + Path_Name : String (1 .. File_Path'Length + Project_File_Extension'Length); Path_Last : Natural := File_Path'Length; @@ -475,46 +479,57 @@ package body Prj.Makr is Decl_Item : constant Project_Node_Id := Default_Project_Node (Of_Kind => - N_Declarative_Item); + N_Declarative_Item, + In_Tree => Tree); Attribute : constant Project_Node_Id := Default_Project_Node (Of_Kind => - N_Attribute_Declaration); + N_Attribute_Declaration, + In_Tree => Tree); Expression : constant Project_Node_Id := Default_Project_Node (Of_Kind => N_Expression, - And_Expr_Kind => Single); + And_Expr_Kind => Single, + In_Tree => Tree); Term : constant Project_Node_Id := Default_Project_Node (Of_Kind => N_Term, - And_Expr_Kind => Single); + And_Expr_Kind => Single, + In_Tree => Tree); Value : constant Project_Node_Id := Default_Project_Node - (Of_Kind => N_Literal_String, - And_Expr_Kind => Single); + (Of_Kind => N_Literal_String, + And_Expr_Kind => Single, + In_Tree => Tree); begin Set_Next_Declarative_Item (Decl_Item, To => First_Declarative_Item_Of - (Naming_Package)); + (Naming_Package, Tree), + In_Tree => Tree); Set_First_Declarative_Item_Of - (Naming_Package, To => Decl_Item); + (Naming_Package, + To => Decl_Item, + In_Tree => Tree); Set_Current_Item_Node - (Decl_Item, To => Attribute); + (Decl_Item, + To => Attribute, + In_Tree => Tree); -- Is it a spec or a body? if SFN_Prag.Spec then Set_Name_Of - (Attribute, To => Name_Spec); + (Attribute, Tree, + To => Name_Spec); else Set_Name_Of - (Attribute, + (Attribute, Tree, To => Name_Body); end if; @@ -523,20 +538,21 @@ package body Prj.Makr is Get_Name_String (SFN_Prag.Unit); To_Lower (Name_Buffer (1 .. Name_Len)); Set_Associative_Array_Index_Of - (Attribute, To => Name_Find); + (Attribute, Tree, To => Name_Find); Set_Expression_Of - (Attribute, To => Expression); + (Attribute, Tree, To => Expression); Set_First_Term - (Expression, To => Term); - Set_Current_Term (Term, To => Value); + (Expression, Tree, To => Term); + Set_Current_Term + (Term, Tree, To => Value); -- And set the name of the file Set_String_Value_Of - (Value, To => File_Name_Id); + (Value, Tree, To => File_Name_Id); Set_Source_Index_Of - (Value, To => SFN_Prag.Index); + (Value, Tree, To => SFN_Prag.Index); end; end if; end loop; @@ -649,7 +665,8 @@ package body Prj.Makr is Csets.Initialize; Namet.Initialize; Snames.Initialize; - Prj.Initialize; + Prj.Initialize (No_Project_Tree); + Prj.Tree.Initialize (Tree); SFN_Pragmas.Set_Last (0); @@ -707,7 +724,8 @@ package body Prj.Makr is end if; Part.Parse - (Project => Project_Node, + (In_Tree => Tree, + Project => Project_Node, Project_File_Name => Output_Name (1 .. Output_Name_Last), Always_Errout_Finalize => False); @@ -725,27 +743,29 @@ package body Prj.Makr is declare With_Clause : Project_Node_Id := - First_With_Clause_Of (Project_Node); + First_With_Clause_Of (Project_Node, Tree); Previous : Project_Node_Id := Empty_Node; begin while With_Clause /= Empty_Node loop - if Tree.Name_Of (With_Clause) = Project_Naming_Id then + if Prj.Tree.Name_Of (With_Clause, Tree) = + Project_Naming_Id + then if Previous = Empty_Node then Set_First_With_Clause_Of - (Project_Node, - To => Next_With_Clause_Of (With_Clause)); + (Project_Node, Tree, + To => Next_With_Clause_Of (With_Clause, Tree)); else Set_Next_With_Clause_Of - (Previous, - To => Next_With_Clause_Of (With_Clause)); + (Previous, Tree, + To => Next_With_Clause_Of (With_Clause, Tree)); end if; exit; end if; Previous := With_Clause; - With_Clause := Next_With_Clause_Of (With_Clause); + With_Clause := Next_With_Clause_Of (With_Clause, Tree); end loop; end; @@ -757,41 +777,45 @@ package body Prj.Makr is Declaration : Project_Node_Id := First_Declarative_Item_Of (Project_Declaration_Of - (Project_Node)); + (Project_Node, Tree), + Tree); Previous : Project_Node_Id := Empty_Node; Current_Node : Project_Node_Id := Empty_Node; begin while Declaration /= Empty_Node loop - Current_Node := Current_Item_Node (Declaration); + Current_Node := Current_Item_Node (Declaration, Tree); - if (Kind_Of (Current_Node) = N_Attribute_Declaration + if (Kind_Of (Current_Node, Tree) = N_Attribute_Declaration and then - (Tree.Name_Of (Current_Node) = Name_Source_Files - or else Tree.Name_Of (Current_Node) = - Name_Source_List_File - or else Tree.Name_Of (Current_Node) = - Name_Source_Dirs)) + (Prj.Tree.Name_Of (Current_Node, Tree) = + Name_Source_Files + or else Prj.Tree.Name_Of (Current_Node, Tree) = + Name_Source_List_File + or else Prj.Tree.Name_Of (Current_Node, Tree) = + Name_Source_Dirs)) or else - (Kind_Of (Current_Node) = N_Package_Declaration - and then Tree.Name_Of (Current_Node) = Name_Naming) + (Kind_Of (Current_Node, Tree) = N_Package_Declaration + and then Prj.Tree.Name_Of (Current_Node, Tree) = + Name_Naming) then if Previous = Empty_Node then Set_First_Declarative_Item_Of - (Project_Declaration_Of (Project_Node), - To => Next_Declarative_Item (Declaration)); + (Project_Declaration_Of (Project_Node, Tree), + Tree, + To => Next_Declarative_Item (Declaration, Tree)); else Set_Next_Declarative_Item - (Previous, - To => Next_Declarative_Item (Declaration)); + (Previous, Tree, + To => Next_Declarative_Item (Declaration, Tree)); end if; else Previous := Declaration; end if; - Declaration := Next_Declarative_Item (Declaration); + Declaration := Next_Declarative_Item (Declaration, Tree); end loop; end; end if; @@ -971,11 +995,13 @@ package body Prj.Makr is -- name and its project declaration node. if Project_Node = Empty_Node then - Project_Node := Default_Project_Node (Of_Kind => N_Project); - Set_Name_Of (Project_Node, To => Output_Name_Id); + Project_Node := + Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree); + Set_Name_Of (Project_Node, Tree, To => Output_Name_Id); Set_Project_Declaration_Of - (Project_Node, - To => Default_Project_Node (Of_Kind => N_Project_Declaration)); + (Project_Node, Tree, + To => Default_Project_Node + (Of_Kind => N_Project_Declaration, In_Tree => Tree)); end if; @@ -983,93 +1009,109 @@ package body Prj.Makr is -- for Source_Files as an empty list, to indicate there are no -- sources in the naming project. - Project_Naming_Node := Default_Project_Node (Of_Kind => N_Project); - Set_Name_Of (Project_Naming_Node, To => Project_Naming_Id); + Project_Naming_Node := + Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree); + Set_Name_Of (Project_Naming_Node, Tree, To => Project_Naming_Id); Project_Naming_Decl := - Default_Project_Node (Of_Kind => N_Project_Declaration); - Set_Project_Declaration_Of (Project_Naming_Node, Project_Naming_Decl); + Default_Project_Node + (Of_Kind => N_Project_Declaration, In_Tree => Tree); + Set_Project_Declaration_Of + (Project_Naming_Node, Tree, Project_Naming_Decl); Naming_Package := - Default_Project_Node (Of_Kind => N_Package_Declaration); - Set_Name_Of (Naming_Package, To => Name_Naming); + Default_Project_Node + (Of_Kind => N_Package_Declaration, In_Tree => Tree); + Set_Name_Of (Naming_Package, Tree, To => Name_Naming); declare Decl_Item : constant Project_Node_Id := - Default_Project_Node (Of_Kind => N_Declarative_Item); + Default_Project_Node + (Of_Kind => N_Declarative_Item, In_Tree => Tree); Attribute : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Attribute_Declaration, - And_Expr_Kind => List); + Default_Project_Node + (Of_Kind => N_Attribute_Declaration, + In_Tree => Tree, + And_Expr_Kind => List); Expression : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Expression, - And_Expr_Kind => List); + Default_Project_Node + (Of_Kind => N_Expression, + In_Tree => Tree, + And_Expr_Kind => List); - Term : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Term, - And_Expr_Kind => List); + Term : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Term, + In_Tree => Tree, + And_Expr_Kind => List); Empty_List : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Literal_String_List); + Default_Project_Node + (Of_Kind => N_Literal_String_List, + In_Tree => Tree); begin Set_First_Declarative_Item_Of - (Project_Naming_Decl, To => Decl_Item); - Set_Next_Declarative_Item (Decl_Item, Naming_Package); - Set_Current_Item_Node (Decl_Item, To => Attribute); - Set_Name_Of (Attribute, To => Name_Source_Files); - Set_Expression_Of (Attribute, To => Expression); - Set_First_Term (Expression, To => Term); - Set_Current_Term (Term, To => Empty_List); + (Project_Naming_Decl, Tree, To => Decl_Item); + Set_Next_Declarative_Item (Decl_Item, Tree, Naming_Package); + Set_Current_Item_Node (Decl_Item, Tree, To => Attribute); + Set_Name_Of (Attribute, Tree, To => Name_Source_Files); + Set_Expression_Of (Attribute, Tree, To => Expression); + Set_First_Term (Expression, Tree, To => Term); + Set_Current_Term (Term, Tree, To => Empty_List); end; -- Add a with clause on the naming project in the main project declare With_Clause : constant Project_Node_Id := - Default_Project_Node (Of_Kind => N_With_Clause); + Default_Project_Node + (Of_Kind => N_With_Clause, In_Tree => Tree); begin Set_Next_With_Clause_Of - (With_Clause, To => First_With_Clause_Of (Project_Node)); - Set_First_With_Clause_Of (Project_Node, To => With_Clause); - Set_Name_Of (With_Clause, To => Project_Naming_Id); + (With_Clause, Tree, + To => First_With_Clause_Of (Project_Node, Tree)); + Set_First_With_Clause_Of (Project_Node, Tree, To => With_Clause); + Set_Name_Of (With_Clause, Tree, To => Project_Naming_Id); -- We set the project node to something different than -- Empty_Node, so that Prj.PP does not generate a limited -- with clause. - Set_Project_Node_Of (With_Clause, Non_Empty_Node); + Set_Project_Node_Of (With_Clause, Tree, Non_Empty_Node); Name_Len := Project_Naming_Last; Name_Buffer (1 .. Name_Len) := Project_Naming_File_Name (1 .. Project_Naming_Last); - Set_String_Value_Of (With_Clause, To => Name_Find); + Set_String_Value_Of (With_Clause, Tree, To => Name_Find); end; - Project_Declaration := Project_Declaration_Of (Project_Node); + Project_Declaration := Project_Declaration_Of (Project_Node, Tree); -- Add a renaming declaration for package Naming in the main project declare Decl_Item : constant Project_Node_Id := - Default_Project_Node (Of_Kind => N_Declarative_Item); + Default_Project_Node + (Of_Kind => N_Declarative_Item, + In_Tree => Tree); Naming : constant Project_Node_Id := - Default_Project_Node (Of_Kind => N_Package_Declaration); + Default_Project_Node + (Of_Kind => N_Package_Declaration, + In_Tree => Tree); + begin Set_Next_Declarative_Item - (Decl_Item, - To => First_Declarative_Item_Of (Project_Declaration)); + (Decl_Item, Tree, + To => First_Declarative_Item_Of (Project_Declaration, Tree)); Set_First_Declarative_Item_Of - (Project_Declaration, To => Decl_Item); - Set_Current_Item_Node (Decl_Item, To => Naming); - Set_Name_Of (Naming, To => Name_Naming); + (Project_Declaration, Tree, To => Decl_Item); + Set_Current_Item_Node (Decl_Item, Tree, To => Naming); + Set_Name_Of (Naming, Tree, To => Name_Naming); Set_Project_Of_Renamed_Package_Of - (Naming, To => Project_Naming_Node); + (Naming, Tree, To => Project_Naming_Node); end; -- Add an attribute declaration for Source_Dirs, initialized as an @@ -1078,36 +1120,43 @@ package body Prj.Makr is declare Decl_Item : constant Project_Node_Id := - Default_Project_Node (Of_Kind => N_Declarative_Item); + Default_Project_Node + (Of_Kind => N_Declarative_Item, + In_Tree => Tree); Attribute : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Attribute_Declaration, - And_Expr_Kind => List); + Default_Project_Node + (Of_Kind => N_Attribute_Declaration, + In_Tree => Tree, + And_Expr_Kind => List); Expression : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Expression, - And_Expr_Kind => List); + Default_Project_Node + (Of_Kind => N_Expression, + In_Tree => Tree, + And_Expr_Kind => List); Term : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Term, And_Expr_Kind => List); + Default_Project_Node + (Of_Kind => N_Term, In_Tree => Tree, + And_Expr_Kind => List); begin Set_Next_Declarative_Item - (Decl_Item, - To => First_Declarative_Item_Of (Project_Declaration)); + (Decl_Item, Tree, + To => First_Declarative_Item_Of (Project_Declaration, Tree)); Set_First_Declarative_Item_Of - (Project_Declaration, To => Decl_Item); - Set_Current_Item_Node (Decl_Item, To => Attribute); - Set_Name_Of (Attribute, To => Name_Source_Dirs); - Set_Expression_Of (Attribute, To => Expression); - Set_First_Term (Expression, To => Term); + (Project_Declaration, Tree, To => Decl_Item); + Set_Current_Item_Node (Decl_Item, Tree, To => Attribute); + Set_Name_Of (Attribute, Tree, To => Name_Source_Dirs); + Set_Expression_Of (Attribute, Tree, To => Expression); + Set_First_Term (Expression, Tree, To => Term); Source_Dirs_List := - Default_Project_Node (Of_Kind => N_Literal_String_List, - And_Expr_Kind => List); - Set_Current_Term (Term, To => Source_Dirs_List); + Default_Project_Node + (Of_Kind => N_Literal_String_List, + In_Tree => Tree, + And_Expr_Kind => List); + Set_Current_Term (Term, Tree, To => Source_Dirs_List); end; -- Add an attribute declaration for Source_List_File with the @@ -1115,43 +1164,49 @@ package body Prj.Makr is declare Decl_Item : constant Project_Node_Id := - Default_Project_Node (Of_Kind => N_Declarative_Item); + Default_Project_Node + (Of_Kind => N_Declarative_Item, + In_Tree => Tree); - Attribute : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Attribute_Declaration, - And_Expr_Kind => Single); + Attribute : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Attribute_Declaration, + In_Tree => Tree, + And_Expr_Kind => Single); Expression : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Expression, - And_Expr_Kind => Single); - - Term : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Term, - And_Expr_Kind => Single); - - Value : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Literal_String, - And_Expr_Kind => Single); + Default_Project_Node + (Of_Kind => N_Expression, + In_Tree => Tree, + And_Expr_Kind => Single); + + Term : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Term, + In_Tree => Tree, + And_Expr_Kind => Single); + + Value : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Literal_String, + In_Tree => Tree, + And_Expr_Kind => Single); begin Set_Next_Declarative_Item - (Decl_Item, - To => First_Declarative_Item_Of (Project_Declaration)); + (Decl_Item, Tree, + To => First_Declarative_Item_Of (Project_Declaration, Tree)); Set_First_Declarative_Item_Of - (Project_Declaration, To => Decl_Item); - Set_Current_Item_Node (Decl_Item, To => Attribute); - Set_Name_Of (Attribute, To => Name_Source_List_File); - Set_Expression_Of (Attribute, To => Expression); - Set_First_Term (Expression, To => Term); - Set_Current_Term (Term, To => Value); + (Project_Declaration, Tree, To => Decl_Item); + Set_Current_Item_Node (Decl_Item, Tree, To => Attribute); + Set_Name_Of (Attribute, Tree, To => Name_Source_List_File); + Set_Expression_Of (Attribute, Tree, To => Expression); + Set_First_Term (Expression, Tree, To => Term); + Set_Current_Term (Term, Tree, To => Value); Name_Len := Source_List_Last; Name_Buffer (1 .. Name_Len) := Source_List_Path (1 .. Source_List_Last); - Set_String_Value_Of (Value, To => Name_Find); + Set_String_Value_Of (Value, Tree, To => Name_Find); end; end if; @@ -1163,6 +1218,7 @@ package body Prj.Makr is Dir_Name : constant String := Directories (Index).all; Last : Natural := Dir_Name'Last; Recursively : Boolean := False; + begin if Dir_Name'Length >= 4 and then (Dir_Name (Last - 2 .. Last) = "/**") @@ -1177,35 +1233,38 @@ package body Prj.Makr is declare Expression : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Expression, - And_Expr_Kind => Single); - - Term : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Term, - And_Expr_Kind => Single); - - Value : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Literal_String, - And_Expr_Kind => Single); + Default_Project_Node + (Of_Kind => N_Expression, + In_Tree => Tree, + And_Expr_Kind => Single); + + Term : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Term, + In_Tree => Tree, + And_Expr_Kind => Single); + + Value : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Literal_String, + In_Tree => Tree, + And_Expr_Kind => Single); begin if Current_Source_Dir = Empty_Node then Set_First_Expression_In_List - (Source_Dirs_List, To => Expression); + (Source_Dirs_List, Tree, To => Expression); else Set_Next_Expression_In_List - (Current_Source_Dir, To => Expression); + (Current_Source_Dir, Tree, To => Expression); end if; Current_Source_Dir := Expression; - Set_First_Term (Expression, To => Term); - Set_Current_Term (Term, To => Value); + Set_First_Term (Expression, Tree, To => Term); + Set_Current_Term (Term, Tree, To => Value); Name_Len := Dir_Name'Length; Name_Buffer (1 .. Name_Len) := Dir_Name; - Set_String_Value_Of (Value, To => Name_Find); + Set_String_Value_Of (Value, Tree, To => Name_Find); end; end if; @@ -1252,7 +1311,7 @@ package body Prj.Makr is -- Output the project file Prj.PP.Pretty_Print - (Project_Node, + (Project_Node, Tree, W_Char => Write_A_Char'Access, W_Eol => Write_Eol'Access, W_Str => Write_A_String'Access, @@ -1290,7 +1349,7 @@ package body Prj.Makr is -- Output the naming project file Prj.PP.Pretty_Print - (Project_Naming_Node, + (Project_Naming_Node, Tree, W_Char => Write_A_Char'Access, W_Eol => Write_Eol'Access, W_Str => Write_A_String'Access, diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index b56bdcc5678..c51fbd5efab 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2005 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,7 +32,6 @@ with Namet; use Namet; with Osint; use Osint; with Output; use Output; with MLib.Tgt; use MLib.Tgt; -with Prj.Com; use Prj.Com; with Prj.Env; use Prj.Env; with Prj.Err; with Prj.Util; use Prj.Util; @@ -147,18 +146,18 @@ package body Prj.Nmsc is function ALI_File_Name (Source : String) return String; -- Return the ALI file name corresponding to a source - procedure Check_Ada_Name - (Name : String; - Unit : out Name_Id); + procedure Check_Ada_Name (Name : String; Unit : out Name_Id); -- Check that a name is a valid Ada unit name procedure Check_Naming_Scheme (Data : in out Project_Data; - Project : Project_Id); + Project : Project_Id; + In_Tree : Project_Tree_Ref); -- Check the naming scheme part of Data procedure Check_Ada_Naming_Scheme_Validity (Project : Project_Id; + In_Tree : Project_Tree_Ref; Naming : Naming_Data); -- Check that the package Naming is correct @@ -166,54 +165,74 @@ package body Prj.Nmsc is (File_Name : Name_Id; Path_Name : Name_Id; Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data; Location : Source_Ptr; Language : Language_Index; Suffix : String; Naming_Exception : Boolean); - -- Check if a file in a source directory is a source for a specific - -- language other than Ada. Comments required for parameters ??? + -- Check if a file, with name File_Name and path Path_Name, in a source + -- directory is a source for language Language in project Project of + -- project tree In_Tree. ??? procedure Check_If_Externally_Built (Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data); - -- ??? comment required + -- Check attribute Externally_Built of project Project in project tree + -- In_Tree and modify its data Data if it has the value "true". procedure Check_Library_Attributes (Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data); - -- ??? comment required + -- Check the library attributes of project Project in project tree In_Tree + -- and modify its data Data accordingly. procedure Check_Package_Naming (Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data); - -- ??? comment required + -- Check package Naming of project Project in project tree In_Tree and + -- modify its data Data accordingly. - procedure Check_Programming_Languages (Data : in out Project_Data); - -- ??? comment required + procedure Check_Programming_Languages + (In_Tree : Project_Tree_Ref; Data : in out Project_Data); + -- Check attribute Languages for the project with data Data in project + -- tree In_Tree and set the components of Data for all the programming + -- languages indicated in attribute Languages, if any. function Check_Project (P : Project_Id; Root_Project : Project_Id; + In_Tree : Project_Tree_Ref; Extending : Boolean) return Boolean; -- Returns True if P is Root_Project or, if Extending is True, a project -- extended by Root_Project. procedure Check_Stand_Alone_Library (Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data; Extending : Boolean); + -- Check if project Project in project tree In_Tree is a Stand-Alone + -- Library project, and modify its data Data accordingly if it is one. function Compute_Directory_Last (Dir : String) return Natural; -- Return the index of the last significant character in Dir. This is used -- to avoid duplicates '/' at the end of directory names function Body_Suffix_Of - (Language : Language_Index; In_Project : Project_Data) + (Language : Language_Index; + In_Project : Project_Data; + In_Tree : Project_Tree_Ref) return String; + -- Returns the suffix of sources of language Language in project In_Project + -- in project tree In_Tree. procedure Error_Msg (Project : Project_Id; + In_Tree : Project_Tree_Ref; Msg : String; Flag_Location : Source_Ptr); -- Output an error message. If Error_Report is null, simply call @@ -222,6 +241,7 @@ package body Prj.Nmsc is procedure Find_Sources (Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data; For_Language : Language_Index; Follow_Links : Boolean := False); @@ -233,18 +253,23 @@ package body Prj.Nmsc is procedure Get_Directories (Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data); -- Get the object directory, the exec directory and the source directories -- of a project. - procedure Get_Mains (Project : Project_Id; Data : in out Project_Data); + procedure Get_Mains + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Data : in out Project_Data); -- Get the mains of a project from attribute Main, if it exists, and put -- them in the project data. procedure Get_Sources_From_File (Path : String; Location : Source_Ptr; - Project : Project_Id); + Project : Project_Id; + In_Tree : Project_Tree_Ref); -- Get the list of sources from a text file and put them in hash table -- Source_Names. @@ -280,9 +305,10 @@ package body Prj.Nmsc is procedure Look_For_Sources (Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data; Follow_Links : Boolean); - -- Comment required ??? + -- Find all the sources of a project function Path_Name_Of (File_Name : Name_Id; @@ -291,14 +317,16 @@ package body Prj.Nmsc is -- Returns an empty string if file cannot be found. procedure Prepare_Ada_Naming_Exceptions - (List : Array_Element_Id; - Kind : Spec_Or_Body); + (List : Array_Element_Id; + In_Tree : Project_Tree_Ref; + Kind : Spec_Or_Body); -- Prepare the internal hash tables used for checking naming exceptions -- for Ada. Insert all elements of List in the tables. function Project_Extends (Extending : Project_Id; - Extended : Project_Id) return Boolean; + Extended : Project_Id; + In_Tree : Project_Tree_Ref) return Boolean; -- Returns True if Extending is extending Extended either directly or -- indirectly. @@ -306,6 +334,7 @@ package body Prj.Nmsc is (File_Name : Name_Id; Path_Name : Name_Id; Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data; Location : Source_Ptr; Current_Source : in out String_List_Id; @@ -316,6 +345,7 @@ package body Prj.Nmsc is procedure Record_Other_Sources (Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data; Language : Language_Index; Naming_Exceptions : Boolean); @@ -323,17 +353,20 @@ package body Prj.Nmsc is -- When Naming_Exceptions is True, mark the found sources as such, to -- later remove those that are not named in a list of sources. - procedure Show_Source_Dirs (Project : Project_Id); + procedure Show_Source_Dirs + (Project : Project_Id; In_Tree : Project_Tree_Ref); -- List all the source directories of a project function Suffix_For (Language : Language_Index; - Naming : Naming_Data) return Name_Id; + Naming : Naming_Data; + In_Tree : Project_Tree_Ref) return Name_Id; -- Get the suffix for the source of a language from a package naming. -- If not specified, return the default for the language. procedure Warn_If_Not_Sources (Project : Project_Id; + In_Tree : Project_Tree_Ref; Conventions : Array_Element_Id; Specs : Boolean; Extending : Boolean); @@ -367,12 +400,12 @@ package body Prj.Nmsc is procedure Check (Project : Project_Id; + In_Tree : Project_Tree_Ref; Report_Error : Put_Line_Access; Follow_Links : Boolean) is - Data : Project_Data := Projects.Table (Project); - - Extending : Boolean := False; + Data : Project_Data := In_Tree.Projects.Table (Project); + Extending : Boolean := False; begin Error_Report := Report_Error; @@ -381,35 +414,37 @@ package body Prj.Nmsc is -- Object, exec and source directories - Get_Directories (Project, Data); + Get_Directories (Project, In_Tree, Data); -- Get the programming languages - Check_Programming_Languages (Data); + Check_Programming_Languages (In_Tree, Data); -- Library attributes - Check_Library_Attributes (Project, Data); + Check_Library_Attributes (Project, In_Tree, Data); - Check_If_Externally_Built (Project, Data); + Check_If_Externally_Built (Project, In_Tree, Data); if Current_Verbosity = High then - Show_Source_Dirs (Project); + Show_Source_Dirs (Project, In_Tree); end if; - Check_Package_Naming (Project, Data); + Check_Package_Naming (Project, In_Tree, Data); Extending := Data.Extends /= No_Project; - Check_Naming_Scheme (Data, Project); + Check_Naming_Scheme (Data, Project, In_Tree); - Prepare_Ada_Naming_Exceptions (Data.Naming.Bodies, Body_Part); - Prepare_Ada_Naming_Exceptions (Data.Naming.Specs, Specification); + Prepare_Ada_Naming_Exceptions + (Data.Naming.Bodies, In_Tree, Body_Part); + Prepare_Ada_Naming_Exceptions + (Data.Naming.Specs, In_Tree, Specification); -- Find the sources if Data.Source_Dirs /= Nil_String then - Look_For_Sources (Project, Data, Follow_Links); + Look_For_Sources (Project, In_Tree, Data, Follow_Links); end if; if Data.Ada_Sources_Present then @@ -418,29 +453,28 @@ package body Prj.Nmsc is -- this project file. Warn_If_Not_Sources - (Project, Data.Naming.Bodies, + (Project, In_Tree, Data.Naming.Bodies, Specs => False, Extending => Extending); Warn_If_Not_Sources - (Project, Data.Naming.Specs, + (Project, In_Tree, Data.Naming.Specs, Specs => True, Extending => Extending); end if; - -- If it is a library project file, check if it is a standalone library if Data.Library then - Check_Stand_Alone_Library (Project, Data, Extending); + Check_Stand_Alone_Library (Project, In_Tree, Data, Extending); end if; -- Put the list of Mains, if any, in the project data - Get_Mains (Project, Data); + Get_Mains (Project, In_Tree, Data); -- Update the project data in the Projects table - Projects.Table (Project) := Data; + In_Tree.Projects.Table (Project) := Data; Free_Ada_Naming_Exceptions; end Check; @@ -449,10 +483,7 @@ package body Prj.Nmsc is -- Check_Ada_Name -- -------------------- - procedure Check_Ada_Name - (Name : String; - Unit : out Name_Id) - is + procedure Check_Ada_Name (Name : String; Unit : out Name_Id) is The_Name : String := Name; Real_Name : Name_Id; Need_Letter : Boolean := True; @@ -571,6 +602,7 @@ package body Prj.Nmsc is procedure Check_Ada_Naming_Scheme_Validity (Project : Project_Id; + In_Tree : Project_Tree_Ref; Naming : Naming_Data) is begin @@ -619,7 +651,7 @@ package body Prj.Nmsc is Pattern => ".") /= 0) then Error_Msg - (Project, + (Project, In_Tree, '"' & Dot_Replacement & """ is illegal for Dot_Replacement.", Naming.Dot_Repl_Loc); @@ -633,7 +665,7 @@ package body Prj.Nmsc is then Err_Vars.Error_Msg_Name_1 := Naming.Ada_Spec_Suffix; Error_Msg - (Project, + (Project, In_Tree, "{ is illegal for Spec_Suffix", Naming.Spec_Suffix_Loc); end if; @@ -643,7 +675,7 @@ package body Prj.Nmsc is then Err_Vars.Error_Msg_Name_1 := Naming.Ada_Body_Suffix; Error_Msg - (Project, + (Project, In_Tree, "{ is illegal for Body_Suffix", Naming.Body_Suffix_Loc); end if; @@ -654,7 +686,7 @@ package body Prj.Nmsc is then Err_Vars.Error_Msg_Name_1 := Naming.Separate_Suffix; Error_Msg - (Project, + (Project, In_Tree, "{ is illegal for Separate_Suffix", Naming.Sep_Suffix_Loc); end if; @@ -670,7 +702,7 @@ package body Prj.Nmsc is Body_Suffix'Last) = Spec_Suffix then Error_Msg - (Project, + (Project, In_Tree, "Body_Suffix (""" & Body_Suffix & """) cannot end with" & @@ -688,7 +720,7 @@ package body Prj.Nmsc is Separate_Suffix'Last) = Spec_Suffix then Error_Msg - (Project, + (Project, In_Tree, "Separate_Suffix (""" & Separate_Suffix & """) cannot end with" & @@ -708,6 +740,7 @@ package body Prj.Nmsc is (File_Name : Name_Id; Path_Name : Name_Id; Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data; Location : Source_Ptr; Language : Language_Index; @@ -842,7 +875,7 @@ package body Prj.Nmsc is -- directories. while Source_Id /= No_Other_Source loop - Source := Other_Sources.Table (Source_Id); + Source := In_Tree.Other_Sources.Table (Source_Id); Source_Id := Source.Next; if Source.File_Name = File_Id then @@ -853,7 +886,7 @@ package body Prj.Nmsc is if Source.Language /= Language then Error_Msg_Name_1 := File_Name; Error_Msg - (Project, + (Project, In_Tree, "{ cannot be a source of several languages", Real_Location); return; @@ -867,8 +900,8 @@ package body Prj.Nmsc is -- naming exception. if not Naming_Exception then - Other_Sources.Table (Source_Id).Naming_Exception := - False; + In_Tree.Other_Sources.Table + (Source_Id).Naming_Exception := False; end if; return; @@ -887,7 +920,7 @@ package body Prj.Nmsc is else Error_Msg_Name_1 := File_Name; Error_Msg - (Project, + (Project, In_Tree, "{ is found in several source directories", Real_Location); return; @@ -901,7 +934,7 @@ package body Prj.Nmsc is Error_Msg_Name_2 := Source.File_Name; Error_Msg_Name_3 := Obj_Id; Error_Msg - (Project, + (Project, In_Tree, "{ and { have the same object file {", Real_Location); return; @@ -936,8 +969,11 @@ package body Prj.Nmsc is -- And add it to the Other_Sources table - Other_Sources.Increment_Last; - Other_Sources.Table (Other_Sources.Last) := Source; + Other_Source_Table.Increment_Last + (In_Tree.Other_Sources); + In_Tree.Other_Sources.Table + (Other_Source_Table.Last (In_Tree.Other_Sources)) := + Source; -- There are sources of languages other than Ada in this project @@ -945,20 +981,22 @@ package body Prj.Nmsc is -- And there are sources of this language in this project - Set (Language, True, Data); + Set (Language, True, Data, In_Tree); -- Add this source to the list of sources of languages other than -- Ada of the project. if Data.First_Other_Source = No_Other_Source then - Data.First_Other_Source := Other_Sources.Last; + Data.First_Other_Source := + Other_Source_Table.Last (In_Tree.Other_Sources); else - Other_Sources.Table (Data.Last_Other_Source).Next := - Other_Sources.Last; + In_Tree.Other_Sources.Table (Data.Last_Other_Source).Next := + Other_Source_Table.Last (In_Tree.Other_Sources); end if; - Data.Last_Other_Source := Other_Sources.Last; + Data.Last_Other_Source := + Other_Source_Table.Last (In_Tree.Other_Sources); end; end if; end Check_For_Source; @@ -968,11 +1006,14 @@ package body Prj.Nmsc is ------------------------------- procedure Check_If_Externally_Built - (Project : Project_Id; Data : in out Project_Data) + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Data : in out Project_Data) is Externally_Built : constant Variable_Value := Util.Value_Of - (Name_Externally_Built, Data.Decl.Attributes); + (Name_Externally_Built, + Data.Decl.Attributes, In_Tree); begin if not Externally_Built.Default then @@ -983,7 +1024,7 @@ package body Prj.Nmsc is Data.Externally_Built := True; elsif Name_Buffer (1 .. Name_Len) /= "false" then - Error_Msg (Project, + Error_Msg (Project, In_Tree, "Externally_Built may only be true or false", Externally_Built.Location); end if; @@ -1006,10 +1047,11 @@ package body Prj.Nmsc is procedure Check_Naming_Scheme (Data : in out Project_Data; - Project : Project_Id) + Project : Project_Id; + In_Tree : Project_Tree_Ref) is Naming_Id : constant Package_Id := - Util.Value_Of (Name_Naming, Data.Decl.Packages); + Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree); Naming : Package_Element; @@ -1029,7 +1071,7 @@ package body Prj.Nmsc is -- Loop through elements of the string list while Current /= No_Array_Element loop - Element := Array_Elements.Table (Current); + Element := In_Tree.Array_Elements.Table (Current); -- Put file name in canonical case @@ -1045,7 +1087,7 @@ package body Prj.Nmsc is if Unit_Name = No_Name then Err_Vars.Error_Msg_Name_1 := Element.Index; Error_Msg - (Project, + (Project, In_Tree, "{ is not a valid unit name.", Element.Value.Location); @@ -1057,7 +1099,7 @@ package body Prj.Nmsc is end if; Element.Index := Unit_Name; - Array_Elements.Table (Current) := Element; + In_Tree.Array_Elements.Table (Current) := Element; end if; Current := Element.Next; @@ -1071,7 +1113,7 @@ package body Prj.Nmsc is -- this package Naming. if Naming_Id /= No_Package then - Naming := Packages.Table (Naming_Id); + Naming := In_Tree.Packages.Table (Naming_Id); if Current_Verbosity = High then Write_Line ("Checking ""Naming"" for Ada."); @@ -1079,10 +1121,10 @@ package body Prj.Nmsc is declare Bodies : constant Array_Element_Id := - Util.Value_Of (Name_Body, Naming.Decl.Arrays); + Util.Value_Of (Name_Body, Naming.Decl.Arrays, In_Tree); Specs : constant Array_Element_Id := - Util.Value_Of (Name_Spec, Naming.Decl.Arrays); + Util.Value_Of (Name_Spec, Naming.Decl.Arrays, In_Tree); begin if Bodies /= No_Array_Element then @@ -1133,7 +1175,7 @@ package body Prj.Nmsc is Dot_Replacement : constant Variable_Value := Util.Value_Of (Name_Dot_Replacement, - Naming.Decl.Attributes); + Naming.Decl.Attributes, In_Tree); begin pragma Assert (Dot_Replacement.Kind = Single, @@ -1144,7 +1186,7 @@ package body Prj.Nmsc is if Name_Len = 0 then Error_Msg - (Project, + (Project, In_Tree, "Dot_Replacement cannot be empty", Dot_Replacement.Location); @@ -1168,7 +1210,7 @@ package body Prj.Nmsc is declare Casing_String : constant Variable_Value := Util.Value_Of - (Name_Casing, Naming.Decl.Attributes); + (Name_Casing, Naming.Decl.Attributes, In_Tree); begin pragma Assert (Casing_String.Kind = Single, @@ -1183,22 +1225,14 @@ package body Prj.Nmsc is Casing_Value : constant Casing_Type := Value (Casing_Image); begin - -- Ignore Casing on platforms where file names are - -- case-insensitive. - - if not File_Names_Case_Sensitive then - Data.Naming.Casing := All_Lower_Case; - - else - Data.Naming.Casing := Casing_Value; - end if; + Data.Naming.Casing := Casing_Value; end; exception when Constraint_Error => if Casing_Image'Length = 0 then Error_Msg - (Project, + (Project, In_Tree, "Casing cannot be an empty string", Casing_String.Location); @@ -1207,7 +1241,7 @@ package body Prj.Nmsc is Name_Buffer (1 .. Name_Len) := Casing_Image; Err_Vars.Error_Msg_Name_1 := Name_Find; Error_Msg - (Project, + (Project, In_Tree, "{ is not a correct Casing", Casing_String.Location); end if; @@ -1229,7 +1263,8 @@ package body Prj.Nmsc is Prj.Util.Value_Of (Index => Name_Ada, Src_Index => 0, - In_Array => Data.Naming.Spec_Suffix); + In_Array => Data.Naming.Spec_Suffix, + In_Tree => In_Tree); begin if Ada_Spec_Suffix.Kind = Single @@ -1259,7 +1294,8 @@ package body Prj.Nmsc is Prj.Util.Value_Of (Index => Name_Ada, Src_Index => 0, - In_Array => Data.Naming.Body_Suffix); + In_Array => Data.Naming.Body_Suffix, + In_Tree => In_Tree); begin if Ada_Body_Suffix.Kind = Single @@ -1288,7 +1324,8 @@ package body Prj.Nmsc is Ada_Sep_Suffix : constant Variable_Value := Prj.Util.Value_Of (Variable_Name => Name_Separate_Suffix, - In_Variables => Naming.Decl.Attributes); + In_Variables => Naming.Decl.Attributes, + In_Tree => In_Tree); begin if Ada_Sep_Suffix.Default then @@ -1300,7 +1337,7 @@ package body Prj.Nmsc is if Name_Len = 0 then Error_Msg - (Project, + (Project, In_Tree, "Separate_Suffix cannot be empty", Ada_Sep_Suffix.Location); @@ -1321,7 +1358,7 @@ package body Prj.Nmsc is -- Check if Data.Naming is valid - Check_Ada_Naming_Scheme_Validity (Project, Data.Naming); + Check_Ada_Naming_Scheme_Validity (Project, In_Tree, Data.Naming); else Data.Naming.Ada_Spec_Suffix := Default_Ada_Spec_Suffix; @@ -1335,23 +1372,27 @@ package body Prj.Nmsc is ------------------------------ procedure Check_Library_Attributes - (Project : Project_Id; Data : in out Project_Data) + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Data : in out Project_Data) is Attributes : constant Prj.Variable_Id := Data.Decl.Attributes; Lib_Dir : constant Prj.Variable_Value := - Prj.Util.Value_Of (Snames.Name_Library_Dir, Attributes); + Prj.Util.Value_Of + (Snames.Name_Library_Dir, Attributes, In_Tree); Lib_Name : constant Prj.Variable_Value := - Prj.Util.Value_Of (Snames.Name_Library_Name, Attributes); + Prj.Util.Value_Of + (Snames.Name_Library_Name, Attributes, In_Tree); Lib_Version : constant Prj.Variable_Value := Prj.Util.Value_Of - (Snames.Name_Library_Version, Attributes); + (Snames.Name_Library_Version, Attributes, In_Tree); The_Lib_Kind : constant Prj.Variable_Value := Prj.Util.Value_Of - (Snames.Name_Library_Kind, Attributes); + (Snames.Name_Library_Kind, Attributes, In_Tree); begin -- Special case of extending project @@ -1359,7 +1400,7 @@ package body Prj.Nmsc is if Data.Extends /= No_Project then declare Extended_Data : constant Project_Data := - Projects.Table (Data.Extends); + In_Tree.Projects.Table (Data.Extends); begin -- If the project extended is a library project, we inherit @@ -1375,14 +1416,15 @@ package body Prj.Nmsc is if Lib_Dir.Default then if not Data.Virtual then Error_Msg - (Project, + (Project, In_Tree, "a project extending a library project must " & "specify an attribute Library_Dir", Data.Location); end if; end if; - Projects.Table (Data.Extends).Library := False; + In_Tree.Projects.Table (Data.Extends).Library := + False; end if; end; end if; @@ -1431,23 +1473,23 @@ package body Prj.Nmsc is -- Report the error Error_Msg - (Project, + (Project, In_Tree, "library directory { does not exist", Lib_Dir.Location); end; - -- comment ??? + -- The library directory cannot be the same as the Object directory elsif Data.Library_Dir = Data.Object_Directory then Error_Msg - (Project, + (Project, In_Tree, "library directory cannot be the same " & "as object directory", Lib_Dir.Location); Data.Library_Dir := No_Name; Data.Display_Library_Dir := No_Name; - -- comment ??? + -- Display the Library directory in high verbosity else if Current_Verbosity = High then @@ -1489,7 +1531,7 @@ package body Prj.Nmsc is if Data.Library then if MLib.Tgt.Support_For_Libraries = MLib.Tgt.None then Error_Msg - (Project, + (Project, In_Tree, "?libraries are not supported on this platform", Lib_Name.Location); Data.Library := False; @@ -1534,7 +1576,7 @@ package body Prj.Nmsc is else Error_Msg - (Project, + (Project, In_Tree, "illegal value for Library_Kind", The_Lib_Kind.Location); OK := False; @@ -1549,7 +1591,7 @@ package body Prj.Nmsc is MLib.Tgt.Support_For_Libraries = MLib.Tgt.Static_Only then Error_Msg - (Project, + (Project, In_Tree, "only static libraries are supported " & "on this platform", The_Lib_Kind.Location); @@ -1571,10 +1613,12 @@ package body Prj.Nmsc is -------------------------- procedure Check_Package_Naming - (Project : Project_Id; Data : in out Project_Data) + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Data : in out Project_Data) is Naming_Id : constant Package_Id := - Util.Value_Of (Name_Naming, Data.Decl.Packages); + Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree); Naming : Package_Element; @@ -1583,7 +1627,7 @@ package body Prj.Nmsc is -- what is in this package Naming. if Naming_Id /= No_Package then - Naming := Packages.Table (Naming_Id); + Naming := In_Tree.Packages.Table (Naming_Id); if Current_Verbosity = High then Write_Line ("Checking ""Naming""."); @@ -1595,7 +1639,8 @@ package body Prj.Nmsc is Spec_Suffixs : Array_Element_Id := Util.Value_Of (Name_Spec_Suffix, - Naming.Decl.Arrays); + Naming.Decl.Arrays, + In_Tree); Suffix : Array_Element_Id; Element : Array_Element; @@ -1611,13 +1656,15 @@ package body Prj.Nmsc is Suffix := Data.Naming.Spec_Suffix; while Suffix /= No_Array_Element loop - Element := Array_Elements.Table (Suffix); + Element := + In_Tree.Array_Elements.Table (Suffix); Suffix2 := Spec_Suffixs; while Suffix2 /= No_Array_Element loop - exit when Array_Elements.Table (Suffix2).Index = - Element.Index; - Suffix2 := Array_Elements.Table (Suffix2).Next; + exit when In_Tree.Array_Elements.Table + (Suffix2).Index = Element.Index; + Suffix2 := In_Tree.Array_Elements.Table + (Suffix2).Next; end loop; -- There is a registered default suffix, but no @@ -1625,14 +1672,18 @@ package body Prj.Nmsc is -- Add the default to the array. if Suffix2 = No_Array_Element then - Array_Elements.Increment_Last; - Array_Elements.Table (Array_Elements.Last) := + Array_Element_Table.Increment_Last + (In_Tree.Array_Elements); + In_Tree.Array_Elements.Table + (Array_Element_Table.Last + (In_Tree.Array_Elements)) := (Index => Element.Index, Src_Index => Element.Src_Index, Index_Case_Sensitive => False, Value => Element.Value, Next => Spec_Suffixs); - Spec_Suffixs := Array_Elements.Last; + Spec_Suffixs := Array_Element_Table.Last + (In_Tree.Array_Elements); end if; Suffix := Element.Next; @@ -1650,17 +1701,17 @@ package body Prj.Nmsc is begin while Current /= No_Array_Element loop - Element := Array_Elements.Table (Current); + Element := In_Tree.Array_Elements.Table (Current); Get_Name_String (Element.Value.Value); if Name_Len = 0 then Error_Msg - (Project, + (Project, In_Tree, "Spec_Suffix cannot be empty", Element.Value.Location); end if; - Array_Elements.Table (Current) := Element; + In_Tree.Array_Elements.Table (Current) := Element; Current := Element.Next; end loop; end; @@ -1671,7 +1722,8 @@ package body Prj.Nmsc is Impl_Suffixs : Array_Element_Id := Util.Value_Of (Name_Body_Suffix, - Naming.Decl.Arrays); + Naming.Decl.Arrays, + In_Tree); Suffix : Array_Element_Id; Element : Array_Element; @@ -1687,13 +1739,15 @@ package body Prj.Nmsc is Suffix := Data.Naming.Body_Suffix; while Suffix /= No_Array_Element loop - Element := Array_Elements.Table (Suffix); + Element := + In_Tree.Array_Elements.Table (Suffix); Suffix2 := Impl_Suffixs; while Suffix2 /= No_Array_Element loop - exit when Array_Elements.Table (Suffix2).Index = - Element.Index; - Suffix2 := Array_Elements.Table (Suffix2).Next; + exit when In_Tree.Array_Elements.Table + (Suffix2).Index = Element.Index; + Suffix2 := In_Tree.Array_Elements.Table + (Suffix2).Next; end loop; -- There is a registered default suffix, but no suffix was @@ -1701,14 +1755,18 @@ package body Prj.Nmsc is -- array. if Suffix2 = No_Array_Element then - Array_Elements.Increment_Last; - Array_Elements.Table (Array_Elements.Last) := + Array_Element_Table.Increment_Last + (In_Tree.Array_Elements); + In_Tree.Array_Elements.Table + (Array_Element_Table.Last + (In_Tree.Array_Elements)) := (Index => Element.Index, Src_Index => Element.Src_Index, Index_Case_Sensitive => False, Value => Element.Value, Next => Impl_Suffixs); - Impl_Suffixs := Array_Elements.Last; + Impl_Suffixs := Array_Element_Table.Last + (In_Tree.Array_Elements); end if; Suffix := Element.Next; @@ -1726,17 +1784,17 @@ package body Prj.Nmsc is begin while Current /= No_Array_Element loop - Element := Array_Elements.Table (Current); + Element := In_Tree.Array_Elements.Table (Current); Get_Name_String (Element.Value.Value); if Name_Len = 0 then Error_Msg - (Project, + (Project, In_Tree, "Body_Suffix cannot be empty", Element.Value.Location); end if; - Array_Elements.Table (Current) := Element; + In_Tree.Array_Elements.Table (Current) := Element; Current := Element.Next; end loop; end; @@ -1746,12 +1804,14 @@ package body Prj.Nmsc is Data.Naming.Specification_Exceptions := Util.Value_Of (Name_Specification_Exceptions, - In_Arrays => Naming.Decl.Arrays); + In_Arrays => Naming.Decl.Arrays, + In_Tree => In_Tree); Data.Naming.Implementation_Exceptions := Util.Value_Of (Name_Implementation_Exceptions, - In_Arrays => Naming.Decl.Arrays); + In_Arrays => Naming.Decl.Arrays, + In_Tree => In_Tree); end if; end Check_Package_Naming; @@ -1759,11 +1819,15 @@ package body Prj.Nmsc is -- Check_Programming_Languages -- --------------------------------- - procedure Check_Programming_Languages (Data : in out Project_Data) is + procedure Check_Programming_Languages + (In_Tree : Project_Tree_Ref; + Data : in out Project_Data) + is Languages : Variable_Value := Nil_Variable_Value; begin - Languages := Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes); + Languages := + Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes, In_Tree); Data.Ada_Sources_Present := Data.Source_Dirs /= Nil_String; Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String; @@ -1799,7 +1863,8 @@ package body Prj.Nmsc is -- Languages, if any while Current /= Nil_String loop - Element := String_Elements.Table (Current); + Element := + In_Tree.String_Elements.Table (Current); Get_Name_String (Element.Value); To_Lower (Name_Buffer (1 .. Name_Len)); Lang_Name := Name_Find; @@ -1810,10 +1875,11 @@ package body Prj.Nmsc is Index := Last_Language_Index; end if; - Set (Index, True, Data); + Set (Index, True, Data, In_Tree); Set (Language_Processing => Default_Language_Processing_Data, For_Language => Index, - In_Project => Data); + In_Project => Data, + In_Tree => In_Tree); if Index = Ada_Language_Index then Data.Ada_Sources_Present := True; @@ -1836,6 +1902,7 @@ package body Prj.Nmsc is function Check_Project (P : Project_Id; Root_Project : Project_Id; + In_Tree : Project_Tree_Ref; Extending : Boolean) return Boolean is begin @@ -1844,7 +1911,7 @@ package body Prj.Nmsc is elsif Extending then declare - Data : Project_Data := Projects.Table (Root_Project); + Data : Project_Data := In_Tree.Projects.Table (Root_Project); begin while Data.Extends /= No_Project loop @@ -1852,7 +1919,7 @@ package body Prj.Nmsc is return True; end if; - Data := Projects.Table (Data.Extends); + Data := In_Tree.Projects.Table (Data.Extends); end loop; end; end if; @@ -1866,38 +1933,45 @@ package body Prj.Nmsc is procedure Check_Stand_Alone_Library (Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data; Extending : Boolean) is Lib_Interfaces : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Interface, - Data.Decl.Attributes); + Data.Decl.Attributes, + In_Tree); Lib_Auto_Init : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Auto_Init, - Data.Decl.Attributes); + Data.Decl.Attributes, + In_Tree); Lib_Src_Dir : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Src_Dir, - Data.Decl.Attributes); + Data.Decl.Attributes, + In_Tree); Lib_Symbol_File : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Symbol_File, - Data.Decl.Attributes); + Data.Decl.Attributes, + In_Tree); Lib_Symbol_Policy : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Symbol_Policy, - Data.Decl.Attributes); + Data.Decl.Attributes, + In_Tree); Lib_Ref_Symbol_File : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Reference_Symbol_File, - Data.Decl.Attributes); + Data.Decl.Attributes, + In_Tree); Auto_Init_Supported : constant Boolean := MLib.Tgt. @@ -1939,16 +2013,21 @@ package body Prj.Nmsc is Name_Buffer (1 .. Name_Len) := ALI; ALI_Name_Id := Name_Find; - String_Elements.Increment_Last; - String_Elements.Table (String_Elements.Last) := + String_Element_Table.Increment_Last + (In_Tree.String_Elements); + In_Tree.String_Elements.Table + (String_Element_Table.Last + (In_Tree.String_Elements)) := (Value => ALI_Name_Id, Index => 0, Display_Value => ALI_Name_Id, - Location => String_Elements.Table - (Interfaces).Location, + Location => + In_Tree.String_Elements.Table + (Interfaces).Location, Flag => False, Next => Interface_ALIs); - Interface_ALIs := String_Elements.Last; + Interface_ALIs := String_Element_Table.Last + (In_Tree.String_Elements); end; end Add_ALI_For; @@ -1961,7 +2040,7 @@ package body Prj.Nmsc is if Interfaces = Nil_String then Error_Msg - (Project, + (Project, In_Tree, "Library_Interface cannot be an empty list", Lib_Interfaces.Location); end if; @@ -1971,39 +2050,43 @@ package body Prj.Nmsc is while Interfaces /= Nil_String loop Get_Name_String - (String_Elements.Table (Interfaces).Value); + (In_Tree.String_Elements.Table + (Interfaces).Value); To_Lower (Name_Buffer (1 .. Name_Len)); if Name_Len = 0 then Error_Msg - (Project, + (Project, In_Tree, "an interface cannot be an empty string", - String_Elements.Table (Interfaces).Location); + In_Tree.String_Elements.Table + (Interfaces).Location); else Unit := Name_Find; Error_Msg_Name_1 := Unit; - The_Unit_Id := Units_Htable.Get (Unit); + The_Unit_Id := + Units_Htable.Get (In_Tree.Units_HT, Unit); - if The_Unit_Id = Prj.Com.No_Unit then + if The_Unit_Id = No_Unit then Error_Msg - (Project, + (Project, In_Tree, "unknown unit {", - String_Elements.Table (Interfaces).Location); + In_Tree.String_Elements.Table + (Interfaces).Location); else -- Check that the unit is part of the project - The_Unit_Data := Units.Table (The_Unit_Id); + The_Unit_Data := + In_Tree.Units.Table (The_Unit_Id); - if The_Unit_Data.File_Names - (Com.Body_Part).Name /= No_Name - and then The_Unit_Data.File_Names - (Com.Body_Part).Path /= Slash + if The_Unit_Data.File_Names (Body_Part).Name /= No_Name + and then The_Unit_Data.File_Names (Body_Part).Path /= + Slash then if Check_Project (The_Unit_Data.File_Names (Body_Part).Project, - Project, Extending) + Project, In_Tree, Extending) then -- There is a body for this unit. -- If there is no spec, we need to check @@ -2025,11 +2108,12 @@ package body Prj.Nmsc is (Src_Ind) then Error_Msg - (Project, + (Project, In_Tree, "{ is a subunit; " & "it cannot be an interface", - String_Elements.Table - (Interfaces).Location); + In_Tree. + String_Elements.Table + (Interfaces).Location); end if; end; end if; @@ -2043,20 +2127,20 @@ package body Prj.Nmsc is else Error_Msg - (Project, + (Project, In_Tree, "{ is not an unit of this project", - String_Elements.Table + In_Tree.String_Elements.Table (Interfaces).Location); end if; elsif The_Unit_Data.File_Names - (Com.Specification).Name /= No_Name + (Specification).Name /= No_Name and then The_Unit_Data.File_Names - (Com.Specification).Path /= Slash + (Specification).Path /= Slash and then Check_Project (The_Unit_Data.File_Names (Specification).Project, - Project, Extending) + Project, In_Tree, Extending) then -- The unit is part of the project, it has @@ -2068,15 +2152,17 @@ package body Prj.Nmsc is else Error_Msg - (Project, + (Project, In_Tree, "{ is not an unit of this project", - String_Elements.Table (Interfaces).Location); + In_Tree.String_Elements.Table + (Interfaces).Location); end if; end if; end if; - Interfaces := String_Elements.Table (Interfaces).Next; + Interfaces := + In_Tree.String_Elements.Table (Interfaces).Next; end loop; -- Put the list of Interface ALIs in the project data @@ -2109,7 +2195,7 @@ package body Prj.Nmsc is -- is not supported Error_Msg - (Project, + (Project, In_Tree, "library auto init not supported " & "on this platform", Lib_Auto_Init.Location); @@ -2117,7 +2203,7 @@ package body Prj.Nmsc is else Error_Msg - (Project, + (Project, In_Tree, "invalid value for attribute Library_Auto_Init", Lib_Auto_Init.Location); end if; @@ -2178,7 +2264,7 @@ package body Prj.Nmsc is -- Report the error Error_Msg - (Project, + (Project, In_Tree, "Directory { does not exist", Lib_Src_Dir.Location); end; @@ -2188,7 +2274,7 @@ package body Prj.Nmsc is elsif Data.Library_Src_Dir = Data.Object_Directory then Error_Msg - (Project, + (Project, In_Tree, "directory to copy interfaces cannot be " & "the object directory", Lib_Src_Dir.Location); @@ -2203,14 +2289,15 @@ package body Prj.Nmsc is begin while Src_Dirs /= Nil_String loop - Src_Dir := String_Elements.Table (Src_Dirs); + Src_Dir := In_Tree.String_Elements.Table + (Src_Dirs); Src_Dirs := Src_Dir.Next; -- Report error if it is one of the source directories if Data.Library_Src_Dir = Src_Dir.Value then Error_Msg - (Project, + (Project, In_Tree, "directory to copy interfaces cannot " & "be one of the source directories", Lib_Src_Dir.Location); @@ -2220,19 +2307,24 @@ package body Prj.Nmsc is end loop; end; - -- pages of code follow here with no comments at all ??? + -- In high verbosity, if there is a valid Library_Src_Dir, + -- display its path name. if Data.Library_Src_Dir /= No_Name and then Current_Verbosity = High then Write_Str ("Directory to copy interfaces ="""); - Write_Str (Get_Name_String (Data.Library_Dir)); + Write_Str (Get_Name_String (Data.Library_Src_Dir)); Write_Line (""""); end if; end if; end; end if; + -- Check the symbol related attributes + + -- First, the symbol policy + if not Lib_Symbol_Policy.Default then declare Value : constant String := @@ -2240,6 +2332,8 @@ package body Prj.Nmsc is (Get_Name_String (Lib_Symbol_Policy.Value)); begin + -- Symbol policy must hove one of a limited number of values + if Value = "autonomous" or else Value = "default" then Data.Symbol_Data.Symbol_Policy := Autonomous; @@ -2254,30 +2348,35 @@ package body Prj.Nmsc is else Error_Msg - (Project, + (Project, In_Tree, "illegal value for Library_Symbol_Policy", Lib_Symbol_Policy.Location); end if; end; end if; + -- If attribute Library_Symbol_File is not specified, symbol policy + -- cannot be Restricted. + if Lib_Symbol_File.Default then if Data.Symbol_Data.Symbol_Policy = Restricted then Error_Msg - (Project, + (Project, In_Tree, "Library_Symbol_File needs to be defined when " & "symbol policy is Restricted", Lib_Symbol_Policy.Location); end if; else + -- Library_Symbol_File is defined. Check that the file exists. + Data.Symbol_Data.Symbol_File := Lib_Symbol_File.Value; Get_Name_String (Lib_Symbol_File.Value); if Name_Len = 0 then Error_Msg - (Project, + (Project, In_Tree, "symbol file name cannot be an empty string", Lib_Symbol_File.Location); @@ -2298,7 +2397,7 @@ package body Prj.Nmsc is if not OK then Error_Msg_Name_1 := Lib_Symbol_File.Value; Error_Msg - (Project, + (Project, In_Tree, "symbol file name { is illegal. " & "Name canot include directory info.", Lib_Symbol_File.Location); @@ -2306,24 +2405,29 @@ package body Prj.Nmsc is end if; end if; + -- If attribute Library_Reference_Symbol_File is not defined, + -- symbol policy cannot be Compilant or Controlled. + if Lib_Ref_Symbol_File.Default then if Data.Symbol_Data.Symbol_Policy = Compliant or else Data.Symbol_Data.Symbol_Policy = Controlled then Error_Msg - (Project, + (Project, In_Tree, "a reference symbol file need to be defined", Lib_Symbol_Policy.Location); end if; else + -- Library_Reference_Symbol_File is defined, check file exists + Data.Symbol_Data.Reference := Lib_Ref_Symbol_File.Value; Get_Name_String (Lib_Ref_Symbol_File.Value); if Name_Len = 0 then Error_Msg - (Project, + (Project, In_Tree, "reference symbol file name cannot be an empty string", Lib_Symbol_File.Location); @@ -2344,7 +2448,7 @@ package body Prj.Nmsc is if not OK then Error_Msg_Name_1 := Lib_Ref_Symbol_File.Value; Error_Msg - (Project, + (Project, In_Tree, "reference symbol file { name is illegal. " & "Name canot include directory info.", Lib_Ref_Symbol_File.Location); @@ -2357,11 +2461,14 @@ package body Prj.Nmsc is then Error_Msg_Name_1 := Lib_Ref_Symbol_File.Value; Error_Msg - (Project, + (Project, In_Tree, "library reference symbol file { does not exist", Lib_Ref_Symbol_File.Location); end if; + -- Check that the reference symbol file and the symbol file + -- are not the same file. + if Data.Symbol_Data.Symbol_File /= No_Name then declare Symbol : String := @@ -2378,7 +2485,7 @@ package body Prj.Nmsc is if Symbol = Reference then Error_Msg - (Project, + (Project, In_Tree, "reference symbol file and symbol file " & "cannot be the same file", Lib_Ref_Symbol_File.Location); @@ -2412,9 +2519,11 @@ package body Prj.Nmsc is function Body_Suffix_Of (Language : Language_Index; - In_Project : Project_Data) return String + In_Project : Project_Data; + In_Tree : Project_Tree_Ref) return String is - Suffix_Id : constant Name_Id := Suffix_Of (Language, In_Project); + Suffix_Id : constant Name_Id := + Suffix_Of (Language, In_Project, In_Tree); begin if Suffix_Id /= No_Name then return Get_Name_String (Suffix_Id); @@ -2429,6 +2538,7 @@ package body Prj.Nmsc is procedure Error_Msg (Project : Project_Id; + In_Tree : Project_Tree_Ref; Msg : String; Flag_Location : Source_Ptr) is @@ -2512,7 +2622,7 @@ package body Prj.Nmsc is end loop; - Error_Report (Error_Buffer (1 .. Error_Last), Project); + Error_Report (Error_Buffer (1 .. Error_Last), Project, In_Tree); end Error_Msg; ------------------ @@ -2521,6 +2631,7 @@ package body Prj.Nmsc is procedure Find_Sources (Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data; For_Language : Language_Index; Follow_Links : Boolean := False) @@ -2541,7 +2652,7 @@ package body Prj.Nmsc is while Source_Dir /= Nil_String loop begin Source_Recorded := False; - Element := String_Elements.Table (Source_Dir); + Element := In_Tree.String_Elements.Table (Source_Dir); if Element.Value /= No_Name then Get_Name_String (Element.Display_Value); @@ -2599,6 +2710,7 @@ package body Prj.Nmsc is (File_Name => File_Name, Path_Name => Path_Name, Project => Project, + In_Tree => In_Tree, Data => Data, Location => No_Location, Current_Source => Current_Source, @@ -2610,11 +2722,12 @@ package body Prj.Nmsc is (File_Name => File_Name, Path_Name => Path_Name, Project => Project, + In_Tree => In_Tree, Data => Data, Location => No_Location, Language => For_Language, Suffix => - Body_Suffix_Of (For_Language, Data), + Body_Suffix_Of (For_Language, Data, In_Tree), Naming_Exception => False); end if; end; @@ -2630,7 +2743,8 @@ package body Prj.Nmsc is end; if Source_Recorded then - String_Elements.Table (Source_Dir).Flag := True; + In_Tree.String_Elements.Table (Source_Dir).Flag := + True; end if; Source_Dir := Element.Next; @@ -2652,7 +2766,7 @@ package body Prj.Nmsc is elsif Data.Extends = No_Project then Error_Msg - (Project, + (Project, In_Tree, "there are no Ada sources in this project", Data.Location); end if; @@ -2676,17 +2790,20 @@ package body Prj.Nmsc is procedure Get_Directories (Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data) is Object_Dir : constant Variable_Value := - Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes); + Util.Value_Of + (Name_Object_Dir, Data.Decl.Attributes, In_Tree); Exec_Dir : constant Variable_Value := - Util.Value_Of (Name_Exec_Dir, Data.Decl.Attributes); + Util.Value_Of + (Name_Exec_Dir, Data.Decl.Attributes, In_Tree); Source_Dirs : constant Variable_Value := Util.Value_Of - (Name_Source_Dirs, Data.Decl.Attributes); + (Name_Source_Dirs, Data.Decl.Attributes, In_Tree); Last_Source_Dir : String_List_Id := Nil_String; @@ -2752,7 +2869,7 @@ package body Prj.Nmsc is -- Check if directory is already in list while List /= Nil_String loop - Element := String_Elements.Table (List); + Element := In_Tree.String_Elements.Table (List); if Element.Value /= No_Name then Found := Element.Value = Canonical_Path; @@ -2770,7 +2887,8 @@ package body Prj.Nmsc is Write_Line (The_Path (The_Path'First .. The_Path_Last)); end if; - String_Elements.Increment_Last; + String_Element_Table.Increment_Last + (In_Tree.String_Elements); Element := (Value => Canonical_Path, Display_Value => Non_Canonical_Path, @@ -2782,21 +2900,26 @@ package body Prj.Nmsc is -- Case of first source directory if Last_Source_Dir = Nil_String then - Data.Source_Dirs := String_Elements.Last; + Data.Source_Dirs := String_Element_Table.Last + (In_Tree.String_Elements); -- Here we already have source directories else -- Link the previous last to the new one - String_Elements.Table (Last_Source_Dir).Next := - String_Elements.Last; + In_Tree.String_Elements.Table + (Last_Source_Dir).Next := + String_Element_Table.Last + (In_Tree.String_Elements); end if; -- And register this source directory as the new last - Last_Source_Dir := String_Elements.Last; - String_Elements.Table (Last_Source_Dir) := Element; + Last_Source_Dir := String_Element_Table.Last + (In_Tree.String_Elements); + In_Tree.String_Elements.Table (Last_Source_Dir) := + Element; end if; -- Now look for subdirectories. We do that even when this @@ -2906,12 +3029,12 @@ package body Prj.Nmsc is if Location = No_Location then Error_Msg - (Project, + (Project, In_Tree, "{ is not a valid directory.", Data.Location); else Error_Msg - (Project, + (Project, In_Tree, "{ is not a valid directory.", Location); end if; @@ -2950,12 +3073,12 @@ package body Prj.Nmsc is if Location = No_Location then Error_Msg - (Project, + (Project, In_Tree, "{ is not a valid directory", Data.Location); else Error_Msg - (Project, + (Project, In_Tree, "{ is not a valid directory", Location); end if; @@ -2964,7 +3087,8 @@ package body Prj.Nmsc is -- As it is an existing directory, we add it to -- the list of directories. - String_Elements.Increment_Last; + String_Element_Table.Increment_Last + (In_Tree.String_Elements); Element.Value := Path_Name; Element.Display_Value := Display_Path_Name; @@ -2972,20 +3096,25 @@ package body Prj.Nmsc is -- This is the first source directory - Data.Source_Dirs := String_Elements.Last; + Data.Source_Dirs := String_Element_Table.Last + (In_Tree.String_Elements); else -- We already have source directories, -- link the previous last to the new one. - String_Elements.Table (Last_Source_Dir).Next := - String_Elements.Last; + In_Tree.String_Elements.Table + (Last_Source_Dir).Next := + String_Element_Table.Last + (In_Tree.String_Elements); end if; -- And register this source directory as the new last - Last_Source_Dir := String_Elements.Last; - String_Elements.Table (Last_Source_Dir) := Element; + Last_Source_Dir := String_Element_Table.Last + (In_Tree.String_Elements); + In_Tree.String_Elements.Table + (Last_Source_Dir) := Element; end if; end; end if; @@ -3013,7 +3142,7 @@ package body Prj.Nmsc is if Name_Len = 0 then Error_Msg - (Project, + (Project, In_Tree, "Object_Dir cannot be empty", Object_Dir.Location); @@ -3030,7 +3159,7 @@ package body Prj.Nmsc is Err_Vars.Error_Msg_Name_1 := Object_Dir.Value; Error_Msg - (Project, + (Project, In_Tree, "the object directory { cannot be found", Data.Location); @@ -3072,7 +3201,7 @@ package body Prj.Nmsc is if Name_Len = 0 then Error_Msg - (Project, + (Project, In_Tree, "Exec_Dir cannot be empty", Exec_Dir.Location); @@ -3087,7 +3216,7 @@ package body Prj.Nmsc is if Data.Exec_Directory = No_Name then Err_Vars.Error_Msg_Name_1 := Exec_Dir.Value; Error_Msg - (Project, + (Project, In_Tree, "the exec directory { cannot be found", Data.Location); end if; @@ -3117,9 +3246,11 @@ package body Prj.Nmsc is -- No Source_Dirs specified: the single source directory -- is the one containing the project file - String_Elements.Increment_Last; - Data.Source_Dirs := String_Elements.Last; - String_Elements.Table (Data.Source_Dirs) := + String_Element_Table.Increment_Last + (In_Tree.String_Elements); + Data.Source_Dirs := String_Element_Table.Last + (In_Tree.String_Elements); + In_Tree.String_Elements.Table (Data.Source_Dirs) := (Value => Data.Directory, Display_Value => Data.Display_Directory, Location => No_Location, @@ -3161,7 +3292,8 @@ package body Prj.Nmsc is -- element of the list while Source_Dir /= Nil_String loop - Element := String_Elements.Table (Source_Dir); + Element := + In_Tree.String_Elements.Table (Source_Dir); Find_Source_Dirs (Element.Value, Element.Location); Source_Dir := Element.Next; end loop; @@ -3178,12 +3310,12 @@ package body Prj.Nmsc is begin while Current /= Nil_String loop - Element := String_Elements.Table (Current); + Element := In_Tree.String_Elements.Table (Current); if Element.Value /= No_Name then Get_Name_String (Element.Value); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Element.Value := Name_Find; - String_Elements.Table (Current) := Element; + In_Tree.String_Elements.Table (Current) := Element; end if; Current := Element.Next; @@ -3196,9 +3328,12 @@ package body Prj.Nmsc is -- Get_Mains -- --------------- - procedure Get_Mains (Project : Project_Id; Data : in out Project_Data) is + procedure Get_Mains + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Data : in out Project_Data) is Mains : constant Variable_Value := - Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes); + Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes, In_Tree); begin Data.Mains := Mains.Values; @@ -3208,14 +3343,15 @@ package body Prj.Nmsc is if Mains.Default then if Data.Extends /= No_Project then - Data.Mains := Projects.Table (Data.Extends).Mains; + Data.Mains := + In_Tree.Projects.Table (Data.Extends).Mains; end if; -- In a library project file, Main cannot be specified elsif Data.Library then Error_Msg - (Project, + (Project, In_Tree, "a library project file cannot have Main specified", Mains.Location); end if; @@ -3228,7 +3364,8 @@ package body Prj.Nmsc is procedure Get_Sources_From_File (Path : String; Location : Source_Ptr; - Project : Project_Id) + Project : Project_Id; + In_Tree : Project_Tree_Ref) is File : Prj.Util.Text_File; Line : String (1 .. 250); @@ -3249,7 +3386,7 @@ package body Prj.Nmsc is Prj.Util.Open (File, Path); if not Prj.Util.Is_Valid (File) then - Error_Msg (Project, "file does not exist", Location); + Error_Msg (Project, In_Tree, "file does not exist", Location); else -- Read the lines one by one @@ -3686,6 +3823,7 @@ package body Prj.Nmsc is procedure Look_For_Sources (Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data; Follow_Links : Boolean) is @@ -3726,7 +3864,7 @@ package body Prj.Nmsc is while Source_Dir /= Nil_String loop Source_Recorded := False; - Element := String_Elements.Table (Source_Dir); + Element := In_Tree.String_Elements.Table (Source_Dir); declare Dir_Path : constant String := Get_Name_String (Element.Value); @@ -3775,6 +3913,7 @@ package body Prj.Nmsc is (File_Name => Name, Path_Name => Path, Project => Project, + In_Tree => In_Tree, Data => Data, Location => NL.Location, Current_Source => Current_Source, @@ -3787,7 +3926,8 @@ package body Prj.Nmsc is end; if Source_Recorded then - String_Elements.Table (Source_Dir).Flag := True; + In_Tree.String_Elements.Table (Source_Dir).Flag := + True; end if; Source_Dir := Element.Next; @@ -3804,14 +3944,14 @@ package body Prj.Nmsc is if First_Error then Error_Msg - (Project, + (Project, In_Tree, "source file { cannot be found", NL.Location); First_Error := False; else Error_Msg - (Project, + (Project, In_Tree, "\source file { cannot be found", NL.Location); end if; @@ -3833,7 +3973,7 @@ package body Prj.Nmsc is -- Get the list of sources from the file and put them in hash table -- Source_Names. - Get_Sources_From_File (Path, Location, Project); + Get_Sources_From_File (Path, Location, Project, In_Tree); -- Look in the source directories to find those sources @@ -3843,7 +3983,7 @@ package body Prj.Nmsc is -- If not, report an error. if Data.Sources = Nil_String then - Error_Msg (Project, + Error_Msg (Project, In_Tree, "there are no Ada sources in this project", Location); end if; @@ -3855,17 +3995,20 @@ package body Prj.Nmsc is Sources : constant Variable_Value := Util.Value_Of (Name_Source_Files, - Data.Decl.Attributes); + Data.Decl.Attributes, + In_Tree); Source_List_File : constant Variable_Value := Util.Value_Of (Name_Source_List_File, - Data.Decl.Attributes); + Data.Decl.Attributes, + In_Tree); Locally_Removed : constant Variable_Value := Util.Value_Of (Name_Locally_Removed_Files, - Data.Decl.Attributes); + Data.Decl.Attributes, + In_Tree); begin pragma Assert @@ -3879,7 +4022,7 @@ package body Prj.Nmsc is if not Sources.Default then if not Source_List_File.Default then Error_Msg - (Project, + (Project, In_Tree, "?both variables source_files and " & "source_list_file are present", Source_List_File.Location); @@ -3899,7 +4042,8 @@ package body Prj.Nmsc is Data.Ada_Sources_Present := Current /= Nil_String; while Current /= Nil_String loop - Element := String_Elements.Table (Current); + Element := + In_Tree.String_Elements.Table (Current); Get_Name_String (Element.Value); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Name := Name_Find; @@ -3945,7 +4089,7 @@ package body Prj.Nmsc is if Source_File_Path_Name'Length = 0 then Err_Vars.Error_Msg_Name_1 := Source_List_File.Value; Error_Msg - (Project, + (Project, In_Tree, "file with sources { does not exist", Source_List_File.Location); @@ -3962,7 +4106,7 @@ package body Prj.Nmsc is -- scheme in all the source directories. Find_Sources - (Project, Data, Ada_Language_Index, Follow_Links); + (Project, In_Tree, Data, Ada_Language_Index, Follow_Links); end if; -- If there are sources that are locally removed, mark them as @@ -3975,7 +4119,7 @@ package body Prj.Nmsc is if Data.Extends = No_Project then Error_Msg - (Project, + (Project, In_Tree, "Locally_Removed_Files can only be used " & "in an extending project file", Locally_Removed.Location); @@ -3992,7 +4136,8 @@ package body Prj.Nmsc is begin while Current /= Nil_String loop - Element := String_Elements.Table (Current); + Element := + In_Tree.String_Elements.Table (Current); Get_Name_String (Element.Value); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Name := Name_Find; @@ -4009,8 +4154,10 @@ package body Prj.Nmsc is OK := False; - for Index in 1 .. Units.Last loop - Unit := Units.Table (Index); + for Index in Unit_Table.First .. + Unit_Table.Last (In_Tree.Units) + loop + Unit := In_Tree.Units.Table (Index); if Unit.File_Names (Specification).Name = Name then OK := True; @@ -4024,26 +4171,27 @@ package body Prj.Nmsc is if Extended = Project then Error_Msg - (Project, + (Project, In_Tree, "cannot remove a source " & "of the same project", Location); elsif - Project_Extends (Project, Extended) + Project_Extends (Project, Extended, In_Tree) then Unit.File_Names (Specification).Path := Slash; Unit.File_Names (Specification).Needs_Pragma := False; - Units.Table (Index) := Unit; + In_Tree.Units.Table (Index) := + Unit; Add_Forbidden_File_Name (Unit.File_Names (Specification).Name); exit; else Error_Msg - (Project, + (Project, In_Tree, "cannot remove a source from " & "another project", Location); @@ -4063,18 +4211,19 @@ package body Prj.Nmsc is if Extended = Project then Error_Msg - (Project, + (Project, In_Tree, "cannot remove a source " & "of the same project", Location); elsif - Project_Extends (Project, Extended) + Project_Extends (Project, Extended, In_Tree) then Unit.File_Names (Body_Part).Path := Slash; Unit.File_Names (Body_Part).Needs_Pragma := False; - Units.Table (Index) := Unit; + In_Tree.Units.Table (Index) := + Unit; Add_Forbidden_File_Name (Unit.File_Names (Body_Part).Name); exit; @@ -4085,7 +4234,8 @@ package body Prj.Nmsc is if not OK then Err_Vars.Error_Msg_Name_1 := Name; - Error_Msg (Project, "unknown file {", Location); + Error_Msg + (Project, In_Tree, "unknown file {", Location); end if; Current := Element.Next; @@ -4106,19 +4256,20 @@ package body Prj.Nmsc is -- For each language (other than Ada) in the project file - if Is_Present (Lang, Data) then + if Is_Present (Lang, Data, In_Tree) then -- Reset the indication that there are sources of this -- language. It will be set back to True whenever we find a -- source of the language. - Set (Lang, False, Data); + Set (Lang, False, Data, In_Tree); -- First, get the source suffix for the language - Set (Suffix => Suffix_For (Lang, Data.Naming), + Set (Suffix => Suffix_For (Lang, Data.Naming, In_Tree), For_Language => Lang, - In_Project => Data); + In_Project => Data, + In_Tree => In_Tree); -- Then, deal with the naming exceptions, if any @@ -4129,7 +4280,8 @@ package body Prj.Nmsc is Value_Of (Index => Language_Names.Table (Lang), Src_Index => 0, - In_Array => Data.Naming.Implementation_Exceptions); + In_Array => Data.Naming.Implementation_Exceptions, + In_Tree => In_Tree); Element_Id : String_List_Id; Element : String_Element; File_Id : Name_Id; @@ -4143,7 +4295,8 @@ package body Prj.Nmsc is Element_Id := Naming_Exceptions.Values; while Element_Id /= Nil_String loop - Element := String_Elements.Table (Element_Id); + Element := In_Tree.String_Elements.Table + (Element_Id); Get_Name_String (Element.Value); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); @@ -4173,6 +4326,7 @@ package body Prj.Nmsc is if Source_Found then Record_Other_Sources (Project => Project, + In_Tree => In_Tree, Data => Data, Language => Lang, Naming_Exceptions => True); @@ -4191,12 +4345,14 @@ package body Prj.Nmsc is Sources : constant Variable_Value := Util.Value_Of (Name_Source_Files, - Data.Decl.Attributes); + Data.Decl.Attributes, + In_Tree); Source_List_File : constant Variable_Value := Util.Value_Of (Name_Source_List_File, - Data.Decl.Attributes); + Data.Decl.Attributes, + In_Tree); begin pragma Assert @@ -4210,7 +4366,7 @@ package body Prj.Nmsc is if not Sources.Default then if not Source_List_File.Default then Error_Msg - (Project, + (Project, In_Tree, "?both variables source_files and " & "source_list_file are present", Source_List_File.Location); @@ -4230,7 +4386,9 @@ package body Prj.Nmsc is -- Put all the sources in the Source_Names hash table while Current /= Nil_String loop - Element := String_Elements.Table (Current); + Element := + In_Tree.String_Elements.Table + (Current); Get_Name_String (Element.Value); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); @@ -4259,6 +4417,7 @@ package body Prj.Nmsc is Record_Other_Sources (Project => Project, + In_Tree => In_Tree, Data => Data, Language => Lang, Naming_Exceptions => False); @@ -4284,7 +4443,7 @@ package body Prj.Nmsc is Err_Vars.Error_Msg_Name_1 := Source_List_File.Value; Error_Msg - (Project, + (Project, In_Tree, "file with sources { does not exist", Source_List_File.Location); @@ -4295,12 +4454,13 @@ package body Prj.Nmsc is Get_Sources_From_File (Source_File_Path_Name, Source_List_File.Location, - Project); + Project, In_Tree); -- And look for their directories Record_Other_Sources (Project => Project, + In_Tree => In_Tree, Data => Data, Language => Lang, Naming_Exceptions => False); @@ -4315,7 +4475,7 @@ package body Prj.Nmsc is -- that effectively exist are also part of the source -- of this language. - Find_Sources (Project, Data, Lang); + Find_Sources (Project, In_Tree, Data, Lang); end if; end; end if; @@ -4354,8 +4514,9 @@ package body Prj.Nmsc is ------------------------------- procedure Prepare_Ada_Naming_Exceptions - (List : Array_Element_Id; - Kind : Spec_Or_Body) + (List : Array_Element_Id; + In_Tree : Project_Tree_Ref; + Kind : Spec_Or_Body) is Current : Array_Element_Id := List; Element : Array_Element; @@ -4366,7 +4527,7 @@ package body Prj.Nmsc is -- Traverse the list while Current /= No_Array_Element loop - Element := Array_Elements.Table (Current); + Element := In_Tree.Array_Elements.Table (Current); if Element.Index /= No_Name then Unit := @@ -4393,7 +4554,8 @@ package body Prj.Nmsc is function Project_Extends (Extending : Project_Id; - Extended : Project_Id) return Boolean + Extended : Project_Id; + In_Tree : Project_Tree_Ref) return Boolean is Current : Project_Id := Extending; begin @@ -4405,7 +4567,7 @@ package body Prj.Nmsc is return True; end if; - Current := Projects.Table (Current).Extends; + Current := In_Tree.Projects.Table (Current).Extends; end loop; end Project_Extends; @@ -4417,6 +4579,7 @@ package body Prj.Nmsc is (File_Name : Name_Id; Path_Name : Name_Id; Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data; Location : Source_Ptr; Current_Source : in out String_List_Id; @@ -4520,8 +4683,11 @@ package body Prj.Nmsc is -- Put the file name in the list of sources of the project if not File_Name_Recorded then - String_Elements.Increment_Last; - String_Elements.Table (String_Elements.Last) := + String_Element_Table.Increment_Last + (In_Tree.String_Elements); + In_Tree.String_Elements.Table + (String_Element_Table.Last + (In_Tree.String_Elements)) := (Value => Canonical_File_Name, Display_Value => File_Name, Location => No_Location, @@ -4531,18 +4697,23 @@ package body Prj.Nmsc is end if; if Current_Source = Nil_String then - Data.Sources := String_Elements.Last; + Data.Sources := String_Element_Table.Last + (In_Tree.String_Elements); else - String_Elements.Table (Current_Source).Next := - String_Elements.Last; + In_Tree.String_Elements.Table + (Current_Source).Next := + String_Element_Table.Last + (In_Tree.String_Elements); end if; - Current_Source := String_Elements.Last; + Current_Source := String_Element_Table.Last + (In_Tree.String_Elements); -- Put the unit in unit list declare - The_Unit : Unit_Id := Units_Htable.Get (Unit_Name); + The_Unit : Unit_Id := + Units_Htable.Get (In_Tree.Units_HT, Unit_Name); The_Unit_Data : Unit_Data; begin @@ -4556,13 +4727,14 @@ package body Prj.Nmsc is -- only the other unit kind (spec or body), or what is -- in the unit list is a unit of a project we are extending. - if The_Unit /= Prj.Com.No_Unit then - The_Unit_Data := Units.Table (The_Unit); + if The_Unit /= No_Unit then + The_Unit_Data := In_Tree.Units.Table (The_Unit); if The_Unit_Data.File_Names (Unit_Kind).Name = No_Name or else Project_Extends (Data.Extends, - The_Unit_Data.File_Names (Unit_Kind).Project) + The_Unit_Data.File_Names (Unit_Kind).Project, + In_Tree) then if The_Unit_Data.File_Names (Unit_Kind).Path = Slash then Remove_Forbidden_File_Name @@ -4572,7 +4744,10 @@ package body Prj.Nmsc is -- Record the file name in the hash table Files_Htable Unit_Prj := (Unit => The_Unit, Project => Project); - Files_Htable.Set (Canonical_File_Name, Unit_Prj); + Files_Htable.Set + (In_Tree.Files_HT, + Canonical_File_Name, + Unit_Prj); The_Unit_Data.File_Names (Unit_Kind) := (Name => Canonical_File_Name, @@ -4582,7 +4757,8 @@ package body Prj.Nmsc is Display_Path => Path_Name, Project => Project, Needs_Pragma => Needs_Pragma); - Units.Table (The_Unit) := The_Unit_Data; + In_Tree.Units.Table (The_Unit) := + The_Unit_Data; Source_Recorded := True; elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project @@ -4593,9 +4769,10 @@ package body Prj.Nmsc is if Previous_Source = Nil_String then Data.Sources := Nil_String; else - String_Elements.Table (Previous_Source).Next := - Nil_String; - String_Elements.Decrement_Last; + In_Tree.String_Elements.Table + (Previous_Source).Next := Nil_String; + String_Element_Table.Decrement_Last + (In_Tree.String_Elements); end if; Current_Source := Previous_Source; @@ -4605,25 +4782,30 @@ package body Prj.Nmsc is -- and the same kind (spec or body). if The_Location = No_Location then - The_Location := Projects.Table (Project).Location; + The_Location := + In_Tree.Projects.Table + (Project).Location; end if; Err_Vars.Error_Msg_Name_1 := Unit_Name; - Error_Msg (Project, "duplicate source {", The_Location); + Error_Msg + (Project, In_Tree, "duplicate source {", The_Location); Err_Vars.Error_Msg_Name_1 := - Projects.Table + In_Tree.Projects.Table (The_Unit_Data.File_Names (Unit_Kind).Project).Name; Err_Vars.Error_Msg_Name_2 := The_Unit_Data.File_Names (Unit_Kind).Path; Error_Msg - (Project, "\ project file {, {", The_Location); + (Project, In_Tree, + "\ project file {, {", The_Location); Err_Vars.Error_Msg_Name_1 := - Projects.Table (Project).Name; + In_Tree.Projects.Table (Project).Name; Err_Vars.Error_Msg_Name_2 := Canonical_Path_Name; Error_Msg - (Project, "\ project file {, {", The_Location); + (Project, In_Tree, + "\ project file {, {", The_Location); end if; -- It is a new unit, create a new record @@ -4634,25 +4816,31 @@ package body Prj.Nmsc is -- Of course, we do that only for the first unit in the -- source file. - Unit_Prj := Files_Htable.Get (Canonical_File_Name); + Unit_Prj := Files_Htable.Get + (In_Tree.Files_HT, Canonical_File_Name); if not File_Name_Recorded and then Unit_Prj /= No_Unit_Project then Error_Msg_Name_1 := File_Name; Error_Msg_Name_2 := - Projects.Table (Unit_Prj.Project).Name; + In_Tree.Projects.Table + (Unit_Prj.Project).Name; Error_Msg - (Project, + (Project, In_Tree, "{ is already a source of project {", Location); else - Units.Increment_Last; - The_Unit := Units.Last; - Units_Htable.Set (Unit_Name, The_Unit); + Unit_Table.Increment_Last (In_Tree.Units); + The_Unit := Unit_Table.Last (In_Tree.Units); + Units_Htable.Set + (In_Tree.Units_HT, Unit_Name, The_Unit); Unit_Prj := (Unit => The_Unit, Project => Project); - Files_Htable.Set (Canonical_File_Name, Unit_Prj); + Files_Htable.Set + (In_Tree.Files_HT, + Canonical_File_Name, + Unit_Prj); The_Unit_Data.Name := Unit_Name; The_Unit_Data.File_Names (Unit_Kind) := (Name => Canonical_File_Name, @@ -4662,7 +4850,8 @@ package body Prj.Nmsc is Display_Path => Path_Name, Project => Project, Needs_Pragma => Needs_Pragma); - Units.Table (The_Unit) := The_Unit_Data; + In_Tree.Units.Table (The_Unit) := + The_Unit_Data; Source_Recorded := True; end if; end if; @@ -4680,6 +4869,7 @@ package body Prj.Nmsc is procedure Record_Other_Sources (Project : Project_Id; + In_Tree : Project_Tree_Ref; Data : in out Project_Data; Language : Language_Index; Naming_Exceptions : Boolean) @@ -4697,11 +4887,11 @@ package body Prj.Nmsc is First_Error : Boolean := True; - Suffix : constant String := Body_Suffix_Of (Language, Data); + Suffix : constant String := Body_Suffix_Of (Language, Data, In_Tree); begin while Source_Dir /= Nil_String loop - Element := String_Elements.Table (Source_Dir); + Element := In_Tree.String_Elements.Table (Source_Dir); declare Dir_Path : constant String := Get_Name_String (Element.Value); @@ -4743,7 +4933,7 @@ package body Prj.Nmsc is if not Data.Known_Order_Of_Source_Dirs then Error_Msg_Name_1 := Canonical_Name; Error_Msg - (Project, + (Project, In_Tree, "{ is found in several source directories", NL.Location); end if; @@ -4761,6 +4951,7 @@ package body Prj.Nmsc is (File_Name => Canonical_Name, Path_Name => Path, Project => Project, + In_Tree => In_Tree, Data => Data, Location => NL.Location, Language => Language, @@ -4789,14 +4980,14 @@ package body Prj.Nmsc is if First_Error then Error_Msg - (Project, + (Project, In_Tree, "source file { cannot be found", NL.Location); First_Error := False; else Error_Msg - (Project, + (Project, In_Tree, "\source file { cannot be found", NL.Location); end if; @@ -4815,7 +5006,7 @@ package body Prj.Nmsc is begin while Source_Id /= No_Other_Source loop - Source := Other_Sources.Table (Source_Id); + Source := In_Tree.Other_Sources.Table (Source_Id); if Source.Language = Language and then Source.Naming_Exception @@ -4831,7 +5022,8 @@ package body Prj.Nmsc is Data.First_Other_Source := Source.Next; else - Other_Sources.Table (Prev_Id).Next := Source.Next; + In_Tree.Other_Sources.Table + (Prev_Id).Next := Source.Next; end if; Source_Id := Source.Next; @@ -4853,15 +5045,19 @@ package body Prj.Nmsc is -- Show_Source_Dirs -- ---------------------- - procedure Show_Source_Dirs (Project : Project_Id) is - Current : String_List_Id := Projects.Table (Project).Source_Dirs; + procedure Show_Source_Dirs + (Project : Project_Id; + In_Tree : Project_Tree_Ref) + is + Current : String_List_Id; Element : String_Element; begin Write_Line ("Source_Dirs:"); + Current := In_Tree.Projects.Table (Project).Source_Dirs; while Current /= Nil_String loop - Element := String_Elements.Table (Current); + Element := In_Tree.String_Elements.Table (Current); Write_Str (" "); Write_Line (Get_Name_String (Element.Value)); Current := Element.Next; @@ -4876,13 +5072,15 @@ package body Prj.Nmsc is function Suffix_For (Language : Language_Index; - Naming : Naming_Data) return Name_Id + Naming : Naming_Data; + In_Tree : Project_Tree_Ref) return Name_Id is Suffix : constant Variable_Value := Value_Of (Index => Language_Names.Table (Language), Src_Index => 0, - In_Array => Naming.Body_Suffix); + In_Array => Naming.Body_Suffix, + In_Tree => In_Tree); begin -- If no suffix for this language in package Naming, use the default @@ -4921,6 +5119,7 @@ package body Prj.Nmsc is procedure Warn_If_Not_Sources (Project : Project_Id; + In_Tree : Project_Tree_Ref; Conventions : Array_Element_Id; Specs : Boolean; Extending : Boolean) @@ -4933,48 +5132,50 @@ package body Prj.Nmsc is begin while Conv /= No_Array_Element loop - Unit := Array_Elements.Table (Conv).Index; + Unit := In_Tree.Array_Elements.Table (Conv).Index; Error_Msg_Name_1 := Unit; Get_Name_String (Unit); To_Lower (Name_Buffer (1 .. Name_Len)); Unit := Name_Find; - The_Unit_Id := Units_Htable.Get (Unit); - Location := Array_Elements.Table (Conv).Value.Location; + The_Unit_Id := Units_Htable.Get + (In_Tree.Units_HT, Unit); + Location := In_Tree.Array_Elements.Table + (Conv).Value.Location; - if The_Unit_Id = Prj.Com.No_Unit then + if The_Unit_Id = No_Unit then Error_Msg - (Project, + (Project, In_Tree, "?unknown unit {", Location); else - The_Unit_Data := Units.Table (The_Unit_Id); + The_Unit_Data := In_Tree.Units.Table (The_Unit_Id); if Specs then if not Check_Project (The_Unit_Data.File_Names (Specification).Project, - Project, Extending) + Project, In_Tree, Extending) then Error_Msg - (Project, + (Project, In_Tree, "?unit{ has no spec in this project", Location); end if; else if not Check_Project - (The_Unit_Data.File_Names (Com.Body_Part).Project, - Project, Extending) + (The_Unit_Data.File_Names (Body_Part).Project, + Project, In_Tree, Extending) then Error_Msg - (Project, + (Project, In_Tree, "?unit{ has no body in this project", Location); end if; end if; end if; - Conv := Array_Elements.Table (Conv).Next; + Conv := In_Tree.Array_Elements.Table (Conv).Next; end loop; end Warn_If_Not_Sources; diff --git a/gcc/ada/prj-nmsc.ads b/gcc/ada/prj-nmsc.ads index a8d4c9f3d5b..b7e356b3f28 100644 --- a/gcc/ada/prj-nmsc.ads +++ b/gcc/ada/prj-nmsc.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2005 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- -- @@ -34,6 +34,7 @@ private package Prj.Nmsc is procedure Check (Project : Project_Id; + In_Tree : Project_Tree_Ref; Report_Error : Put_Line_Access; Follow_Links : Boolean); -- Check the object directory and the source directories diff --git a/gcc/ada/prj-pars.adb b/gcc/ada/prj-pars.adb index 8ea1eac340a..05bb50f1ed8 100644 --- a/gcc/ada/prj-pars.adb +++ b/gcc/ada/prj-pars.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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,7 +28,6 @@ with Ada.Exceptions; use Ada.Exceptions; with Opt; with Output; use Output; -with Prj.Com; use Prj.Com; with Prj.Err; use Prj.Err; with Prj.Part; with Prj.Proc; @@ -41,32 +40,40 @@ package body Prj.Pars is ----------- procedure Parse - (Project : out Project_Id; + (In_Tree : Project_Tree_Ref; + Project : out Project_Id; Project_File_Name : String; Packages_To_Check : String_List_Access := All_Packages) is - Project_Tree : Project_Node_Id := Empty_Node; + Project_Node_Tree : constant Project_Node_Tree_Ref := + new Project_Node_Tree_Data; + Project_Node : Project_Node_Id := Empty_Node; The_Project : Project_Id := No_Project; Success : Boolean := True; begin + Prj.Tree.Initialize (Project_Node_Tree); + -- Parse the main project file into a tree Prj.Part.Parse - (Project => Project_Tree, + (In_Tree => Project_Node_Tree, + Project => Project_Node, Project_File_Name => Project_File_Name, Always_Errout_Finalize => False, Packages_To_Check => Packages_To_Check); -- If there were no error, process the tree - if Project_Tree /= Empty_Node then + if Project_Node /= Empty_Node then Prj.Proc.Process - (Project => The_Project, - Success => Success, - From_Project_Node => Project_Tree, - Report_Error => null, - Follow_Links => Opt.Follow_Links); + (In_Tree => In_Tree, + Project => The_Project, + Success => Success, + From_Project_Node => Project_Node, + From_Project_Node_Tree => Project_Node_Tree, + Report_Error => null, + Follow_Links => Opt.Follow_Links); Prj.Err.Finalize; if not Success then diff --git a/gcc/ada/prj-pars.ads b/gcc/ada/prj-pars.ads index 99800e39c24..97e1e835512 100644 --- a/gcc/ada/prj-pars.ads +++ b/gcc/ada/prj-pars.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2005 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- -- @@ -34,10 +34,12 @@ package Prj.Pars is -- Set the verbosity when parsing the project files procedure Parse - (Project : out Project_Id; + (In_Tree : Project_Tree_Ref; + Project : out Project_Id; Project_File_Name : String; Packages_To_Check : String_List_Access := All_Packages); - -- Parse a project files and all its imported project files. + -- Parse a project files and all its imported project files, in the + -- project tree In_Tree. -- -- If parsing is successful, Project_Id is the project ID -- of the main project file; otherwise, Project_Id is set diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 291fc23eb2a..54d2812d7a6 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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- -- @@ -52,6 +52,9 @@ pragma Elaborate_All (GNAT.OS_Lib); package body Prj.Part is + Buffer : String_Access; + Buffer_Last : Natural := 0; + Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator; type Extension_Origin is (None, Extending_Simple, Extending_All); @@ -104,7 +107,7 @@ package body Prj.Part is -- limited imported projects when there is a circularity with at least -- one limited imported project file. - package Virtual_Hash is new Simple_HTable + package Virtual_Hash is new System.HTable.Simple_HTable (Header_Num => Header_Num, Element => Project_Node_Id, No_Element => Empty_Node, @@ -114,7 +117,7 @@ package body Prj.Part is -- Hash table to store the node id of the project for which a virtual -- extending project need to be created. - package Processed_Hash is new Simple_HTable + package Processed_Hash is new System.HTable.Simple_HTable (Header_Num => Header_Num, Element => Boolean, No_Element => False, @@ -127,12 +130,14 @@ package body Prj.Part is procedure Create_Virtual_Extending_Project (For_Project : Project_Node_Id; - Main_Project : Project_Node_Id); + Main_Project : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref); -- Create a virtual extending project of For_Project. Main_Project is -- the extending all project. procedure Look_For_Virtual_Projects_For (Proj : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; Potentially_Virtual : Boolean); -- Look for projects that need to have a virtual extending project. -- This procedure is recursive. If called with Potentially_Virtual set to @@ -140,7 +145,9 @@ package body Prj.Part is -- does not (because it is already extended), but other projects that it -- imports may need to be virtually extended. - procedure Pre_Parse_Context_Clause (Context_Clause : out With_Id); + procedure Pre_Parse_Context_Clause + (In_Tree : Project_Node_Tree_Ref; + Context_Clause : out With_Id); -- Parse the context clause of a project. -- Store the paths and locations of the imported projects in table Withs. -- Does nothing if there is no context clause (if the current @@ -148,22 +155,26 @@ package body Prj.Part is procedure Post_Parse_Context_Clause (Context_Clause : With_Id; + In_Tree : Project_Node_Tree_Ref; Imported_Projects : out Project_Node_Id; Project_Directory : Name_Id; From_Extended : Extension_Origin; - In_Limited : Boolean); + In_Limited : Boolean; + Packages_To_Check : String_List_Access); -- 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 "limited with". procedure Parse_Single_Project - (Project : out Project_Node_Id; - Extends_All : out Boolean; - Path_Name : String; - Extended : Boolean; - From_Extended : Extension_Origin; - In_Limited : Boolean); + (In_Tree : Project_Node_Tree_Ref; + Project : out Project_Node_Id; + Extends_All : out Boolean; + Path_Name : String; + Extended : Boolean; + From_Extended : Extension_Origin; + In_Limited : Boolean; + Packages_To_Check : String_List_Access); -- Parse a project file. -- Recursive procedure: it calls itself for imported and extended -- projects. When From_Extended is not None, if the project has already @@ -193,12 +204,13 @@ package body Prj.Part is procedure Create_Virtual_Extending_Project (For_Project : Project_Node_Id; - Main_Project : Project_Node_Id) + Main_Project : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) is Virtual_Name : constant String := Virtual_Prefix & - Get_Name_String (Name_Of (For_Project)); + Get_Name_String (Name_Of (For_Project, In_Tree)); -- The name of the virtual extending project Virtual_Name_Id : Name_Id; @@ -209,7 +221,7 @@ package body Prj.Part is -- the same directory as the extending all project. Virtual_Dir_Id : constant Name_Id := - Immediate_Directory_Of (Path_Name_Of (Main_Project)); + Immediate_Directory_Of (Path_Name_Of (Main_Project, In_Tree)); -- The directory of the extending all project -- The source of the virtual extending project is something like: @@ -226,23 +238,29 @@ package body Prj.Part is -- Nodes that made up the virtual extending project Virtual_Project : constant Project_Node_Id := - Default_Project_Node (N_Project); + Default_Project_Node + (In_Tree, N_Project); With_Clause : constant Project_Node_Id := - Default_Project_Node (N_With_Clause); + Default_Project_Node + (In_Tree, N_With_Clause); Project_Declaration : constant Project_Node_Id := - Default_Project_Node (N_Project_Declaration); + Default_Project_Node + (In_Tree, N_Project_Declaration); Source_Dirs_Declaration : constant Project_Node_Id := - Default_Project_Node (N_Declarative_Item); + Default_Project_Node + (In_Tree, N_Declarative_Item); Source_Dirs_Attribute : constant Project_Node_Id := Default_Project_Node - (N_Attribute_Declaration, List); + (In_Tree, N_Attribute_Declaration, List); Source_Dirs_Expression : constant Project_Node_Id := - Default_Project_Node (N_Expression, List); + Default_Project_Node + (In_Tree, N_Expression, List); Source_Dirs_Term : constant Project_Node_Id := - Default_Project_Node (N_Term, List); + Default_Project_Node + (In_Tree, N_Term, List); Source_Dirs_List : constant Project_Node_Id := Default_Project_Node - (N_Literal_String_List, List); + (In_Tree, N_Literal_String_List, List); begin -- Get the virtual name id @@ -253,7 +271,7 @@ package body Prj.Part is -- Get the virtual path name - Get_Name_String (Path_Name_Of (Main_Project)); + Get_Name_String (Path_Name_Of (Main_Project, In_Tree)); while Name_Len > 0 and then Name_Buffer (Name_Len) /= Directory_Separator @@ -269,45 +287,49 @@ package body Prj.Part is -- With clause - Set_Name_Of (With_Clause, Virtual_Name_Id); - Set_Path_Name_Of (With_Clause, Virtual_Path_Id); - Set_Project_Node_Of (With_Clause, Virtual_Project); + Set_Name_Of (With_Clause, In_Tree, Virtual_Name_Id); + Set_Path_Name_Of (With_Clause, In_Tree, Virtual_Path_Id); + Set_Project_Node_Of (With_Clause, In_Tree, Virtual_Project); Set_Next_With_Clause_Of - (With_Clause, First_With_Clause_Of (Main_Project)); - Set_First_With_Clause_Of (Main_Project, With_Clause); + (With_Clause, In_Tree, First_With_Clause_Of (Main_Project, In_Tree)); + Set_First_With_Clause_Of (Main_Project, In_Tree, With_Clause); -- Virtual project node - Set_Name_Of (Virtual_Project, Virtual_Name_Id); - Set_Path_Name_Of (Virtual_Project, Virtual_Path_Id); - Set_Location_Of (Virtual_Project, Location_Of (Main_Project)); - Set_Directory_Of (Virtual_Project, Virtual_Dir_Id); - Set_Project_Declaration_Of (Virtual_Project, Project_Declaration); + Set_Name_Of (Virtual_Project, In_Tree, Virtual_Name_Id); + Set_Path_Name_Of (Virtual_Project, In_Tree, Virtual_Path_Id); + Set_Location_Of + (Virtual_Project, In_Tree, Location_Of (Main_Project, In_Tree)); + Set_Directory_Of (Virtual_Project, In_Tree, Virtual_Dir_Id); + Set_Project_Declaration_Of + (Virtual_Project, In_Tree, Project_Declaration); Set_Extended_Project_Path_Of - (Virtual_Project, Path_Name_Of (For_Project)); + (Virtual_Project, In_Tree, Path_Name_Of (For_Project, In_Tree)); -- Project declaration Set_First_Declarative_Item_Of - (Project_Declaration, Source_Dirs_Declaration); - Set_Extended_Project_Of (Project_Declaration, For_Project); + (Project_Declaration, In_Tree, Source_Dirs_Declaration); + Set_Extended_Project_Of (Project_Declaration, In_Tree, For_Project); -- Source_Dirs declaration - Set_Current_Item_Node (Source_Dirs_Declaration, Source_Dirs_Attribute); + Set_Current_Item_Node + (Source_Dirs_Declaration, In_Tree, Source_Dirs_Attribute); -- Source_Dirs attribute - Set_Name_Of (Source_Dirs_Attribute, Snames.Name_Source_Dirs); - Set_Expression_Of (Source_Dirs_Attribute, Source_Dirs_Expression); + Set_Name_Of (Source_Dirs_Attribute, In_Tree, Snames.Name_Source_Dirs); + Set_Expression_Of + (Source_Dirs_Attribute, In_Tree, Source_Dirs_Expression); -- Source_Dirs expression - Set_First_Term (Source_Dirs_Expression, Source_Dirs_Term); + Set_First_Term (Source_Dirs_Expression, In_Tree, Source_Dirs_Term); -- Source_Dirs term - Set_Current_Term (Source_Dirs_Term, Source_Dirs_List); + Set_Current_Term (Source_Dirs_Term, In_Tree, Source_Dirs_List); -- Source_Dirs empty list: nothing to do @@ -352,6 +374,7 @@ package body Prj.Part is procedure Look_For_Virtual_Projects_For (Proj : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; Potentially_Virtual : Boolean) is @@ -376,10 +399,10 @@ package body Prj.Part is Processed_Hash.Set (Proj, True); - Declaration := Project_Declaration_Of (Proj); + Declaration := Project_Declaration_Of (Proj, In_Tree); if Declaration /= Empty_Node then - Extended := Extended_Project_Of (Declaration); + Extended := Extended_Project_Of (Declaration, In_Tree); end if; -- If this is a project that may need a virtual extending project @@ -391,17 +414,17 @@ package body Prj.Part is -- Now check the projects it imports - With_Clause := First_With_Clause_Of (Proj); + With_Clause := First_With_Clause_Of (Proj, In_Tree); while With_Clause /= Empty_Node loop - Imported := Project_Node_Of (With_Clause); + Imported := Project_Node_Of (With_Clause, In_Tree); if Imported /= Empty_Node then Look_For_Virtual_Projects_For - (Imported, Potentially_Virtual => True); + (Imported, In_Tree, Potentially_Virtual => True); end if; - With_Clause := Next_With_Clause_Of (With_Clause); + With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); end loop; -- Check also the eventual project extended by Proj. As this project @@ -409,7 +432,7 @@ package body Prj.Part is -- being False. Look_For_Virtual_Projects_For - (Extended, Potentially_Virtual => False); + (Extended, In_Tree, Potentially_Virtual => False); end if; end Look_For_Virtual_Projects_For; @@ -418,7 +441,8 @@ package body Prj.Part is ----------- procedure Parse - (Project : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Project : out Project_Node_Id; Project_File_Name : String; Always_Errout_Finalize : Boolean; Packages_To_Check : String_List_Access := All_Packages; @@ -428,11 +452,6 @@ package body Prj.Part is Dummy : Boolean; begin - -- Save the Packages_To_Check in Prj, so that it is visible from - -- Prj.Dect. - - Current_Packages_To_Check := Packages_To_Check; - Project := Empty_Node; if Current_Verbosity >= Medium then @@ -461,18 +480,22 @@ package body Prj.Part is end if; Parse_Single_Project - (Project => Project, - Extends_All => Dummy, - Path_Name => Path_Name, - Extended => False, - From_Extended => None, - In_Limited => False); + (In_Tree => In_Tree, + Project => Project, + Extends_All => Dummy, + Path_Name => Path_Name, + Extended => False, + From_Extended => None, + In_Limited => False, + Packages_To_Check => Packages_To_Check); -- If Project is an extending-all project, create the eventual -- virtual extending projects and check that there are no illegally -- imported projects. - if Project /= Empty_Node and then Is_Extending_All (Project) then + if Project /= Empty_Node + and then Is_Extending_All (Project, In_Tree) + then -- First look for projects that potentially need a virtual -- extending project. @@ -487,10 +510,10 @@ package body Prj.Part is declare Declaration : constant Project_Node_Id := - Project_Declaration_Of (Project); + Project_Declaration_Of (Project, In_Tree); begin Look_For_Virtual_Projects_For - (Extended_Project_Of (Declaration), + (Extended_Project_Of (Declaration, In_Tree), In_Tree, Potentially_Virtual => False); end; @@ -501,30 +524,33 @@ package body Prj.Part is -- the project being "extended-all" by the main project. declare - With_Clause : Project_Node_Id := - First_With_Clause_Of (Project); + With_Clause : Project_Node_Id; Imported : Project_Node_Id := Empty_Node; Declaration : Project_Node_Id := Empty_Node; begin + With_Clause := First_With_Clause_Of (Project, In_Tree); while With_Clause /= Empty_Node loop - Imported := Project_Node_Of (With_Clause); + Imported := Project_Node_Of (With_Clause, In_Tree); if Imported /= Empty_Node then - Declaration := Project_Declaration_Of (Imported); + Declaration := Project_Declaration_Of (Imported, In_Tree); - if Extended_Project_Of (Declaration) /= Empty_Node then + if Extended_Project_Of (Declaration, In_Tree) /= + Empty_Node + then loop - Imported := Extended_Project_Of (Declaration); + Imported := + Extended_Project_Of (Declaration, In_Tree); exit when Imported = Empty_Node; Virtual_Hash.Remove (Imported); - Declaration := Project_Declaration_Of (Imported); + Declaration := + Project_Declaration_Of (Imported, In_Tree); end loop; end if; - end if; - With_Clause := Next_With_Clause_Of (With_Clause); + With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); end loop; end; @@ -534,7 +560,7 @@ package body Prj.Part is Proj : Project_Node_Id := Virtual_Hash.Get_First; begin while Proj /= Empty_Node loop - Create_Virtual_Extending_Project (Proj, Project); + Create_Virtual_Extending_Project (Proj, Project, In_Tree); Proj := Virtual_Hash.Get_Next; end loop; end; @@ -568,7 +594,10 @@ package body Prj.Part is -- Pre_Parse_Context_Clause -- ------------------------------ - procedure Pre_Parse_Context_Clause (Context_Clause : out With_Id) is + procedure Pre_Parse_Context_Clause + (In_Tree : Project_Node_Tree_Ref; + Context_Clause : out With_Id) + is Current_With_Clause : With_Id := No_With; Limited_With : Boolean := False; @@ -582,22 +611,23 @@ package body Prj.Part is Context_Clause := No_With; With_Loop : - -- If Token is not WITH or LIMITED, there is no context clause, - -- or we have exhausted the with clauses. + -- If Token is not WITH or LIMITED, there is no context clause, or we + -- have exhausted the with clauses. while Token = Tok_With or else Token = Tok_Limited loop - Current_With_Node := Default_Project_Node (Of_Kind => N_With_Clause); + Current_With_Node := + Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree); Limited_With := Token = Tok_Limited; if Limited_With then - Scan; -- scan past LIMITED + Scan (In_Tree); -- scan past LIMITED Expect (Tok_With, "WITH"); exit With_Loop when Token /= Tok_With; end if; Comma_Loop : loop - Scan; -- scan past WITH or "," + Scan (In_Tree); -- scan past WITH or "," Expect (Tok_String_Literal, "literal string"); @@ -626,7 +656,7 @@ package body Prj.Part is Current_With_Clause := Withs.Last; - Scan; + Scan (In_Tree); if Token = Tok_Semicolon then Set_End_Of_Line (Current_With_Node); @@ -634,7 +664,7 @@ package body Prj.Part is -- End of (possibly multiple) with clause; - Scan; -- scan past the semicolon. + Scan (In_Tree); -- scan past the semicolon. exit Comma_Loop; elsif Token /= Tok_Comma then @@ -643,7 +673,8 @@ package body Prj.Part is end if; Current_With_Node := - Default_Project_Node (Of_Kind => N_With_Clause); + Default_Project_Node + (Of_Kind => N_With_Clause, In_Tree => In_Tree); end loop Comma_Loop; end loop With_Loop; end Pre_Parse_Context_Clause; @@ -655,10 +686,12 @@ package body Prj.Part is procedure Post_Parse_Context_Clause (Context_Clause : With_Id; + In_Tree : Project_Node_Tree_Ref; Imported_Projects : out Project_Node_Id; Project_Directory : Name_Id; From_Extended : Extension_Origin; - In_Limited : Boolean) + In_Limited : Boolean; + Packages_To_Check : String_List_Access) is Current_With_Clause : With_Id := Context_Clause; @@ -684,12 +717,11 @@ package body Prj.Part is declare Original_Path : constant String := - Get_Name_String (Current_With.Path); + Get_Name_String (Current_With.Path); Imported_Path_Name : constant String := Project_Path_Name_Of - (Original_Path, - Project_Directory_Path); + (Original_Path, Project_Directory_Path); Resolved_Path : constant String := Normalize_Pathname @@ -732,13 +764,15 @@ package body Prj.Part is else Next_Project := Current_With.Node; - Set_Next_With_Clause_Of (Current_Project, Next_Project); + Set_Next_With_Clause_Of + (Current_Project, In_Tree, Next_Project); Current_Project := Next_Project; end if; Set_String_Value_Of - (Current_Project, Current_With.Path); - Set_Location_Of (Current_Project, Current_With.Location); + (Current_Project, In_Tree, Current_With.Path); + Set_Location_Of + (Current_Project, In_Tree, Current_With.Location); -- If this is a "limited with", check if we have a circularity. -- If we have one, get the project id of the limited imported @@ -772,15 +806,17 @@ package body Prj.Part is if Withed_Project = Empty_Node then Parse_Single_Project - (Project => Withed_Project, - Extends_All => Extends_All, - Path_Name => Imported_Path_Name, - Extended => False, - From_Extended => From_Extended, - In_Limited => Limited_With); + (In_Tree => In_Tree, + Project => Withed_Project, + Extends_All => Extends_All, + Path_Name => Imported_Path_Name, + Extended => False, + From_Extended => From_Extended, + In_Limited => Limited_With, + Packages_To_Check => Packages_To_Check); else - Extends_All := Is_Extending_All (Withed_Project); + Extends_All := Is_Extending_All (Withed_Project, In_Tree); end if; if Withed_Project = Empty_Node then @@ -794,7 +830,7 @@ package body Prj.Part is else Set_Next_With_Clause_Of - (Current_Project, Empty_Node); + (Current_Project, In_Tree, Empty_Node); end if; else -- If parsing was successful, record project name @@ -802,16 +838,20 @@ package body Prj.Part is Set_Project_Node_Of (Node => Current_Project, + In_Tree => In_Tree, To => Withed_Project, - Limited_With => Limited_With); - Set_Name_Of (Current_Project, Name_Of (Withed_Project)); + Limited_With => Current_With.Limited_With); + Set_Name_Of + (Current_Project, + In_Tree, + Name_Of (Withed_Project, In_Tree)); Name_Len := Resolved_Path'Length; Name_Buffer (1 .. Name_Len) := Resolved_Path; - Set_Path_Name_Of (Current_Project, Name_Find); + Set_Path_Name_Of (Current_Project, In_Tree, Name_Find); if Extends_All then - Set_Is_Extending_All (Current_Project); + Set_Is_Extending_All (Current_Project, In_Tree); end if; end if; end if; @@ -824,12 +864,14 @@ package body Prj.Part is -------------------------- procedure Parse_Single_Project - (Project : out Project_Node_Id; - Extends_All : out Boolean; - Path_Name : String; - Extended : Boolean; - From_Extended : Extension_Origin; - In_Limited : Boolean) + (In_Tree : Project_Node_Tree_Ref; + Project : out Project_Node_Id; + Extends_All : out Boolean; + Path_Name : String; + Extended : Boolean; + From_Extended : Extension_Origin; + In_Limited : Boolean; + Packages_To_Check : String_List_Access) is Normed_Path_Name : Name_Id; Canonical_Path_Name : Name_Id; @@ -842,7 +884,8 @@ package body Prj.Part is Extended_Project : Project_Node_Id := Empty_Node; A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node := - Tree_Private_Part.Projects_Htable.Get_First; + Tree_Private_Part.Projects_Htable.Get_First + (In_Tree.Projects_HT); Name_From_Path : constant Name_Id := Project_Name_From (Path_Name); @@ -931,7 +974,7 @@ package body Prj.Part is elsif A_Project_Name_And_Node.Extended then Extends_All := - Is_Extending_All (A_Project_Name_And_Node.Node); + Is_Extending_All (A_Project_Name_And_Node.Node, In_Tree); -- If the imported project is an extended project A, -- and we are in an extended project, replace A with the @@ -941,15 +984,17 @@ package body Prj.Part is declare Decl : Project_Node_Id := Project_Declaration_Of - (A_Project_Name_And_Node.Node); + (A_Project_Name_And_Node.Node, In_Tree); - Prj : Project_Node_Id := Extending_Project_Of (Decl); + Prj : Project_Node_Id := + Extending_Project_Of (Decl, In_Tree); begin loop - Decl := Project_Declaration_Of (Prj); - exit when Extending_Project_Of (Decl) = Empty_Node; - Prj := Extending_Project_Of (Decl); + Decl := Project_Declaration_Of (Prj, In_Tree); + exit when Extending_Project_Of (Decl, In_Tree) = + Empty_Node; + Prj := Extending_Project_Of (Decl, In_Tree); end loop; A_Project_Name_And_Node.Node := Prj; @@ -966,7 +1011,8 @@ package body Prj.Part is return; end if; - A_Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next; + A_Project_Name_And_Node := + Tree_Private_Part.Projects_Htable.Get_Next (In_Tree.Projects_HT); end loop; -- We never encountered this project file @@ -986,7 +1032,7 @@ package body Prj.Part is Prj.Err.Scanner.Initialize_Scanner (Types.No_Unit, Source_Index); Tree.Reset_State; - Scan; + Scan (In_Tree); if Name_From_Path = No_Name then @@ -1007,22 +1053,23 @@ package body Prj.Part is -- Is there any imported project? - Pre_Parse_Context_Clause (First_With); + Pre_Parse_Context_Clause (In_Tree, First_With); Project_Directory := Immediate_Directory_Of (Normed_Path_Name); - Project := Default_Project_Node (Of_Kind => N_Project); + Project := Default_Project_Node + (Of_Kind => N_Project, In_Tree => In_Tree); Project_Stack.Table (Project_Stack.Last).Id := Project; - Set_Directory_Of (Project, Project_Directory); - Set_Path_Name_Of (Project, Normed_Path_Name); - Set_Location_Of (Project, Token_Ptr); + Set_Directory_Of (Project, In_Tree, Project_Directory); + Set_Path_Name_Of (Project, In_Tree, Normed_Path_Name); + Set_Location_Of (Project, In_Tree, Token_Ptr); Expect (Tok_Project, "PROJECT"); -- Mark location of PROJECT token if present if Token = Tok_Project then - Set_Location_Of (Project, Token_Ptr); - Scan; -- scan past project + Set_Location_Of (Project, In_Tree, Token_Ptr); + Scan (In_Tree); -- scan past project end if; -- Clear the Buffer @@ -1042,21 +1089,21 @@ package body Prj.Part is -- Add the identifier name to the buffer Get_Name_String (Token_Name); - Add_To_Buffer (Name_Buffer (1 .. Name_Len)); + Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last); -- Scan past the identifier - Scan; + Scan (In_Tree); -- If we have a dot, add a dot the the Buffer and look for the next -- identifier. exit when Token /= Tok_Dot; - Add_To_Buffer ("."); + Add_To_Buffer (".", Buffer, Buffer_Last); -- Scan past the dot - Scan; + Scan (In_Tree); end loop; -- See if this is an extending project @@ -1071,12 +1118,12 @@ package body Prj.Part is Extending := True; - Scan; -- scan past EXTENDS + Scan (In_Tree); -- scan past EXTENDS if Token = Tok_All then Extends_All := True; - Set_Is_Extending_All (Project); - Scan; -- scan past ALL + Set_Is_Extending_All (Project, In_Tree); + Scan (In_Tree); -- scan past ALL end if; end if; @@ -1089,7 +1136,7 @@ package body Prj.Part is Name_Len := Buffer_Last; Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last); Name_Of_Project := Name_Find; - Set_Name_Of (Project, Name_Of_Project); + Set_Name_Of (Project, In_Tree, Name_Of_Project); -- To get expected name of the project file, replace dots by dashes @@ -1138,17 +1185,20 @@ package body Prj.Part is end if; Post_Parse_Context_Clause - (Context_Clause => First_With, + (In_Tree => In_Tree, + Context_Clause => First_With, Imported_Projects => Imported_Projects, Project_Directory => Project_Directory, From_Extended => From_Ext, - In_Limited => In_Limited); - Set_First_With_Clause_Of (Project, Imported_Projects); + In_Limited => In_Limited, + Packages_To_Check => Packages_To_Check); + Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); end; declare Name_And_Node : Tree_Private_Part.Project_Name_And_Node := - Tree_Private_Part.Projects_Htable.Get_First; + Tree_Private_Part.Projects_Htable.Get_First + (In_Tree.Projects_HT); Project_Name : Name_Id := Name_And_Node.Name; begin @@ -1157,7 +1207,9 @@ package body Prj.Part is while Project_Name /= No_Name and then Project_Name /= Name_Of_Project loop - Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next; + Name_And_Node := + Tree_Private_Part.Projects_Htable.Get_Next + (In_Tree.Projects_HT); Project_Name := Name_And_Node.Name; end loop; @@ -1165,9 +1217,12 @@ package body Prj.Part is if Project_Name /= No_Name then Error_Msg_Name_1 := Project_Name; - Error_Msg ("duplicate project name {", Location_Of (Project)); - Error_Msg_Name_1 := Path_Name_Of (Name_And_Node.Node); - Error_Msg ("\already in {", Location_Of (Project)); + Error_Msg + ("duplicate project name {", Location_Of (Project, In_Tree)); + Error_Msg_Name_1 := + Path_Name_Of (Name_And_Node.Node, In_Tree); + Error_Msg + ("\already in {", Location_Of (Project, In_Tree)); else -- Otherwise, add the name of the project to the hash table, so @@ -1175,7 +1230,8 @@ package body Prj.Part is -- the same name. Tree_Private_Part.Projects_Htable.Set - (K => Name_Of_Project, + (T => In_Tree.Projects_HT, + K => Name_Of_Project, E => (Name => Name_Of_Project, Node => Project, Canonical_Path => Canonical_Path_Name, @@ -1189,7 +1245,7 @@ package body Prj.Part is Expect (Tok_String_Literal, "literal string"); if Token = Tok_String_Literal then - Set_Extended_Project_Path_Of (Project, Token_Name); + Set_Extended_Project_Path_Of (Project, In_Tree, Token_Name); declare Original_Path_Name : constant String := @@ -1198,8 +1254,8 @@ package body Prj.Part is Extended_Project_Path_Name : constant String := Project_Path_Name_Of (Original_Path_Name, - Get_Name_String - (Project_Directory)); + Get_Name_String + (Project_Directory)); begin if Extended_Project_Path_Name = "" then @@ -1235,50 +1291,53 @@ package body Prj.Part is end if; Parse_Single_Project - (Project => Extended_Project, - Extends_All => Extends_All, - Path_Name => Extended_Project_Path_Name, - Extended => True, - From_Extended => From_Ext, - In_Limited => In_Limited); + (In_Tree => In_Tree, + Project => Extended_Project, + Extends_All => Extends_All, + Path_Name => Extended_Project_Path_Name, + Extended => True, + From_Extended => From_Ext, + In_Limited => In_Limited, + Packages_To_Check => Packages_To_Check); end; -- A project that extends an extending-all project is also -- an extending-all project. if Extended_Project /= Empty_Node - and then Is_Extending_All (Extended_Project) + and then Is_Extending_All (Extended_Project, In_Tree) then - Set_Is_Extending_All (Project); + Set_Is_Extending_All (Project, In_Tree); end if; end if; end; - Scan; -- scan past the extended project path + Scan (In_Tree); -- scan past the extended project path end if; end if; -- Check that a non extending-all project does not import an -- extending-all project. - if not Is_Extending_All (Project) then + if not Is_Extending_All (Project, In_Tree) then declare - With_Clause : Project_Node_Id := First_With_Clause_Of (Project); + With_Clause : Project_Node_Id := + First_With_Clause_Of (Project, In_Tree); Imported : Project_Node_Id := Empty_Node; begin With_Clause_Loop : while With_Clause /= Empty_Node loop - Imported := Project_Node_Of (With_Clause); + Imported := Project_Node_Of (With_Clause, In_Tree); - if Is_Extending_All (With_Clause) then - Error_Msg_Name_1 := Name_Of (Imported); + if Is_Extending_All (With_Clause, In_Tree) then + Error_Msg_Name_1 := Name_Of (Imported, In_Tree); Error_Msg ("cannot import extending-all project {", Token_Ptr); exit With_Clause_Loop; end if; - With_Clause := Next_With_Clause_Of (With_Clause); + With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); end loop With_Clause_Loop; end; end if; @@ -1308,22 +1367,25 @@ package body Prj.Part is declare Parent_Name : constant Name_Id := Name_Find; Parent_Found : Boolean := False; - With_Clause : Project_Node_Id := First_With_Clause_Of (Project); + With_Clause : Project_Node_Id := + First_With_Clause_Of (Project, In_Tree); begin -- If there is an extended project, check its name if Extended_Project /= Empty_Node then - Parent_Found := Name_Of (Extended_Project) = Parent_Name; + Parent_Found := + Name_Of (Extended_Project, In_Tree) = Parent_Name; end if; -- If the parent project is not the extended project, -- check each imported project until we find the parent project. while not Parent_Found and then With_Clause /= Empty_Node loop - Parent_Found := Name_Of (Project_Node_Of (With_Clause)) - = Parent_Name; - With_Clause := Next_With_Clause_Of (With_Clause); + Parent_Found := + Name_Of (Project_Node_Of (With_Clause, In_Tree), In_Tree) = + Parent_Name; + With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); end loop; -- If the parent project was not found, report an error @@ -1332,7 +1394,7 @@ package body Prj.Part is Error_Msg_Name_1 := Name_Of_Project; Error_Msg_Name_2 := Parent_Name; Error_Msg ("project { does not import or extend project {", - Location_Of (Project)); + Location_Of (Project, In_Tree)); end if; end; end if; @@ -1349,14 +1411,17 @@ package body Prj.Part is -- No need to Scan past "is", Prj.Dect.Parse will do it Prj.Dect.Parse - (Declarations => Project_Declaration, - Current_Project => Project, - Extends => Extended_Project); - Set_Project_Declaration_Of (Project, Project_Declaration); + (In_Tree => In_Tree, + Declarations => Project_Declaration, + Current_Project => Project, + Extends => Extended_Project, + Packages_To_Check => Packages_To_Check); + Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration); if Extended_Project /= Empty_Node then Set_Extending_Project_Of - (Project_Declaration_Of (Extended_Project), To => Project); + (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree, + To => Project); end if; end; @@ -1366,7 +1431,7 @@ package body Prj.Part is -- Skip "end" if present if Token = Tok_End then - Scan; + Scan (In_Tree); end if; -- Clear the Buffer @@ -1389,26 +1454,26 @@ package body Prj.Part is -- Add the identifier to the Buffer Get_Name_String (Token_Name); - Add_To_Buffer (Name_Buffer (1 .. Name_Len)); + Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last); -- Scan past the identifier - Scan; + Scan (In_Tree); exit when Token /= Tok_Dot; - Add_To_Buffer ("."); - Scan; + Add_To_Buffer (".", Buffer, Buffer_Last); + Scan (In_Tree); end loop; -- If we have a valid name, check if it is the name of the project if Name_Of_Project /= No_Name and then Buffer_Last > 0 then if To_Lower (Buffer (1 .. Buffer_Last)) /= - Get_Name_String (Name_Of (Project)) + Get_Name_String (Name_Of (Project, In_Tree)) then -- Invalid name: report an error Error_Msg ("Expected """ & - Get_Name_String (Name_Of (Project)) & """", + Get_Name_String (Name_Of (Project, In_Tree)) & """", Token_Ptr); end if; end if; @@ -1420,7 +1485,7 @@ package body Prj.Part is if Token = Tok_Semicolon then Set_Previous_End_Node (Project); - Scan; + Scan (In_Tree); if Token /= Tok_EOF then Error_Msg @@ -1439,7 +1504,9 @@ package body Prj.Part is -- Indicate if there are unkept comments Tree.Set_Project_File_Includes_Unkept_Comments - (Node => Project, To => Tree.There_Are_Unkept_Comments); + (Node => Project, + In_Tree => In_Tree, + To => Tree.There_Are_Unkept_Comments); -- And restore the comment state that was saved diff --git a/gcc/ada/prj-part.ads b/gcc/ada/prj-part.ads index 5b8f3921928..05b089250c1 100644 --- a/gcc/ada/prj-part.ads +++ b/gcc/ada/prj-part.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2005 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- -- @@ -31,7 +31,8 @@ with Prj.Tree; use Prj.Tree; package Prj.Part is procedure Parse - (Project : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Project : out Project_Node_Id; Project_File_Name : String; Always_Errout_Finalize : Boolean; Packages_To_Check : String_List_Access := All_Packages; diff --git a/gcc/ada/prj-pp.adb b/gcc/ada/prj-pp.adb index f9cceb5bc52..b1ef31e16f0 100644 --- a/gcc/ada/prj-pp.adb +++ b/gcc/ada/prj-pp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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- -- @@ -63,6 +63,7 @@ package body Prj.PP is procedure Pretty_Print (Project : Prj.Tree.Project_Node_Id; + In_Tree : Prj.Tree.Project_Node_Tree_Ref; Increment : Positive := 3; Eliminate_Empty_Case_Constructions : Boolean := False; Minimize_Empty_Lines : Boolean := False; @@ -254,7 +255,7 @@ package body Prj.PP is ------------------------------- procedure Write_End_Of_Line_Comment (Node : Project_Node_Id) is - Value : constant Name_Id := End_Of_Line_Comment (Node); + Value : constant Name_Id := End_Of_Line_Comment (Node, In_Tree); begin if Value /= No_Name then @@ -309,136 +310,152 @@ package body Prj.PP is begin if Node /= Empty_Node then - case Kind_Of (Node) is + case Kind_Of (Node, In_Tree) is when N_Project => pragma Debug (Indicate_Tested (N_Project)); - if First_With_Clause_Of (Node) /= Empty_Node then + if First_With_Clause_Of (Node, In_Tree) /= Empty_Node then -- with clause(s) - Print (First_With_Clause_Of (Node), Indent); + Print (First_With_Clause_Of (Node, In_Tree), Indent); Write_Empty_Line (Always => True); end if; - Print (First_Comment_Before (Node), Indent); + Print (First_Comment_Before (Node, In_Tree), Indent); Start_Line (Indent); Write_String ("project "); - Output_Name (Name_Of (Node)); + Output_Name (Name_Of (Node, In_Tree)); -- Check if this project extends another project - if Extended_Project_Path_Of (Node) /= No_Name then + if Extended_Project_Path_Of (Node, In_Tree) /= No_Name then Write_String (" extends "); - Output_String (Extended_Project_Path_Of (Node)); + Output_String (Extended_Project_Path_Of (Node, In_Tree)); end if; Write_String (" is"); Write_End_Of_Line_Comment (Node); - Print (First_Comment_After (Node), Indent + Increment); + Print + (First_Comment_After (Node, In_Tree), Indent + Increment); Write_Empty_Line (Always => True); -- Output all of the declarations in the project - Print (Project_Declaration_Of (Node), Indent); - Print (First_Comment_Before_End (Node), Indent + Increment); + Print (Project_Declaration_Of (Node, In_Tree), Indent); + Print + (First_Comment_Before_End (Node, In_Tree), + Indent + Increment); Start_Line (Indent); Write_String ("end "); - Output_Name (Name_Of (Node)); + Output_Name (Name_Of (Node, In_Tree)); Write_Line (";"); - Print (First_Comment_After_End (Node), Indent); + Print (First_Comment_After_End (Node, In_Tree), Indent); when N_With_Clause => pragma Debug (Indicate_Tested (N_With_Clause)); - if Name_Of (Node) /= No_Name then - Print (First_Comment_Before (Node), Indent); + if Name_Of (Node, In_Tree) /= No_Name then + Print (First_Comment_Before (Node, In_Tree), Indent); Start_Line (Indent); - if Non_Limited_Project_Node_Of (Node) = Empty_Node then + if Non_Limited_Project_Node_Of (Node, In_Tree) = + Empty_Node + then Write_String ("limited "); end if; Write_String ("with "); - Output_String (String_Value_Of (Node)); + Output_String (String_Value_Of (Node, In_Tree)); Write_String (";"); Write_End_Of_Line_Comment (Node); - Print (First_Comment_After (Node), Indent); + Print (First_Comment_After (Node, In_Tree), Indent); end if; - Print (Next_With_Clause_Of (Node), Indent); + Print (Next_With_Clause_Of (Node, In_Tree), Indent); when N_Project_Declaration => pragma Debug (Indicate_Tested (N_Project_Declaration)); - if First_Declarative_Item_Of (Node) /= Empty_Node then + if + First_Declarative_Item_Of (Node, In_Tree) /= Empty_Node + then Print - (First_Declarative_Item_Of (Node), Indent + Increment); + (First_Declarative_Item_Of (Node, In_Tree), + Indent + Increment); Write_Empty_Line (Always => True); end if; when N_Declarative_Item => pragma Debug (Indicate_Tested (N_Declarative_Item)); - Print (Current_Item_Node (Node), Indent); - Print (Next_Declarative_Item (Node), Indent); + Print (Current_Item_Node (Node, In_Tree), Indent); + Print (Next_Declarative_Item (Node, In_Tree), Indent); when N_Package_Declaration => pragma Debug (Indicate_Tested (N_Package_Declaration)); Write_Empty_Line (Always => True); - Print (First_Comment_Before (Node), Indent); + Print (First_Comment_Before (Node, In_Tree), Indent); Start_Line (Indent); Write_String ("package "); - Output_Name (Name_Of (Node)); + Output_Name (Name_Of (Node, In_Tree)); - if Project_Of_Renamed_Package_Of (Node) /= Empty_Node then + if Project_Of_Renamed_Package_Of (Node, In_Tree) /= + Empty_Node + then Write_String (" renames "); Output_Name - (Name_Of (Project_Of_Renamed_Package_Of (Node))); + (Name_Of + (Project_Of_Renamed_Package_Of (Node, In_Tree), + In_Tree)); Write_String ("."); - Output_Name (Name_Of (Node)); + Output_Name (Name_Of (Node, In_Tree)); Write_String (";"); Write_End_Of_Line_Comment (Node); - Print (First_Comment_After_End (Node), Indent); + Print (First_Comment_After_End (Node, In_Tree), Indent); else Write_String (" is"); Write_End_Of_Line_Comment (Node); - Print (First_Comment_After (Node), Indent + Increment); + Print (First_Comment_After (Node, In_Tree), + Indent + Increment); - if First_Declarative_Item_Of (Node) /= Empty_Node then + if First_Declarative_Item_Of (Node, In_Tree) /= + Empty_Node + then Print - (First_Declarative_Item_Of (Node), + (First_Declarative_Item_Of (Node, In_Tree), Indent + Increment); end if; - Print (First_Comment_Before_End (Node), + Print (First_Comment_Before_End (Node, In_Tree), Indent + Increment); Start_Line (Indent); Write_String ("end "); - Output_Name (Name_Of (Node)); + Output_Name (Name_Of (Node, In_Tree)); Write_Line (";"); - Print (First_Comment_After_End (Node), Indent); + Print (First_Comment_After_End (Node, In_Tree), Indent); Write_Empty_Line; end if; when N_String_Type_Declaration => pragma Debug (Indicate_Tested (N_String_Type_Declaration)); - Print (First_Comment_Before (Node), Indent); + Print (First_Comment_Before (Node, In_Tree), Indent); Start_Line (Indent); Write_String ("type "); - Output_Name (Name_Of (Node)); + Output_Name (Name_Of (Node, In_Tree)); Write_Line (" is"); Start_Line (Indent + Increment); Write_String ("("); declare String_Node : Project_Node_Id := - First_Literal_String (Node); + First_Literal_String (Node, In_Tree); begin while String_Node /= Empty_Node loop - Output_String (String_Value_Of (String_Node)); - String_Node := Next_Literal_String (String_Node); + Output_String (String_Value_Of (String_Node, In_Tree)); + String_Node := + Next_Literal_String (String_Node, In_Tree); if String_Node /= Empty_Node then Write_String (", "); @@ -448,76 +465,78 @@ package body Prj.PP is Write_String (");"); Write_End_Of_Line_Comment (Node); - Print (First_Comment_After (Node), Indent); + Print (First_Comment_After (Node, In_Tree), Indent); when N_Literal_String => pragma Debug (Indicate_Tested (N_Literal_String)); - Output_String (String_Value_Of (Node)); + Output_String (String_Value_Of (Node, In_Tree)); - if Source_Index_Of (Node) /= 0 then + if Source_Index_Of (Node, In_Tree) /= 0 then Write_String (" at "); - Write_String (Source_Index_Of (Node)'Img); + Write_String (Source_Index_Of (Node, In_Tree)'Img); end if; when N_Attribute_Declaration => pragma Debug (Indicate_Tested (N_Attribute_Declaration)); - Print (First_Comment_Before (Node), Indent); + Print (First_Comment_Before (Node, In_Tree), Indent); Start_Line (Indent); Write_String ("for "); - Output_Attribute_Name (Name_Of (Node)); + Output_Attribute_Name (Name_Of (Node, In_Tree)); - if Associative_Array_Index_Of (Node) /= No_Name then + if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then Write_String (" ("); - Output_String (Associative_Array_Index_Of (Node)); + Output_String + (Associative_Array_Index_Of (Node, In_Tree)); - if Source_Index_Of (Node) /= 0 then + if Source_Index_Of (Node, In_Tree) /= 0 then Write_String (" at "); - Write_String (Source_Index_Of (Node)'Img); + Write_String (Source_Index_Of (Node, In_Tree)'Img); end if; Write_String (")"); end if; Write_String (" use "); - Print (Expression_Of (Node), Indent); + Print (Expression_Of (Node, In_Tree), Indent); Write_String (";"); Write_End_Of_Line_Comment (Node); - Print (First_Comment_After (Node), Indent); + Print (First_Comment_After (Node, In_Tree), Indent); when N_Typed_Variable_Declaration => pragma Debug (Indicate_Tested (N_Typed_Variable_Declaration)); - Print (First_Comment_Before (Node), Indent); + Print (First_Comment_Before (Node, In_Tree), Indent); Start_Line (Indent); - Output_Name (Name_Of (Node)); + Output_Name (Name_Of (Node, In_Tree)); Write_String (" : "); - Output_Name (Name_Of (String_Type_Of (Node))); + Output_Name + (Name_Of (String_Type_Of (Node, In_Tree), In_Tree)); Write_String (" := "); - Print (Expression_Of (Node), Indent); + Print (Expression_Of (Node, In_Tree), Indent); Write_String (";"); Write_End_Of_Line_Comment (Node); - Print (First_Comment_After (Node), Indent); + Print (First_Comment_After (Node, In_Tree), Indent); when N_Variable_Declaration => pragma Debug (Indicate_Tested (N_Variable_Declaration)); - Print (First_Comment_Before (Node), Indent); + Print (First_Comment_Before (Node, In_Tree), Indent); Start_Line (Indent); - Output_Name (Name_Of (Node)); + Output_Name (Name_Of (Node, In_Tree)); Write_String (" := "); - Print (Expression_Of (Node), Indent); + Print (Expression_Of (Node, In_Tree), Indent); Write_String (";"); Write_End_Of_Line_Comment (Node); - Print (First_Comment_After (Node), Indent); + Print (First_Comment_After (Node, In_Tree), Indent); when N_Expression => pragma Debug (Indicate_Tested (N_Expression)); declare - Term : Project_Node_Id := First_Term (Node); + Term : Project_Node_Id := First_Term (Node, In_Tree); begin while Term /= Empty_Node loop Print (Term, Indent); - Term := Next_Term (Term); + Term := Next_Term (Term, In_Tree); if Term /= Empty_Node then Write_String (" & "); @@ -527,7 +546,7 @@ package body Prj.PP is when N_Term => pragma Debug (Indicate_Tested (N_Term)); - Print (Current_Term (Node), Indent); + Print (Current_Term (Node, In_Tree), Indent); when N_Literal_String_List => pragma Debug (Indicate_Tested (N_Literal_String_List)); @@ -535,12 +554,13 @@ package body Prj.PP is declare Expression : Project_Node_Id := - First_Expression_In_List (Node); + First_Expression_In_List (Node, In_Tree); begin while Expression /= Empty_Node loop Print (Expression, Indent); - Expression := Next_Expression_In_List (Expression); + Expression := + Next_Expression_In_List (Expression, In_Tree); if Expression /= Empty_Node then Write_String (", "); @@ -552,26 +572,28 @@ package body Prj.PP is when N_Variable_Reference => pragma Debug (Indicate_Tested (N_Variable_Reference)); - if Project_Node_Of (Node) /= Empty_Node then - Output_Name (Name_Of (Project_Node_Of (Node))); + if Project_Node_Of (Node, In_Tree) /= Empty_Node then + Output_Name + (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree)); Write_String ("."); end if; - if Package_Node_Of (Node) /= Empty_Node then - Output_Name (Name_Of (Package_Node_Of (Node))); + if Package_Node_Of (Node, In_Tree) /= Empty_Node then + Output_Name + (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree)); Write_String ("."); end if; - Output_Name (Name_Of (Node)); + Output_Name (Name_Of (Node, In_Tree)); when N_External_Value => pragma Debug (Indicate_Tested (N_External_Value)); Write_String ("external ("); - Print (External_Reference_Of (Node), Indent); + Print (External_Reference_Of (Node, In_Tree), Indent); - if External_Default_Of (Node) /= Empty_Node then + if External_Default_Of (Node, In_Tree) /= Empty_Node then Write_String (", "); - Print (External_Default_Of (Node), Indent); + Print (External_Default_Of (Node, In_Tree), Indent); end if; Write_String (")"); @@ -579,29 +601,32 @@ package body Prj.PP is when N_Attribute_Reference => pragma Debug (Indicate_Tested (N_Attribute_Reference)); - if Project_Node_Of (Node) /= Empty_Node - and then Project_Node_Of (Node) /= Project + if Project_Node_Of (Node, In_Tree) /= Empty_Node + and then Project_Node_Of (Node, In_Tree) /= Project then - Output_Name (Name_Of (Project_Node_Of (Node))); + Output_Name + (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree)); - if Package_Node_Of (Node) /= Empty_Node then + if Package_Node_Of (Node, In_Tree) /= Empty_Node then Write_String ("."); - Output_Name (Name_Of (Package_Node_Of (Node))); + Output_Name + (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree)); end if; - elsif Package_Node_Of (Node) /= Empty_Node then - Output_Name (Name_Of (Package_Node_Of (Node))); + elsif Package_Node_Of (Node, In_Tree) /= Empty_Node then + Output_Name + (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree)); else Write_String ("project"); end if; Write_String ("'"); - Output_Attribute_Name (Name_Of (Node)); + Output_Attribute_Name (Name_Of (Node, In_Tree)); declare Index : constant Name_Id := - Associative_Array_Index_Of (Node); + Associative_Array_Index_Of (Node, In_Tree); begin if Index /= No_Name then @@ -615,72 +640,81 @@ package body Prj.PP is pragma Debug (Indicate_Tested (N_Case_Construction)); declare - Case_Item : Project_Node_Id := First_Case_Item_Of (Node); + Case_Item : Project_Node_Id; Is_Non_Empty : Boolean := False; + begin + Case_Item := First_Case_Item_Of (Node, In_Tree); while Case_Item /= Empty_Node loop - if First_Declarative_Item_Of (Case_Item) /= Empty_Node + if First_Declarative_Item_Of (Case_Item, In_Tree) /= + Empty_Node or else not Eliminate_Empty_Case_Constructions then Is_Non_Empty := True; exit; end if; - Case_Item := Next_Case_Item (Case_Item); + + Case_Item := Next_Case_Item (Case_Item, In_Tree); end loop; if Is_Non_Empty then Write_Empty_Line; - Print (First_Comment_Before (Node), Indent); + Print (First_Comment_Before (Node, In_Tree), Indent); Start_Line (Indent); Write_String ("case "); - Print (Case_Variable_Reference_Of (Node), Indent); + Print + (Case_Variable_Reference_Of (Node, In_Tree), + Indent); Write_String (" is"); Write_End_Of_Line_Comment (Node); - Print (First_Comment_After (Node), Indent + Increment); + Print + (First_Comment_After (Node, In_Tree), + Indent + Increment); declare Case_Item : Project_Node_Id := - First_Case_Item_Of (Node); - + First_Case_Item_Of (Node, In_Tree); begin while Case_Item /= Empty_Node loop pragma Assert - (Kind_Of (Case_Item) = N_Case_Item); + (Kind_Of (Case_Item, In_Tree) = N_Case_Item); Print (Case_Item, Indent + Increment); - Case_Item := Next_Case_Item (Case_Item); + Case_Item := + Next_Case_Item (Case_Item, In_Tree); end loop; end; - Print (First_Comment_Before_End (Node), + Print (First_Comment_Before_End (Node, In_Tree), Indent + Increment); Start_Line (Indent); Write_Line ("end case;"); - Print (First_Comment_After_End (Node), Indent); + Print + (First_Comment_After_End (Node, In_Tree), Indent); end if; end; when N_Case_Item => pragma Debug (Indicate_Tested (N_Case_Item)); - if First_Declarative_Item_Of (Node) /= Empty_Node + if First_Declarative_Item_Of (Node, In_Tree) /= Empty_Node or else not Eliminate_Empty_Case_Constructions then Write_Empty_Line; - Print (First_Comment_Before (Node), Indent); + Print (First_Comment_Before (Node, In_Tree), Indent); Start_Line (Indent); Write_String ("when "); - if First_Choice_Of (Node) = Empty_Node then + if First_Choice_Of (Node, In_Tree) = Empty_Node then Write_String ("others"); else declare - Label : Project_Node_Id := First_Choice_Of (Node); - + Label : Project_Node_Id := + First_Choice_Of (Node, In_Tree); begin while Label /= Empty_Node loop Print (Label, Indent); - Label := Next_Literal_String (Label); + Label := Next_Literal_String (Label, In_Tree); if Label /= Empty_Node then Write_String (" | "); @@ -691,16 +725,16 @@ package body Prj.PP is Write_String (" =>"); Write_End_Of_Line_Comment (Node); - Print (First_Comment_After (Node), Indent + Increment); + Print + (First_Comment_After (Node, In_Tree), + Indent + Increment); declare First : constant Project_Node_Id := - First_Declarative_Item_Of (Node); - + First_Declarative_Item_Of (Node, In_Tree); begin if First = Empty_Node then Write_Empty_Line; - else Print (First, Indent + Increment); end if; @@ -716,22 +750,22 @@ package body Prj.PP is when N_Comment => pragma Debug (Indicate_Tested (N_Comment)); - if Follows_Empty_Line (Node) then + if Follows_Empty_Line (Node, In_Tree) then Write_Empty_Line; end if; Start_Line (Indent); Write_String ("--"); Write_String - (Get_Name_String (String_Value_Of (Node)), + (Get_Name_String (String_Value_Of (Node, In_Tree)), Truncated => True); Write_Line (""); - if Is_Followed_By_Empty_Line (Node) then + if Is_Followed_By_Empty_Line (Node, In_Tree) then Write_Empty_Line; end if; - Print (Next_Comment (Node), Indent); + Print (Next_Comment (Node, In_Tree), Indent); end case; end if; end Print; diff --git a/gcc/ada/prj-pp.ads b/gcc/ada/prj-pp.ads index aba19ac88c0..37e47fa6acb 100644 --- a/gcc/ada/prj-pp.ads +++ b/gcc/ada/prj-pp.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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- -- @@ -27,7 +27,7 @@ -- This package is the Project File Pretty Printer. -- It is used to output a project file from a project file tree. -- It is used by gnatname to update or create project files. --- It is also used GLIDE2 to display project file trees. +-- It is also used GPS to display project file trees. -- It can also be used for debugging purposes for tools that create project -- file trees. @@ -46,6 +46,7 @@ package Prj.PP is procedure Pretty_Print (Project : Prj.Tree.Project_Node_Id; + In_Tree : Prj.Tree.Project_Node_Tree_Ref; Increment : Positive := 3; Eliminate_Empty_Case_Constructions : Boolean := False; Minimize_Empty_Lines : Boolean := False; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 7adcd08dac7..c67f2a3305f 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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- -- @@ -57,49 +57,59 @@ package body Prj.Proc is procedure Add_Attributes (Project : Project_Id; + In_Tree : Project_Tree_Ref; Decl : in out Declarations; First : Attribute_Node_Id); -- Add all attributes, starting with First, with their default -- values to the package or project with declarations Decl. procedure Check - (Project : in out Project_Id; + (In_Tree : Project_Tree_Ref; + Project : in out Project_Id; Follow_Links : Boolean); -- Set all projects to not checked, then call Recursive_Check for the -- main project Project. Project is set to No_Project if errors occurred. function Expression - (Project : Project_Id; - From_Project_Node : Project_Node_Id; - Pkg : Package_Id; - First_Term : Project_Node_Id; - Kind : Variable_Kind) return Variable_Value; + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + From_Project_Node : Project_Node_Id; + From_Project_Node_Tree : Project_Node_Tree_Ref; + Pkg : Package_Id; + First_Term : Project_Node_Id; + Kind : Variable_Kind) return Variable_Value; -- From N_Expression project node From_Project_Node, compute the value -- of an expression and return it as a Variable_Value. function Imported_Or_Extended_Project_From (Project : Project_Id; + In_Tree : Project_Tree_Ref; With_Name : Name_Id) return Project_Id; -- Find an imported or extended project of Project whose name is With_Name function Package_From (Project : Project_Id; + In_Tree : Project_Tree_Ref; With_Name : Name_Id) return Package_Id; -- Find the package of Project whose name is With_Name procedure Process_Declarative_Items - (Project : Project_Id; - From_Project_Node : Project_Node_Id; - Pkg : Package_Id; - Item : Project_Node_Id); + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + From_Project_Node : Project_Node_Id; + From_Project_Node_Tree : Project_Node_Tree_Ref; + Pkg : Package_Id; + Item : Project_Node_Id); -- Process declarative items starting with From_Project_Node, and put them -- in declarations Decl. This is a recursive procedure; it calls itself for -- a package declaration or a case construction. procedure Recursive_Process - (Project : out Project_Id; - From_Project_Node : Project_Node_Id; - Extended_By : Project_Id); + (In_Tree : Project_Tree_Ref; + Project : out Project_Id; + From_Project_Node : Project_Node_Id; + From_Project_Node_Tree : Project_Node_Tree_Ref; + Extended_By : Project_Id); -- Process project with node From_Project_Node in the tree. -- Do nothing if From_Project_Node is Empty_Node. -- If project has already been processed, simply return its project id. @@ -109,6 +119,7 @@ package body Prj.Proc is procedure Recursive_Check (Project : Project_Id; + In_Tree : Project_Tree_Ref; Follow_Links : Boolean); -- If Project is not marked as checked, mark it as checked, call -- Check_Naming_Scheme for the project, then call itself for a @@ -146,6 +157,7 @@ package body Prj.Proc is procedure Add_Attributes (Project : Project_Id; + In_Tree : Project_Tree_Ref; Decl : in out Declarations; First : Attribute_Node_Id) is @@ -190,12 +202,16 @@ package body Prj.Proc is end case; - Variable_Elements.Increment_Last; - Variable_Elements.Table (Variable_Elements.Last) := + Variable_Element_Table.Increment_Last + (In_Tree.Variable_Elements); + In_Tree.Variable_Elements.Table + (Variable_Element_Table.Last + (In_Tree.Variable_Elements)) := (Next => Decl.Attributes, Name => Attribute_Name_Of (The_Attribute), Value => New_Attribute); - Decl.Attributes := Variable_Elements.Last; + Decl.Attributes := Variable_Element_Table.Last + (In_Tree.Variable_Elements); end; end if; @@ -208,17 +224,20 @@ package body Prj.Proc is ----------- procedure Check - (Project : in out Project_Id; + (In_Tree : Project_Tree_Ref; + Project : in out Project_Id; Follow_Links : Boolean) is begin -- Make sure that all projects are marked as not checked - for Index in 1 .. Projects.Last loop - Projects.Table (Index).Checked := False; + for Index in Project_Table.First .. + Project_Table.Last (In_Tree.Projects) + loop + In_Tree.Projects.Table (Index).Checked := False; end loop; - Recursive_Check (Project, Follow_Links); + Recursive_Check (Project, In_Tree, Follow_Links); end Check; ---------------- @@ -226,11 +245,13 @@ package body Prj.Proc is ---------------- function Expression - (Project : Project_Id; - From_Project_Node : Project_Node_Id; - Pkg : Package_Id; - First_Term : Project_Node_Id; - Kind : Variable_Kind) return Variable_Value + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + From_Project_Node : Project_Node_Id; + From_Project_Node_Tree : Project_Node_Tree_Ref; + Pkg : Package_Id; + First_Term : Project_Node_Id; + Kind : Variable_Kind) return Variable_Value is The_Term : Project_Node_Id := First_Term; -- The term in the expression list @@ -246,14 +267,14 @@ package body Prj.Proc is begin Result.Project := Project; - Result.Location := Location_Of (First_Term); + Result.Location := Location_Of (First_Term, From_Project_Node_Tree); -- Process each term of the expression, starting with First_Term while The_Term /= Empty_Node loop - The_Current_Term := Current_Term (The_Term); + The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree); - case Kind_Of (The_Current_Term) is + case Kind_Of (The_Current_Term, From_Project_Node_Tree) is when N_Literal_String => @@ -267,30 +288,46 @@ package body Prj.Proc is raise Program_Error; when Single => - Add (Result.Value, String_Value_Of (The_Current_Term)); - Result.Index := Source_Index_Of (The_Current_Term); + Add (Result.Value, + String_Value_Of + (The_Current_Term, From_Project_Node_Tree)); + Result.Index := + Source_Index_Of + (The_Current_Term, From_Project_Node_Tree); when List => - String_Elements.Increment_Last; + String_Element_Table.Increment_Last + (In_Tree.String_Elements); if Last = Nil_String then -- This can happen in an expression like () & "toto" - Result.Values := String_Elements.Last; + Result.Values := String_Element_Table.Last + (In_Tree.String_Elements); else - String_Elements.Table (Last).Next := - String_Elements.Last; + In_Tree.String_Elements.Table + (Last).Next := String_Element_Table.Last + (In_Tree.String_Elements); end if; - Last := String_Elements.Last; - String_Elements.Table (Last) := - (Value => String_Value_Of (The_Current_Term), - Index => Source_Index_Of (The_Current_Term), + Last := String_Element_Table.Last + (In_Tree.String_Elements); + In_Tree.String_Elements.Table (Last) := + (Value => + String_Value_Of + (The_Current_Term, + From_Project_Node_Tree), + Index => + Source_Index_Of + (The_Current_Term, From_Project_Node_Tree), Display_Value => No_Name, - Location => Location_Of (The_Current_Term), + Location => + Location_Of + (The_Current_Term, + From_Project_Node_Tree), Flag => False, Next => Nil_String); end case; @@ -299,7 +336,9 @@ package body Prj.Proc is declare String_Node : Project_Node_Id := - First_Expression_In_List (The_Current_Term); + First_Expression_In_List + (The_Current_Term, + From_Project_Node_Tree); Value : Variable_Value; @@ -310,27 +349,36 @@ package body Prj.Proc is -- there is nothing to do Value := Expression - (Project => Project, - From_Project_Node => From_Project_Node, - Pkg => Pkg, - First_Term => Tree.First_Term (String_Node), - Kind => Single); - String_Elements.Increment_Last; + (Project => Project, + In_Tree => In_Tree, + From_Project_Node => From_Project_Node, + From_Project_Node_Tree => From_Project_Node_Tree, + Pkg => Pkg, + First_Term => + Tree.First_Term + (String_Node, From_Project_Node_Tree), + Kind => Single); + String_Element_Table.Increment_Last + (In_Tree.String_Elements); if Result.Values = Nil_String then -- This literal string list is the first term -- in a string list expression - Result.Values := String_Elements.Last; + Result.Values := + String_Element_Table.Last (In_Tree.String_Elements); else - String_Elements.Table (Last).Next := - String_Elements.Last; + In_Tree.String_Elements.Table + (Last).Next := + String_Element_Table.Last (In_Tree.String_Elements); end if; - Last := String_Elements.Last; - String_Elements.Table (Last) := + Last := + String_Element_Table.Last (In_Tree.String_Elements); + + In_Tree.String_Elements.Table (Last) := (Value => Value.Value, Display_Value => No_Name, Location => Value.Location, @@ -343,23 +391,31 @@ package body Prj.Proc is -- one after the other String_Node := - Next_Expression_In_List (String_Node); + Next_Expression_In_List + (String_Node, From_Project_Node_Tree); exit when String_Node = Empty_Node; Value := Expression - (Project => Project, - From_Project_Node => From_Project_Node, - Pkg => Pkg, - First_Term => Tree.First_Term (String_Node), - Kind => Single); - - String_Elements.Increment_Last; - String_Elements.Table (Last).Next := - String_Elements.Last; - Last := String_Elements.Last; - String_Elements.Table (Last) := + (Project => Project, + In_Tree => In_Tree, + From_Project_Node => From_Project_Node, + From_Project_Node_Tree => From_Project_Node_Tree, + Pkg => Pkg, + First_Term => + Tree.First_Term + (String_Node, From_Project_Node_Tree), + Kind => Single); + + String_Element_Table.Increment_Last + (In_Tree.String_Elements); + In_Tree.String_Elements.Table + (Last).Next := String_Element_Table.Last + (In_Tree.String_Elements); + Last := String_Element_Table.Last + (In_Tree.String_Elements); + In_Tree.String_Elements.Table (Last) := (Value => Value.Value, Display_Value => No_Name, Location => Value.Location, @@ -367,9 +423,7 @@ package body Prj.Proc is Next => Nil_String, Index => Value.Index); end loop; - end if; - end; when N_Variable_Reference | N_Attribute_Reference => @@ -381,9 +435,11 @@ package body Prj.Proc is The_Variable_Id : Variable_Id := No_Variable; The_Variable : Variable_Value; Term_Project : constant Project_Node_Id := - Project_Node_Of (The_Current_Term); + Project_Node_Of + (The_Current_Term, From_Project_Node_Tree); Term_Package : constant Project_Node_Id := - Package_Node_Of (The_Current_Term); + Package_Node_Of + (The_Current_Term, From_Project_Node_Tree); Index : Name_Id := No_Name; begin @@ -392,9 +448,11 @@ package body Prj.Proc is then -- This variable or attribute comes from another project - The_Name := Name_Of (Term_Project); + The_Name := + Name_Of (Term_Project, From_Project_Node_Tree); The_Project := Imported_Or_Extended_Project_From (Project => Project, + In_Tree => In_Tree, With_Name => The_Name); end if; @@ -402,27 +460,39 @@ package body Prj.Proc is -- This is an attribute of a package - The_Name := Name_Of (Term_Package); - The_Package := Projects.Table (The_Project).Decl.Packages; + The_Name := + Name_Of (Term_Package, From_Project_Node_Tree); + The_Package := In_Tree.Projects.Table + (The_Project).Decl.Packages; while The_Package /= No_Package - and then Packages.Table (The_Package).Name /= The_Name + and then In_Tree.Packages.Table + (The_Package).Name /= The_Name loop - The_Package := Packages.Table (The_Package).Next; + The_Package := + In_Tree.Packages.Table + (The_Package).Next; end loop; pragma Assert (The_Package /= No_Package, "package not found."); - elsif Kind_Of (The_Current_Term) = N_Attribute_Reference then + elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) = + N_Attribute_Reference + then The_Package := No_Package; end if; - The_Name := Name_Of (The_Current_Term); + The_Name := + Name_Of (The_Current_Term, From_Project_Node_Tree); - if Kind_Of (The_Current_Term) = N_Attribute_Reference then - Index := Associative_Array_Index_Of (The_Current_Term); + if Kind_Of (The_Current_Term, From_Project_Node_Tree) = + N_Attribute_Reference + then + Index := + Associative_Array_Index_Of + (The_Current_Term, From_Project_Node_Tree); end if; -- If it is not an associative array attribute @@ -435,24 +505,26 @@ package body Prj.Proc is -- First, if there is a package, look into the package - if - Kind_Of (The_Current_Term) = N_Variable_Reference + if Kind_Of (The_Current_Term, From_Project_Node_Tree) = + N_Variable_Reference then The_Variable_Id := - Packages.Table (The_Package).Decl.Variables; - + In_Tree.Packages.Table + (The_Package).Decl.Variables; else The_Variable_Id := - Packages.Table (The_Package).Decl.Attributes; + In_Tree.Packages.Table + (The_Package).Decl.Attributes; end if; while The_Variable_Id /= No_Variable and then - Variable_Elements.Table (The_Variable_Id).Name /= - The_Name + In_Tree.Variable_Elements.Table + (The_Variable_Id).Name /= The_Name loop The_Variable_Id := - Variable_Elements.Table (The_Variable_Id).Next; + In_Tree.Variable_Elements.Table + (The_Variable_Id).Next; end loop; end if; @@ -461,24 +533,26 @@ package body Prj.Proc is -- If we have not found it, look into the project - if - Kind_Of (The_Current_Term) = N_Variable_Reference + if Kind_Of (The_Current_Term, From_Project_Node_Tree) = + N_Variable_Reference then The_Variable_Id := - Projects.Table (The_Project).Decl.Variables; - + In_Tree.Projects.Table + (The_Project).Decl.Variables; else The_Variable_Id := - Projects.Table (The_Project).Decl.Attributes; + In_Tree.Projects.Table + (The_Project).Decl.Attributes; end if; while The_Variable_Id /= No_Variable and then - Variable_Elements.Table (The_Variable_Id).Name /= - The_Name + In_Tree.Variable_Elements.Table + (The_Variable_Id).Name /= The_Name loop The_Variable_Id := - Variable_Elements.Table (The_Variable_Id).Next; + In_Tree.Variable_Elements.Table + (The_Variable_Id).Next; end loop; end if; @@ -486,7 +560,8 @@ package body Prj.Proc is pragma Assert (The_Variable_Id /= No_Variable, "variable or attribute not found"); - The_Variable := Variable_Elements.Table + The_Variable := + In_Tree.Variable_Elements.Table (The_Variable_Id).Value; else @@ -497,50 +572,61 @@ package body Prj.Proc is The_Array : Array_Id := No_Array; The_Element : Array_Element_Id := No_Array_Element; Array_Index : Name_Id := No_Name; + begin if The_Package /= No_Package then The_Array := - Packages.Table (The_Package).Decl.Arrays; - + In_Tree.Packages.Table + (The_Package).Decl.Arrays; else The_Array := - Projects.Table (The_Project).Decl.Arrays; + In_Tree.Projects.Table + (The_Project).Decl.Arrays; end if; while The_Array /= No_Array - and then Arrays.Table (The_Array).Name /= The_Name + and then In_Tree.Arrays.Table + (The_Array).Name /= The_Name loop - The_Array := Arrays.Table (The_Array).Next; + The_Array := In_Tree.Arrays.Table + (The_Array).Next; end loop; if The_Array /= No_Array then - The_Element := Arrays.Table (The_Array).Value; + The_Element := In_Tree.Arrays.Table + (The_Array).Value; Get_Name_String (Index); - if Case_Insensitive (The_Current_Term) then + if Case_Insensitive + (The_Current_Term, From_Project_Node_Tree) + then To_Lower (Name_Buffer (1 .. Name_Len)); end if; Array_Index := Name_Find; while The_Element /= No_Array_Element - and then Array_Elements.Table (The_Element).Index - /= Array_Index + and then + In_Tree.Array_Elements.Table + (The_Element).Index /= Array_Index loop The_Element := - Array_Elements.Table (The_Element).Next; + In_Tree.Array_Elements.Table + (The_Element).Next; end loop; end if; if The_Element /= No_Array_Element then The_Variable := - Array_Elements.Table (The_Element).Value; + In_Tree.Array_Elements.Table + (The_Element).Value; else - if - Expression_Kind_Of (The_Current_Term) = List + if Expression_Kind_Of + (The_Current_Term, From_Project_Node_Tree) = + List then The_Variable := (Project => Project, @@ -548,7 +634,6 @@ package body Prj.Proc is Location => No_Location, Default => True, Values => Nil_String); - else The_Variable := (Project => Project, @@ -599,28 +684,38 @@ package body Prj.Proc is null; when Single => - String_Elements.Increment_Last; + String_Element_Table.Increment_Last + (In_Tree.String_Elements); if Last = Nil_String then -- This can happen in an expression such as -- () & Var - Result.Values := String_Elements.Last; + Result.Values := + String_Element_Table.Last + (In_Tree.String_Elements); else - String_Elements.Table (Last).Next := - String_Elements.Last; + In_Tree.String_Elements.Table + (Last).Next := + String_Element_Table.Last + (In_Tree.String_Elements); end if; - Last := String_Elements.Last; - String_Elements.Table (Last) := - (Value => The_Variable.Value, + Last := + String_Element_Table.Last + (In_Tree.String_Elements); + + In_Tree.String_Elements.Table (Last) := + (Value => The_Variable.Value, Display_Value => No_Name, - Location => Location_Of (The_Current_Term), - Flag => False, - Next => Nil_String, - Index => 0); + Location => Location_Of + (The_Current_Term, + From_Project_Node_Tree), + Flag => False, + Next => Nil_String, + Index => 0); when List => @@ -630,30 +725,44 @@ package body Prj.Proc is begin while The_List /= Nil_String loop - String_Elements.Increment_Last; + String_Element_Table.Increment_Last + (In_Tree.String_Elements); if Last = Nil_String then - Result.Values := String_Elements.Last; + Result.Values := + String_Element_Table.Last + (In_Tree. + String_Elements); else - String_Elements.Table (Last).Next := - String_Elements.Last; + In_Tree. + String_Elements.Table (Last).Next := + String_Element_Table.Last + (In_Tree. + String_Elements); end if; - Last := String_Elements.Last; - String_Elements.Table (Last) := - (Value => - String_Elements.Table - (The_List).Value, + Last := + String_Element_Table.Last + (In_Tree.String_Elements); + + In_Tree.String_Elements.Table (Last) := + (Value => + In_Tree.String_Elements.Table + (The_List).Value, Display_Value => No_Name, - Location => Location_Of - (The_Current_Term), - Flag => False, - Next => Nil_String, - Index => 0); + Location => + Location_Of + (The_Current_Term, + From_Project_Node_Tree), + Flag => False, + Next => Nil_String, + Index => 0); + The_List := - String_Elements.Table (The_List).Next; + In_Tree. String_Elements.Table + (The_List).Next; end loop; end; end case; @@ -662,7 +771,10 @@ package body Prj.Proc is when N_External_Value => Get_Name_String - (String_Value_Of (External_Reference_Of (The_Current_Term))); + (String_Value_Of + (External_Reference_Of + (The_Current_Term, From_Project_Node_Tree), + From_Project_Node_Tree)); declare Name : constant Name_Id := Name_Find; @@ -670,11 +782,13 @@ package body Prj.Proc is Value : Name_Id := No_Name; Default_Node : constant Project_Node_Id := - External_Default_Of (The_Current_Term); + External_Default_Of + (The_Current_Term, From_Project_Node_Tree); begin if Default_Node /= Empty_Node then - Default := String_Value_Of (Default_Node); + Default := + String_Value_Of (Default_Node, From_Project_Node_Tree); end if; Value := Prj.Ext.Value_Of (Name, Default); @@ -684,18 +798,17 @@ package body Prj.Proc is if Error_Report = null then Error_Msg ("?undefined external reference", - Location_Of (The_Current_Term)); - + Location_Of + (The_Current_Term, From_Project_Node_Tree)); else Error_Report ("warning: """ & Get_Name_String (Name) & """ is an undefined external reference", - Project); + Project, In_Tree); end if; end if; Value := Empty_String; - end if; case Kind is @@ -707,21 +820,27 @@ package body Prj.Proc is Add (Result.Value, Value); when List => - String_Elements.Increment_Last; + String_Element_Table.Increment_Last + (In_Tree.String_Elements); if Last = Nil_String then - Result.Values := String_Elements.Last; + Result.Values := String_Element_Table.Last + (In_Tree.String_Elements); else - String_Elements.Table (Last).Next := - String_Elements.Last; + In_Tree.String_Elements.Table + (Last).Next := String_Element_Table.Last + (In_Tree.String_Elements); end if; - Last := String_Elements.Last; - String_Elements.Table (Last) := + Last := String_Element_Table.Last + (In_Tree.String_Elements); + In_Tree.String_Elements.Table (Last) := (Value => Value, Display_Value => No_Name, - Location => Location_Of (The_Current_Term), + Location => + Location_Of + (The_Current_Term, From_Project_Node_Tree), Flag => False, Next => Nil_String, Index => 0); @@ -740,7 +859,7 @@ package body Prj.Proc is end case; - The_Term := Next_Term (The_Term); + The_Term := Next_Term (The_Term, From_Project_Node_Tree); end loop; return Result; @@ -752,9 +871,11 @@ package body Prj.Proc is function Imported_Or_Extended_Project_From (Project : Project_Id; + In_Tree : Project_Tree_Ref; With_Name : Name_Id) return Project_Id is - Data : constant Project_Data := Projects.Table (Project); + Data : constant Project_Data := + In_Tree.Projects.Table (Project); List : Project_List := Data.Imported_Projects; Result : Project_Id := No_Project; Temp_Result : Project_Id := No_Project; @@ -763,7 +884,8 @@ package body Prj.Proc is -- First check if it is the name of an extended project if Data.Extends /= No_Project - and then Projects.Table (Data.Extends).Name = With_Name + and then In_Tree.Projects.Table (Data.Extends).Name = + With_Name then return Data.Extends; @@ -771,11 +893,13 @@ package body Prj.Proc is -- Then check the name of each imported project while List /= Empty_Project_List loop - Result := Project_Lists.Table (List).Project; + Result := In_Tree.Project_Lists.Table (List).Project; -- If the project is directly imported, then returns its ID - if Projects.Table (Result).Name = With_Name then + if + In_Tree.Projects.Table (Result).Name = With_Name + then return Result; end if; @@ -784,19 +908,22 @@ package body Prj.Proc is -- returned ID if the project is not imported directly. declare - Proj : Project_Id := Projects.Table (Result).Extends; + Proj : Project_Id := + In_Tree.Projects.Table (Result).Extends; begin while Proj /= No_Project loop - if Projects.Table (Proj).Name = With_Name then + if In_Tree.Projects.Table (Proj).Name = + With_Name + then Temp_Result := Result; exit; end if; - Proj := Projects.Table (Proj).Extends; + Proj := In_Tree.Projects.Table (Proj).Extends; end loop; end; - List := Project_Lists.Table (List).Next; + List := In_Tree.Project_Lists.Table (List).Next; end loop; pragma Assert @@ -813,23 +940,26 @@ package body Prj.Proc is function Package_From (Project : Project_Id; + In_Tree : Project_Tree_Ref; With_Name : Name_Id) return Package_Id is - Data : constant Project_Data := Projects.Table (Project); + Data : constant Project_Data := + In_Tree.Projects.Table (Project); Result : Package_Id := Data.Decl.Packages; begin -- Check the name of each existing package of Project while Result /= No_Package - and then - Packages.Table (Result).Name /= With_Name + and then In_Tree.Packages.Table (Result).Name /= With_Name loop - Result := Packages.Table (Result).Next; + Result := In_Tree.Packages.Table (Result).Next; end loop; if Result = No_Package then + -- Should never happen + Write_Line ("package """ & Get_Name_String (With_Name) & """ not found"); raise Program_Error; @@ -844,11 +974,13 @@ package body Prj.Proc is ------------- procedure Process - (Project : out Project_Id; - Success : out Boolean; - From_Project_Node : Project_Node_Id; - Report_Error : Put_Line_Access; - Follow_Links : Boolean := True) + (In_Tree : Project_Tree_Ref; + Project : out Project_Id; + Success : out Boolean; + From_Project_Node : Project_Node_Id; + From_Project_Node_Tree : Project_Node_Tree_Ref; + Report_Error : Put_Line_Access; + Follow_Links : Boolean := True) is Obj_Dir : Name_Id; Extending : Project_Id; @@ -860,19 +992,21 @@ package body Prj.Proc is -- Make sure there is no projects in the data structure - Projects.Set_Last (No_Project); + Project_Table.Set_Last (In_Tree.Projects, No_Project); Processed_Projects.Reset; -- And process the main project and all of the projects it depends on, -- recursively Recursive_Process - (Project => Project, - From_Project_Node => From_Project_Node, - Extended_By => No_Project); + (Project => Project, + In_Tree => In_Tree, + From_Project_Node => From_Project_Node, + From_Project_Node_Tree => From_Project_Node_Tree, + Extended_By => No_Project); if Project /= No_Project then - Check (Project, Follow_Links); + Check (In_Tree, Project, Follow_Links); end if; -- If main project is an extending all project, set the object @@ -880,15 +1014,18 @@ package body Prj.Proc is -- of the main project. if Project /= No_Project - and then Is_Extending_All (From_Project_Node) + and then Is_Extending_All (From_Project_Node, From_Project_Node_Tree) then declare Object_Dir : constant Name_Id := - Projects.Table (Project).Object_Directory; + In_Tree.Projects.Table (Project).Object_Directory; begin - for Index in Projects.First .. Projects.Last loop - if Projects.Table (Index).Virtual then - Projects.Table (Index).Object_Directory := Object_Dir; + for Index in + Project_Table.First .. Project_Table.Last (In_Tree.Projects) + loop + if In_Tree.Projects.Table (Index).Virtual then + In_Tree.Projects.Table (Index).Object_Directory := + Object_Dir; end if; end loop; end; @@ -898,11 +1035,13 @@ package body Prj.Proc is -- the project(s) it extends. if Project /= No_Project then - for Proj in 1 .. Projects.Last loop - Extending := Projects.Table (Proj).Extended_By; + for Proj in + Project_Table.First .. Project_Table.Last (In_Tree.Projects) + loop + Extending := In_Tree.Projects.Table (Proj).Extended_By; if Extending /= No_Project then - Obj_Dir := Projects.Table (Proj).Object_Directory; + Obj_Dir := In_Tree.Projects.Table (Proj).Object_Directory; -- Check that a project being extended does not share its -- object directory with any project that extends it, directly @@ -911,53 +1050,42 @@ package body Prj.Proc is -- Start with the project directly extending it Extending2 := Extending; - while Extending2 /= No_Project loop - --- why is this code commented out ??? - --- if ((Process_Languages = Ada_Language --- and then --- Projects.Table (Extending2).Ada_Sources_Present) --- or else --- (Process_Languages = Other_Languages --- and then --- Projects.Table (Extending2).Other_Sources_Present)) - - if Projects.Table (Extending2).Ada_Sources_Present + if In_Tree.Projects.Table (Extending2).Ada_Sources_Present and then - Projects.Table (Extending2).Object_Directory = Obj_Dir + In_Tree.Projects.Table (Extending2).Object_Directory = + Obj_Dir then - if Projects.Table (Extending2).Virtual then - Error_Msg_Name_1 := Projects.Table (Proj).Name; + if In_Tree.Projects.Table (Extending2).Virtual then + Error_Msg_Name_1 := In_Tree.Projects.Table (Proj).Name; if Error_Report = null then Error_Msg ("project % cannot be extended by a virtual " & "project with the same object directory", - Projects.Table (Proj).Location); - + In_Tree.Projects.Table (Proj).Location); else Error_Report ("project """ & Get_Name_String (Error_Msg_Name_1) & """ cannot be extended by a virtual " & "project with the same object directory", - Project); + Project, In_Tree); end if; else Error_Msg_Name_1 := - Projects.Table (Extending2).Name; - Error_Msg_Name_2 := Projects.Table (Proj).Name; + In_Tree.Projects.Table (Extending2).Name; + Error_Msg_Name_2 := + In_Tree.Projects.Table (Proj).Name; if Error_Report = null then Error_Msg ("project % cannot extend project %", - Projects.Table (Extending2).Location); + In_Tree.Projects.Table (Extending2).Location); Error_Msg ("\they share the same object directory", - Projects.Table (Extending2).Location); + In_Tree.Projects.Table (Extending2).Location); else Error_Report @@ -965,17 +1093,18 @@ package body Prj.Proc is Get_Name_String (Error_Msg_Name_1) & """ cannot extend project """ & Get_Name_String (Error_Msg_Name_2) & """", - Project); + Project, In_Tree); Error_Report ("they share the same object directory", - Project); + Project, In_Tree); end if; end if; end if; -- Continue with the next extending project, if any - Extending2 := Projects.Table (Extending2).Extended_By; + Extending2 := + In_Tree.Projects.Table (Extending2).Extended_By; end loop; end if; end loop; @@ -989,10 +1118,12 @@ package body Prj.Proc is ------------------------------- procedure Process_Declarative_Items - (Project : Project_Id; - From_Project_Node : Project_Node_Id; - Pkg : Package_Id; - Item : Project_Node_Id) + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + From_Project_Node : Project_Node_Id; + From_Project_Node_Tree : Project_Node_Tree_Ref; + Pkg : Package_Id; + Item : Project_Node_Id) is Current_Declarative_Item : Project_Node_Id := Item; Current_Item : Project_Node_Id := Empty_Node; @@ -1004,50 +1135,61 @@ package body Prj.Proc is -- Get its data - Current_Item := Current_Item_Node (Current_Declarative_Item); + Current_Item := + Current_Item_Node + (Current_Declarative_Item, From_Project_Node_Tree); -- And set Current_Declarative_Item to the next declarative item -- ready for the next iteration. - Current_Declarative_Item := Next_Declarative_Item - (Current_Declarative_Item); + Current_Declarative_Item := + Next_Declarative_Item + (Current_Declarative_Item, From_Project_Node_Tree); - case Kind_Of (Current_Item) is + case Kind_Of (Current_Item, From_Project_Node_Tree) is when N_Package_Declaration => -- Do not process a package declaration that should be ignored - if Expression_Kind_Of (Current_Item) /= Ignored then + if Expression_Kind_Of + (Current_Item, From_Project_Node_Tree) /= Ignored + then -- Create the new package - Packages.Increment_Last; + Package_Table.Increment_Last (In_Tree.Packages); declare - New_Pkg : constant Package_Id := Packages.Last; + New_Pkg : constant Package_Id := + Package_Table.Last (In_Tree.Packages); The_New_Package : Package_Element; - Project_Of_Renamed_Package : constant Project_Node_Id := - Project_Of_Renamed_Package_Of - (Current_Item); + Project_Of_Renamed_Package : + constant Project_Node_Id := + Project_Of_Renamed_Package_Of + (Current_Item, From_Project_Node_Tree); begin -- Set the name of the new package - The_New_Package.Name := Name_Of (Current_Item); + The_New_Package.Name := + Name_Of (Current_Item, From_Project_Node_Tree); -- Insert the new package in the appropriate list if Pkg /= No_Package then The_New_Package.Next := - Packages.Table (Pkg).Decl.Packages; - Packages.Table (Pkg).Decl.Packages := New_Pkg; + In_Tree.Packages.Table (Pkg).Decl.Packages; + In_Tree.Packages.Table (Pkg).Decl.Packages := + New_Pkg; else The_New_Package.Next := - Projects.Table (Project).Decl.Packages; - Projects.Table (Project).Decl.Packages := New_Pkg; + In_Tree.Projects.Table (Project).Decl.Packages; + In_Tree.Projects.Table (Project).Decl.Packages := + New_Pkg; end if; - Packages.Table (New_Pkg) := The_New_Package; + In_Tree.Packages.Table (New_Pkg) := + The_New_Package; if Project_Of_Renamed_Package /= Empty_Node then @@ -1055,24 +1197,28 @@ package body Prj.Proc is declare Project_Name : constant Name_Id := - Name_Of - (Project_Of_Renamed_Package); + Name_Of + (Project_Of_Renamed_Package, + From_Project_Node_Tree); - Renamed_Project : constant Project_Id := - Imported_Or_Extended_Project_From - (Project, Project_Name); + Renamed_Project : + constant Project_Id := + Imported_Or_Extended_Project_From + (Project, In_Tree, Project_Name); Renamed_Package : constant Package_Id := - Package_From - (Renamed_Project, - Name_Of (Current_Item)); + Package_From + (Renamed_Project, In_Tree, + Name_Of + (Current_Item, + From_Project_Node_Tree)); begin -- For a renamed package, set declarations to -- the declarations of the renamed package. - Packages.Table (New_Pkg).Decl := - Packages.Table (Renamed_Package).Decl; + In_Tree.Packages.Table (New_Pkg).Decl := + In_Tree.Packages.Table (Renamed_Package).Decl; end; -- Standard package declaration, not renaming @@ -1081,19 +1227,23 @@ package body Prj.Proc is -- Set the default values of the attributes Add_Attributes - (Project, - Packages.Table (New_Pkg).Decl, + (Project, In_Tree, + In_Tree.Packages.Table (New_Pkg).Decl, First_Attribute_Of - (Package_Id_Of (Current_Item))); + (Package_Id_Of + (Current_Item, From_Project_Node_Tree))); -- And process declarative items of the new package Process_Declarative_Items - (Project => Project, - From_Project_Node => From_Project_Node, - Pkg => New_Pkg, - Item => First_Declarative_Item_Of - (Current_Item)); + (Project => Project, + In_Tree => In_Tree, + From_Project_Node => From_Project_Node, + From_Project_Node_Tree => From_Project_Node_Tree, + Pkg => New_Pkg, + Item => + First_Declarative_Item_Of + (Current_Item, From_Project_Node_Tree)); end if; end; end if; @@ -1108,13 +1258,15 @@ package body Prj.Proc is N_Typed_Variable_Declaration | N_Variable_Declaration => - if Expression_Of (Current_Item) = Empty_Node then + if Expression_Of (Current_Item, From_Project_Node_Tree) = + Empty_Node + then -- It must be a full associative array attribute declaration declare Current_Item_Name : constant Name_Id := - Name_Of (Current_Item); + Name_Of (Current_Item, From_Project_Node_Tree); -- The name of the attribute New_Array : Array_Id; @@ -1160,48 +1312,65 @@ package body Prj.Proc is -- has elements declared. if Pkg /= No_Package then - New_Array := Packages.Table (Pkg).Decl.Arrays; + New_Array := In_Tree.Packages.Table + (Pkg).Decl.Arrays; else - New_Array := Projects.Table (Project).Decl.Arrays; + New_Array := In_Tree.Projects.Table + (Project).Decl.Arrays; end if; - while New_Array /= No_Array and then - Arrays.Table (New_Array).Name /= Current_Item_Name + while New_Array /= No_Array + and then In_Tree.Arrays.Table (New_Array).Name /= + Current_Item_Name loop - New_Array := Arrays.Table (New_Array).Next; + New_Array := In_Tree.Arrays.Table (New_Array).Next; end loop; -- If the attribute has never been declared add new entry -- in the arrays of the project/package and link it. if New_Array = No_Array then - Arrays.Increment_Last; - New_Array := Arrays.Last; + Array_Table.Increment_Last (In_Tree.Arrays); + New_Array := Array_Table.Last (In_Tree.Arrays); if Pkg /= No_Package then - Arrays.Table (New_Array) := + In_Tree.Arrays.Table (New_Array) := (Name => Current_Item_Name, Value => No_Array_Element, - Next => Packages.Table (Pkg).Decl.Arrays); - Packages.Table (Pkg).Decl.Arrays := New_Array; + Next => + In_Tree.Packages.Table (Pkg).Decl.Arrays); + + In_Tree.Packages.Table (Pkg).Decl.Arrays := + New_Array; else - Arrays.Table (New_Array) := + In_Tree.Arrays.Table (New_Array) := (Name => Current_Item_Name, Value => No_Array_Element, - Next => Projects.Table (Project).Decl.Arrays); - Projects.Table (Project).Decl.Arrays := New_Array; + Next => + In_Tree.Projects.Table (Project).Decl.Arrays); + + In_Tree.Projects.Table (Project).Decl.Arrays := + New_Array; end if; end if; -- Find the project where the value is declared Orig_Project_Name := - Name_Of (Associative_Project_Of (Current_Item)); - - for Index in Projects.First .. Projects.Last loop - if Projects.Table (Index).Name = Orig_Project_Name then + Name_Of + (Associative_Project_Of + (Current_Item, From_Project_Node_Tree), + From_Project_Node_Tree); + + for Index in Project_Table.First .. + Project_Table.Last + (In_Tree.Projects) + loop + if In_Tree.Projects.Table (Index).Name = + Orig_Project_Name + then Orig_Project := Index; exit; end if; @@ -1210,55 +1379,69 @@ package body Prj.Proc is pragma Assert (Orig_Project /= No_Project, "original project not found"); - if Associative_Package_Of (Current_Item) = Empty_Node then + if Associative_Package_Of + (Current_Item, From_Project_Node_Tree) = Empty_Node + then Orig_Array := - Projects.Table (Orig_Project).Decl.Arrays; + In_Tree.Projects.Table + (Orig_Project).Decl.Arrays; else -- If in a package, find the package where the -- value is declared. Orig_Package_Name := - Name_Of (Associative_Package_Of (Current_Item)); + Name_Of + (Associative_Package_Of + (Current_Item, From_Project_Node_Tree), + From_Project_Node_Tree); + Orig_Package := - Projects.Table (Orig_Project).Decl.Packages; + In_Tree.Projects.Table + (Orig_Project).Decl.Packages; pragma Assert (Orig_Package /= No_Package, "original package not found"); - while Packages.Table (Orig_Package).Name /= - Orig_Package_Name + while In_Tree.Packages.Table + (Orig_Package).Name /= Orig_Package_Name loop - Orig_Package := Packages.Table (Orig_Package).Next; + Orig_Package := In_Tree.Packages.Table + (Orig_Package).Next; pragma Assert (Orig_Package /= No_Package, "original package not found"); end loop; Orig_Array := - Packages.Table (Orig_Package).Decl.Arrays; + In_Tree.Packages.Table + (Orig_Package).Decl.Arrays; end if; -- Now look for the array while Orig_Array /= No_Array and then - Arrays.Table (Orig_Array).Name /= Current_Item_Name + In_Tree.Arrays.Table (Orig_Array).Name /= + Current_Item_Name loop - Orig_Array := Arrays.Table (Orig_Array).Next; + Orig_Array := In_Tree.Arrays.Table + (Orig_Array).Next; end loop; if Orig_Array = No_Array then if Error_Report = null then Error_Msg ("associative array value cannot be found", - Location_Of (Current_Item)); + Location_Of + (Current_Item, From_Project_Node_Tree)); else Error_Report ("associative array value cannot be found", - Project); + Project, In_Tree); end if; else - Orig_Element := Arrays.Table (Orig_Array).Value; + Orig_Element := + In_Tree.Arrays.Table (Orig_Array).Value; -- Copy each array element @@ -1271,20 +1454,25 @@ package body Prj.Proc is -- And there is no array element declared yet, -- create a new first array element. - if Arrays.Table (New_Array).Value = + if In_Tree.Arrays.Table (New_Array).Value = No_Array_Element then - Array_Elements.Increment_Last; - New_Element := Array_Elements.Last; - Arrays.Table (New_Array).Value := New_Element; + Array_Element_Table.Increment_Last + (In_Tree.Array_Elements); + New_Element := Array_Element_Table.Last + (In_Tree.Array_Elements); + In_Tree.Arrays.Table + (New_Array).Value := New_Element; Next_Element := No_Array_Element; -- Otherwise, the new element is the first else - New_Element := Arrays.Table (New_Array).Value; + New_Element := In_Tree.Arrays. + Table (New_Array).Value; Next_Element := - Array_Elements.Table (New_Element).Next; + In_Tree.Array_Elements.Table + (New_Element).Next; end if; -- Otherwise, reuse an existing element, or create @@ -1292,30 +1480,36 @@ package body Prj.Proc is else Next_Element := - Array_Elements.Table (Prev_Element).Next; + In_Tree.Array_Elements.Table + (Prev_Element).Next; if Next_Element = No_Array_Element then - Array_Elements.Increment_Last; - New_Element := Array_Elements.Last; + Array_Element_Table.Increment_Last + (In_Tree.Array_Elements); + New_Element := Array_Element_Table.Last + (In_Tree.Array_Elements); else New_Element := Next_Element; Next_Element := - Array_Elements.Table (New_Element).Next; + In_Tree.Array_Elements.Table + (New_Element).Next; end if; end if; -- Copy the value of the element - Array_Elements.Table (New_Element) := - Array_Elements.Table (Orig_Element); - Array_Elements.Table (New_Element).Value.Project := - Project; + In_Tree.Array_Elements.Table + (New_Element) := + In_Tree.Array_Elements.Table + (Orig_Element); + In_Tree.Array_Elements.Table + (New_Element).Value.Project := Project; -- Adjust the Next link - Array_Elements.Table (New_Element).Next := - Next_Element; + In_Tree.Array_Elements.Table + (New_Element).Next := Next_Element; -- Adjust the previous id for the next element @@ -1324,14 +1518,15 @@ package body Prj.Proc is -- Go to the next element in the original array Orig_Element := - Array_Elements.Table (Orig_Element).Next; + In_Tree.Array_Elements.Table + (Orig_Element).Next; end loop; -- Make sure that the array ends here, in case there -- previously a greater number of elements. - Array_Elements.Table (New_Element).Next := - No_Array_Element; + In_Tree.Array_Elements.Table + (New_Element).Next := No_Array_Element; end if; end; @@ -1341,62 +1536,73 @@ package body Prj.Proc is declare New_Value : constant Variable_Value := Expression - (Project => Project, - From_Project_Node => From_Project_Node, - Pkg => Pkg, - First_Term => - Tree.First_Term (Expression_Of - (Current_Item)), - Kind => - Expression_Kind_Of (Current_Item)); + (Project => Project, + In_Tree => In_Tree, + From_Project_Node => From_Project_Node, + From_Project_Node_Tree => From_Project_Node_Tree, + Pkg => Pkg, + First_Term => + Tree.First_Term + (Expression_Of + (Current_Item, From_Project_Node_Tree), + From_Project_Node_Tree), + Kind => + Expression_Kind_Of + (Current_Item, From_Project_Node_Tree)); -- The expression value The_Variable : Variable_Id := No_Variable; Current_Item_Name : constant Name_Id := - Name_Of (Current_Item); + Name_Of (Current_Item, From_Project_Node_Tree); begin -- Process a typed variable declaration - if - Kind_Of (Current_Item) = N_Typed_Variable_Declaration + if Kind_Of (Current_Item, From_Project_Node_Tree) = + N_Typed_Variable_Declaration then -- Report an error for an empty string if New_Value.Value = Empty_String then - Error_Msg_Name_1 := Name_Of (Current_Item); + Error_Msg_Name_1 := + Name_Of (Current_Item, From_Project_Node_Tree); if Error_Report = null then Error_Msg ("no value defined for %", - Location_Of (Current_Item)); + Location_Of + (Current_Item, From_Project_Node_Tree)); else Error_Report ("no value defined for " & Get_Name_String (Error_Msg_Name_1), - Project); + Project, In_Tree); end if; else declare Current_String : Project_Node_Id := - First_Literal_String - (String_Type_Of - (Current_Item)); + First_Literal_String + (String_Type_Of + (Current_Item, + From_Project_Node_Tree), + From_Project_Node_Tree); begin - -- Loop through all the valid strings for - -- the string type and compare to the string - -- value. + -- Loop through all the valid strings for the + -- string type and compare to the string value. while Current_String /= Empty_Node - and then String_Value_Of (Current_String) /= - New_Value.Value + and then + String_Value_Of + (Current_String, From_Project_Node_Tree) /= + New_Value.Value loop Current_String := - Next_Literal_String (Current_String); + Next_Literal_String + (Current_String, From_Project_Node_Tree); end loop; -- Report an error if the string value is not @@ -1404,12 +1610,16 @@ package body Prj.Proc is if Current_String = Empty_Node then Error_Msg_Name_1 := New_Value.Value; - Error_Msg_Name_2 := Name_Of (Current_Item); + Error_Msg_Name_2 := + Name_Of + (Current_Item, From_Project_Node_Tree); if Error_Report = null then Error_Msg ("value { is illegal for typed string %", - Location_Of (Current_Item)); + Location_Of + (Current_Item, + From_Project_Node_Tree)); else Error_Report @@ -1418,16 +1628,18 @@ package body Prj.Proc is """ is illegal for typed string """ & Get_Name_String (Error_Msg_Name_2) & """", - Project); + Project, In_Tree); end if; end if; end; end if; end if; - if Kind_Of (Current_Item) /= N_Attribute_Declaration + if Kind_Of (Current_Item, From_Project_Node_Tree) /= + N_Attribute_Declaration or else - Associative_Array_Index_Of (Current_Item) = No_Name + Associative_Array_Index_Of + (Current_Item, From_Project_Node_Tree) = No_Name then -- Case of a variable declaration or of a not -- associative array attribute. @@ -1435,26 +1647,28 @@ package body Prj.Proc is -- First, find the list where to find the variable -- or attribute. - if - Kind_Of (Current_Item) = N_Attribute_Declaration + if Kind_Of (Current_Item, From_Project_Node_Tree) = + N_Attribute_Declaration then if Pkg /= No_Package then The_Variable := - Packages.Table (Pkg).Decl.Attributes; - + In_Tree.Packages.Table + (Pkg).Decl.Attributes; else The_Variable := - Projects.Table (Project).Decl.Attributes; + In_Tree.Projects.Table + (Project).Decl.Attributes; end if; else if Pkg /= No_Package then The_Variable := - Packages.Table (Pkg).Decl.Variables; - + In_Tree.Packages.Table + (Pkg).Decl.Variables; else The_Variable := - Projects.Table (Project).Decl.Variables; + In_Tree.Projects.Table + (Project).Decl.Variables; end if; end if; @@ -1462,58 +1676,65 @@ package body Prj.Proc is -- Loop through the list, to find if it has already -- been declared. - while - The_Variable /= No_Variable + while The_Variable /= No_Variable and then - Variable_Elements.Table (The_Variable).Name /= - Current_Item_Name + In_Tree.Variable_Elements.Table + (The_Variable).Name /= Current_Item_Name loop The_Variable := - Variable_Elements.Table (The_Variable).Next; + In_Tree.Variable_Elements.Table + (The_Variable).Next; end loop; -- If it has not been declared, create a new entry -- in the list. if The_Variable = No_Variable then + -- All single string attribute should already have -- been declared with a default empty string value. pragma Assert - (Kind_Of (Current_Item) /= + (Kind_Of (Current_Item, From_Project_Node_Tree) /= N_Attribute_Declaration, "illegal attribute declaration"); - Variable_Elements.Increment_Last; - The_Variable := Variable_Elements.Last; + Variable_Element_Table.Increment_Last + (In_Tree.Variable_Elements); + The_Variable := Variable_Element_Table.Last + (In_Tree.Variable_Elements); -- Put the new variable in the appropriate list if Pkg /= No_Package then - Variable_Elements.Table (The_Variable) := + In_Tree.Variable_Elements.Table (The_Variable) := (Next => - Packages.Table (Pkg).Decl.Variables, + In_Tree.Packages.Table + (Pkg).Decl.Variables, Name => Current_Item_Name, Value => New_Value); - Packages.Table (Pkg).Decl.Variables := - The_Variable; + In_Tree.Packages.Table + (Pkg).Decl.Variables := The_Variable; else - Variable_Elements.Table (The_Variable) := + In_Tree.Variable_Elements.Table (The_Variable) := (Next => - Projects.Table (Project).Decl.Variables, + In_Tree.Projects.Table + (Project).Decl.Variables, Name => Current_Item_Name, Value => New_Value); - Projects.Table (Project).Decl.Variables := - The_Variable; + In_Tree.Projects.Table + (Project).Decl.Variables := + The_Variable; end if; -- If the variable/attribute has already been -- declared, just change the value. else - Variable_Elements.Table (The_Variable).Value := - New_Value; + In_Tree.Variable_Elements.Table + (The_Variable).Value := + New_Value; end if; @@ -1523,11 +1744,14 @@ package body Prj.Proc is -- Get the string index Get_Name_String - (Associative_Array_Index_Of (Current_Item)); + (Associative_Array_Index_Of + (Current_Item, From_Project_Node_Tree)); -- Put in lower case, if necessary - if Case_Insensitive (Current_Item) then + if Case_Insensitive + (Current_Item, From_Project_Node_Tree) + then GNAT.Case_Util.To_Lower (Name_Buffer (1 .. Name_Len)); end if; @@ -1536,7 +1760,7 @@ package body Prj.Proc is The_Array : Array_Id; The_Array_Element : Array_Element_Id := - No_Array_Element; + No_Array_Element; Index_Name : constant Name_Id := Name_Find; -- The name id of the index @@ -1545,19 +1769,21 @@ package body Prj.Proc is -- Look for the array in the appropriate list if Pkg /= No_Package then - The_Array := Packages.Table (Pkg).Decl.Arrays; + The_Array := In_Tree.Packages.Table + (Pkg).Decl.Arrays; else - The_Array := Projects.Table + The_Array := In_Tree.Projects.Table (Project).Decl.Arrays; end if; while The_Array /= No_Array - and then Arrays.Table (The_Array).Name /= - Current_Item_Name + and then In_Tree.Arrays.Table + (The_Array).Name /= Current_Item_Name loop - The_Array := Arrays.Table (The_Array).Next; + The_Array := In_Tree.Arrays.Table + (The_Array).Next; end loop; -- If the array cannot be found, create a new @@ -1566,24 +1792,36 @@ package body Prj.Proc is -- will be created automatically later. if The_Array = No_Array then - Arrays.Increment_Last; - The_Array := Arrays.Last; + Array_Table.Increment_Last + (In_Tree.Arrays); + The_Array := Array_Table.Last + (In_Tree.Arrays); if Pkg /= No_Package then - Arrays.Table (The_Array) := + In_Tree.Arrays.Table + (The_Array) := (Name => Current_Item_Name, Value => No_Array_Element, - Next => Packages.Table (Pkg).Decl.Arrays); - Packages.Table (Pkg).Decl.Arrays := The_Array; + Next => + In_Tree.Packages.Table + (Pkg).Decl.Arrays); + + In_Tree.Packages.Table + (Pkg).Decl.Arrays := + The_Array; else - Arrays.Table (The_Array) := + In_Tree.Arrays.Table + (The_Array) := (Name => Current_Item_Name, Value => No_Array_Element, Next => - Projects.Table (Project).Decl.Arrays); - Projects.Table (Project).Decl.Arrays := - The_Array; + In_Tree.Projects.Table + (Project).Decl.Arrays); + + In_Tree.Projects.Table + (Project).Decl.Arrays := + The_Array; end if; -- Otherwise, initialize The_Array_Element as the @@ -1591,7 +1829,8 @@ package body Prj.Proc is else The_Array_Element := - Arrays.Table (The_Array).Value; + In_Tree.Arrays.Table + (The_Array).Value; end if; -- Look in the list, if any, to find an element @@ -1599,11 +1838,12 @@ package body Prj.Proc is while The_Array_Element /= No_Array_Element and then - Array_Elements.Table (The_Array_Element).Index /= - Index_Name + In_Tree.Array_Elements.Table + (The_Array_Element).Index /= Index_Name loop The_Array_Element := - Array_Elements.Table (The_Array_Element).Next; + In_Tree.Array_Elements.Table + (The_Array_Element).Next; end loop; -- If no such element were found, create a new @@ -1611,25 +1851,32 @@ package body Prj.Proc is -- the propoer value. if The_Array_Element = No_Array_Element then - Array_Elements.Increment_Last; - The_Array_Element := Array_Elements.Last; + Array_Element_Table.Increment_Last + (In_Tree.Array_Elements); + The_Array_Element := Array_Element_Table.Last + (In_Tree.Array_Elements); - Array_Elements.Table (The_Array_Element) := + In_Tree.Array_Elements.Table + (The_Array_Element) := (Index => Index_Name, - Src_Index => Source_Index_Of (Current_Item), + Src_Index => + Source_Index_Of + (Current_Item, From_Project_Node_Tree), Index_Case_Sensitive => - not Case_Insensitive (Current_Item), + not Case_Insensitive + (Current_Item, From_Project_Node_Tree), Value => New_Value, - Next => Arrays.Table (The_Array).Value); - Arrays.Table (The_Array).Value := - The_Array_Element; + Next => In_Tree.Arrays.Table + (The_Array).Value); + In_Tree.Arrays.Table + (The_Array).Value := The_Array_Element; -- An element with the same index already exists, -- just replace its value with the new one. else - Array_Elements.Table (The_Array_Element).Value := - New_Value; + In_Tree.Array_Elements.Table + (The_Array_Element).Value := New_Value; end if; end; end if; @@ -1658,7 +1905,8 @@ package body Prj.Proc is declare Variable_Node : constant Project_Node_Id := Case_Variable_Reference_Of - (Current_Item); + (Current_Item, + From_Project_Node_Tree); Var_Id : Variable_Id := No_Variable; Name : Name_Id := No_Name; @@ -1667,33 +1915,51 @@ package body Prj.Proc is -- If a project were specified for the case variable, -- get its id. - if Project_Node_Of (Variable_Node) /= Empty_Node then - Name := Name_Of (Project_Node_Of (Variable_Node)); + if Project_Node_Of + (Variable_Node, From_Project_Node_Tree) /= Empty_Node + then + Name := + Name_Of + (Project_Node_Of + (Variable_Node, From_Project_Node_Tree), + From_Project_Node_Tree); The_Project := - Imported_Or_Extended_Project_From (Project, Name); + Imported_Or_Extended_Project_From + (Project, In_Tree, Name); end if; -- If a package were specified for the case variable, -- get its id. - if Package_Node_Of (Variable_Node) /= Empty_Node then - Name := Name_Of (Package_Node_Of (Variable_Node)); - The_Package := Package_From (The_Project, Name); + if Package_Node_Of + (Variable_Node, From_Project_Node_Tree) /= Empty_Node + then + Name := + Name_Of + (Package_Node_Of + (Variable_Node, From_Project_Node_Tree), + From_Project_Node_Tree); + The_Package := + Package_From (The_Project, In_Tree, Name); end if; - Name := Name_Of (Variable_Node); + Name := Name_Of (Variable_Node, From_Project_Node_Tree); -- First, look for the case variable into the package, -- if any. if The_Package /= No_Package then - Var_Id := Packages.Table (The_Package).Decl.Variables; - Name := Name_Of (Variable_Node); + Var_Id := In_Tree.Packages.Table + (The_Package).Decl.Variables; + Name := + Name_Of (Variable_Node, From_Project_Node_Tree); while Var_Id /= No_Variable and then - Variable_Elements.Table (Var_Id).Name /= Name + In_Tree.Variable_Elements.Table + (Var_Id).Name /= Name loop - Var_Id := Variable_Elements.Table (Var_Id).Next; + Var_Id := In_Tree.Variable_Elements. + Table (Var_Id).Next; end loop; end if; @@ -1701,14 +1967,19 @@ package body Prj.Proc is -- package, look at the project level. if Var_Id = No_Variable - and then Package_Node_Of (Variable_Node) = Empty_Node + and then + Package_Node_Of + (Variable_Node, From_Project_Node_Tree) = Empty_Node then - Var_Id := Projects.Table (The_Project).Decl.Variables; + Var_Id := In_Tree.Projects.Table + (The_Project).Decl.Variables; while Var_Id /= No_Variable and then - Variable_Elements.Table (Var_Id).Name /= Name + In_Tree.Variable_Elements.Table + (Var_Id).Name /= Name loop - Var_Id := Variable_Elements.Table (Var_Id).Next; + Var_Id := In_Tree.Variable_Elements. + Table (Var_Id).Next; end loop; end if; @@ -1725,7 +1996,8 @@ package body Prj.Proc is -- Get the case variable - The_Variable := Variable_Elements.Table (Var_Id).Value; + The_Variable := In_Tree.Variable_Elements. + Table (Var_Id).Value; if The_Variable.Kind /= Single then @@ -1744,16 +2016,20 @@ package body Prj.Proc is -- Now look into all the case items of the case construction - Case_Item := First_Case_Item_Of (Current_Item); + Case_Item := + First_Case_Item_Of (Current_Item, From_Project_Node_Tree); Case_Item_Loop : while Case_Item /= Empty_Node loop - Choice_String := First_Choice_Of (Case_Item); + Choice_String := + First_Choice_Of (Case_Item, From_Project_Node_Tree); -- When Choice_String is nil, it means that it is -- the "when others =>" alternative. if Choice_String = Empty_Node then - Decl_Item := First_Declarative_Item_Of (Case_Item); + Decl_Item := + First_Declarative_Item_Of + (Case_Item, From_Project_Node_Tree); exit Case_Item_Loop; end if; @@ -1761,28 +2037,35 @@ package body Prj.Proc is Choice_Loop : while Choice_String /= Empty_Node loop - if - Case_Value = String_Value_Of (Choice_String) + if Case_Value = + String_Value_Of + (Choice_String, From_Project_Node_Tree) then Decl_Item := - First_Declarative_Item_Of (Case_Item); + First_Declarative_Item_Of + (Case_Item, From_Project_Node_Tree); exit Case_Item_Loop; end if; Choice_String := - Next_Literal_String (Choice_String); + Next_Literal_String + (Choice_String, From_Project_Node_Tree); end loop Choice_Loop; - Case_Item := Next_Case_Item (Case_Item); + + Case_Item := + Next_Case_Item (Case_Item, From_Project_Node_Tree); end loop Case_Item_Loop; -- If there is an alternative, then we process it if Decl_Item /= Empty_Node then Process_Declarative_Items - (Project => Project, - From_Project_Node => From_Project_Node, - Pkg => Pkg, - Item => Decl_Item); + (Project => Project, + In_Tree => In_Tree, + From_Project_Node => From_Project_Node, + From_Project_Node_Tree => From_Project_Node_Tree, + Pkg => Pkg, + Item => Decl_Item); end if; end; @@ -1791,7 +2074,9 @@ package body Prj.Proc is -- Should never happen Write_Line ("Illegal declarative item: " & - Project_Node_Kind'Image (Kind_Of (Current_Item))); + Project_Node_Kind'Image + (Kind_Of + (Current_Item, From_Project_Node_Tree))); raise Program_Error; end case; end loop; @@ -1803,6 +2088,7 @@ package body Prj.Proc is procedure Recursive_Check (Project : Project_Id; + In_Tree : Project_Tree_Ref; Follow_Links : Boolean) is Data : Project_Data; @@ -1813,29 +2099,31 @@ package body Prj.Proc is -- been marked as checked. if Project /= No_Project - and then not Projects.Table (Project).Checked + and then not In_Tree.Projects.Table (Project).Checked then -- Mark project as checked, to avoid infinite recursion in -- ill-formed trees, where a project imports itself. - Projects.Table (Project).Checked := True; + In_Tree.Projects.Table (Project).Checked := True; - Data := Projects.Table (Project); + Data := In_Tree.Projects.Table (Project); -- Call itself for a possible extended project. -- (if there is no extended project, then nothing happens). - Recursive_Check (Data.Extends, Follow_Links); + Recursive_Check (Data.Extends, In_Tree, Follow_Links); -- Call itself for all imported projects Imported_Project_List := Data.Imported_Projects; while Imported_Project_List /= Empty_Project_List loop Recursive_Check - (Project_Lists.Table (Imported_Project_List).Project, - Follow_Links); + (In_Tree.Project_Lists.Table + (Imported_Project_List).Project, + In_Tree, Follow_Links); Imported_Project_List := - Project_Lists.Table (Imported_Project_List).Next; + In_Tree.Project_Lists.Table + (Imported_Project_List).Next; end loop; if Opt.Verbose_Mode then @@ -1844,7 +2132,7 @@ package body Prj.Proc is Write_Line (""""); end if; - Prj.Nmsc.Check (Project, Error_Report, Follow_Links); + Prj.Nmsc.Check (Project, In_Tree, Error_Report, Follow_Links); end if; end Recursive_Check; @@ -1853,9 +2141,11 @@ package body Prj.Proc is ----------------------- procedure Recursive_Process - (Project : out Project_Id; - From_Project_Node : Project_Node_Id; - Extended_By : Project_Id) + (In_Tree : Project_Tree_Ref; + Project : out Project_Id; + From_Project_Node : Project_Node_Id; + From_Project_Node_Tree : Project_Node_Tree_Ref; + Extended_By : Project_Id) is With_Clause : Project_Node_Id; @@ -1865,10 +2155,11 @@ package body Prj.Proc is else declare - Processed_Data : Project_Data := Empty_Project; + Processed_Data : Project_Data := Empty_Project (In_Tree); Imported : Project_List := Empty_Project_List; Declaration_Node : Project_Node_Id := Empty_Node; - Name : constant Name_Id := Name_Of (From_Project_Node); + Name : constant Name_Id := + Name_Of (From_Project_Node, From_Project_Node_Tree); begin Project := Processed_Projects.Get (Name); @@ -1877,8 +2168,8 @@ package body Prj.Proc is return; end if; - Projects.Increment_Last; - Project := Projects.Last; + Project_Table.Increment_Last (In_Tree.Projects); + Project := Project_Table.Last (In_Tree.Projects); Processed_Projects.Set (Name, Project); Processed_Data.Name := Name; @@ -1896,15 +2187,16 @@ package body Prj.Proc is end if; Processed_Data.Display_Path_Name := - Path_Name_Of (From_Project_Node); + Path_Name_Of (From_Project_Node, From_Project_Node_Tree); Get_Name_String (Processed_Data.Display_Path_Name); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Processed_Data.Path_Name := Name_Find; - Processed_Data.Location := Location_Of (From_Project_Node); + Processed_Data.Location := + Location_Of (From_Project_Node, From_Project_Node_Tree); Processed_Data.Display_Directory := - Directory_Of (From_Project_Node); + Directory_Of (From_Project_Node, From_Project_Node_Tree); Get_Name_String (Processed_Data.Display_Directory); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Processed_Data.Directory := Name_Find; @@ -1912,8 +2204,10 @@ package body Prj.Proc is Processed_Data.Extended_By := Extended_By; Processed_Data.Naming := Standard_Naming_Data; - Add_Attributes (Project, Processed_Data.Decl, Attribute_First); - With_Clause := First_With_Clause_Of (From_Project_Node); + Add_Attributes + (Project, In_Tree, Processed_Data.Decl, Attribute_First); + With_Clause := + First_With_Clause_Of (From_Project_Node, From_Project_Node_Tree); while With_Clause /= Empty_Node loop declare @@ -1922,56 +2216,79 @@ package body Prj.Proc is begin Recursive_Process - (Project => New_Project, - From_Project_Node => Project_Node_Of (With_Clause), - Extended_By => No_Project); - New_Data := Projects.Table (New_Project); + (In_Tree => In_Tree, + Project => New_Project, + From_Project_Node => + Project_Node_Of (With_Clause, From_Project_Node_Tree), + From_Project_Node_Tree => From_Project_Node_Tree, + Extended_By => No_Project); + New_Data := + In_Tree.Projects.Table (New_Project); -- If we were the first project to import it, -- set First_Referred_By to us. if New_Data.First_Referred_By = No_Project then New_Data.First_Referred_By := Project; - Projects.Table (New_Project) := New_Data; + In_Tree.Projects.Table (New_Project) := + New_Data; end if; -- Add this project to our list of imported projects - Project_Lists.Increment_Last; - Project_Lists.Table (Project_Lists.Last) := + Project_List_Table.Increment_Last + (In_Tree.Project_Lists); + In_Tree.Project_Lists.Table + (Project_List_Table.Last + (In_Tree.Project_Lists)) := (Project => New_Project, Next => Empty_Project_List); -- Imported is the id of the last imported project. -- If it is nil, then this imported project is our first. if Imported = Empty_Project_List then - Processed_Data.Imported_Projects := Project_Lists.Last; + Processed_Data.Imported_Projects := + Project_List_Table.Last + (In_Tree.Project_Lists); else - Project_Lists.Table (Imported).Next := Project_Lists.Last; + In_Tree.Project_Lists.Table + (Imported).Next := Project_List_Table.Last + (In_Tree.Project_Lists); end if; - Imported := Project_Lists.Last; + Imported := Project_List_Table.Last + (In_Tree.Project_Lists); - With_Clause := Next_With_Clause_Of (With_Clause); + With_Clause := + Next_With_Clause_Of (With_Clause, From_Project_Node_Tree); end; end loop; - Declaration_Node := Project_Declaration_Of (From_Project_Node); + Declaration_Node := + Project_Declaration_Of + (From_Project_Node, From_Project_Node_Tree); Recursive_Process - (Project => Processed_Data.Extends, - From_Project_Node => Extended_Project_Of (Declaration_Node), - Extended_By => Project); + (In_Tree => In_Tree, + Project => Processed_Data.Extends, + From_Project_Node => + Extended_Project_Of + (Declaration_Node, From_Project_Node_Tree), + From_Project_Node_Tree => From_Project_Node_Tree, + Extended_By => Project); - Projects.Table (Project) := Processed_Data; + In_Tree.Projects.Table (Project) := Processed_Data; Process_Declarative_Items - (Project => Project, - From_Project_Node => From_Project_Node, - Pkg => No_Package, - Item => First_Declarative_Item_Of - (Declaration_Node)); + (Project => Project, + In_Tree => In_Tree, + From_Project_Node => From_Project_Node, + From_Project_Node_Tree => From_Project_Node_Tree, + Pkg => No_Package, + Item => + First_Declarative_Item_Of + (Declaration_Node, From_Project_Node_Tree)); -- If it is an extending project, inherit all packages -- from the extended project that are not explicitely defined @@ -1979,11 +2296,11 @@ package body Prj.Proc is -- is not explicitely defined. if Processed_Data.Extends /= No_Project then - Processed_Data := Projects.Table (Project); + Processed_Data := In_Tree.Projects.Table (Project); declare Extended_Pkg : Package_Id := - Projects.Table + In_Tree.Projects.Table (Processed_Data.Extends).Decl.Packages; Current_Pkg : Package_Id; Element : Package_Element; @@ -1996,21 +2313,25 @@ package body Prj.Proc is begin while Extended_Pkg /= No_Package loop - Element := Packages.Table (Extended_Pkg); + Element := + In_Tree.Packages.Table (Extended_Pkg); Current_Pkg := First; loop exit when Current_Pkg = No_Package - or else Packages.Table (Current_Pkg).Name - = Element.Name; - Current_Pkg := Packages.Table (Current_Pkg).Next; + or else In_Tree.Packages.Table + (Current_Pkg).Name = Element.Name; + Current_Pkg := In_Tree.Packages.Table + (Current_Pkg).Next; end loop; if Current_Pkg = No_Package then - Packages.Increment_Last; - Current_Pkg := Packages.Last; - Packages.Table (Current_Pkg) := + Package_Table.Increment_Last + (In_Tree.Packages); + Current_Pkg := Package_Table.Last + (In_Tree.Packages); + In_Tree.Packages.Table (Current_Pkg) := (Name => Element.Name, Decl => Element.Decl, Parent => No_Package, @@ -2026,7 +2347,8 @@ package body Prj.Proc is Attribute1 := Processed_Data.Decl.Attributes; while Attribute1 /= No_Variable loop - Attr_Value1 := Variable_Elements.Table (Attribute1); + Attr_Value1 := In_Tree.Variable_Elements. + Table (Attribute1); exit when Attr_Value1.Name = Snames.Name_Languages; Attribute1 := Attr_Value1.Next; end loop; @@ -2039,10 +2361,12 @@ package body Prj.Proc is -- extended. Attribute2 := - Projects.Table (Processed_Data.Extends).Decl.Attributes; + In_Tree.Projects.Table + (Processed_Data.Extends).Decl.Attributes; while Attribute2 /= No_Variable loop - Attr_Value2 := Variable_Elements.Table (Attribute2); + Attr_Value2 := In_Tree.Variable_Elements. + Table (Attribute2); exit when Attr_Value2.Name = Snames.Name_Languages; Attribute2 := Attr_Value2.Next; end loop; @@ -2055,20 +2379,23 @@ package body Prj.Proc is -- project. if Attribute1 = No_Variable then - Variable_Elements.Increment_Last; - Attribute1 := Variable_Elements.Last; + Variable_Element_Table.Increment_Last + (In_Tree.Variable_Elements); + Attribute1 := Variable_Element_Table.Last + (In_Tree.Variable_Elements); Attr_Value1.Next := Processed_Data.Decl.Attributes; Processed_Data.Decl.Attributes := Attribute1; end if; Attr_Value1.Name := Snames.Name_Languages; Attr_Value1.Value := Attr_Value2.Value; - Variable_Elements.Table (Attribute1) := Attr_Value1; + In_Tree.Variable_Elements.Table + (Attribute1) := Attr_Value1; end if; end if; end; - Projects.Table (Project) := Processed_Data; + In_Tree.Projects.Table (Project) := Processed_Data; end if; end; end if; diff --git a/gcc/ada/prj-proc.ads b/gcc/ada/prj-proc.ads index dae791b27d6..74b16fa0c4b 100644 --- a/gcc/ada/prj-proc.ads +++ b/gcc/ada/prj-proc.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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- -- @@ -33,11 +33,13 @@ with Prj.Tree; use Prj.Tree; package Prj.Proc is procedure Process - (Project : out Project_Id; - Success : out Boolean; - From_Project_Node : Project_Node_Id; - Report_Error : Put_Line_Access; - Follow_Links : Boolean := True); + (In_Tree : Project_Tree_Ref; + Project : out Project_Id; + Success : out Boolean; + From_Project_Node : Project_Node_Id; + From_Project_Node_Tree : Project_Node_Tree_Ref; + Report_Error : Put_Line_Access; + Follow_Links : Boolean := True); -- Process a project file tree into project file data structures. -- If Report_Error is null, use the error reporting mechanism. -- Otherwise, report errors using Report_Error. diff --git a/gcc/ada/prj-strt.adb b/gcc/ada/prj-strt.adb index b11124a2e38..ae7941c203b 100644 --- a/gcc/ada/prj-strt.adb +++ b/gcc/ada/prj-strt.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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- -- @@ -37,6 +37,9 @@ with Uintp; use Uintp; package body Prj.Strt is + Buffer : String_Access; + Buffer_Last : Natural := 0; + type Choice_String is record The_String : Name_Id; Already_Used : Boolean := False; @@ -102,18 +105,22 @@ package body Prj.Strt is procedure Add_To_Names (NL : Name_Location); -- Add one single names to table Names - procedure External_Reference (External_Value : out Project_Node_Id); + procedure External_Reference + (In_Tree : Project_Node_Tree_Ref; + External_Value : out Project_Node_Id); -- Parse an external reference. Current token is "external". procedure Attribute_Reference - (Reference : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Reference : out Project_Node_Id; First_Attribute : Attribute_Node_Id; Current_Project : Project_Node_Id; Current_Package : Project_Node_Id); -- Parse an attribute reference. Current token is an apostrophe. procedure Terms - (Term : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Term : out Project_Node_Id; Expr_Kind : in out Variable_Kind; Current_Project : Project_Node_Id; Current_Package : Project_Node_Id; @@ -148,7 +155,8 @@ package body Prj.Strt is ------------------------- procedure Attribute_Reference - (Reference : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Reference : out Project_Node_Id; First_Attribute : Attribute_Node_Id; Current_Project : Project_Node_Id; Current_Package : Project_Node_Id) @@ -158,9 +166,11 @@ package body Prj.Strt is begin -- Declare the node of the attribute reference - Reference := Default_Project_Node (Of_Kind => N_Attribute_Reference); - Set_Location_Of (Reference, To => Token_Ptr); - Scan; -- past apostrophe + Reference := + Default_Project_Node + (Of_Kind => N_Attribute_Reference, In_Tree => In_Tree); + Set_Location_Of (Reference, In_Tree, To => Token_Ptr); + Scan (In_Tree); -- past apostrophe -- Body may be an attribute name @@ -172,7 +182,7 @@ package body Prj.Strt is Expect (Tok_Identifier, "identifier"); if Token = Tok_Identifier then - Set_Name_Of (Reference, To => Token_Name); + Set_Name_Of (Reference, In_Tree, To => Token_Name); -- Check if the identifier is one of the attribute identifiers in the -- context (package or project level attributes). @@ -189,22 +199,23 @@ package body Prj.Strt is -- Scan past the attribute name - Scan; + Scan (In_Tree); else -- Give its characteristics to this attribute reference - Set_Project_Node_Of (Reference, To => Current_Project); - Set_Package_Node_Of (Reference, To => Current_Package); + Set_Project_Node_Of (Reference, In_Tree, To => Current_Project); + Set_Package_Node_Of (Reference, In_Tree, To => Current_Package); Set_Expression_Kind_Of - (Reference, To => Variable_Kind_Of (Current_Attribute)); + (Reference, In_Tree, To => Variable_Kind_Of (Current_Attribute)); Set_Case_Insensitive - (Reference, To => Attribute_Kind_Of (Current_Attribute) = - Case_Insensitive_Associative_Array); + (Reference, In_Tree, + To => Attribute_Kind_Of (Current_Attribute) = + Case_Insensitive_Associative_Array); -- Scan past the attribute name - Scan; + Scan (In_Tree); -- If the attribute is an associative array, get the index @@ -212,17 +223,17 @@ package body Prj.Strt is Expect (Tok_Left_Paren, "`(`"); if Token = Tok_Left_Paren then - Scan; + Scan (In_Tree); Expect (Tok_String_Literal, "literal string"); if Token = Tok_String_Literal then Set_Associative_Array_Index_Of - (Reference, To => Token_Name); - Scan; + (Reference, In_Tree, To => Token_Name); + Scan (In_Tree); Expect (Tok_Right_Paren, "`)`"); if Token = Tok_Right_Paren then - Scan; + Scan (In_Tree); end if; end if; end if; @@ -232,18 +243,20 @@ package body Prj.Strt is -- Change name of obsolete attributes if Reference /= Empty_Node then - case Name_Of (Reference) is + case Name_Of (Reference, In_Tree) is when Snames.Name_Specification => - Set_Name_Of (Reference, To => Snames.Name_Spec); + Set_Name_Of (Reference, In_Tree, To => Snames.Name_Spec); when Snames.Name_Specification_Suffix => - Set_Name_Of (Reference, To => Snames.Name_Spec_Suffix); + Set_Name_Of + (Reference, In_Tree, To => Snames.Name_Spec_Suffix); when Snames.Name_Implementation => - Set_Name_Of (Reference, To => Snames.Name_Body); + Set_Name_Of (Reference, In_Tree, To => Snames.Name_Body); when Snames.Name_Implementation_Suffix => - Set_Name_Of (Reference, To => Snames.Name_Body_Suffix); + Set_Name_Of + (Reference, In_Tree, To => Snames.Name_Body_Suffix); when others => null; @@ -327,26 +340,31 @@ package body Prj.Strt is -- External_Reference -- ------------------------ - procedure External_Reference (External_Value : out Project_Node_Id) is + procedure External_Reference + (In_Tree : Project_Node_Tree_Ref; + External_Value : out Project_Node_Id) + is Field_Id : Project_Node_Id := Empty_Node; begin External_Value := - Default_Project_Node (Of_Kind => N_External_Value, - And_Expr_Kind => Single); - Set_Location_Of (External_Value, To => Token_Ptr); + Default_Project_Node + (Of_Kind => N_External_Value, + In_Tree => In_Tree, + And_Expr_Kind => Single); + Set_Location_Of (External_Value, In_Tree, To => Token_Ptr); -- The current token is External -- Get the left parenthesis - Scan; + Scan (In_Tree); Expect (Tok_Left_Paren, "`(`"); -- Scan past the left parenthesis if Token = Tok_Left_Paren then - Scan; + Scan (In_Tree); end if; -- Get the name of the external reference @@ -355,27 +373,29 @@ package body Prj.Strt is if Token = Tok_String_Literal then Field_Id := - Default_Project_Node (Of_Kind => N_Literal_String, - And_Expr_Kind => Single); - Set_String_Value_Of (Field_Id, To => Token_Name); - Set_External_Reference_Of (External_Value, To => Field_Id); + Default_Project_Node + (Of_Kind => N_Literal_String, + In_Tree => In_Tree, + And_Expr_Kind => Single); + Set_String_Value_Of (Field_Id, In_Tree, To => Token_Name); + Set_External_Reference_Of (External_Value, In_Tree, To => Field_Id); -- Scan past the first argument - Scan; + Scan (In_Tree); case Token is when Tok_Right_Paren => -- Scan past the right parenthesis - Scan; + Scan (In_Tree); when Tok_Comma => -- Scan past the comma - Scan; + Scan (In_Tree); Expect (Tok_String_Literal, "literal string"); @@ -383,17 +403,20 @@ package body Prj.Strt is if Token = Tok_String_Literal then Field_Id := - Default_Project_Node (Of_Kind => N_Literal_String, - And_Expr_Kind => Single); - Set_String_Value_Of (Field_Id, To => Token_Name); - Set_External_Default_Of (External_Value, To => Field_Id); - Scan; + Default_Project_Node + (Of_Kind => N_Literal_String, + In_Tree => In_Tree, + And_Expr_Kind => Single); + Set_String_Value_Of (Field_Id, In_Tree, To => Token_Name); + Set_External_Default_Of + (External_Value, In_Tree, To => Field_Id); + Scan (In_Tree); Expect (Tok_Right_Paren, "`)`"); end if; -- Scan past the right parenthesis if Token = Tok_Right_Paren then - Scan; + Scan (In_Tree); end if; when others => @@ -406,7 +429,10 @@ package body Prj.Strt is -- Parse_Choice_List -- ----------------------- - procedure Parse_Choice_List (First_Choice : out Project_Node_Id) is + procedure Parse_Choice_List + (In_Tree : Project_Node_Tree_Ref; + First_Choice : out Project_Node_Id) + is Current_Choice : Project_Node_Id := Empty_Node; Next_Choice : Project_Node_Id := Empty_Node; Choice_String : Name_Id := No_Name; @@ -416,8 +442,10 @@ package body Prj.Strt is -- Declare the node of the first choice First_Choice := - Default_Project_Node (Of_Kind => N_Literal_String, - And_Expr_Kind => Single); + Default_Project_Node + (Of_Kind => N_Literal_String, + In_Tree => In_Tree, + And_Expr_Kind => Single); -- Initially Current_Choice is the same as First_Choice @@ -426,12 +454,12 @@ package body Prj.Strt is loop Expect (Tok_String_Literal, "literal string"); exit when Token /= Tok_String_Literal; - Set_Location_Of (Current_Choice, To => Token_Ptr); + Set_Location_Of (Current_Choice, In_Tree, To => Token_Ptr); Choice_String := Token_Name; -- Give the string value to the current choice - Set_String_Value_Of (Current_Choice, To => Choice_String); + Set_String_Value_Of (Current_Choice, In_Tree, To => Choice_String); -- Check if the label is part of the string type and if it has not -- been already used. @@ -466,7 +494,7 @@ package body Prj.Strt is -- Scan past the label - Scan; + Scan (In_Tree); -- If there is no '|', we are done @@ -475,11 +503,14 @@ package body Prj.Strt is -- Current_Choice and set Current_Choice to this new node. Next_Choice := - Default_Project_Node (Of_Kind => N_Literal_String, - And_Expr_Kind => Single); - Set_Next_Literal_String (Current_Choice, To => Next_Choice); + Default_Project_Node + (Of_Kind => N_Literal_String, + In_Tree => In_Tree, + And_Expr_Kind => Single); + Set_Next_Literal_String + (Current_Choice, In_Tree, To => Next_Choice); Current_Choice := Next_Choice; - Scan; + Scan (In_Tree); else exit; end if; @@ -491,7 +522,8 @@ package body Prj.Strt is ---------------------- procedure Parse_Expression - (Expression : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Expression : out Project_Node_Id; Current_Project : Project_Node_Id; Current_Package : Project_Node_Id; Optional_Index : Boolean) @@ -502,12 +534,14 @@ package body Prj.Strt is begin -- Declare the node of the expression - Expression := Default_Project_Node (Of_Kind => N_Expression); - Set_Location_Of (Expression, To => Token_Ptr); + Expression := + Default_Project_Node (Of_Kind => N_Expression, In_Tree => In_Tree); + Set_Location_Of (Expression, In_Tree, To => Token_Ptr); -- Parse the term or terms of the expression - Terms (Term => First_Term, + Terms (In_Tree => In_Tree, + Term => First_Term, Expr_Kind => Expression_Kind, Current_Project => Current_Project, Current_Package => Current_Package, @@ -515,15 +549,18 @@ package body Prj.Strt is -- Set the first term and the expression kind - Set_First_Term (Expression, To => First_Term); - Set_Expression_Kind_Of (Expression, To => Expression_Kind); + Set_First_Term (Expression, In_Tree, To => First_Term); + Set_Expression_Kind_Of (Expression, In_Tree, To => Expression_Kind); end Parse_Expression; ---------------------------- -- Parse_String_Type_List -- ---------------------------- - procedure Parse_String_Type_List (First_String : out Project_Node_Id) is + procedure Parse_String_Type_List + (In_Tree : Project_Node_Tree_Ref; + First_String : out Project_Node_Id) + is Last_String : Project_Node_Id := Empty_Node; Next_String : Project_Node_Id := Empty_Node; String_Value : Name_Id := No_Name; @@ -532,8 +569,10 @@ package body Prj.Strt is -- Declare the node of the first string First_String := - Default_Project_Node (Of_Kind => N_Literal_String, - And_Expr_Kind => Single); + Default_Project_Node + (Of_Kind => N_Literal_String, + In_Tree => In_Tree, + And_Expr_Kind => Single); -- Initially, Last_String is the same as First_String @@ -546,8 +585,8 @@ package body Prj.Strt is -- Give its string value to Last_String - Set_String_Value_Of (Last_String, To => String_Value); - Set_Location_Of (Last_String, To => Token_Ptr); + Set_String_Value_Of (Last_String, In_Tree, To => String_Value); + Set_Location_Of (Last_String, In_Tree, To => Token_Ptr); -- Now, check if the string is already part of the string type @@ -556,7 +595,7 @@ package body Prj.Strt is begin while Current /= Last_String loop - if String_Value_Of (Current) = String_Value then + if String_Value_Of (Current, In_Tree) = String_Value then -- This is a repetition, report an error Error_Msg_Name_1 := String_Value; @@ -564,13 +603,13 @@ package body Prj.Strt is exit; end if; - Current := Next_Literal_String (Current); + Current := Next_Literal_String (Current, In_Tree); end loop; end; -- Scan past the literal string - Scan; + Scan (In_Tree); -- If there is no comma following the literal string, we are done @@ -582,11 +621,13 @@ package body Prj.Strt is -- Last_String to its node. Next_String := - Default_Project_Node (Of_Kind => N_Literal_String, - And_Expr_Kind => Single); - Set_Next_Literal_String (Last_String, To => Next_String); + Default_Project_Node + (Of_Kind => N_Literal_String, + In_Tree => In_Tree, + And_Expr_Kind => Single); + Set_Next_Literal_String (Last_String, In_Tree, To => Next_String); Last_String := Next_String; - Scan; + Scan (In_Tree); end if; end loop; end Parse_String_Type_List; @@ -596,7 +637,8 @@ package body Prj.Strt is ------------------------------ procedure Parse_Variable_Reference - (Variable : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Variable : out Project_Node_Id; Current_Project : Project_Node_Id; Current_Package : Project_Node_Id) is @@ -623,9 +665,9 @@ package body Prj.Strt is end if; Add_To_Names (NL => (Name => Token_Name, Location => Token_Ptr)); - Scan; + Scan (In_Tree); exit when Token /= Tok_Dot; - Scan; + Scan (In_Tree); end loop; if Look_For_Variable then @@ -654,7 +696,7 @@ package body Prj.Strt is -- Now, look if it can be a project name The_Project := Imported_Or_Extended_Project_Of - (Current_Project, Names.Table (1).Name); + (Current_Project, In_Tree, Names.Table (1).Name); if The_Project = Empty_Node then -- If it is neither a project name nor a package name, @@ -670,14 +712,15 @@ package body Prj.Strt is -- If it is a package name, check if the package -- has already been declared in the current project. - The_Package := First_Package_Of (Current_Project); + The_Package := + First_Package_Of (Current_Project, In_Tree); while The_Package /= Empty_Node - and then Name_Of (The_Package) /= + and then Name_Of (The_Package, In_Tree) /= Names.Table (1).Name loop The_Package := - Next_Package_In_Project (The_Package); + Next_Package_In_Project (The_Package, In_Tree); end loop; -- If it has not been already declared, report an @@ -717,10 +760,11 @@ package body Prj.Strt is for Index in 1 .. Names.Last - 1 loop Add_To_Buffer - (Get_Name_String (Names.Table (Index).Name)); + (Get_Name_String (Names.Table (Index).Name), + Buffer, Buffer_Last); if Index /= Names.Last - 1 then - Add_To_Buffer ("."); + Add_To_Buffer (".", Buffer, Buffer_Last); end if; end loop; @@ -732,9 +776,10 @@ package body Prj.Strt is -- Now, add the last simple name to get the name of the -- long project. - Add_To_Buffer ("."); + Add_To_Buffer (".", Buffer, Buffer_Last); Add_To_Buffer - (Get_Name_String (Names.Table (Names.Last).Name)); + (Get_Name_String (Names.Table (Names.Last).Name), + Buffer, Buffer_Last); Name_Len := Buffer_Last; Name_Buffer (1 .. Buffer_Last) := Buffer (1 .. Buffer_Last); @@ -743,7 +788,7 @@ package body Prj.Strt is -- Check if the long project is imported or extended The_Project := Imported_Or_Extended_Project_Of - (Current_Project, Long_Project); + (Current_Project, In_Tree, Long_Project); -- If the long project exists, then this is the prefix -- of the attribute. @@ -757,7 +802,8 @@ package body Prj.Strt is -- or extended. The_Project := Imported_Or_Extended_Project_Of - (Current_Project, Short_Project); + (Current_Project, In_Tree, + Short_Project); -- If the short project does not exist, we report an -- error. @@ -774,13 +820,14 @@ package body Prj.Strt is -- Now, we check if the package has been declared -- in this project. - The_Package := First_Package_Of (The_Project); + The_Package := + First_Package_Of (The_Project, In_Tree); while The_Package /= Empty_Node - and then Name_Of (The_Package) /= + and then Name_Of (The_Package, In_Tree) /= Names.Table (Names.Last).Name loop The_Package := - Next_Package_In_Project (The_Package); + Next_Package_In_Project (The_Package, In_Tree); end loop; -- If it has not, then we report an error @@ -799,7 +846,7 @@ package body Prj.Strt is First_Attribute := First_Attribute_Of - (Package_Id_Of (The_Package)); + (Package_Id_Of (The_Package, In_Tree)); end if; end if; end if; @@ -807,7 +854,8 @@ package body Prj.Strt is end case; Attribute_Reference - (Variable, + (In_Tree, + Variable, Current_Project => The_Project, Current_Package => The_Package, First_Attribute => First_Attribute); @@ -816,7 +864,8 @@ package body Prj.Strt is end if; Variable := - Default_Project_Node (Of_Kind => N_Variable_Reference); + Default_Project_Node + (Of_Kind => N_Variable_Reference, In_Tree => In_Tree); if Look_For_Variable then case Names.Last is @@ -830,7 +879,7 @@ package body Prj.Strt is -- Simple variable name - Set_Name_Of (Variable, To => Names.Table (1).Name); + Set_Name_Of (Variable, In_Tree, To => Names.Table (1).Name); when 2 => @@ -838,22 +887,24 @@ package body Prj.Strt is -- a project name or a package name. Project names have -- priority over package names. - Set_Name_Of (Variable, To => Names.Table (2).Name); + Set_Name_Of (Variable, In_Tree, To => Names.Table (2).Name); -- Check if it can be a package name - The_Package := First_Package_Of (Current_Project); + The_Package := First_Package_Of (Current_Project, In_Tree); while The_Package /= Empty_Node - and then Name_Of (The_Package) /= Names.Table (1).Name + and then Name_Of (The_Package, In_Tree) /= + Names.Table (1).Name loop - The_Package := Next_Package_In_Project (The_Package); + The_Package := + Next_Package_In_Project (The_Package, In_Tree); end loop; -- Now look for a possible project name The_Project := Imported_Or_Extended_Project_Of - (Current_Project, Names.Table (1).Name); + (Current_Project, In_Tree, Names.Table (1).Name); if The_Project /= Empty_Node then Specified_Project := The_Project; @@ -874,7 +925,8 @@ package body Prj.Strt is -- made of several simple names, or a project name followed -- by a package name. - Set_Name_Of (Variable, To => Names.Table (Names.Last).Name); + Set_Name_Of + (Variable, In_Tree, To => Names.Table (Names.Last).Name); declare Short_Project : Name_Id; @@ -891,10 +943,11 @@ package body Prj.Strt is for Index in 1 .. Names.Last - 2 loop Add_To_Buffer - (Get_Name_String (Names.Table (Index).Name)); + (Get_Name_String (Names.Table (Index).Name), + Buffer, Buffer_Last); if Index /= Names.Last - 2 then - Add_To_Buffer ("."); + Add_To_Buffer (".", Buffer, Buffer_Last); end if; end loop; @@ -904,9 +957,10 @@ package body Prj.Strt is -- Add the simple name before the name of the variable - Add_To_Buffer ("."); + Add_To_Buffer (".", Buffer, Buffer_Last); Add_To_Buffer - (Get_Name_String (Names.Table (Names.Last - 1).Name)); + (Get_Name_String (Names.Table (Names.Last - 1).Name), + Buffer, Buffer_Last); Name_Len := Buffer_Last; Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last); Long_Project := Name_Find; @@ -915,7 +969,7 @@ package body Prj.Strt is -- extended project. The_Project := Imported_Or_Extended_Project_Of - (Current_Project, Long_Project); + (Current_Project, In_Tree, Long_Project); if The_Project /= Empty_Node then Specified_Project := The_Project; @@ -927,7 +981,7 @@ package body Prj.Strt is -- First check for a possible project name The_Project := Imported_Or_Extended_Project_Of - (Current_Project, Short_Project); + (Current_Project, In_Tree, Short_Project); if The_Project = Empty_Node then -- Unknown prefix, report an error @@ -943,14 +997,14 @@ package body Prj.Strt is -- Now look for the package in this project - The_Package := First_Package_Of (The_Project); + The_Package := First_Package_Of (The_Project, In_Tree); while The_Package /= Empty_Node - and then Name_Of (The_Package) /= + and then Name_Of (The_Package, In_Tree) /= Names.Table (Names.Last - 1).Name loop The_Package := - Next_Package_In_Project (The_Package); + Next_Package_In_Project (The_Package, In_Tree); end loop; if The_Package = Empty_Node then @@ -971,9 +1025,9 @@ package body Prj.Strt is end if; if Look_For_Variable then - Variable_Name := Name_Of (Variable); - Set_Project_Node_Of (Variable, To => Specified_Project); - Set_Package_Node_Of (Variable, To => Specified_Package); + Variable_Name := Name_Of (Variable, In_Tree); + Set_Project_Node_Of (Variable, In_Tree, To => Specified_Project); + Set_Package_Node_Of (Variable, In_Tree, To => Specified_Package); if Specified_Project /= Empty_Node then The_Project := Specified_Project; @@ -990,13 +1044,14 @@ package body Prj.Strt is -- declared in this package. if Specified_Package /= Empty_Node then - Current_Variable := First_Variable_Of (Specified_Package); + Current_Variable := + First_Variable_Of (Specified_Package, In_Tree); while Current_Variable /= Empty_Node and then - Name_Of (Current_Variable) /= Variable_Name + Name_Of (Current_Variable, In_Tree) /= Variable_Name loop - Current_Variable := Next_Variable (Current_Variable); + Current_Variable := Next_Variable (Current_Variable, In_Tree); end loop; else @@ -1007,12 +1062,14 @@ package body Prj.Strt is if Specified_Project = Empty_Node and then Current_Package /= Empty_Node then - Current_Variable := First_Variable_Of (Current_Package); + Current_Variable := + First_Variable_Of (Current_Package, In_Tree); while Current_Variable /= Empty_Node - and then Name_Of (Current_Variable) /= Variable_Name + and then Name_Of (Current_Variable, In_Tree) /= Variable_Name loop - Current_Variable := Next_Variable (Current_Variable); + Current_Variable := + Next_Variable (Current_Variable, In_Tree); end loop; end if; @@ -1020,12 +1077,13 @@ package body Prj.Strt is -- variable has been declared in the project. if Current_Variable = Empty_Node then - Current_Variable := First_Variable_Of (The_Project); + Current_Variable := First_Variable_Of (The_Project, In_Tree); while Current_Variable /= Empty_Node - and then Name_Of (Current_Variable) /= Variable_Name + and then Name_Of (Current_Variable, In_Tree) /= Variable_Name loop - Current_Variable := Next_Variable (Current_Variable); + Current_Variable := + Next_Variable (Current_Variable, In_Tree); end loop; end if; end if; @@ -1041,11 +1099,15 @@ package body Prj.Strt is if Current_Variable /= Empty_Node then Set_Expression_Kind_Of - (Variable, To => Expression_Kind_Of (Current_Variable)); + (Variable, In_Tree, + To => Expression_Kind_Of (Current_Variable, In_Tree)); - if Kind_Of (Current_Variable) = N_Typed_Variable_Declaration then + if + Kind_Of (Current_Variable, In_Tree) = N_Typed_Variable_Declaration + then Set_String_Type_Of - (Variable, To => String_Type_Of (Current_Variable)); + (Variable, In_Tree, + To => String_Type_Of (Current_Variable, In_Tree)); end if; end if; @@ -1054,15 +1116,15 @@ package body Prj.Strt is if Token = Tok_Left_Paren then Error_Msg ("\variables cannot be associative arrays", Token_Ptr); - Scan; + Scan (In_Tree); Expect (Tok_String_Literal, "literal string"); if Token = Tok_String_Literal then - Scan; + Scan (In_Tree); Expect (Tok_Right_Paren, "`)`"); if Token = Tok_Right_Paren then - Scan; + Scan (In_Tree); end if; end if; end if; @@ -1072,7 +1134,10 @@ package body Prj.Strt is -- Start_New_Case_Construction -- --------------------------------- - procedure Start_New_Case_Construction (String_Type : Project_Node_Id) is + procedure Start_New_Case_Construction + (In_Tree : Project_Node_Tree_Ref; + String_Type : Project_Node_Id) + is Current_String : Project_Node_Id; begin @@ -1089,11 +1154,11 @@ package body Prj.Strt is -- Add to table Choices the literal of the string type if String_Type /= Empty_Node then - Current_String := First_Literal_String (String_Type); + Current_String := First_Literal_String (String_Type, In_Tree); while Current_String /= Empty_Node loop - Add (This_String => String_Value_Of (Current_String)); - Current_String := Next_Literal_String (Current_String); + Add (This_String => String_Value_Of (Current_String, In_Tree)); + Current_String := Next_Literal_String (Current_String, In_Tree); end loop; end if; @@ -1109,7 +1174,8 @@ package body Prj.Strt is ----------- procedure Terms - (Term : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Term : out Project_Node_Id; Expr_Kind : in out Variable_Kind; Current_Project : Project_Node_Id; Current_Package : Project_Node_Id; @@ -1125,8 +1191,8 @@ package body Prj.Strt is begin -- Declare a new node for the term - Term := Default_Project_Node (Of_Kind => N_Term); - Set_Location_Of (Term, To => Token_Ptr); + Term := Default_Project_Node (Of_Kind => N_Term, In_Tree => In_Tree); + Set_Location_Of (Term, In_Tree, To => Token_Ptr); case Token is when Tok_Left_Paren => @@ -1156,20 +1222,21 @@ package body Prj.Strt is -- Declare a new node for this literal string list Term_Id := Default_Project_Node - (Of_Kind => N_Literal_String_List, + (Of_Kind => N_Literal_String_List, + In_Tree => In_Tree, And_Expr_Kind => List); - Set_Current_Term (Term, To => Term_Id); - Set_Location_Of (Term, To => Token_Ptr); + Set_Current_Term (Term, In_Tree, To => Term_Id); + Set_Location_Of (Term, In_Tree, To => Token_Ptr); -- Scan past the left parenthesis - Scan; + Scan (In_Tree); -- If the left parenthesis is immediately followed by a right -- parenthesis, the literal string list is empty. if Token = Tok_Right_Paren then - Scan; + Scan (In_Tree); else -- Otherwise, we parse the expression(s) in the literal string @@ -1177,14 +1244,16 @@ package body Prj.Strt is loop Current_Location := Token_Ptr; - Parse_Expression (Expression => Next_Expression, - Current_Project => Current_Project, - Current_Package => Current_Package, - Optional_Index => Optional_Index); + Parse_Expression + (In_Tree => In_Tree, + Expression => Next_Expression, + Current_Project => Current_Project, + Current_Package => Current_Package, + Optional_Index => Optional_Index); -- The expression kind is String list, report an error - if Expression_Kind_Of (Next_Expression) = List then + if Expression_Kind_Of (Next_Expression, In_Tree) = List then Error_Msg ("single expression expected", Current_Location); end if; @@ -1194,10 +1263,10 @@ package body Prj.Strt is if Current_Expression = Empty_Node then Set_First_Expression_In_List - (Term_Id, To => Next_Expression); + (Term_Id, In_Tree, To => Next_Expression); else Set_Next_Expression_In_List - (Current_Expression, To => Next_Expression); + (Current_Expression, In_Tree, To => Next_Expression); end if; Current_Expression := Next_Expression; @@ -1205,7 +1274,7 @@ package body Prj.Strt is -- If there is a comma, continue with the next expression exit when Token /= Tok_Comma; - Scan; -- past the comma + Scan (In_Tree); -- past the comma end loop; -- We expect a closing right parenthesis @@ -1213,7 +1282,7 @@ package body Prj.Strt is Expect (Tok_Right_Paren, "`)`"); if Token = Tok_Right_Paren then - Scan; + Scan (In_Tree); end if; end if; @@ -1228,29 +1297,31 @@ package body Prj.Strt is -- Declare a new node for the string literal - Term_Id := Default_Project_Node (Of_Kind => N_Literal_String); - Set_Current_Term (Term, To => Term_Id); - Set_String_Value_Of (Term_Id, To => Token_Name); + Term_Id := + Default_Project_Node + (Of_Kind => N_Literal_String, In_Tree => In_Tree); + Set_Current_Term (Term, In_Tree, To => Term_Id); + Set_String_Value_Of (Term_Id, In_Tree, To => Token_Name); -- Scan past the string literal - Scan; + Scan (In_Tree); -- Check for possible index expression if Token = Tok_At then if not Optional_Index then Error_Msg ("index not allowed here", Token_Ptr); - Scan; + Scan (In_Tree); if Token = Tok_Integer_Literal then - Scan; + Scan (In_Tree); end if; -- Set the index value else - Scan; + Scan (In_Tree); Expect (Tok_Integer_Literal, "integer literal"); if Token = Tok_Integer_Literal then @@ -1260,11 +1331,12 @@ package body Prj.Strt is if Index = 0 then Error_Msg ("index cannot be zero", Token_Ptr); else - Set_Source_Index_Of (Term_Id, To => Index); + Set_Source_Index_Of + (Term_Id, In_Tree, To => Index); end if; end; - Scan; + Scan (In_Tree); end if; end if; end if; @@ -1275,10 +1347,11 @@ package body Prj.Strt is -- Get the variable or attribute reference Parse_Variable_Reference - (Variable => Reference, + (In_Tree => In_Tree, + Variable => Reference, Current_Project => Current_Project, Current_Package => Current_Package); - Set_Current_Term (Term, To => Reference); + Set_Current_Term (Term, In_Tree, To => Reference); if Reference /= Empty_Node then @@ -1286,10 +1359,10 @@ package body Prj.Strt is -- has the kind of the variable or attribute reference. if Expr_Kind = Undefined then - Expr_Kind := Expression_Kind_Of (Reference); + Expr_Kind := Expression_Kind_Of (Reference, In_Tree); elsif Expr_Kind = Single - and then Expression_Kind_Of (Reference) = List + and then Expression_Kind_Of (Reference, In_Tree) = List then -- If the expression is a single list, and the reference is -- a string list, report an error, and set the expression @@ -1308,26 +1381,27 @@ package body Prj.Strt is -- attribute reference of the current project. Current_Location := Token_Ptr; - Scan; + Scan (In_Tree); Expect (Tok_Apostrophe, "`'`"); if Token = Tok_Apostrophe then Attribute_Reference - (Reference => Reference, + (In_Tree => In_Tree, + Reference => Reference, First_Attribute => Prj.Attr.Attribute_First, Current_Project => Current_Project, Current_Package => Empty_Node); - Set_Current_Term (Term, To => Reference); + Set_Current_Term (Term, In_Tree, To => Reference); end if; -- Same checks as above for the expression kind if Reference /= Empty_Node then if Expr_Kind = Undefined then - Expr_Kind := Expression_Kind_Of (Reference); + Expr_Kind := Expression_Kind_Of (Reference, In_Tree); elsif Expr_Kind = Single - and then Expression_Kind_Of (Reference) = List + and then Expression_Kind_Of (Reference, In_Tree) = List then Error_Msg ("lists cannot appear in single string expression", @@ -1342,8 +1416,9 @@ package body Prj.Strt is Expr_Kind := Single; end if; - External_Reference (External_Value => Reference); - Set_Current_Term (Term, To => Reference); + External_Reference + (In_Tree => In_Tree, External_Value => Reference); + Set_Current_Term (Term, In_Tree, To => Reference); when others => Error_Msg ("cannot be part of an expression", Token_Ptr); @@ -1357,17 +1432,19 @@ package body Prj.Strt is -- Scan past the '&' - Scan; + Scan (In_Tree); - Terms (Term => Next_Term, - Expr_Kind => Expr_Kind, - Current_Project => Current_Project, - Current_Package => Current_Package, - Optional_Index => Optional_Index); + Terms + (In_Tree => In_Tree, + Term => Next_Term, + Expr_Kind => Expr_Kind, + Current_Project => Current_Project, + Current_Package => Current_Package, + Optional_Index => Optional_Index); -- And link the next term to this term - Set_Next_Term (Term, To => Next_Term); + Set_Next_Term (Term, In_Tree, To => Next_Term); end if; end Terms; diff --git a/gcc/ada/prj-strt.ads b/gcc/ada/prj-strt.ads index 612a3984d27..623c5bf16f6 100644 --- a/gcc/ada/prj-strt.ads +++ b/gcc/ada/prj-strt.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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- -- @@ -30,7 +30,9 @@ with Prj.Tree; use Prj.Tree; private package Prj.Strt is - procedure Parse_String_Type_List (First_String : out Project_Node_Id); + procedure Parse_String_Type_List + (In_Tree : Project_Node_Tree_Ref; + First_String : out Project_Node_Id); -- Get the list of literal strings that are allowed for a typed string. -- On entry, the current token is the first literal string following -- a left parenthesis in a string type declaration such as: @@ -45,7 +47,9 @@ private package Prj.Strt is -- or after a comma -- - two literal strings in the list are equal - procedure Start_New_Case_Construction (String_Type : Project_Node_Id); + procedure Start_New_Case_Construction + (In_Tree : Project_Node_Tree_Ref; + String_Type : Project_Node_Id); -- This procedure is called at the beginning of a case construction -- The parameter String_Type is the node for the string type -- of the case label variable. @@ -65,7 +69,8 @@ private package Prj.Strt is -- not been specified. procedure Parse_Choice_List - (First_Choice : out Project_Node_Id); + (In_Tree : Project_Node_Tree_Ref; + First_Choice : out Project_Node_Id); -- Get the label for a choice list. -- Report an error if -- - a case label is not a literal string @@ -73,7 +78,8 @@ private package Prj.Strt is -- - the same case label is repeated in the same case construction procedure Parse_Expression - (Expression : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Expression : out Project_Node_Id; Current_Project : Project_Node_Id; Current_Package : Project_Node_Id; Optional_Index : Boolean); @@ -85,7 +91,8 @@ private package Prj.Strt is -- been parsed. procedure Parse_Variable_Reference - (Variable : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Variable : out Project_Node_Id; Current_Project : Project_Node_Id; Current_Package : Project_Node_Id); -- Parse a variable or attribute reference. diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index 2a67b57c5b1..de210e1edb7 100644 --- a/gcc/ada/prj-tree.adb +++ b/gcc/ada/prj-tree.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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- -- @@ -76,7 +76,8 @@ package body Prj.Tree is -- Set to True when some comments may not be associated with any node function Comment_Zones_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; -- Returns the ID of the N_Comment_Zones node associated with node Node. -- If there is not already an N_Comment_Zones node, create one and -- associate it with node Node. @@ -85,7 +86,10 @@ package body Prj.Tree is -- Add_Comments -- ------------------ - procedure Add_Comments (To : Project_Node_Id; Where : Comment_Location) is + procedure Add_Comments + (To : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + Where : Comment_Location) is Zone : Project_Node_Id := Empty_Node; Previous : Project_Node_Id := Empty_Node; @@ -93,16 +97,17 @@ package body Prj.Tree is pragma Assert (To /= Empty_Node and then - Project_Nodes.Table (To).Kind /= N_Comment); + In_Tree.Project_Nodes.Table (To).Kind /= N_Comment); - Zone := Project_Nodes.Table (To).Comments; + Zone := In_Tree.Project_Nodes.Table (To).Comments; if Zone = Empty_Node then -- Create new N_Comment_Zones node - Project_Nodes.Increment_Last; - Project_Nodes.Table (Project_Nodes.Last) := + Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); + In_Tree.Project_Nodes.Table + (Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Kind => N_Comment_Zones, Expr_Kind => Undefined, Location => No_Location, @@ -121,12 +126,12 @@ package body Prj.Tree is Flag2 => False, Comments => Empty_Node); - Zone := Project_Nodes.Last; - Project_Nodes.Table (To).Comments := Zone; + Zone := Project_Node_Table.Last (In_Tree.Project_Nodes); + In_Tree.Project_Nodes.Table (To).Comments := Zone; end if; if Where = End_Of_Line then - Project_Nodes.Table (Zone).Value := Comments.Table (1).Value; + In_Tree.Project_Nodes.Table (Zone).Value := Comments.Table (1).Value; else -- Get each comments in the Comments table and link them to node To @@ -145,8 +150,9 @@ package body Prj.Tree is return; end if; - Project_Nodes.Increment_Last; - Project_Nodes.Table (Project_Nodes.Last) := + Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); + In_Tree.Project_Nodes.Table + (Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Kind => N_Comment, Expr_Kind => Undefined, Flag1 => Comments.Table (J).Follows_Empty_Line, @@ -172,16 +178,20 @@ package body Prj.Tree is if Previous = Empty_Node then case Where is when Before => - Project_Nodes.Table (Zone).Field1 := Project_Nodes.Last; + In_Tree.Project_Nodes.Table (Zone).Field1 := + Project_Node_Table.Last (In_Tree.Project_Nodes); when After => - Project_Nodes.Table (Zone).Field2 := Project_Nodes.Last; + In_Tree.Project_Nodes.Table (Zone).Field2 := + Project_Node_Table.Last (In_Tree.Project_Nodes); when Before_End => - Project_Nodes.Table (Zone).Field3 := Project_Nodes.Last; + In_Tree.Project_Nodes.Table (Zone).Field3 := + Project_Node_Table.Last (In_Tree.Project_Nodes); when After_End => - Project_Nodes.Table (Zone).Comments := Project_Nodes.Last; + In_Tree.Project_Nodes.Table (Zone).Comments := + Project_Node_Table.Last (In_Tree.Project_Nodes); when End_Of_Line => null; @@ -190,13 +200,14 @@ package body Prj.Tree is else -- When it is not the first, link it to the previous one - Project_Nodes.Table (Previous).Comments := Project_Nodes.Last; + In_Tree.Project_Nodes.Table (Previous).Comments := + Project_Node_Table.Last (In_Tree.Project_Nodes); end if; -- This node becomes the previous one for the next comment, if -- there is one. - Previous := Project_Nodes.Last; + Previous := Project_Node_Table.Last (In_Tree.Project_Nodes); end loop; end if; @@ -211,16 +222,17 @@ package body Prj.Tree is -------------------------------- function Associative_Array_Index_Of - (Node : Project_Node_Id) return Name_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Name_Id is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration + (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration or else - Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); - return Project_Nodes.Table (Node).Value; + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); + return In_Tree.Project_Nodes.Table (Node).Value; end Associative_Array_Index_Of; ---------------------------- @@ -228,14 +240,15 @@ package body Prj.Tree is ---------------------------- function Associative_Package_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); - return Project_Nodes.Table (Node).Field3; + (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); + return In_Tree.Project_Nodes.Table (Node).Field3; end Associative_Package_Of; ---------------------------- @@ -243,29 +256,32 @@ package body Prj.Tree is ---------------------------- function Associative_Project_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); - return Project_Nodes.Table (Node).Field2; + (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); + return In_Tree.Project_Nodes.Table (Node).Field2; end Associative_Project_Of; ---------------------- -- Case_Insensitive -- ---------------------- - function Case_Insensitive (Node : Project_Node_Id) return Boolean is + function Case_Insensitive + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Boolean is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration + (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration or else - Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); - return Project_Nodes.Table (Node).Flag1; + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); + return In_Tree.Project_Nodes.Table (Node).Flag1; end Case_Insensitive; -------------------------------- @@ -273,14 +289,15 @@ package body Prj.Tree is -------------------------------- function Case_Variable_Reference_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Case_Construction); - return Project_Nodes.Table (Node).Field1; + In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction); + return In_Tree.Project_Nodes.Table (Node).Field1; end Case_Variable_Reference_Of; ---------------------- @@ -288,21 +305,22 @@ package body Prj.Tree is ---------------------- function Comment_Zones_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is Zone : Project_Node_Id; begin pragma Assert (Node /= Empty_Node); - Zone := Project_Nodes.Table (Node).Comments; + Zone := In_Tree.Project_Nodes.Table (Node).Comments; -- If there is not already an N_Comment_Zones associated, create a new -- one and associate it with node Node. if Zone = Empty_Node then - Project_Nodes.Increment_Last; - Zone := Project_Nodes.Last; - Project_Nodes.Table (Zone) := + Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); + Zone := Project_Node_Table.Last (In_Tree.Project_Nodes); + In_Tree.Project_Nodes.Table (Zone) := (Kind => N_Comment_Zones, Location => No_Location, Directory => No_Name, @@ -320,7 +338,7 @@ package body Prj.Tree is Flag1 => False, Flag2 => False, Comments => Empty_Node); - Project_Nodes.Table (Node).Comments := Zone; + In_Tree.Project_Nodes.Table (Node).Comments := Zone; end if; return Zone; @@ -331,14 +349,15 @@ package body Prj.Tree is ----------------------- function Current_Item_Node - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Declarative_Item); - return Project_Nodes.Table (Node).Field1; + In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item); + return In_Tree.Project_Nodes.Table (Node).Field1; end Current_Item_Node; ------------------ @@ -346,14 +365,15 @@ package body Prj.Tree is ------------------ function Current_Term - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Term); - return Project_Nodes.Table (Node).Field1; + In_Tree.Project_Nodes.Table (Node).Kind = N_Term); + return In_Tree.Project_Nodes.Table (Node).Field1; end Current_Term; -------------------------- @@ -361,7 +381,8 @@ package body Prj.Tree is -------------------------- function Default_Project_Node - (Of_Kind : Project_Node_Kind; + (In_Tree : Project_Node_Tree_Ref; + Of_Kind : Project_Node_Kind; And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id is Result : Project_Node_Id; @@ -371,8 +392,9 @@ package body Prj.Tree is begin -- Create new node with specified kind and expression kind - Project_Nodes.Increment_Last; - Project_Nodes.Table (Project_Nodes.Last) := + Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); + In_Tree.Project_Nodes.Table + (Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Kind => Of_Kind, Location => No_Location, Directory => No_Name, @@ -393,7 +415,7 @@ package body Prj.Tree is -- Save the new node for the returned value - Result := Project_Nodes.Last; + Result := Project_Node_Table.Last (In_Tree.Project_Nodes); if Comments.Last > 0 then @@ -404,8 +426,9 @@ package body Prj.Tree is elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then - Project_Nodes.Increment_Last; - Project_Nodes.Table (Project_Nodes.Last) := + Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); + In_Tree.Project_Nodes.Table + (Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Kind => N_Comment_Zones, Expr_Kind => Undefined, Location => No_Location, @@ -424,16 +447,17 @@ package body Prj.Tree is Flag2 => False, Comments => Empty_Node); - Zone := Project_Nodes.Last; - Project_Nodes.Table (Result).Comments := Zone; + Zone := Project_Node_Table.Last (In_Tree.Project_Nodes); + In_Tree.Project_Nodes.Table (Result).Comments := Zone; Previous := Empty_Node; for J in 1 .. Comments.Last loop -- Create a new N_Comment node - Project_Nodes.Increment_Last; - Project_Nodes.Table (Project_Nodes.Last) := + Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); + In_Tree.Project_Nodes.Table + (Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Kind => N_Comment, Expr_Kind => Undefined, Flag1 => Comments.Table (J).Follows_Empty_Line, @@ -457,17 +481,18 @@ package body Prj.Tree is -- otherwise to the previous one. if Previous = Empty_Node then - Project_Nodes.Table (Zone).Field1 := Project_Nodes.Last; + In_Tree.Project_Nodes.Table (Zone).Field1 := + Project_Node_Table.Last (In_Tree.Project_Nodes); else - Project_Nodes.Table (Previous).Comments := - Project_Nodes.Last; + In_Tree.Project_Nodes.Table (Previous).Comments := + Project_Node_Table.Last (In_Tree.Project_Nodes); end if; -- This new node will be the previous one for the next -- N_Comment node, if there is one. - Previous := Project_Nodes.Last; + Previous := Project_Node_Table.Last (In_Tree.Project_Nodes); end loop; -- Empty the Comments table after all comments have been processed @@ -483,30 +508,34 @@ package body Prj.Tree is -- Directory_Of -- ------------------ - function Directory_Of (Node : Project_Node_Id) return Name_Id is + function Directory_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Name_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Project); - return Project_Nodes.Table (Node).Directory; + In_Tree.Project_Nodes.Table (Node).Kind = N_Project); + return In_Tree.Project_Nodes.Table (Node).Directory; end Directory_Of; ------------------------- -- End_Of_Line_Comment -- ------------------------- - function End_Of_Line_Comment (Node : Project_Node_Id) return Name_Id is + function End_Of_Line_Comment + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Name_Id is Zone : Project_Node_Id := Empty_Node; begin pragma Assert (Node /= Empty_Node); - Zone := Project_Nodes.Table (Node).Comments; + Zone := In_Tree.Project_Nodes.Table (Node).Comments; if Zone = Empty_Node then return No_Name; else - return Project_Nodes.Table (Zone).Value; + return In_Tree.Project_Nodes.Table (Zone).Value; end if; end End_Of_Line_Comment; @@ -514,30 +543,34 @@ package body Prj.Tree is -- Expression_Kind_Of -- ------------------------ - function Expression_Kind_Of (Node : Project_Node_Id) return Variable_Kind is + function Expression_Kind_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Variable_Kind is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Literal_String + (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String or else - Project_Nodes.Table (Node).Kind = N_Attribute_Declaration + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration or else - Project_Nodes.Table (Node).Kind = N_Variable_Declaration + In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration or else - Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration + In_Tree.Project_Nodes.Table (Node).Kind = + N_Typed_Variable_Declaration or else - Project_Nodes.Table (Node).Kind = N_Package_Declaration + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration or else - Project_Nodes.Table (Node).Kind = N_Expression + In_Tree.Project_Nodes.Table (Node).Kind = N_Expression or else - Project_Nodes.Table (Node).Kind = N_Term + In_Tree.Project_Nodes.Table (Node).Kind = N_Term or else - Project_Nodes.Table (Node).Kind = N_Variable_Reference + In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference or else - Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); + In_Tree.Project_Nodes.Table (Node).Kind = + N_Attribute_Reference)); - return Project_Nodes.Table (Node).Expr_Kind; + return In_Tree.Project_Nodes.Table (Node).Expr_Kind; end Expression_Kind_Of; ------------------- @@ -545,19 +578,23 @@ package body Prj.Tree is ------------------- function Expression_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration + (In_Tree.Project_Nodes.Table (Node).Kind = + N_Attribute_Declaration or else - Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration + In_Tree.Project_Nodes.Table (Node).Kind = + N_Typed_Variable_Declaration or else - Project_Nodes.Table (Node).Kind = N_Variable_Declaration)); + In_Tree.Project_Nodes.Table (Node).Kind = + N_Variable_Declaration)); - return Project_Nodes.Table (Node).Field1; + return In_Tree.Project_Nodes.Table (Node).Field1; end Expression_Of; ------------------------- @@ -565,14 +602,15 @@ package body Prj.Tree is ------------------------- function Extended_Project_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Project_Declaration); - return Project_Nodes.Table (Node).Field2; + In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration); + return In_Tree.Project_Nodes.Table (Node).Field2; end Extended_Project_Of; ------------------------------ @@ -580,28 +618,30 @@ package body Prj.Tree is ------------------------------ function Extended_Project_Path_Of - (Node : Project_Node_Id) return Name_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Name_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Project); - return Project_Nodes.Table (Node).Value; + In_Tree.Project_Nodes.Table (Node).Kind = N_Project); + return In_Tree.Project_Nodes.Table (Node).Value; end Extended_Project_Path_Of; -------------------------- -- Extending_Project_Of -- -------------------------- function Extending_Project_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Project_Declaration); - return Project_Nodes.Table (Node).Field3; + In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration); + return In_Tree.Project_Nodes.Table (Node).Field3; end Extending_Project_Of; --------------------------- @@ -609,14 +649,15 @@ package body Prj.Tree is --------------------------- function External_Reference_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_External_Value); - return Project_Nodes.Table (Node).Field1; + In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value); + return In_Tree.Project_Nodes.Table (Node).Field1; end External_Reference_Of; ------------------------- @@ -624,15 +665,16 @@ package body Prj.Tree is ------------------------- function External_Default_Of - (Node : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_External_Value); - return Project_Nodes.Table (Node).Field2; + In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value); + return In_Tree.Project_Nodes.Table (Node).Field2; end External_Default_Of; ------------------------ @@ -640,14 +682,15 @@ package body Prj.Tree is ------------------------ function First_Case_Item_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Case_Construction); - return Project_Nodes.Table (Node).Field2; + In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction); + return In_Tree.Project_Nodes.Table (Node).Field2; end First_Case_Item_Of; --------------------- @@ -655,15 +698,16 @@ package body Prj.Tree is --------------------- function First_Choice_Of - (Node : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Case_Item); - return Project_Nodes.Table (Node).Field1; + In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item); + return In_Tree.Project_Nodes.Table (Node).Field1; end First_Choice_Of; ------------------------- @@ -671,18 +715,19 @@ package body Prj.Tree is ------------------------- function First_Comment_After - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is Zone : Project_Node_Id := Empty_Node; begin pragma Assert (Node /= Empty_Node); - Zone := Project_Nodes.Table (Node).Comments; + Zone := In_Tree.Project_Nodes.Table (Node).Comments; if Zone = Empty_Node then return Empty_Node; else - return Project_Nodes.Table (Zone).Field2; + return In_Tree.Project_Nodes.Table (Zone).Field2; end if; end First_Comment_After; @@ -691,20 +736,21 @@ package body Prj.Tree is ----------------------------- function First_Comment_After_End - (Node : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is Zone : Project_Node_Id := Empty_Node; begin pragma Assert (Node /= Empty_Node); - Zone := Project_Nodes.Table (Node).Comments; + Zone := In_Tree.Project_Nodes.Table (Node).Comments; if Zone = Empty_Node then return Empty_Node; else - return Project_Nodes.Table (Zone).Comments; + return In_Tree.Project_Nodes.Table (Zone).Comments; end if; end First_Comment_After_End; @@ -713,19 +759,20 @@ package body Prj.Tree is -------------------------- function First_Comment_Before - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is Zone : Project_Node_Id := Empty_Node; begin pragma Assert (Node /= Empty_Node); - Zone := Project_Nodes.Table (Node).Comments; + Zone := In_Tree.Project_Nodes.Table (Node).Comments; if Zone = Empty_Node then return Empty_Node; else - return Project_Nodes.Table (Zone).Field1; + return In_Tree.Project_Nodes.Table (Zone).Field1; end if; end First_Comment_Before; @@ -734,19 +781,20 @@ package body Prj.Tree is ------------------------------ function First_Comment_Before_End - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is Zone : Project_Node_Id := Empty_Node; begin pragma Assert (Node /= Empty_Node); - Zone := Project_Nodes.Table (Node).Comments; + Zone := In_Tree.Project_Nodes.Table (Node).Comments; if Zone = Empty_Node then return Empty_Node; else - return Project_Nodes.Table (Zone).Field3; + return In_Tree.Project_Nodes.Table (Zone).Field3; end if; end First_Comment_Before_End; @@ -755,22 +803,23 @@ package body Prj.Tree is ------------------------------- function First_Declarative_Item_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Project_Declaration + (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration or else - Project_Nodes.Table (Node).Kind = N_Case_Item + In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item or else - Project_Nodes.Table (Node).Kind = N_Package_Declaration)); + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration)); - if Project_Nodes.Table (Node).Kind = N_Project_Declaration then - return Project_Nodes.Table (Node).Field1; + if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then + return In_Tree.Project_Nodes.Table (Node).Field1; else - return Project_Nodes.Table (Node).Field2; + return In_Tree.Project_Nodes.Table (Node).Field2; end if; end First_Declarative_Item_Of; @@ -779,14 +828,15 @@ package body Prj.Tree is ------------------------------ function First_Expression_In_List - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Literal_String_List); - return Project_Nodes.Table (Node).Field1; + In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List); + return In_Tree.Project_Nodes.Table (Node).Field1; end First_Expression_In_List; -------------------------- @@ -794,14 +844,16 @@ package body Prj.Tree is -------------------------- function First_Literal_String - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_String_Type_Declaration); - return Project_Nodes.Table (Node).Field1; + In_Tree.Project_Nodes.Table (Node).Kind = + N_String_Type_Declaration); + return In_Tree.Project_Nodes.Table (Node).Field1; end First_Literal_String; ---------------------- @@ -809,14 +861,15 @@ package body Prj.Tree is ---------------------- function First_Package_Of - (Node : Project_Node_Id) return Package_Declaration_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Project); - return Project_Nodes.Table (Node).Packages; + In_Tree.Project_Nodes.Table (Node).Kind = N_Project); + return In_Tree.Project_Nodes.Table (Node).Packages; end First_Package_Of; -------------------------- @@ -824,14 +877,15 @@ package body Prj.Tree is -------------------------- function First_String_Type_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Project); - return Project_Nodes.Table (Node).Field3; + In_Tree.Project_Nodes.Table (Node).Kind = N_Project); + return In_Tree.Project_Nodes.Table (Node).Field3; end First_String_Type_Of; ---------------- @@ -839,14 +893,15 @@ package body Prj.Tree is ---------------- function First_Term - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Expression); - return Project_Nodes.Table (Node).Field1; + In_Tree.Project_Nodes.Table (Node).Kind = N_Expression); + return In_Tree.Project_Nodes.Table (Node).Field1; end First_Term; ----------------------- @@ -854,17 +909,18 @@ package body Prj.Tree is ----------------------- function First_Variable_Of - (Node : Project_Node_Id) return Variable_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Project + (In_Tree.Project_Nodes.Table (Node).Kind = N_Project or else - Project_Nodes.Table (Node).Kind = N_Package_Declaration)); + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration)); - return Project_Nodes.Table (Node).Variables; + return In_Tree.Project_Nodes.Table (Node).Variables; end First_Variable_Of; -------------------------- @@ -872,27 +928,30 @@ package body Prj.Tree is -------------------------- function First_With_Clause_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Project); - return Project_Nodes.Table (Node).Field1; + In_Tree.Project_Nodes.Table (Node).Kind = N_Project); + return In_Tree.Project_Nodes.Table (Node).Field1; end First_With_Clause_Of; ------------------------ -- Follows_Empty_Line -- ------------------------ - function Follows_Empty_Line (Node : Project_Node_Id) return Boolean is + function Follows_Empty_Line + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Boolean is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Comment); - return Project_Nodes.Table (Node).Flag1; + In_Tree.Project_Nodes.Table (Node).Kind = N_Comment); + return In_Tree.Project_Nodes.Table (Node).Flag1; end Follows_Empty_Line; ---------- @@ -908,10 +967,10 @@ package body Prj.Tree is -- Initialize -- ---------------- - procedure Initialize is + procedure Initialize (Tree : Project_Node_Tree_Ref) is begin - Project_Nodes.Set_Last (Empty_Node); - Projects_Htable.Reset; + Project_Node_Table.Init (Tree.Project_Nodes); + Projects_Htable.Reset (Tree.Projects_HT); end Initialize; ------------------------------- @@ -919,29 +978,32 @@ package body Prj.Tree is ------------------------------- function Is_Followed_By_Empty_Line - (Node : Project_Node_Id) return Boolean + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Boolean is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Comment); - return Project_Nodes.Table (Node).Flag2; + In_Tree.Project_Nodes.Table (Node).Kind = N_Comment); + return In_Tree.Project_Nodes.Table (Node).Flag2; end Is_Followed_By_Empty_Line; ---------------------- -- Is_Extending_All -- ---------------------- - function Is_Extending_All (Node : Project_Node_Id) return Boolean is + function Is_Extending_All + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Boolean is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Project + (In_Tree.Project_Nodes.Table (Node).Kind = N_Project or else - Project_Nodes.Table (Node).Kind = N_With_Clause)); - return Project_Nodes.Table (Node).Flag2; + In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause)); + return In_Tree.Project_Nodes.Table (Node).Flag2; end Is_Extending_All; ------------------------------------- @@ -950,9 +1012,11 @@ package body Prj.Tree is function Imported_Or_Extended_Project_Of (Project : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; With_Name : Name_Id) return Project_Node_Id is - With_Clause : Project_Node_Id := First_With_Clause_Of (Project); + With_Clause : Project_Node_Id := + First_With_Clause_Of (Project, In_Tree); Result : Project_Node_Id := Empty_Node; begin @@ -963,18 +1027,21 @@ package body Prj.Tree is -- Only non limited imported project may be used as prefix -- of variable or attributes. - Result := Non_Limited_Project_Node_Of (With_Clause); - exit when Result /= Empty_Node and then Name_Of (Result) = With_Name; - With_Clause := Next_With_Clause_Of (With_Clause); + Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree); + exit when Result /= Empty_Node + and then Name_Of (Result, In_Tree) = With_Name; + With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); end loop; -- If it is not an imported project, it might be the imported project if With_Clause = Empty_Node then - Result := Extended_Project_Of (Project_Declaration_Of (Project)); + Result := + Extended_Project_Of + (Project_Declaration_Of (Project, In_Tree), In_Tree); if Result /= Empty_Node - and then Name_Of (Result) /= With_Name + and then Name_Of (Result, In_Tree) /= With_Name then Result := Empty_Node; end if; @@ -987,30 +1054,36 @@ package body Prj.Tree is -- Kind_Of -- ------------- - function Kind_Of (Node : Project_Node_Id) return Project_Node_Kind is + function Kind_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind is begin pragma Assert (Node /= Empty_Node); - return Project_Nodes.Table (Node).Kind; + return In_Tree.Project_Nodes.Table (Node).Kind; end Kind_Of; ----------------- -- Location_Of -- ----------------- - function Location_Of (Node : Project_Node_Id) return Source_Ptr is + function Location_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Source_Ptr is begin pragma Assert (Node /= Empty_Node); - return Project_Nodes.Table (Node).Location; + return In_Tree.Project_Nodes.Table (Node).Location; end Location_Of; ------------- -- Name_Of -- ------------- - function Name_Of (Node : Project_Node_Id) return Name_Id is + function Name_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Name_Id is begin pragma Assert (Node /= Empty_Node); - return Project_Nodes.Table (Node).Name; + return In_Tree.Project_Nodes.Table (Node).Name; end Name_Of; -------------------- @@ -1018,27 +1091,30 @@ package body Prj.Tree is -------------------- function Next_Case_Item - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Case_Item); - return Project_Nodes.Table (Node).Field3; + In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item); + return In_Tree.Project_Nodes.Table (Node).Field3; end Next_Case_Item; ------------------ -- Next_Comment -- ------------------ - function Next_Comment (Node : Project_Node_Id) return Project_Node_Id is + function Next_Comment + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Comment); - return Project_Nodes.Table (Node).Comments; + In_Tree.Project_Nodes.Table (Node).Kind = N_Comment); + return In_Tree.Project_Nodes.Table (Node).Comments; end Next_Comment; --------------------------- @@ -1046,14 +1122,15 @@ package body Prj.Tree is --------------------------- function Next_Declarative_Item - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Declarative_Item); - return Project_Nodes.Table (Node).Field2; + In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item); + return In_Tree.Project_Nodes.Table (Node).Field2; end Next_Declarative_Item; ----------------------------- @@ -1061,14 +1138,15 @@ package body Prj.Tree is ----------------------------- function Next_Expression_In_List - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Expression); - return Project_Nodes.Table (Node).Field2; + In_Tree.Project_Nodes.Table (Node).Kind = N_Expression); + return In_Tree.Project_Nodes.Table (Node).Field2; end Next_Expression_In_List; ------------------------- @@ -1076,15 +1154,16 @@ package body Prj.Tree is ------------------------- function Next_Literal_String - (Node : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Literal_String); - return Project_Nodes.Table (Node).Field1; + In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String); + return In_Tree.Project_Nodes.Table (Node).Field1; end Next_Literal_String; ----------------------------- @@ -1092,14 +1171,15 @@ package body Prj.Tree is ----------------------------- function Next_Package_In_Project - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Package_Declaration); - return Project_Nodes.Table (Node).Field3; + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); + return In_Tree.Project_Nodes.Table (Node).Field3; end Next_Package_In_Project; ---------------------- @@ -1107,15 +1187,17 @@ package body Prj.Tree is ---------------------- function Next_String_Type - (Node : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_String_Type_Declaration); - return Project_Nodes.Table (Node).Field2; + In_Tree.Project_Nodes.Table (Node).Kind = + N_String_Type_Declaration); + return In_Tree.Project_Nodes.Table (Node).Field2; end Next_String_Type; --------------- @@ -1123,14 +1205,15 @@ package body Prj.Tree is --------------- function Next_Term - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Term); - return Project_Nodes.Table (Node).Field2; + In_Tree.Project_Nodes.Table (Node).Kind = N_Term); + return In_Tree.Project_Nodes.Table (Node).Field2; end Next_Term; ------------------- @@ -1138,18 +1221,21 @@ package body Prj.Tree is ------------------- function Next_Variable - (Node : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration + (In_Tree.Project_Nodes.Table (Node).Kind = + N_Typed_Variable_Declaration or else - Project_Nodes.Table (Node).Kind = N_Variable_Declaration)); + In_Tree.Project_Nodes.Table (Node).Kind = + N_Variable_Declaration)); - return Project_Nodes.Table (Node).Field3; + return In_Tree.Project_Nodes.Table (Node).Field3; end Next_Variable; ------------------------- @@ -1157,14 +1243,15 @@ package body Prj.Tree is ------------------------- function Next_With_Clause_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_With_Clause); - return Project_Nodes.Table (Node).Field2; + In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause); + return In_Tree.Project_Nodes.Table (Node).Field2; end Next_With_Clause_Of; --------------------------------- @@ -1172,27 +1259,31 @@ package body Prj.Tree is --------------------------------- function Non_Limited_Project_Node_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_With_Clause)); - return Project_Nodes.Table (Node).Field3; + (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause)); + return In_Tree.Project_Nodes.Table (Node).Field3; end Non_Limited_Project_Node_Of; ------------------- -- Package_Id_Of -- ------------------- - function Package_Id_Of (Node : Project_Node_Id) return Package_Node_Id is + function Package_Id_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Package_Node_Id + is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Package_Declaration); - return Project_Nodes.Table (Node).Pkg_Id; + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); + return In_Tree.Project_Nodes.Table (Node).Pkg_Id; end Package_Id_Of; --------------------- @@ -1200,31 +1291,35 @@ package body Prj.Tree is --------------------- function Package_Node_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Variable_Reference + (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference or else - Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); - return Project_Nodes.Table (Node).Field2; + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); + return In_Tree.Project_Nodes.Table (Node).Field2; end Package_Node_Of; ------------------ -- Path_Name_Of -- ------------------ - function Path_Name_Of (Node : Project_Node_Id) return Name_Id is + function Path_Name_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Name_Id + is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Project + (In_Tree.Project_Nodes.Table (Node).Kind = N_Project or else - Project_Nodes.Table (Node).Kind = N_With_Clause)); - return Project_Nodes.Table (Node).Path_Name; + In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause)); + return In_Tree.Project_Nodes.Table (Node).Path_Name; end Path_Name_Of; ---------------------------- @@ -1232,14 +1327,15 @@ package body Prj.Tree is ---------------------------- function Project_Declaration_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Project); - return Project_Nodes.Table (Node).Field2; + In_Tree.Project_Nodes.Table (Node).Kind = N_Project); + return In_Tree.Project_Nodes.Table (Node).Field2; end Project_Declaration_Of; ------------------------------------------- @@ -1247,11 +1343,13 @@ package body Prj.Tree is ------------------------------------------- function Project_File_Includes_Unkept_Comments - (Node : Project_Node_Id) return Boolean + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Boolean is - Declaration : constant Project_Node_Id := Project_Declaration_Of (Node); + Declaration : constant Project_Node_Id := + Project_Declaration_Of (Node, In_Tree); begin - return Project_Nodes.Table (Declaration).Flag1; + return In_Tree.Project_Nodes.Table (Declaration).Flag1; end Project_File_Includes_Unkept_Comments; --------------------- @@ -1259,18 +1357,19 @@ package body Prj.Tree is --------------------- function Project_Node_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_With_Clause + (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause or else - Project_Nodes.Table (Node).Kind = N_Variable_Reference + In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference or else - Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); - return Project_Nodes.Table (Node).Field1; + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); + return In_Tree.Project_Nodes.Table (Node).Field1; end Project_Node_Of; ----------------------------------- @@ -1278,14 +1377,15 @@ package body Prj.Tree is ----------------------------------- function Project_Of_Renamed_Package_Of - (Node : Project_Node_Id) return Project_Node_Id + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Package_Declaration); - return Project_Nodes.Table (Node).Field1; + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); + return In_Tree.Project_Nodes.Table (Node).Field1; end Project_Of_Renamed_Package_Of; -------------------------- @@ -1354,8 +1454,9 @@ package body Prj.Tree is -- Scan -- ---------- - procedure Scan is + procedure Scan (In_Tree : Project_Node_Tree_Ref) is Empty_Line : Boolean := False; + begin -- If there are comments, then they will not be kept. Set the flag and -- clear the comments. @@ -1400,9 +1501,9 @@ package body Prj.Tree is elsif End_Of_Line_Node /= Empty_Node then declare Zones : constant Project_Node_Id := - Comment_Zones_Of (End_Of_Line_Node); + Comment_Zones_Of (End_Of_Line_Node, In_Tree); begin - Project_Nodes.Table (Zones).Value := Comment_Id; + In_Tree.Project_Nodes.Table (Zones).Value := Comment_Id; end; -- Otherwise, this end of line node cannot be kept @@ -1424,11 +1525,15 @@ package body Prj.Tree is not Comments.Table (1).Follows_Empty_Line then if Previous_Line_Node /= Empty_Node then Add_Comments - (To => Previous_Line_Node, Where => After); + (To => Previous_Line_Node, + Where => After, + In_Tree => In_Tree); elsif Previous_End_Node /= Empty_Node then Add_Comments - (To => Previous_End_Node, Where => After_End); + (To => Previous_End_Node, + Where => After_End, + In_Tree => In_Tree); end if; end if; @@ -1440,8 +1545,9 @@ package body Prj.Tree is if Comments.Last > 0 and then Token = Tok_End then if Next_End_Nodes.Last > 0 then Add_Comments - (To => Next_End_Nodes.Table (Next_End_Nodes.Last), - Where => Before_End); + (To => Next_End_Nodes.Table (Next_End_Nodes.Last), + Where => Before_End, + In_Tree => In_Tree); else Unkept_Comments := True; @@ -1469,17 +1575,18 @@ package body Prj.Tree is ------------------------------------ procedure Set_Associative_Array_Index_Of - (Node : Project_Node_Id; - To : Name_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Name_Id) is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration + (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration or else - Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); - Project_Nodes.Table (Node).Value := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); + In_Tree.Project_Nodes.Table (Node).Value := To; end Set_Associative_Array_Index_Of; -------------------------------- @@ -1487,15 +1594,16 @@ package body Prj.Tree is -------------------------------- procedure Set_Associative_Package_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Attribute_Declaration); - Project_Nodes.Table (Node).Field3 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration); + In_Tree.Project_Nodes.Table (Node).Field3 := To; end Set_Associative_Package_Of; -------------------------------- @@ -1503,15 +1611,17 @@ package body Prj.Tree is -------------------------------- procedure Set_Associative_Project_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); - Project_Nodes.Table (Node).Field2 := To; + (In_Tree.Project_Nodes.Table (Node).Kind = + N_Attribute_Declaration)); + In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Associative_Project_Of; -------------------------- @@ -1519,17 +1629,18 @@ package body Prj.Tree is -------------------------- procedure Set_Case_Insensitive - (Node : Project_Node_Id; - To : Boolean) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Boolean) is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration + (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration or else - Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); - Project_Nodes.Table (Node).Flag1 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); + In_Tree.Project_Nodes.Table (Node).Flag1 := To; end Set_Case_Insensitive; ------------------------------------ @@ -1537,15 +1648,16 @@ package body Prj.Tree is ------------------------------------ procedure Set_Case_Variable_Reference_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Case_Construction); - Project_Nodes.Table (Node).Field1 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction); + In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_Case_Variable_Reference_Of; --------------------------- @@ -1553,15 +1665,16 @@ package body Prj.Tree is --------------------------- procedure Set_Current_Item_Node - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Declarative_Item); - Project_Nodes.Table (Node).Field1 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item); + In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_Current_Item_Node; ---------------------- @@ -1569,15 +1682,16 @@ package body Prj.Tree is ---------------------- procedure Set_Current_Term - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Term); - Project_Nodes.Table (Node).Field1 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Term); + In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_Current_Term; ---------------------- @@ -1585,15 +1699,16 @@ package body Prj.Tree is ---------------------- procedure Set_Directory_Of - (Node : Project_Node_Id; - To : Name_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Name_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Project); - Project_Nodes.Table (Node).Directory := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Project); + In_Tree.Project_Nodes.Table (Node).Directory := To; end Set_Directory_Of; --------------------- @@ -1610,31 +1725,34 @@ package body Prj.Tree is ---------------------------- procedure Set_Expression_Kind_Of - (Node : Project_Node_Id; - To : Variable_Kind) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Variable_Kind) is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Literal_String + (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String or else - Project_Nodes.Table (Node).Kind = N_Attribute_Declaration + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration or else - Project_Nodes.Table (Node).Kind = N_Variable_Declaration + In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration or else - Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration + In_Tree.Project_Nodes.Table (Node).Kind = + N_Typed_Variable_Declaration or else - Project_Nodes.Table (Node).Kind = N_Package_Declaration + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration or else - Project_Nodes.Table (Node).Kind = N_Expression + In_Tree.Project_Nodes.Table (Node).Kind = N_Expression or else - Project_Nodes.Table (Node).Kind = N_Term + In_Tree.Project_Nodes.Table (Node).Kind = N_Term or else - Project_Nodes.Table (Node).Kind = N_Variable_Reference + In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference or else - Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); - Project_Nodes.Table (Node).Expr_Kind := To; + In_Tree.Project_Nodes.Table (Node).Kind = + N_Attribute_Reference)); + In_Tree.Project_Nodes.Table (Node).Expr_Kind := To; end Set_Expression_Kind_Of; ----------------------- @@ -1642,19 +1760,23 @@ package body Prj.Tree is ----------------------- procedure Set_Expression_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration + (In_Tree.Project_Nodes.Table (Node).Kind = + N_Attribute_Declaration or else - Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration + In_Tree.Project_Nodes.Table (Node).Kind = + N_Typed_Variable_Declaration or else - Project_Nodes.Table (Node).Kind = N_Variable_Declaration)); - Project_Nodes.Table (Node).Field1 := To; + In_Tree.Project_Nodes.Table (Node).Kind = + N_Variable_Declaration)); + In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_Expression_Of; ------------------------------- @@ -1662,15 +1784,16 @@ package body Prj.Tree is ------------------------------- procedure Set_External_Reference_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_External_Value); - Project_Nodes.Table (Node).Field1 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value); + In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_External_Reference_Of; ----------------------------- @@ -1678,15 +1801,16 @@ package body Prj.Tree is ----------------------------- procedure Set_External_Default_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_External_Value); - Project_Nodes.Table (Node).Field2 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value); + In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_External_Default_Of; ---------------------------- @@ -1694,15 +1818,16 @@ package body Prj.Tree is ---------------------------- procedure Set_First_Case_Item_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Case_Construction); - Project_Nodes.Table (Node).Field2 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction); + In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_First_Case_Item_Of; ------------------------- @@ -1710,15 +1835,16 @@ package body Prj.Tree is ------------------------- procedure Set_First_Choice_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Case_Item); - Project_Nodes.Table (Node).Field1 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item); + In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_First_Choice_Of; ----------------------------- @@ -1726,12 +1852,13 @@ package body Prj.Tree is ----------------------------- procedure Set_First_Comment_After - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is - Zone : constant Project_Node_Id := Comment_Zones_Of (Node); + Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree); begin - Project_Nodes.Table (Zone).Field2 := To; + In_Tree.Project_Nodes.Table (Zone).Field2 := To; end Set_First_Comment_After; --------------------------------- @@ -1739,12 +1866,13 @@ package body Prj.Tree is --------------------------------- procedure Set_First_Comment_After_End - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is - Zone : constant Project_Node_Id := Comment_Zones_Of (Node); + Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree); begin - Project_Nodes.Table (Zone).Comments := To; + In_Tree.Project_Nodes.Table (Zone).Comments := To; end Set_First_Comment_After_End; ------------------------------ @@ -1752,13 +1880,14 @@ package body Prj.Tree is ------------------------------ procedure Set_First_Comment_Before - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is - Zone : constant Project_Node_Id := Comment_Zones_Of (Node); + Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree); begin - Project_Nodes.Table (Zone).Field1 := To; + In_Tree.Project_Nodes.Table (Zone).Field1 := To; end Set_First_Comment_Before; ---------------------------------- @@ -1766,12 +1895,13 @@ package body Prj.Tree is ---------------------------------- procedure Set_First_Comment_Before_End - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is - Zone : constant Project_Node_Id := Comment_Zones_Of (Node); + Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree); begin - Project_Nodes.Table (Zone).Field2 := To; + In_Tree.Project_Nodes.Table (Zone).Field2 := To; end Set_First_Comment_Before_End; ------------------------ @@ -1779,15 +1909,16 @@ package body Prj.Tree is ------------------------ procedure Set_Next_Case_Item - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Case_Item); - Project_Nodes.Table (Node).Field3 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item); + In_Tree.Project_Nodes.Table (Node).Field3 := To; end Set_Next_Case_Item; ---------------------- @@ -1795,15 +1926,16 @@ package body Prj.Tree is ---------------------- procedure Set_Next_Comment - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Comment); - Project_Nodes.Table (Node).Comments := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Comment); + In_Tree.Project_Nodes.Table (Node).Comments := To; end Set_Next_Comment; ----------------------------------- @@ -1811,23 +1943,24 @@ package body Prj.Tree is ----------------------------------- procedure Set_First_Declarative_Item_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Project_Declaration + (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration or else - Project_Nodes.Table (Node).Kind = N_Case_Item + In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item or else - Project_Nodes.Table (Node).Kind = N_Package_Declaration)); + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration)); - if Project_Nodes.Table (Node).Kind = N_Project_Declaration then - Project_Nodes.Table (Node).Field1 := To; + if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then + In_Tree.Project_Nodes.Table (Node).Field1 := To; else - Project_Nodes.Table (Node).Field2 := To; + In_Tree.Project_Nodes.Table (Node).Field2 := To; end if; end Set_First_Declarative_Item_Of; @@ -1836,15 +1969,16 @@ package body Prj.Tree is ---------------------------------- procedure Set_First_Expression_In_List - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Literal_String_List); - Project_Nodes.Table (Node).Field1 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List); + In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_First_Expression_In_List; ------------------------------ @@ -1852,15 +1986,17 @@ package body Prj.Tree is ------------------------------ procedure Set_First_Literal_String - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_String_Type_Declaration); - Project_Nodes.Table (Node).Field1 := To; + In_Tree.Project_Nodes.Table (Node).Kind = + N_String_Type_Declaration); + In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_First_Literal_String; -------------------------- @@ -1868,15 +2004,16 @@ package body Prj.Tree is -------------------------- procedure Set_First_Package_Of - (Node : Project_Node_Id; - To : Package_Declaration_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Package_Declaration_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Project); - Project_Nodes.Table (Node).Packages := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Project); + In_Tree.Project_Nodes.Table (Node).Packages := To; end Set_First_Package_Of; ------------------------------ @@ -1884,15 +2021,16 @@ package body Prj.Tree is ------------------------------ procedure Set_First_String_Type_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Project); - Project_Nodes.Table (Node).Field3 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Project); + In_Tree.Project_Nodes.Table (Node).Field3 := To; end Set_First_String_Type_Of; -------------------- @@ -1900,15 +2038,16 @@ package body Prj.Tree is -------------------- procedure Set_First_Term - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Expression); - Project_Nodes.Table (Node).Field1 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Expression); + In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_First_Term; --------------------------- @@ -1916,17 +2055,18 @@ package body Prj.Tree is --------------------------- procedure Set_First_Variable_Of - (Node : Project_Node_Id; - To : Variable_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Variable_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Project + (In_Tree.Project_Nodes.Table (Node).Kind = N_Project or else - Project_Nodes.Table (Node).Kind = N_Package_Declaration)); - Project_Nodes.Table (Node).Variables := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration)); + In_Tree.Project_Nodes.Table (Node).Variables := To; end Set_First_Variable_Of; ------------------------------ @@ -1934,30 +2074,34 @@ package body Prj.Tree is ------------------------------ procedure Set_First_With_Clause_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Project); - Project_Nodes.Table (Node).Field1 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Project); + In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_First_With_Clause_Of; -------------------------- -- Set_Is_Extending_All -- -------------------------- - procedure Set_Is_Extending_All (Node : Project_Node_Id) is + procedure Set_Is_Extending_All + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) + is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Project + (In_Tree.Project_Nodes.Table (Node).Kind = N_Project or else - Project_Nodes.Table (Node).Kind = N_With_Clause)); - Project_Nodes.Table (Node).Flag2 := True; + In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause)); + In_Tree.Project_Nodes.Table (Node).Flag2 := True; end Set_Is_Extending_All; ----------------- @@ -1965,12 +2109,13 @@ package body Prj.Tree is ----------------- procedure Set_Kind_Of - (Node : Project_Node_Id; - To : Project_Node_Kind) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Kind) is begin pragma Assert (Node /= Empty_Node); - Project_Nodes.Table (Node).Kind := To; + In_Tree.Project_Nodes.Table (Node).Kind := To; end Set_Kind_Of; --------------------- @@ -1978,12 +2123,13 @@ package body Prj.Tree is --------------------- procedure Set_Location_Of - (Node : Project_Node_Id; - To : Source_Ptr) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Source_Ptr) is begin pragma Assert (Node /= Empty_Node); - Project_Nodes.Table (Node).Location := To; + In_Tree.Project_Nodes.Table (Node).Location := To; end Set_Location_Of; ----------------------------- @@ -1991,15 +2137,16 @@ package body Prj.Tree is ----------------------------- procedure Set_Extended_Project_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Project_Declaration); - Project_Nodes.Table (Node).Field2 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration); + In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Extended_Project_Of; ---------------------------------- @@ -2007,15 +2154,16 @@ package body Prj.Tree is ---------------------------------- procedure Set_Extended_Project_Path_Of - (Node : Project_Node_Id; - To : Name_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Name_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Project); - Project_Nodes.Table (Node).Value := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Project); + In_Tree.Project_Nodes.Table (Node).Value := To; end Set_Extended_Project_Path_Of; ------------------------------ @@ -2023,15 +2171,16 @@ package body Prj.Tree is ------------------------------ procedure Set_Extending_Project_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Project_Declaration); - Project_Nodes.Table (Node).Field3 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration); + In_Tree.Project_Nodes.Table (Node).Field3 := To; end Set_Extending_Project_Of; ----------------- @@ -2039,12 +2188,13 @@ package body Prj.Tree is ----------------- procedure Set_Name_Of - (Node : Project_Node_Id; - To : Name_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Name_Id) is begin pragma Assert (Node /= Empty_Node); - Project_Nodes.Table (Node).Name := To; + In_Tree.Project_Nodes.Table (Node).Name := To; end Set_Name_Of; ------------------------------- @@ -2052,15 +2202,16 @@ package body Prj.Tree is ------------------------------- procedure Set_Next_Declarative_Item - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Declarative_Item); - Project_Nodes.Table (Node).Field2 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item); + In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Next_Declarative_Item; ----------------------- @@ -2078,15 +2229,16 @@ package body Prj.Tree is --------------------------------- procedure Set_Next_Expression_In_List - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Expression); - Project_Nodes.Table (Node).Field2 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Expression); + In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Next_Expression_In_List; ----------------------------- @@ -2094,15 +2246,16 @@ package body Prj.Tree is ----------------------------- procedure Set_Next_Literal_String - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Literal_String); - Project_Nodes.Table (Node).Field1 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String); + In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_Next_Literal_String; --------------------------------- @@ -2110,15 +2263,16 @@ package body Prj.Tree is --------------------------------- procedure Set_Next_Package_In_Project - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Package_Declaration); - Project_Nodes.Table (Node).Field3 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); + In_Tree.Project_Nodes.Table (Node).Field3 := To; end Set_Next_Package_In_Project; -------------------------- @@ -2126,15 +2280,17 @@ package body Prj.Tree is -------------------------- procedure Set_Next_String_Type - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_String_Type_Declaration); - Project_Nodes.Table (Node).Field2 := To; + In_Tree.Project_Nodes.Table (Node).Kind = + N_String_Type_Declaration); + In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Next_String_Type; ------------------- @@ -2142,15 +2298,16 @@ package body Prj.Tree is ------------------- procedure Set_Next_Term - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Term); - Project_Nodes.Table (Node).Field2 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Term); + In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Next_Term; ----------------------- @@ -2158,17 +2315,20 @@ package body Prj.Tree is ----------------------- procedure Set_Next_Variable - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration + (In_Tree.Project_Nodes.Table (Node).Kind = + N_Typed_Variable_Declaration or else - Project_Nodes.Table (Node).Kind = N_Variable_Declaration)); - Project_Nodes.Table (Node).Field3 := To; + In_Tree.Project_Nodes.Table (Node).Kind = + N_Variable_Declaration)); + In_Tree.Project_Nodes.Table (Node).Field3 := To; end Set_Next_Variable; ----------------------------- @@ -2176,15 +2336,16 @@ package body Prj.Tree is ----------------------------- procedure Set_Next_With_Clause_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_With_Clause); - Project_Nodes.Table (Node).Field2 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause); + In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Next_With_Clause_Of; ----------------------- @@ -2192,15 +2353,16 @@ package body Prj.Tree is ----------------------- procedure Set_Package_Id_Of - (Node : Project_Node_Id; - To : Package_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Package_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Package_Declaration); - Project_Nodes.Table (Node).Pkg_Id := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); + In_Tree.Project_Nodes.Table (Node).Pkg_Id := To; end Set_Package_Id_Of; ------------------------- @@ -2208,17 +2370,18 @@ package body Prj.Tree is ------------------------- procedure Set_Package_Node_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Variable_Reference + (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference or else - Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); - Project_Nodes.Table (Node).Field2 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); + In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Package_Node_Of; ---------------------- @@ -2226,17 +2389,18 @@ package body Prj.Tree is ---------------------- procedure Set_Path_Name_Of - (Node : Project_Node_Id; - To : Name_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Name_Id) is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Project + (In_Tree.Project_Nodes.Table (Node).Kind = N_Project or else - Project_Nodes.Table (Node).Kind = N_With_Clause)); - Project_Nodes.Table (Node).Path_Name := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause)); + In_Tree.Project_Nodes.Table (Node).Path_Name := To; end Set_Path_Name_Of; --------------------------- @@ -2261,15 +2425,16 @@ package body Prj.Tree is -------------------------------- procedure Set_Project_Declaration_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Project); - Project_Nodes.Table (Node).Field2 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Project); + In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Project_Declaration_Of; ----------------------------------------------- @@ -2277,12 +2442,14 @@ package body Prj.Tree is ----------------------------------------------- procedure Set_Project_File_Includes_Unkept_Comments - (Node : Project_Node_Id; - To : Boolean) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Boolean) is - Declaration : constant Project_Node_Id := Project_Declaration_Of (Node); + Declaration : constant Project_Node_Id := + Project_Declaration_Of (Node, In_Tree); begin - Project_Nodes.Table (Declaration).Flag1 := To; + In_Tree.Project_Nodes.Table (Declaration).Flag1 := To; end Set_Project_File_Includes_Unkept_Comments; ------------------------- @@ -2291,6 +2458,7 @@ package body Prj.Tree is procedure Set_Project_Node_Of (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id; Limited_With : Boolean := False) is @@ -2298,17 +2466,17 @@ package body Prj.Tree is pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_With_Clause + (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause or else - Project_Nodes.Table (Node).Kind = N_Variable_Reference + In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference or else - Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); - Project_Nodes.Table (Node).Field1 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); + In_Tree.Project_Nodes.Table (Node).Field1 := To; - if Project_Nodes.Table (Node).Kind = N_With_Clause + if In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause and then not Limited_With then - Project_Nodes.Table (Node).Field3 := To; + In_Tree.Project_Nodes.Table (Node).Field3 := To; end if; end Set_Project_Node_Of; @@ -2317,15 +2485,16 @@ package body Prj.Tree is --------------------------------------- procedure Set_Project_Of_Renamed_Package_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - Project_Nodes.Table (Node).Kind = N_Package_Declaration); - Project_Nodes.Table (Node).Field1 := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); + In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_Project_Of_Renamed_Package_Of; ------------------------- @@ -2333,17 +2502,19 @@ package body Prj.Tree is ------------------------- procedure Set_Source_Index_Of - (Node : Project_Node_Id; - To : Int) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Int) is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Literal_String + (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String or else - Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); - Project_Nodes.Table (Node).Src_Index := To; + In_Tree.Project_Nodes.Table (Node).Kind = + N_Attribute_Declaration)); + In_Tree.Project_Nodes.Table (Node).Src_Index := To; end Set_Source_Index_Of; ------------------------ @@ -2351,23 +2522,26 @@ package body Prj.Tree is ------------------------ procedure Set_String_Type_Of - (Node : Project_Node_Id; - To : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id) is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Variable_Reference + (In_Tree.Project_Nodes.Table (Node).Kind = + N_Variable_Reference or else - Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration) + In_Tree.Project_Nodes.Table (Node).Kind = + N_Typed_Variable_Declaration) and then - Project_Nodes.Table (To).Kind = N_String_Type_Declaration); + In_Tree.Project_Nodes.Table (To).Kind = N_String_Type_Declaration); - if Project_Nodes.Table (Node).Kind = N_Variable_Reference then - Project_Nodes.Table (Node).Field3 := To; + if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then + In_Tree.Project_Nodes.Table (Node).Field3 := To; else - Project_Nodes.Table (Node).Field2 := To; + In_Tree.Project_Nodes.Table (Node).Field2 := To; end if; end Set_String_Type_Of; @@ -2376,53 +2550,63 @@ package body Prj.Tree is ------------------------- procedure Set_String_Value_Of - (Node : Project_Node_Id; - To : Name_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Name_Id) is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_With_Clause + (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause or else - Project_Nodes.Table (Node).Kind = N_Comment + In_Tree.Project_Nodes.Table (Node).Kind = N_Comment or else - Project_Nodes.Table (Node).Kind = N_Literal_String)); - Project_Nodes.Table (Node).Value := To; + In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String)); + In_Tree.Project_Nodes.Table (Node).Value := To; end Set_String_Value_Of; --------------------- -- Source_Index_Of -- --------------------- - function Source_Index_Of (Node : Project_Node_Id) return Int is + function Source_Index_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Int + is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Literal_String + (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String or else - Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); - return Project_Nodes.Table (Node).Src_Index; + In_Tree.Project_Nodes.Table (Node).Kind = + N_Attribute_Declaration)); + return In_Tree.Project_Nodes.Table (Node).Src_Index; end Source_Index_Of; -------------------- -- String_Type_Of -- -------------------- - function String_Type_Of (Node : Project_Node_Id) return Project_Node_Id is + function String_Type_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id + is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Variable_Reference + (In_Tree.Project_Nodes.Table (Node).Kind = + N_Variable_Reference or else - Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration)); + In_Tree.Project_Nodes.Table (Node).Kind = + N_Typed_Variable_Declaration)); - if Project_Nodes.Table (Node).Kind = N_Variable_Reference then - return Project_Nodes.Table (Node).Field3; + if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then + return In_Tree.Project_Nodes.Table (Node).Field3; else - return Project_Nodes.Table (Node).Field2; + return In_Tree.Project_Nodes.Table (Node).Field2; end if; end String_Type_Of; @@ -2430,17 +2614,20 @@ package body Prj.Tree is -- String_Value_Of -- --------------------- - function String_Value_Of (Node : Project_Node_Id) return Name_Id is + function String_Value_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Name_Id + is begin pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_With_Clause + (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause or else - Project_Nodes.Table (Node).Kind = N_Comment + In_Tree.Project_Nodes.Table (Node).Kind = N_Comment or else - Project_Nodes.Table (Node).Kind = N_Literal_String)); - return Project_Nodes.Table (Node).Value; + In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String)); + return In_Tree.Project_Nodes.Table (Node).Value; end String_Value_Of; -------------------- @@ -2449,27 +2636,29 @@ package body Prj.Tree is function Value_Is_Valid (For_Typed_Variable : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; Value : Name_Id) return Boolean is begin pragma Assert (For_Typed_Variable /= Empty_Node and then - (Project_Nodes.Table (For_Typed_Variable).Kind = + (In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind = N_Typed_Variable_Declaration)); declare Current_String : Project_Node_Id := First_Literal_String - (String_Type_Of (For_Typed_Variable)); + (String_Type_Of (For_Typed_Variable, In_Tree), + In_Tree); begin while Current_String /= Empty_Node and then - String_Value_Of (Current_String) /= Value + String_Value_Of (Current_String, In_Tree) /= Value loop Current_String := - Next_Literal_String (Current_String); + Next_Literal_String (Current_String, In_Tree); end loop; return Current_String /= Empty_Node; diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads index e50be5d7878..692b3b6097c 100644 --- a/gcc/ada/prj-tree.ads +++ b/gcc/ada/prj-tree.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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,14 +26,19 @@ -- This package defines the structure of the Project File tree -with GNAT.HTable; +with GNAT.Dynamic_HTables; +with GNAT.Dynamic_Tables; with Prj.Attr; use Prj.Attr; -with Table; use Table; with Types; use Types; package Prj.Tree is + type 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 + -- trees can coexist in memory. + Project_Nodes_Initial : constant := 1_000; Project_Nodes_Increment : constant := 100; -- Allocation parameters for initializing and extending number @@ -85,12 +90,13 @@ package Prj.Tree is -- For the signification of the fields in each node of a -- Project_Node_Kind, look at package Tree_Private_Part. - procedure Initialize; + procedure Initialize (Tree : Project_Node_Tree_Ref); -- Initialize the Project File tree: empty the Project_Nodes table -- and reset the Projects_Htable. function Default_Project_Node - (Of_Kind : Project_Node_Kind; + (In_Tree : Project_Node_Tree_Ref; + Of_Kind : Project_Node_Kind; And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id; -- Returns a Project_Node_Record with the specified Kind and -- Expr_Kind; all the other components have default nil values. @@ -100,6 +106,7 @@ package Prj.Tree is function Imported_Or_Extended_Project_Of (Project : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; With_Name : Name_Id) return Project_Node_Id; -- Return the node of a project imported or extended by project Project and -- whose name is With_Name. Return Empty_Node if there is no such project. @@ -170,13 +177,16 @@ package Prj.Tree is Table_Name => "Prj.Tree.Comments"); -- A table to store the comments that may be stored is the tree - procedure Scan; + procedure Scan (In_Tree : Project_Node_Tree_Ref); -- Scan the tokens and accumulate comments type Comment_Location is (Before, After, Before_End, After_End, End_Of_Line); - procedure Add_Comments (To : Project_Node_Id; Where : Comment_Location); + procedure Add_Comments + (To : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + Where : Comment_Location); -- Add comments to this node ---------------------- @@ -186,287 +196,360 @@ package Prj.Tree is -- The following query functions are part of the abstract interface -- of the Project File tree - function Name_Of (Node : Project_Node_Id) return Name_Id; + function Name_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Name_Id; pragma Inline (Name_Of); -- Valid for all non empty nodes. May return No_Name for nodes that have -- no names. - function Kind_Of (Node : Project_Node_Id) return Project_Node_Kind; + function Kind_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind; pragma Inline (Kind_Of); -- Valid for all non empty nodes - function Location_Of (Node : Project_Node_Id) return Source_Ptr; + function Location_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Source_Ptr; pragma Inline (Location_Of); -- Valid for all non empty nodes function First_Comment_After - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; -- Valid only for N_Comment_Zones nodes function First_Comment_After_End - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; -- Valid only for N_Comment_Zones nodes function First_Comment_Before - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; -- Valid only for N_Comment_Zones nodes function First_Comment_Before_End - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; -- Valid only for N_Comment_Zones nodes - function Next_Comment (Node : Project_Node_Id) return Project_Node_Id; + function Next_Comment + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; -- Valid only for N_Comment nodes - function End_Of_Line_Comment (Node : Project_Node_Id) return Name_Id; + function End_Of_Line_Comment + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Name_Id; -- Valid only for non empty nodes - function Follows_Empty_Line (Node : Project_Node_Id) return Boolean; + function Follows_Empty_Line + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Boolean; -- Valid only for N_Comment nodes - function Is_Followed_By_Empty_Line (Node : Project_Node_Id) return Boolean; + function Is_Followed_By_Empty_Line + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Boolean; -- Valid only for N_Comment nodes function Project_File_Includes_Unkept_Comments - (Node : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Boolean; -- Valid only for N_Project nodes - function Directory_Of (Node : Project_Node_Id) return Name_Id; + function Directory_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Name_Id; pragma Inline (Directory_Of); -- Only valid for N_Project nodes - function Expression_Kind_Of (Node : Project_Node_Id) return Variable_Kind; + function Expression_Kind_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Variable_Kind; pragma Inline (Expression_Kind_Of); -- Only valid for N_Literal_String, N_Attribute_Declaration, -- N_Variable_Declaration, N_Typed_Variable_Declaration, N_Expression, -- N_Term, N_Variable_Reference or N_Attribute_Reference nodes. - function Is_Extending_All (Node : Project_Node_Id) return Boolean; + function Is_Extending_All + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Boolean; pragma Inline (Is_Extending_All); -- Only valid for N_Project and N_With_Clause function First_Variable_Of - (Node : Project_Node_Id) return Variable_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id; pragma Inline (First_Variable_Of); -- Only valid for N_Project or N_Package_Declaration nodes function First_Package_Of - (Node : Project_Node_Id) return Package_Declaration_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id; pragma Inline (First_Package_Of); -- Only valid for N_Project nodes - function Package_Id_Of (Node : Project_Node_Id) return Package_Node_Id; + function Package_Id_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Package_Node_Id; pragma Inline (Package_Id_Of); -- Only valid for N_Package_Declaration nodes - function Path_Name_Of (Node : Project_Node_Id) return Name_Id; + function Path_Name_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Name_Id; pragma Inline (Path_Name_Of); -- Only valid for N_Project and N_With_Clause nodes - function String_Value_Of (Node : Project_Node_Id) return Name_Id; + function String_Value_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Name_Id; pragma Inline (String_Value_Of); -- Only valid for N_With_Clause, N_Literal_String nodes or N_Comment - function Source_Index_Of (Node : Project_Node_Id) return Int; + function Source_Index_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Int; pragma Inline (Source_Index_Of); -- Only valid for N_Literal_String and N_Attribute_Declaration nodes function First_With_Clause_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (First_With_Clause_Of); -- Only valid for N_Project nodes function Project_Declaration_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Project_Declaration_Of); -- Only valid for N_Project nodes function Extending_Project_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Extending_Project_Of); -- Only valid for N_Project_Declaration nodes function First_String_Type_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (First_String_Type_Of); -- Only valid for N_Project nodes function Extended_Project_Path_Of - (Node : Project_Node_Id) return Name_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Name_Id; pragma Inline (Extended_Project_Path_Of); -- Only valid for N_With_Clause nodes function Project_Node_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Project_Node_Of); -- Only valid for N_With_Clause, N_Variable_Reference and -- N_Attribute_Reference nodes. function Non_Limited_Project_Node_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Non_Limited_Project_Node_Of); -- Only valid for N_With_Clause nodes. Returns Empty_Node for limited -- imported project files, otherwise returns the same result as -- Project_Node_Of. function Next_With_Clause_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Next_With_Clause_Of); -- Only valid for N_With_Clause nodes function First_Declarative_Item_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (First_Declarative_Item_Of); -- Only valid for N_With_Clause nodes function Extended_Project_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Extended_Project_Of); -- Only valid for N_Project_Declaration nodes function Current_Item_Node - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Current_Item_Node); -- Only valid for N_Declarative_Item nodes function Next_Declarative_Item - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Next_Declarative_Item); -- Only valid for N_Declarative_Item node function Project_Of_Renamed_Package_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Project_Of_Renamed_Package_Of); -- Only valid for N_Package_Declaration nodes. -- May return Empty_Node. function Next_Package_In_Project - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Next_Package_In_Project); -- Only valid for N_Package_Declaration nodes function First_Literal_String - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (First_Literal_String); -- Only valid for N_String_Type_Declaration nodes function Next_String_Type - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Next_String_Type); -- Only valid for N_String_Type_Declaration nodes function Next_Literal_String - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Next_Literal_String); -- Only valid for N_Literal_String nodes function Expression_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Expression_Of); -- Only valid for N_Attribute_Declaration, N_Typed_Variable_Declaration -- or N_Variable_Declaration nodes function Associative_Project_Of - (Node : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Associative_Project_Of); -- Only valid for N_Attribute_Declaration nodes function Associative_Package_Of - (Node : Project_Node_Id) + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Associative_Package_Of); -- Only valid for N_Attribute_Declaration nodes function Value_Is_Valid (For_Typed_Variable : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; Value : Name_Id) return Boolean; pragma Inline (Value_Is_Valid); -- Only valid for N_Typed_Variable_Declaration. Returns True if Value is -- in the list of allowed strings for For_Typed_Variable. False otherwise. function Associative_Array_Index_Of - (Node : Project_Node_Id) return Name_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Name_Id; pragma Inline (Associative_Array_Index_Of); -- Only valid for N_Attribute_Declaration and N_Attribute_Reference. -- Returns No_String for non associative array attributes. function Next_Variable - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Next_Variable); -- Only valid for N_Typed_Variable_Declaration or N_Variable_Declaration -- nodes. function First_Term - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (First_Term); -- Only valid for N_Expression nodes function Next_Expression_In_List - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Next_Expression_In_List); -- Only valid for N_Expression nodes function Current_Term - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Current_Term); -- Only valid for N_Term nodes function Next_Term - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Next_Term); -- Only valid for N_Term nodes function First_Expression_In_List - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (First_Expression_In_List); -- Only valid for N_Literal_String_List nodes function Package_Node_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Package_Node_Of); -- Only valid for N_Variable_Reference or N_Attribute_Reference nodes. -- May return Empty_Node. function String_Type_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (String_Type_Of); -- Only valid for N_Variable_Reference or N_Typed_Variable_Declaration -- nodes. function External_Reference_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (External_Reference_Of); -- Only valid for N_External_Value nodes function External_Default_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (External_Default_Of); -- Only valid for N_External_Value nodes function Case_Variable_Reference_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Case_Variable_Reference_Of); -- Only valid for N_Case_Construction nodes function First_Case_Item_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (First_Case_Item_Of); -- Only valid for N_Case_Construction nodes function First_Choice_Of - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (First_Choice_Of); -- Return the first choice in a N_Case_Item, or Empty_Node if -- this is when others. function Next_Case_Item - (Node : Project_Node_Id) return Project_Node_Id; + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; pragma Inline (Next_Case_Item); -- Only valid for N_Case_Item nodes - function Case_Insensitive (Node : Project_Node_Id) return Boolean; + function Case_Insensitive + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Boolean; -- Only valid for N_Attribute_Declaration and N_Attribute_Reference nodes -------------------- @@ -480,266 +563,320 @@ package Prj.Tree is -- nodes as the corresponding query function above. procedure Set_Name_Of - (Node : Project_Node_Id; - To : Name_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Name_Id); pragma Inline (Set_Name_Of); procedure Set_Kind_Of - (Node : Project_Node_Id; - To : Project_Node_Kind); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Kind); pragma Inline (Set_Kind_Of); procedure Set_Location_Of - (Node : Project_Node_Id; - To : Source_Ptr); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Source_Ptr); pragma Inline (Set_Location_Of); procedure Set_First_Comment_After - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_First_Comment_After); procedure Set_First_Comment_After_End - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_First_Comment_After_End); procedure Set_First_Comment_Before - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_First_Comment_Before); procedure Set_First_Comment_Before_End - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_First_Comment_Before_End); procedure Set_Next_Comment - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Next_Comment); procedure Set_Project_File_Includes_Unkept_Comments - (Node : Project_Node_Id; - To : Boolean); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Boolean); procedure Set_Directory_Of - (Node : Project_Node_Id; - To : Name_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Name_Id); pragma Inline (Set_Directory_Of); procedure Set_Expression_Kind_Of - (Node : Project_Node_Id; - To : Variable_Kind); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Variable_Kind); pragma Inline (Set_Expression_Kind_Of); - procedure Set_Is_Extending_All (Node : Project_Node_Id); + procedure Set_Is_Extending_All + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref); pragma Inline (Set_Is_Extending_All); procedure Set_First_Variable_Of - (Node : Project_Node_Id; - To : Variable_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Variable_Node_Id); pragma Inline (Set_First_Variable_Of); procedure Set_First_Package_Of - (Node : Project_Node_Id; - To : Package_Declaration_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Package_Declaration_Id); pragma Inline (Set_First_Package_Of); procedure Set_Package_Id_Of - (Node : Project_Node_Id; - To : Package_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Package_Node_Id); pragma Inline (Set_Package_Id_Of); procedure Set_Path_Name_Of - (Node : Project_Node_Id; - To : Name_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Name_Id); pragma Inline (Set_Path_Name_Of); procedure Set_String_Value_Of - (Node : Project_Node_Id; - To : Name_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Name_Id); pragma Inline (Set_String_Value_Of); procedure Set_First_With_Clause_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_First_With_Clause_Of); procedure Set_Project_Declaration_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Project_Declaration_Of); procedure Set_Extending_Project_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Extending_Project_Of); procedure Set_First_String_Type_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_First_String_Type_Of); procedure Set_Extended_Project_Path_Of - (Node : Project_Node_Id; - To : Name_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Name_Id); pragma Inline (Set_Extended_Project_Path_Of); procedure Set_Project_Node_Of (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id; Limited_With : Boolean := False); pragma Inline (Set_Project_Node_Of); procedure Set_Next_With_Clause_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Next_With_Clause_Of); procedure Set_First_Declarative_Item_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_First_Declarative_Item_Of); procedure Set_Extended_Project_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Extended_Project_Of); procedure Set_Current_Item_Node - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Current_Item_Node); procedure Set_Next_Declarative_Item - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Next_Declarative_Item); procedure Set_Project_Of_Renamed_Package_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Project_Of_Renamed_Package_Of); procedure Set_Next_Package_In_Project - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Next_Package_In_Project); procedure Set_First_Literal_String - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_First_Literal_String); procedure Set_Next_String_Type - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Next_String_Type); procedure Set_Next_Literal_String - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Next_Literal_String); procedure Set_Expression_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Expression_Of); procedure Set_Associative_Project_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Associative_Project_Of); procedure Set_Associative_Package_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Associative_Package_Of); procedure Set_Associative_Array_Index_Of - (Node : Project_Node_Id; - To : Name_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Name_Id); pragma Inline (Set_Associative_Array_Index_Of); procedure Set_Next_Variable - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Next_Variable); procedure Set_First_Term - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_First_Term); procedure Set_Next_Expression_In_List - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Next_Expression_In_List); procedure Set_Current_Term - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Current_Term); procedure Set_Next_Term - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Next_Term); procedure Set_First_Expression_In_List - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_First_Expression_In_List); procedure Set_Package_Node_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Package_Node_Of); procedure Set_Source_Index_Of - (Node : Project_Node_Id; - To : Int); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Int); pragma Inline (Set_Source_Index_Of); procedure Set_String_Type_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_String_Type_Of); procedure Set_External_Reference_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_External_Reference_Of); procedure Set_External_Default_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_External_Default_Of); procedure Set_Case_Variable_Reference_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Case_Variable_Reference_Of); procedure Set_First_Case_Item_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_First_Case_Item_Of); procedure Set_First_Choice_Of - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_First_Choice_Of); procedure Set_Next_Case_Item - (Node : Project_Node_Id; - To : Project_Node_Id); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id); pragma Inline (Set_Next_Case_Item); procedure Set_Case_Insensitive - (Node : Project_Node_Id; - To : Boolean); + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Boolean); ------------------------------- -- Restricted Access Section -- @@ -1028,13 +1165,13 @@ package Prj.Tree is -- -- Flag2: comment is followed by an empty line -- -- Comments: next comment - package Project_Nodes is - new Table.Table (Table_Component_Type => Project_Node_Record, - Table_Index_Type => Project_Node_Id, - Table_Low_Bound => First_Node_Id, - Table_Initial => Project_Nodes_Initial, - Table_Increment => Project_Nodes_Increment, - Table_Name => "Project_Nodes"); + package Project_Node_Table is + new GNAT.Dynamic_Tables + (Table_Component_Type => Project_Node_Record, + Table_Index_Type => Project_Node_Id, + Table_Low_Bound => First_Node_Id, + Table_Initial => Project_Nodes_Initial, + Table_Increment => Project_Nodes_Increment); -- This table contains the syntactic tree of project data -- from project files. @@ -1058,7 +1195,7 @@ package Prj.Tree is Canonical_Path => No_Name, Extended => True); - package Projects_Htable is new GNAT.HTable.Simple_HTable + package Projects_Htable is new GNAT.Dynamic_HTables.Simple_HTable (Header_Num => Header_Num, Element => Project_Name_And_Node, No_Element => No_Project_Name_And_Node, @@ -1073,6 +1210,12 @@ package Prj.Tree is end Tree_Private_Part; + type Project_Node_Tree_Data is record + Project_Nodes : Tree_Private_Part.Project_Node_Table.Instance; + Projects_HT : Tree_Private_Part.Projects_Htable.Instance; + end record; + -- The data for a project node tree + private type Comment_Array is array (Positive range <>) of Comment_Data; type Comments_Ptr is access Comment_Array; diff --git a/gcc/ada/prj-util.adb b/gcc/ada/prj-util.adb index a0709cbb8b1..054aa15bdf1 100644 --- a/gcc/ada/prj-util.adb +++ b/gcc/ada/prj-util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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- -- @@ -75,6 +75,7 @@ package body Prj.Util is function Executable_Of (Project : Project_Id; + In_Tree : Project_Tree_Ref; Main : Name_Id; Index : Int; Ada_Main : Boolean := True) return Name_Id @@ -82,19 +83,21 @@ package body Prj.Util is pragma Assert (Project /= No_Project); The_Packages : constant Package_Id := - Projects.Table (Project).Decl.Packages; + In_Tree.Projects.Table (Project).Decl.Packages; Builder_Package : constant Prj.Package_Id := Prj.Util.Value_Of (Name => Name_Builder, - In_Packages => The_Packages); + In_Packages => The_Packages, + In_Tree => In_Tree); Executable : Variable_Value := Prj.Util.Value_Of (Name => Main, Index => Index, Attribute_Or_Array_Name => Name_Executable, - In_Package => Builder_Package); + In_Package => Builder_Package, + In_Tree => In_Tree); Executable_Suffix : constant Variable_Value := Prj.Util.Value_Of @@ -102,15 +105,16 @@ package body Prj.Util is Index => 0, Attribute_Or_Array_Name => Name_Executable_Suffix, - In_Package => Builder_Package); + In_Package => Builder_Package, + In_Tree => In_Tree); Body_Append : constant String := Get_Name_String - (Projects.Table + (In_Tree.Projects.Table (Project). Naming.Ada_Body_Suffix); Spec_Append : constant String := Get_Name_String - (Projects.Table + (In_Tree.Projects.Table (Project). Naming.Ada_Spec_Suffix); @@ -128,7 +132,7 @@ package body Prj.Util is Last : Positive := Name_Len; Naming : constant Naming_Data := - Projects.Table (Project).Naming; + In_Tree.Projects.Table (Project).Naming; Spec_Suffix : constant String := Get_Name_String (Naming.Ada_Spec_Suffix); @@ -163,7 +167,8 @@ package body Prj.Util is (Name => Name_Find, Index => 0, Attribute_Or_Array_Name => Name_Executable, - In_Package => Builder_Package); + In_Package => Builder_Package, + In_Tree => In_Tree); end if; end; end if; @@ -400,7 +405,8 @@ package body Prj.Util is function Value_Of (Index : Name_Id; - In_Array : Array_Element_Id) return Name_Id + In_Array : Array_Element_Id; + In_Tree : Project_Tree_Ref) return Name_Id is Current : Array_Element_Id := In_Array; Element : Array_Element; @@ -411,7 +417,7 @@ package body Prj.Util is return No_Name; end if; - Element := Array_Elements.Table (Current); + Element := In_Tree.Array_Elements.Table (Current); if not Element.Index_Case_Sensitive then Get_Name_String (Index); @@ -420,7 +426,7 @@ package body Prj.Util is end if; while Current /= No_Array_Element loop - Element := Array_Elements.Table (Current); + Element := In_Tree.Array_Elements.Table (Current); if Real_Index = Element.Index then exit when Element.Value.Kind /= Single; @@ -437,7 +443,8 @@ package body Prj.Util is function Value_Of (Index : Name_Id; Src_Index : Int := 0; - In_Array : Array_Element_Id) return Variable_Value + In_Array : Array_Element_Id; + In_Tree : Project_Tree_Ref) return Variable_Value is Current : Array_Element_Id := In_Array; Element : Array_Element; @@ -448,7 +455,7 @@ package body Prj.Util is return Nil_Variable_Value; end if; - Element := Array_Elements.Table (Current); + Element := In_Tree.Array_Elements.Table (Current); if not Element.Index_Case_Sensitive then Get_Name_String (Index); @@ -457,7 +464,7 @@ package body Prj.Util is end if; while Current /= No_Array_Element loop - Element := Array_Elements.Table (Current); + Element := In_Tree.Array_Elements.Table (Current); if Real_Index = Element.Index and then Src_Index = Element.Src_Index @@ -475,7 +482,8 @@ package body Prj.Util is (Name : Name_Id; Index : Int := 0; Attribute_Or_Array_Name : Name_Id; - In_Package : Package_Id) return Variable_Value + In_Package : Package_Id; + In_Tree : Project_Tree_Ref) return Variable_Value is The_Array : Array_Element_Id; The_Attribute : Variable_Value := Nil_Variable_Value; @@ -488,12 +496,14 @@ package body Prj.Util is The_Array := Value_Of (Name => Attribute_Or_Array_Name, - In_Arrays => Packages.Table (In_Package).Decl.Arrays); + In_Arrays => In_Tree.Packages.Table (In_Package).Decl.Arrays, + In_Tree => In_Tree); The_Attribute := Value_Of (Index => Name, Src_Index => Index, - In_Array => The_Array); + In_Array => The_Array, + In_Tree => In_Tree); -- If there is no array element, look for a variable @@ -501,7 +511,9 @@ package body Prj.Util is The_Attribute := Value_Of (Variable_Name => Attribute_Or_Array_Name, - In_Variables => Packages.Table (In_Package).Decl.Attributes); + In_Variables => In_Tree.Packages.Table + (In_Package).Decl.Attributes, + In_Tree => In_Tree); end if; end if; @@ -511,16 +523,18 @@ package body Prj.Util is function Value_Of (Index : Name_Id; In_Array : Name_Id; - In_Arrays : Array_Id) return Name_Id + In_Arrays : Array_Id; + In_Tree : Project_Tree_Ref) return Name_Id is Current : Array_Id := In_Arrays; The_Array : Array_Data; begin while Current /= No_Array loop - The_Array := Arrays.Table (Current); + The_Array := In_Tree.Arrays.Table (Current); if The_Array.Name = In_Array then - return Value_Of (Index, In_Array => The_Array.Value); + return Value_Of + (Index, In_Array => The_Array.Value, In_Tree => In_Tree); else Current := The_Array.Next; end if; @@ -531,14 +545,15 @@ package body Prj.Util is function Value_Of (Name : Name_Id; - In_Arrays : Array_Id) return Array_Element_Id + In_Arrays : Array_Id; + In_Tree : Project_Tree_Ref) return Array_Element_Id is Current : Array_Id := In_Arrays; The_Array : Array_Data; begin while Current /= No_Array loop - The_Array := Arrays.Table (Current); + The_Array := In_Tree.Arrays.Table (Current); if The_Array.Name = Name then return The_Array.Value; @@ -552,14 +567,15 @@ package body Prj.Util is function Value_Of (Name : Name_Id; - In_Packages : Package_Id) return Package_Id + In_Packages : Package_Id; + In_Tree : Project_Tree_Ref) return Package_Id is Current : Package_Id := In_Packages; The_Package : Package_Element; begin while Current /= No_Package loop - The_Package := Packages.Table (Current); + The_Package := In_Tree.Packages.Table (Current); exit when The_Package.Name /= No_Name and then The_Package.Name = Name; Current := The_Package.Next; @@ -570,14 +586,16 @@ package body Prj.Util is function Value_Of (Variable_Name : Name_Id; - In_Variables : Variable_Id) return Variable_Value + In_Variables : Variable_Id; + In_Tree : Project_Tree_Ref) return Variable_Value is Current : Variable_Id := In_Variables; The_Variable : Variable; begin while Current /= No_Variable loop - The_Variable := Variable_Elements.Table (Current); + The_Variable := + In_Tree.Variable_Elements.Table (Current); if Variable_Name = The_Variable.Name then return The_Variable.Value; diff --git a/gcc/ada/prj-util.ads b/gcc/ada/prj-util.ads index 7373a640d59..894acd82f07 100644 --- a/gcc/ada/prj-util.ads +++ b/gcc/ada/prj-util.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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- -- @@ -34,6 +34,7 @@ package Prj.Util is function Executable_Of (Project : Project_Id; + In_Tree : Project_Tree_Ref; Main : Name_Id; Index : Int; Ada_Main : Boolean := True) return Name_Id; @@ -51,7 +52,8 @@ package Prj.Util is function Value_Of (Index : Name_Id; - In_Array : Array_Element_Id) return Name_Id; + In_Array : Array_Element_Id; + In_Tree : Project_Tree_Ref) return Name_Id; -- Get a single string array component. Returns No_Name if there is no -- component Index, if In_Array is null, or if the component is a String -- list. Depending on the attribute (only attributes may be associative @@ -62,7 +64,8 @@ package Prj.Util is function Value_Of (Index : Name_Id; Src_Index : Int := 0; - In_Array : Array_Element_Id) return Variable_Value; + In_Array : Array_Element_Id; + In_Tree : Project_Tree_Ref) return Variable_Value; -- Get a string array component (single String or String list). -- Returns Nil_Variable_Value if there is no component Index -- or if In_Array is null. @@ -76,7 +79,8 @@ package Prj.Util is (Name : Name_Id; Index : Int := 0; Attribute_Or_Array_Name : Name_Id; - In_Package : Package_Id) return Variable_Value; + In_Package : Package_Id; + In_Tree : Project_Tree_Ref) return Variable_Value; -- In a specific package, -- - if there exists an array Attribute_Or_Array_Name with an index -- Name, returns the corresponding component (depending on the @@ -90,28 +94,32 @@ package Prj.Util is function Value_Of (Index : Name_Id; In_Array : Name_Id; - In_Arrays : Array_Id) return Name_Id; + In_Arrays : Array_Id; + In_Tree : Project_Tree_Ref) return Name_Id; -- Get a string array component in an array of an array list. -- Returns No_Name if there is no component Index, if In_Arrays is null, if -- In_Array is not found in In_Arrays or if the component is a String list. function Value_Of (Name : Name_Id; - In_Arrays : Array_Id) return Array_Element_Id; + In_Arrays : Array_Id; + In_Tree : Project_Tree_Ref) return Array_Element_Id; -- Returns a specified array in an array list. Returns No_Array_Element -- if In_Arrays is null or if Name is not the name of an array in -- In_Arrays. The caller must ensure that Name is in lower case. function Value_Of (Name : Name_Id; - In_Packages : Package_Id) return Package_Id; + In_Packages : Package_Id; + In_Tree : Project_Tree_Ref) return Package_Id; -- Returns a specified package in a package list. Returns No_Package -- if In_Packages is null or if Name is not the name of a package in -- Package_List. The caller must ensure that Name is in lower case. function Value_Of (Variable_Name : Name_Id; - In_Variables : Variable_Id) return Variable_Value; + In_Variables : Variable_Id; + In_Tree : Project_Tree_Ref) return Variable_Value; -- Returns a specified variable in a variable list. Returns null if -- In_Variables is null or if Variable_Name is not the name of a -- variable in In_Variables. Caller must ensure that Name is lower case. diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 602d3a5c550..8158de78dc5 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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- -- @@ -30,7 +30,6 @@ with Namet; use Namet; with Output; use Output; with Osint; use Osint; with Prj.Attr; -with Prj.Com; with Prj.Env; with Prj.Err; use Prj.Err; with Scans; use Scans; @@ -42,10 +41,18 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; package body Prj is + Initial_Buffer_Size : constant := 100; + -- Initial size for extensible buffer used in Add_To_Buffer + The_Empty_String : Name_Id; Name_C_Plus_Plus : Name_Id; + Default_Ada_Spec_Suffix_Id : Name_Id; + Default_Ada_Body_Suffix_Id : Name_Id; + Slash_Id : Name_Id; + -- Initialized in Prj.Initialized, then never modified + subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case; The_Casing_Images : constant array (Known_Casing) of String_Access := @@ -77,7 +84,7 @@ package body Prj is Specification_Exceptions => No_Array_Element, Implementation_Exceptions => No_Array_Element); - Project_Empty : constant Project_Data := + Project_Empty : Project_Data := (Externally_Built => False, Languages => No_Languages, Supp_Languages => No_Supp_Language_Index, @@ -157,26 +164,53 @@ package body Prj is -- Add_To_Buffer -- ------------------- - procedure Add_To_Buffer (S : String) is + procedure Add_To_Buffer + (S : String; + To : in out String_Access; + Last : in out Natural) + is begin + if To = null then + To := new String (1 .. Initial_Buffer_Size); + Last := 0; + end if; + -- If Buffer is too small, double its size - if Buffer_Last + S'Length > Buffer'Last then + while Last + S'Length > To'Last loop declare New_Buffer : constant String_Access := - new String (1 .. 2 * Buffer'Last); + new String (1 .. 2 * Last); begin - New_Buffer (1 .. Buffer_Last) := Buffer (1 .. Buffer_Last); - Free (Buffer); - Buffer := New_Buffer; + New_Buffer (1 .. Last) := To (1 .. Last); + Free (To); + To := New_Buffer; end; - end if; + end loop; - Buffer (Buffer_Last + 1 .. Buffer_Last + S'Length) := S; - Buffer_Last := Buffer_Last + S'Length; + To (Last + 1 .. Last + S'Length) := S; + Last := Last + S'Length; end Add_To_Buffer; + ----------------------------- + -- Default_Ada_Body_Suffix -- + ----------------------------- + + function Default_Ada_Body_Suffix return Name_Id is + begin + return Default_Ada_Body_Suffix_Id; + end Default_Ada_Body_Suffix; + + ----------------------------- + -- Default_Ada_Spec_Suffix -- + ----------------------------- + + function Default_Ada_Spec_Suffix return Name_Id is + begin + return Default_Ada_Spec_Suffix_Id; + end Default_Ada_Spec_Suffix; + --------------------------- -- Display_Language_Name -- --------------------------- @@ -192,10 +226,12 @@ package body Prj is -- Empty_Project -- ------------------- - function Empty_Project return Project_Data is + function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is + Value : Project_Data := Project_Empty; begin - Prj.Initialize; - return Project_Empty; + Prj.Initialize (Tree => No_Project_Tree); + Value.Naming := Tree.Private_Part.Default_Naming; + return Value; end Empty_Project; ------------------ @@ -224,41 +260,45 @@ package body Prj is procedure For_Every_Project_Imported (By : Project_Id; + In_Tree : Project_Tree_Ref; With_State : in out State) is - procedure Check (Project : Project_Id); + procedure Recursive_Check (Project : Project_Id); -- Check if a project has already been seen. If not seen, mark it as -- Seen, Call Action, and check all its imported projects. - ----------- - -- Check -- - ----------- + --------------------- + -- Recursive_Check -- + --------------------- - procedure Check (Project : Project_Id) is + procedure Recursive_Check (Project : Project_Id) is List : Project_List; begin - if not Projects.Table (Project).Seen then - Projects.Table (Project).Seen := True; + if not In_Tree.Projects.Table (Project).Seen then + In_Tree.Projects.Table (Project).Seen := True; Action (Project, With_State); - List := Projects.Table (Project).Imported_Projects; + List := + In_Tree.Projects.Table (Project).Imported_Projects; while List /= Empty_Project_List loop - Check (Project_Lists.Table (List).Project); - List := Project_Lists.Table (List).Next; + Recursive_Check (In_Tree.Project_Lists.Table (List).Project); + List := In_Tree.Project_Lists.Table (List).Next; end loop; end if; - end Check; + end Recursive_Check; - -- Start of procecessing for For_Every_Project_Imported + -- Start of processing for For_Every_Project_Imported begin - for Project in Projects.First .. Projects.Last loop - Projects.Table (Project).Seen := False; + for Project in Project_Table.First .. + Project_Table.Last (In_Tree.Projects) + loop + In_Tree.Projects.Table (Project).Seen := False; end loop; - Check (Project => By); + Recursive_Check (Project => By); end For_Every_Project_Imported; ---------- @@ -283,7 +323,7 @@ package body Prj is -- Initialize -- ---------------- - procedure Initialize is + procedure Initialize (Tree : Project_Tree_Ref) is begin if not Initialized then Initialized := True; @@ -293,24 +333,21 @@ package body Prj is Empty_Name := The_Empty_String; Name_Len := 4; Name_Buffer (1 .. 4) := ".ads"; - Default_Ada_Spec_Suffix := Name_Find; + Default_Ada_Spec_Suffix_Id := Name_Find; Name_Len := 4; Name_Buffer (1 .. 4) := ".adb"; - Default_Ada_Body_Suffix := Name_Find; + Default_Ada_Body_Suffix_Id := Name_Find; Name_Len := 1; Name_Buffer (1) := '/'; - Slash := Name_Find; + Slash_Id := Name_Find; Name_Len := 3; Name_Buffer (1 .. 3) := "c++"; Name_C_Plus_Plus := Name_Find; Std_Naming_Data.Ada_Spec_Suffix := Default_Ada_Spec_Suffix; Std_Naming_Data.Ada_Body_Suffix := Default_Ada_Body_Suffix; - Std_Naming_Data.Separate_Suffix := Default_Ada_Body_Suffix; - Register_Default_Naming_Scheme - (Language => Name_Ada, - Default_Spec_Suffix => Default_Ada_Spec_Suffix, - Default_Body_Suffix => Default_Ada_Body_Suffix); + Std_Naming_Data.Separate_Suffix := Default_Ada_Body_Suffix; + Project_Empty.Naming := Std_Naming_Data; Prj.Env.Initialize; Prj.Attr.Initialize; Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project)); @@ -324,6 +361,10 @@ package body Prj is Add_Language_Name (Name_C); Add_Language_Name (Name_C_Plus_Plus); end if; + + if Tree /= No_Project_Tree then + Reset (Tree); + end if; end Initialize; ---------------- @@ -332,7 +373,8 @@ package body Prj is function Is_Present (Language : Language_Index; - In_Project : Project_Data) return Boolean + In_Project : Project_Data; + In_Tree : Project_Tree_Ref) return Boolean is begin case Language is @@ -349,7 +391,7 @@ package body Prj is begin while Supp_Index /= No_Supp_Language_Index loop - Supp := Present_Languages.Table (Supp_Index); + Supp := In_Tree.Present_Languages.Table (Supp_Index); if Supp.Index = Language then return Supp.Present; @@ -369,7 +411,8 @@ package body Prj is function Language_Processing_Data_Of (Language : Language_Index; - In_Project : Project_Data) return Language_Processing_Data + In_Project : Project_Data; + In_Tree : Project_Tree_Ref) return Language_Processing_Data is begin case Language is @@ -387,7 +430,7 @@ package body Prj is begin while Supp_Index /= No_Supp_Language_Index loop - Supp := Supp_Languages.Table (Supp_Index); + Supp := In_Tree.Supp_Languages.Table (Supp_Index); if Supp.Index = Language then return Supp.Data; @@ -408,7 +451,8 @@ package body Prj is procedure Register_Default_Naming_Scheme (Language : Name_Id; Default_Spec_Suffix : Name_Id; - Default_Body_Suffix : Name_Id) + Default_Body_Suffix : Name_Id; + In_Tree : Project_Tree_Ref) is Lang : Name_Id; Suffix : Array_Element_Id; @@ -422,19 +466,19 @@ package body Prj is Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len)); Lang := Name_Find; - Suffix := Std_Naming_Data.Spec_Suffix; + Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix; Found := False; -- Look for an element of the spec sufix array indexed by the language -- name. If one is found, put the default value. while Suffix /= No_Array_Element and then not Found loop - Element := Array_Elements.Table (Suffix); + Element := In_Tree.Array_Elements.Table (Suffix); if Element.Index = Lang then Found := True; Element.Value.Value := Default_Spec_Suffix; - Array_Elements.Table (Suffix) := Element; + In_Tree.Array_Elements.Table (Suffix) := Element; else Suffix := Element.Next; @@ -454,25 +498,28 @@ package body Prj is Default => False, Value => Default_Spec_Suffix, Index => 0), - Next => Std_Naming_Data.Spec_Suffix); - Array_Elements.Increment_Last; - Array_Elements.Table (Array_Elements.Last) := Element; - Std_Naming_Data.Spec_Suffix := Array_Elements.Last; + Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix); + Array_Element_Table.Increment_Last (In_Tree.Array_Elements); + In_Tree.Array_Elements.Table + (Array_Element_Table.Last (In_Tree.Array_Elements)) := + Element; + In_Tree.Private_Part.Default_Naming.Spec_Suffix := + Array_Element_Table.Last (In_Tree.Array_Elements); end if; - Suffix := Std_Naming_Data.Body_Suffix; + Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix; Found := False; -- Look for an element of the body sufix array indexed by the language -- name. If one is found, put the default value. while Suffix /= No_Array_Element and then not Found loop - Element := Array_Elements.Table (Suffix); + Element := In_Tree.Array_Elements.Table (Suffix); if Element.Index = Lang then Found := True; Element.Value.Value := Default_Body_Suffix; - Array_Elements.Table (Suffix) := Element; + In_Tree.Array_Elements.Table (Suffix) := Element; else Suffix := Element.Next; @@ -492,10 +539,14 @@ package body Prj is Default => False, Value => Default_Body_Suffix, Index => 0), - Next => Std_Naming_Data.Body_Suffix); - Array_Elements.Increment_Last; - Array_Elements.Table (Array_Elements.Last) := Element; - Std_Naming_Data.Body_Suffix := Array_Elements.Last; + Next => In_Tree.Private_Part.Default_Naming.Body_Suffix); + Array_Element_Table.Increment_Last + (In_Tree.Array_Elements); + In_Tree.Array_Elements.Table + (Array_Element_Table.Last (In_Tree.Array_Elements)) + := Element; + In_Tree.Private_Part.Default_Naming.Body_Suffix := + Array_Element_Table.Last (In_Tree.Array_Elements); end if; end Register_Default_Naming_Scheme; @@ -503,17 +554,34 @@ package body Prj is -- Reset -- ----------- - procedure Reset is + procedure Reset (Tree : Project_Tree_Ref) is begin - Projects.Init; - Project_Lists.Init; - Packages.Init; - Arrays.Init; - Variable_Elements.Init; - String_Elements.Init; - Prj.Com.Units.Init; - Prj.Com.Units_Htable.Reset; - Prj.Com.Files_Htable.Reset; + Prj.Env.Initialize; + Present_Language_Table.Init (Tree.Present_Languages); + Supp_Suffix_Table.Init (Tree.Supp_Suffixes); + Name_List_Table.Init (Tree.Name_Lists); + Supp_Language_Table.Init (Tree.Supp_Languages); + Other_Source_Table.Init (Tree.Other_Sources); + String_Element_Table.Init (Tree.String_Elements); + Variable_Element_Table.Init (Tree.Variable_Elements); + Array_Element_Table.Init (Tree.Array_Elements); + Array_Table.Init (Tree.Arrays); + Package_Table.Init (Tree.Packages); + Project_List_Table.Init (Tree.Project_Lists); + Project_Table.Init (Tree.Projects); + Unit_Table.Init (Tree.Units); + Units_Htable.Reset (Tree.Units_HT); + Files_Htable.Reset (Tree.Files_HT); + Naming_Table.Init (Tree.Private_Part.Namings); + Path_File_Table.Init (Tree.Private_Part.Path_Files); + Source_Path_Table.Init (Tree.Private_Part.Source_Paths); + Object_Path_Table.Init (Tree.Private_Part.Object_Paths); + Tree.Private_Part.Default_Naming := Std_Naming_Data; + Register_Default_Naming_Scheme + (Language => Name_Ada, + Default_Spec_Suffix => Default_Ada_Spec_Suffix, + Default_Body_Suffix => Default_Ada_Body_Suffix, + In_Tree => Tree); end Reset; ------------------------ @@ -538,7 +606,8 @@ package body Prj is procedure Set (Language : Language_Index; Present : Boolean; - In_Project : in out Project_Data) + In_Project : in out Project_Data; + In_Tree : Project_Tree_Ref) is begin case Language is @@ -555,10 +624,12 @@ package body Prj is begin while Supp_Index /= No_Supp_Language_Index loop - Supp := Present_Languages.Table (Supp_Index); + Supp := In_Tree.Present_Languages.Table + (Supp_Index); if Supp.Index = Language then - Present_Languages.Table (Supp_Index).Present := Present; + In_Tree.Present_Languages.Table + (Supp_Index).Present := Present; return; end if; @@ -567,9 +638,12 @@ package body Prj is Supp := (Index => Language, Present => Present, Next => In_Project.Supp_Languages); - Present_Languages.Increment_Last; - Supp_Index := Present_Languages.Last; - Present_Languages.Table (Supp_Index) := Supp; + Present_Language_Table.Increment_Last + (In_Tree.Present_Languages); + Supp_Index := Present_Language_Table.Last + (In_Tree.Present_Languages); + In_Tree.Present_Languages.Table (Supp_Index) := + Supp; In_Project.Supp_Languages := Supp_Index; end; end case; @@ -578,7 +652,8 @@ package body Prj is procedure Set (Language_Processing : in Language_Processing_Data; For_Language : Language_Index; - In_Project : in out Project_Data) + In_Project : in out Project_Data; + In_Tree : Project_Tree_Ref) is begin case For_Language is @@ -597,11 +672,12 @@ package body Prj is begin while Supp_Index /= No_Supp_Language_Index loop - Supp := Supp_Languages.Table (Supp_Index); + Supp := In_Tree.Supp_Languages.Table + (Supp_Index); if Supp.Index = For_Language then - Supp_Languages.Table (Supp_Index).Data := - Language_Processing; + In_Tree.Supp_Languages.Table + (Supp_Index).Data := Language_Processing; return; end if; @@ -610,9 +686,11 @@ package body Prj is Supp := (Index => For_Language, Data => Language_Processing, Next => In_Project.Supp_Language_Processing); - Supp_Languages.Increment_Last; - Supp_Index := Supp_Languages.Last; - Supp_Languages.Table (Supp_Index) := Supp; + Supp_Language_Table.Increment_Last + (In_Tree.Supp_Languages); + Supp_Index := Supp_Language_Table.Last + (In_Tree.Supp_Languages); + In_Tree.Supp_Languages.Table (Supp_Index) := Supp; In_Project.Supp_Language_Processing := Supp_Index; end; end case; @@ -621,7 +699,8 @@ package body Prj is procedure Set (Suffix : Name_Id; For_Language : Language_Index; - In_Project : in out Project_Data) + In_Project : in out Project_Data; + In_Tree : Project_Tree_Ref) is begin case For_Language is @@ -639,10 +718,12 @@ package body Prj is begin while Supp_Index /= No_Supp_Language_Index loop - Supp := Supp_Suffix_Table.Table (Supp_Index); + Supp := In_Tree.Supp_Suffixes.Table + (Supp_Index); if Supp.Index = For_Language then - Supp_Suffix_Table.Table (Supp_Index).Suffix := Suffix; + In_Tree.Supp_Suffixes.Table + (Supp_Index).Suffix := Suffix; return; end if; @@ -651,23 +732,40 @@ package body Prj is Supp := (Index => For_Language, Suffix => Suffix, Next => In_Project.Naming.Supp_Suffixes); - Supp_Suffix_Table.Increment_Last; - Supp_Index := Supp_Suffix_Table.Last; - Supp_Suffix_Table.Table (Supp_Index) := Supp; + Supp_Suffix_Table.Increment_Last + (In_Tree.Supp_Suffixes); + Supp_Index := Supp_Suffix_Table.Last + (In_Tree.Supp_Suffixes); + In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp; In_Project.Naming.Supp_Suffixes := Supp_Index; end; end case; end Set; + ----------- + -- Slash -- + ----------- + + function Slash return Name_Id is + begin + return Slash_Id; + end Slash; -------------------------- -- Standard_Naming_Data -- -------------------------- - function Standard_Naming_Data return Naming_Data is + function Standard_Naming_Data (Tree : Project_Tree_Ref := No_Project_Tree) + return Naming_Data + is begin - Prj.Initialize; - return Std_Naming_Data; + if Tree = No_Project_Tree then + Prj.Initialize (Tree => No_Project_Tree); + return Std_Naming_Data; + + else + return Tree.Private_Part.Default_Naming; + end if; end Standard_Naming_Data; --------------- @@ -676,7 +774,8 @@ package body Prj is function Suffix_Of (Language : Language_Index; - In_Project : Project_Data) return Name_Id + In_Project : Project_Data; + In_Tree : Project_Tree_Ref) return Name_Id is begin case Language is @@ -694,7 +793,8 @@ package body Prj is begin while Supp_Index /= No_Supp_Language_Index loop - Supp := Supp_Suffix_Table.Table (Supp_Index); + Supp := In_Tree.Supp_Suffixes.Table + (Supp_Index); if Supp.Index = Language then return Supp.Suffix; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 21c796c4977..a1b685e153d 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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- -- @@ -35,39 +35,47 @@ with Scans; use Scans; with Table; with Types; use Types; -with GNAT.OS_Lib; use GNAT.OS_Lib; +with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables; +with GNAT.Dynamic_Tables; +with GNAT.OS_Lib; use GNAT.OS_Lib; -with System.HTable; use System.HTable; +with System.HTable; package Prj is - Empty_Name : Name_Id; - -- Name_Id for an empty name (no characters). Initialized by the call - -- to procedure Initialize. - - All_Packages : constant String_List_Access := null; + All_Packages : constant String_List_Access; -- Default value of parameter Packages of procedures Parse, in Prj.Pars and -- Prj.Part, indicating that all packages should be checked. - Virtual_Prefix : constant String := "v$"; - -- The prefix for virtual extending projects. Because of the '$', which is - -- normally forbidden for project names, there cannot be any name clash. + type Project_Tree_Data; + type Project_Tree_Ref is access all Project_Tree_Data; + -- Reference to a project tree. + -- Several project trees may exist in memory at the same time. - Project_File_Extension : String := ".gpr"; - -- The standard project file name extension. It is not a constant, because - -- Canonical_Case_File_Name is called on this variable in the body of Prj. + No_Project_Tree : constant Project_Tree_Ref; - Default_Ada_Spec_Suffix : Name_Id; + function Default_Ada_Spec_Suffix return Name_Id; + pragma Inline (Default_Ada_Spec_Suffix); -- The Name_Id for the standard GNAT suffix for Ada spec source file -- name ".ads". Initialized by Prj.Initialize. - Default_Ada_Body_Suffix : Name_Id; + function Default_Ada_Body_Suffix return Name_Id; + pragma Inline (Default_Ada_Body_Suffix); -- The Name_Id for the standard GNAT suffix for Ada body source file -- name ".adb". Initialized by Prj.Initialize. - Slash : Name_Id; + function Slash return Name_Id; + pragma Inline (Slash); -- "/", used as the path of locally removed files + Project_File_Extension : String := ".gpr"; + -- The standard project file name extension. It is not a constant, because + -- Canonical_Case_File_Name is called on this variable in the body of Prj. + + ----------------------------------------------------- + -- Multi-language stuff that will be modified soon -- + ----------------------------------------------------- + type Language_Index is new Nat; No_Language_Index : constant Language_Index := 0; @@ -129,13 +137,12 @@ package Prj is Next : Supp_Language_Index := No_Supp_Language_Index; end record; - package Present_Languages is new Table.Table + package Present_Language_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Supp_Language, Table_Index_Type => Supp_Language_Index, Table_Low_Bound => 1, Table_Initial => 4, - Table_Increment => 100, - Table_Name => "Prj.Present_Languages"); + Table_Increment => 100); -- The table for the presence of languages with an index that is outside -- of First_Language_Indexes. @@ -152,13 +159,12 @@ package Prj is Next : Supp_Language_Index := No_Supp_Language_Index; end record; - package Supp_Suffix_Table is new Table.Table + package Supp_Suffix_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Supp_Suffix, Table_Index_Type => Supp_Language_Index, Table_Low_Bound => 1, Table_Initial => 4, - Table_Increment => 100, - Table_Name => "Prj.Supp_Suffix_Table"); + Table_Increment => 100); -- The table for the presence of languages with an index that is outside -- of First_Language_Indexes. @@ -172,13 +178,12 @@ package Prj is Next : Name_List_Index := No_Name_List; end record; - package Name_Lists is new Table.Table + package Name_List_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Name_Node, Table_Index_Type => Name_List_Index, Table_Low_Bound => 1, Table_Initial => 10, - Table_Increment => 100, - Table_Name => "Prj.Name_Lists"); + Table_Increment => 100); -- The table for lists of names used in package Language_Processing type Language_Processing_Data is record @@ -206,8 +211,9 @@ package Prj is type First_Language_Processing_Data is array (First_Language_Indexes) of Language_Processing_Data; - Default_First_Language_Processing_Data : First_Language_Processing_Data := - (others => Default_Language_Processing_Data); + Default_First_Language_Processing_Data : + constant First_Language_Processing_Data := + (others => Default_Language_Processing_Data); type Supp_Language_Data is record Index : Language_Index := No_Language_Index; @@ -215,13 +221,12 @@ package Prj is Next : Supp_Language_Index := No_Supp_Language_Index; end record; - package Supp_Languages is new Table.Table + package Supp_Language_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Supp_Language_Data, Table_Index_Type => Supp_Language_Index, Table_Low_Bound => 1, Table_Initial => 4, - Table_Increment => 100, - Table_Name => "Prj.Supp_Languages"); + Table_Increment => 100); -- The table for language data when there are more languages than -- in First_Language_Indexes. @@ -243,21 +248,27 @@ package Prj is end record; -- Data for a source in a language other than Ada - package Other_Sources is new Table.Table + package Other_Source_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Other_Source, Table_Index_Type => Other_Source_Id, Table_Low_Bound => 1, Table_Initial => 200, - Table_Increment => 100, - Table_Name => "Prj.Other_Sources"); + Table_Increment => 100); -- The table for sources of languages other than Ada + ---------------------------------- + -- End of multi-language stuff -- + ---------------------------------- + type Verbosity is (Default, Medium, High); -- Verbosity when parsing GNAT Project Files -- Default is default (very quiet, if no errors). -- Medium is more verbose. -- High is extremely verbose. + Current_Verbosity : Verbosity := Default; + -- The current value of the verbosity the project files are parsed with + type Lib_Kind is (Static, Dynamic, Relocatable); type Policy is (Autonomous, Compliant, Controlled, Restricted); -- Type to specify the symbol policy, when symbol control is supported. @@ -274,7 +285,7 @@ package Prj is end record; -- Type to keep the symbol data to be used when building a shared library - No_Symbols : Symbol_Record := + No_Symbols : constant Symbol_Record := (Symbol_File => No_Name, Reference => No_Name, Symbol_Policy => Autonomous); @@ -301,13 +312,12 @@ package Prj is -- Component Flag may be used for various purposes. For source -- directories, it indicates if the directory contains Ada source(s). - package String_Elements is new Table.Table + package String_Element_Table is new GNAT.Dynamic_Tables (Table_Component_Type => String_Element, Table_Index_Type => String_List_Id, Table_Low_Bound => 1, Table_Initial => 200, - Table_Increment => 100, - Table_Name => "Prj.String_Elements"); + Table_Increment => 100); -- The table for string elements in string lists type Variable_Kind is (Undefined, List, Single); @@ -316,7 +326,7 @@ package Prj is subtype Defined_Variable_Kind is Variable_Kind range List .. Single; -- The defined kinds of variables - Ignored : constant Variable_Kind := Single; + Ignored : constant Variable_Kind; -- Used to indicate that a package declaration must be ignored -- while processing the project tree (unknown package name). @@ -337,11 +347,7 @@ package Prj is -- Values for variables and array elements. Default is True if the -- current value is the default one for the variable - Nil_Variable_Value : constant Variable_Value := - (Project => No_Project, - Kind => Undefined, - Location => No_Location, - Default => False); + Nil_Variable_Value : constant Variable_Value; -- Value of a non existing variable or array element type Variable_Id is new Nat; @@ -353,13 +359,12 @@ package Prj is end record; -- To hold the list of variables in a project file and in packages - package Variable_Elements is new Table.Table + package Variable_Element_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Variable, Table_Index_Type => Variable_Id, Table_Low_Bound => 1, Table_Initial => 200, - Table_Increment => 100, - Table_Name => "Prj.Variable_Elements"); + Table_Increment => 100); -- The table of variable in list of variables type Array_Element_Id is new Nat; @@ -374,13 +379,12 @@ package Prj is -- Each Array_Element represents an array element and is linked (Next) -- to the next array element, if any, in the array. - package Array_Elements is new Table.Table + package Array_Element_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Array_Element, Table_Index_Type => Array_Element_Id, Table_Low_Bound => 1, Table_Initial => 200, - Table_Increment => 100, - Table_Name => "Prj.Array_Elements"); + Table_Increment => 100); -- The table that contains all array elements type Array_Id is new Nat; @@ -394,13 +398,12 @@ package Prj is -- Value is the id of the first element. -- Next is the id of the next array in the project file or package. - package Arrays is new Table.Table + package Array_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Array_Data, Table_Index_Type => Array_Id, Table_Low_Bound => 1, Table_Initial => 200, - Table_Increment => 100, - Table_Name => "Prj.Arrays"); + Table_Increment => 100); -- The table that contains all arrays type Package_Id is new Nat; @@ -429,13 +432,12 @@ package Prj is end record; -- A package. Includes declarations that may include other packages. - package Packages is new Table.Table + package Package_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Package_Element, Table_Index_Type => Package_Id, Table_Low_Bound => 1, Table_Initial => 100, - Table_Increment => 100, - Table_Name => "Prj.Packages"); + Table_Increment => 100); -- The table that contains all packages. function Image (Casing : Casing_Type) return String; @@ -511,9 +513,12 @@ package Prj is end record; - function Standard_Naming_Data return Naming_Data; + function Standard_Naming_Data (Tree : Project_Tree_Ref := No_Project_Tree) + return Naming_Data; pragma Inline (Standard_Naming_Data); - -- The standard GNAT naming scheme + -- The standard GNAT naming scheme when Tree is No_Project_Tree. + -- Otherwise, return the default naming scheme for the project tree Tree, + -- which must have been Initialized. function Same_Naming_Scheme (Left, Right : Naming_Data) return Boolean; @@ -531,13 +536,12 @@ package Prj is -- Element in a list of project files. Next is the id of the next -- project file in the list. - package Project_Lists is new Table.Table + package Project_List_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Project_Element, Table_Index_Type => Project_List, Table_Low_Bound => 1, Table_Initial => 100, - Table_Increment => 100, - Table_Name => "Prj.Project_Lists"); + Table_Increment => 100); -- The table that contains the lists of project files -- The following record describes a project file representation @@ -782,80 +786,126 @@ package Prj is end record; - function Is_Present - (Language : Language_Index; - In_Project : Project_Data) return Boolean; - -- Return True when Language is one of the languages used in - -- project Project. - - procedure Set - (Language : Language_Index; - Present : Boolean; - In_Project : in out Project_Data); - -- Indicate if Language is or not a language used in project Project - - function Language_Processing_Data_Of - (Language : Language_Index; - In_Project : Project_Data) return Language_Processing_Data; - -- Return the Language_Processing_Data for language Language in project - -- In_Project. Return the default when no Language_Processing_Data are - -- defined for the language. - - procedure Set - (Language_Processing : Language_Processing_Data; - For_Language : Language_Index; - In_Project : in out Project_Data); - -- Set the Language_Processing_Data for language Language in project - -- In_Project. - - function Suffix_Of - (Language : Language_Index; - In_Project : Project_Data) return Name_Id; - -- Return the suffix for language Language in project In_Project. Return - -- No_Name when no suffix is defined for the language. - - procedure Set - (Suffix : Name_Id; - For_Language : Language_Index; - In_Project : in out Project_Data); - -- Set the suffix for language Language in project In_Project + function Empty_Project (Tree : Project_Tree_Ref) return Project_Data; + -- Return the representation of an empty project in project Tree tree. + -- The project tree Tree must have been Initialized and/or Reset. Project_Error : exception; -- Raised by some subprograms in Prj.Attr. - function Empty_Project return Project_Data; - -- Return the representation of an empty project - - package Projects is new Table.Table ( + package Project_Table is new GNAT.Dynamic_Tables ( Table_Component_Type => Project_Data, Table_Index_Type => Project_Id, Table_Low_Bound => 1, Table_Initial => 100, - Table_Increment => 100, - Table_Name => "Prj.Projects"); + Table_Increment => 100); -- The set of all project files + type Spec_Or_Body is + (Specification, Body_Part); + + type File_Name_Data is record + Name : Name_Id := No_Name; + Index : Int := 0; + Display_Name : Name_Id := No_Name; + Path : Name_Id := No_Name; + Display_Path : Name_Id := No_Name; + Project : Project_Id := No_Project; + Needs_Pragma : Boolean := False; + end record; + -- File and Path name of a spec or body. + + type File_Names_Data is array (Spec_Or_Body) of File_Name_Data; + + type Unit_Id is new Nat; + No_Unit : constant Unit_Id := 0; + type Unit_Data is record + Name : Name_Id := No_Name; + File_Names : File_Names_Data; + end record; + -- Name and File and Path names of a unit, with a reference to its + -- GNAT Project File(s). + + package Unit_Table is new GNAT.Dynamic_Tables + (Table_Component_Type => Unit_Data, + Table_Index_Type => Unit_Id, + Table_Low_Bound => 1, + Table_Initial => 100, + Table_Increment => 100); + -- Table of all units in a project tree + + package Units_Htable is new Simple_HTable + (Header_Num => Header_Num, + Element => Unit_Id, + No_Element => No_Unit, + Key => Name_Id, + Hash => Hash, + Equal => "="); + -- Mapping of unit names to indexes in the Units table + + type Unit_Project is record + Unit : Unit_Id := No_Unit; + Project : Project_Id := No_Project; + end record; + + No_Unit_Project : constant Unit_Project := (No_Unit, No_Project); + + package Files_Htable is new Simple_HTable + (Header_Num => Header_Num, + Element => Unit_Project, + No_Element => No_Unit_Project, + Key => Name_Id, + Hash => Hash, + Equal => "="); + -- Mapping of file names to indexes in the Units table + + type Private_Project_Tree_Data is private; + -- Data for a project tree that is used only by the Project Manager + + type Project_Tree_Data is + record + Present_Languages : Present_Language_Table.Instance; + Supp_Suffixes : Supp_Suffix_Table.Instance; + Name_Lists : Name_List_Table.Instance; + Supp_Languages : Supp_Language_Table.Instance; + Other_Sources : Other_Source_Table.Instance; + String_Elements : String_Element_Table.Instance; + Variable_Elements : Variable_Element_Table.Instance; + Array_Elements : Array_Element_Table.Instance; + Arrays : Array_Table.Instance; + Packages : Package_Table.Instance; + Project_Lists : Project_List_Table.Instance; + Projects : Project_Table.Instance; + Units : Unit_Table.Instance; + Units_HT : Units_Htable.Instance; + Files_HT : Files_Htable.Instance; + Private_Part : Private_Project_Tree_Data; + end record; + -- Data for a project tree + type Put_Line_Access is access procedure (Line : String; - Project : Project_Id); + Project : Project_Id; + In_Tree : Project_Tree_Ref); -- Use to customize error reporting in Prj.Proc and Prj.Nmsc procedure Expect (The_Token : Token_Type; Token_Image : String); -- Check that the current token is The_Token. If it is not, then -- output an error message. - procedure Initialize; + procedure Initialize (Tree : Project_Tree_Ref); -- This procedure must be called before using any services from the Prj -- hierarchy. Namet.Initialize must be called before Prj.Initialize. - procedure Reset; + procedure Reset (Tree : Project_Tree_Ref); -- This procedure resets all the tables that are used when processing a -- project file tree. Initialize must be called before the call to Reset. procedure Register_Default_Naming_Scheme (Language : Name_Id; Default_Spec_Suffix : Name_Id; - Default_Body_Suffix : Name_Id); + Default_Body_Suffix : Name_Id; + In_Tree : Project_Tree_Ref); -- Register the default suffixes for a given language. These extensions -- will be ignored if the user has specified a new naming scheme in a -- project file. @@ -870,29 +920,132 @@ package Prj is With_State : in out State); procedure For_Every_Project_Imported (By : Project_Id; + In_Tree : Project_Tree_Ref; With_State : in out State); -- Call Action for each project imported directly or indirectly by project -- By. Action is called according to the order of importation: if A -- imports B, directly or indirectly, Action will be called for A before - -- it is called for B. With_State may be used by Action to choose a - -- behavior or to report some global result. + -- it is called for B. If two projects import each other directly or + -- indirectly (using at least one "limited with"), it is not specified + -- for which of these two projects Action will be called first. Projects + -- that are extended by other projects are not considered. With_State may + -- be used by Action to choose a behavior or to report some global result. + + ---------------------------------------------------------- + -- Other multi-language stuff that may be modified soon -- + ---------------------------------------------------------- + + function Is_Present + (Language : Language_Index; + In_Project : Project_Data; + In_Tree : Project_Tree_Ref) return Boolean; + -- Return True when Language is one of the languages used in + -- project Project. + + procedure Set + (Language : Language_Index; + Present : Boolean; + In_Project : in out Project_Data; + In_Tree : Project_Tree_Ref); + -- Indicate if Language is or not a language used in project Project + + function Language_Processing_Data_Of + (Language : Language_Index; + In_Project : Project_Data; + In_Tree : Project_Tree_Ref) return Language_Processing_Data; + -- Return the Language_Processing_Data for language Language in project + -- In_Project. Return the default when no Language_Processing_Data are + -- defined for the language. + + procedure Set + (Language_Processing : Language_Processing_Data; + For_Language : Language_Index; + In_Project : in out Project_Data; + In_Tree : Project_Tree_Ref); + -- Set the Language_Processing_Data for language Language in project + -- In_Project. + + function Suffix_Of + (Language : Language_Index; + In_Project : Project_Data; + In_Tree : Project_Tree_Ref) return Name_Id; + -- Return the suffix for language Language in project In_Project. Return + -- No_Name when no suffix is defined for the language. + + procedure Set + (Suffix : Name_Id; + For_Language : Language_Index; + In_Project : in out Project_Data; + In_Tree : Project_Tree_Ref); + -- Set the suffix for language Language in project In_Project private - Initial_Buffer_Size : constant := 100; - -- Initial size for extensible buffer used below + All_Packages : constant String_List_Access := null; - Buffer : String_Access := new String (1 .. Initial_Buffer_Size); - -- An extensible character buffer to store names. Used in Prj.Part and - -- Prj.Strt. + No_Project_Tree : constant Project_Tree_Ref := null; - Buffer_Last : Natural := 0; - -- The index of the last character in the Buffer + Ignored : constant Variable_Kind := Single; - Current_Packages_To_Check : String_List_Access := All_Packages; - -- Global variable, set by Prj.Part.Parse, used by Prj.Dect. + Nil_Variable_Value : constant Variable_Value := + (Project => No_Project, + Kind => Undefined, + Location => No_Location, + Default => False); - procedure Add_To_Buffer (S : String); + Virtual_Prefix : constant String := "v$"; + -- The prefix for virtual extending projects. Because of the '$', which is + -- normally forbidden for project names, there cannot be any name clash. + + Empty_Name : Name_Id; + -- Name_Id for an empty name (no characters). Initialized by the call + -- to procedure Initialize. + + procedure Add_To_Buffer + (S : String; + To : in out String_Access; + Last : in out Natural); -- Append a String to the Buffer + type Naming_Id is new Nat; + + package Naming_Table is new GNAT.Dynamic_Tables + (Table_Component_Type => Naming_Data, + Table_Index_Type => Naming_Id, + Table_Low_Bound => 1, + Table_Initial => 5, + Table_Increment => 100); + + package Path_File_Table is new GNAT.Dynamic_Tables + (Table_Component_Type => Name_Id, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 50, + Table_Increment => 50); + -- Table storing all the temp path file names. + -- Used by Delete_All_Path_Files. + + package Source_Path_Table is new GNAT.Dynamic_Tables + (Table_Component_Type => Name_Id, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 50, + Table_Increment => 50); + -- A table to store the source dirs before creating the source path file + + package Object_Path_Table is new GNAT.Dynamic_Tables + (Table_Component_Type => Name_Id, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 50, + Table_Increment => 50); + -- A table to store the object dirs, before creating the object path file + + type Private_Project_Tree_Data is record + Namings : Naming_Table.Instance; + Path_Files : Path_File_Table.Instance; + Source_Paths : Source_Path_Table.Instance; + Object_Paths : Object_Path_Table.Instance; + Default_Naming : Naming_Data; + end record; end Prj; |