diff options
47 files changed, 5507 insertions, 3557 deletions
diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index c0f6e16..6a53dba 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 0a836043..3164658 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 e799e05..71f95c4 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 28b4670..3cc8ad5 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 926affc..de81c52 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 0a3f11a..2053e3e 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 03ca2d0..541f485 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 7f8ac59..dac5df9 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 004cab8..6c2d443 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 d10becf..ce4b261 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 eee46a1..b3b103e 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 71584f2..762d136 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 0f1be1f..4827e6a 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 140bbcc..9bd970b 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 7f588dd..dd942b7 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 37f961a..699f022 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 bf96371..ca7596b 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 e921566..d3fba7e 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 51b911a..21c4799 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 267177b..0f27810 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 4373dee..b4c656e 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 3104298..94d73c0 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 bc2583f..0000000 --- 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 f5f692f..11b7c5a 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 e030236..0b64d9b 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 487fbeb..ade2e43 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 1ce1209..02a602e 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 32dd376..905e8d0 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 22f94ae..d04ab20 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 b56bdcc..c51fbd5 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 a8d4c9f..b7e356b 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 8ea1eac..05bb50f 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 99800e3..97e1e83 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 291fc23..54d2812 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 5b8f392..05b0892 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 f9cceb5..b1ef31e 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 aba19ac..37e47fa 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 7adcd08..c67f2a3 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 dae791b..74b16fa 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 b11124a..ae7941c 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 612a398..623c5bf 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 2a67b57..de210e1 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 e50be5d..692b3b6 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 a0709cb..054aa15 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 7373a64..894acd8 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 602d3a5..8158de7 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 21c796c..a1b685e 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; |