mlib-tgt-tru64.adb, [...] (Library_Exist_For, [...]): Add new parameter In_Tree to specify the project tree...
2005-03-08 Vincent Celier <celier@adacore.com> * mlib-tgt-tru64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb, mlib-tgt-hpux.adb, mlib-tgt-linux.adb, mlib-tgt-solaris.adb, mlib-tgt-vms-alpha.adb, mlib-tgt-vms-ia64.adb, mlib-tgt-mingw.adb, mlib-tgt-vxworks.adb, mlib-tgt-lynxos.adb (Library_Exist_For, Library_File_Name_For): Add new parameter In_Tree to specify the project tree: needed by the project manager. Adapt to changes in project manager using new parameter In_Tree. Remove local imports, use functions in System.CRTL. * make.adb, clean.adb, gnatcmd.adb (Project_Tree): New constant needed to use the project manager. * makeutl.ads, makeutl.adb (Linker_Options_Switches): New parameter In_Tree to designate the project tree. Adapt to changes in the project manager, using In_Tree. * mlib-prj.ads, mlib-prj.adb (Build_Library, Check_Library, Copy_Interface_Sources): Add new parameter In_Tree to specify the project tree: needed by the project manager. (Build_Library): Check that Arg'Length >= 6 before checking if it contains "--RTS=...". * mlib-tgt.ads, mlib-tgt.adb (Library_Exist_For, Library_File_Name_For): Add new parameter In_Tree to specify the project tree: needed by the project manager. * prj.ads, prj.adb: Major modifications to allow several project trees in memory at the same time. Change tables to dynamic tables and hash tables to dynamic hash tables. Move tables and hash tables from Prj.Com (in the visible part) and Prj.Env (in the private part). Move some constants from the visible part to the private part. Make other constants deferred. (Project_Empty): Make it a variable, not a function (Empty_Project): Add parameter Tree. Returns the data with the default naming data of the project tree Tree. (Initialize): After updating Std_Naming_Data, copy its value to the component Naming of Project Empty. (Register_Default_Naming_Scheme): Use and update the default naming component of the project tree, instead of the global variable Std_Naming_Data. (Standard_Naming_Data): Add defaulted parameter Tree. If project tree Tree is not defaulted, return the default naming data of the Tree. (Initial_Buffer_Size): Constant moved from private part (Default_Ada_Spec_Suffix_Id, Default_Ada_Body_Suffix_Id, Slash_Id); new variables initialized in procedure Initialize. (Add_To_Buffer): Add two in out parameters to replace global variables Buffer and Buffer_Last. (Default_Ada_Spec_Suffix, Default_Body_Spec_Suffix, Slash): New functions. Adapt to changes to use new type Project_Tree_Ref and dynamic tables and hash tables. (Initialize, Reset, register-Default_Namng-Scheme): Add a new parameter for the project tree. (Project_Tree_Data, Project_Tree_Ref, No_Project): Declare types and constant at the beginning of the package spec, so that they cane be used in subprograms before their full declarations. (Standard_Naming_Data): Add defaulted parameter of type Project_Node_Ref (Empty_Project): Add parameter of type Project_Node_Ref (Private_Project_Tree_Data): Add component Default_Naming of type Naming_Data. (Buffer, Buffer_Last): remove global variables (Add_To_Buffer): Add two in out parameters to replace global variables Buffer and Buffer_Last. (Current_Packages_To_Check): Remove global variable (Empty_Name): Move to private part (No-Symbols): Make it a constant (Private_Project_Tree_Data): New type for the private part of the project tree data. (Project_Tree_Data): New type for the data of a project tree (Project_Tree_Ref): New type to designate a project tree (Initialize, Reset, register-Default_Namng-Scheme): Add a new parameter for the project tree. * prj-attr.ads: Add with Table; needed, as package Prj no longer imports package Table. * prj-com.adb: Remove empty, no longer needed body * prj-com.ads: Move most of the content of this package to package Prj. * prj-dect.ads, prj-dect.adb (Parse): New parameters In_Tree to designate the project node tree and Packages_To_Check to replace global variable Current_Packages_To_Check. Add new parameters In_Tree and Packages_To_Check to local subprograms, when needed. Adapt to changes in project manager with project node tree In_Tree. * prj-env.ads, prj-env.adb: Add new parameter In_Tree to designate the project tree to most subprograms. Move tables and hash tables to private part of package Prj. Adapt to changes in project manager using project tree In_Tree. * prj-makr.adb (Tree): New constant to designate the project node tree Adapt to change in project manager using project node tree Tree * prj-nmsc.ads, prj-nmsc.adb (Check_Stand_Alone_Library): Correctly display the Library_Src_Dir and the Library_Dir. Add new parameter In_Tree to designate the project node tree to most subprograms. Adapt to changes in the project manager, using project tree In_Tree. (Check_Naming_Scheme): Do not alter the casing on platforms where the casing of file names is not significant. (Check): Add new parameter In_Tree to designate the * prj-pars.ads, prj-pars.adb (Parse): Add new parameter In_Tree to designate the project tree. Declare a project node tree to call Prj.Part.Parse and Prj.Proc.Process * prj-part.ads, prj-part.adb (Buffer, Buffer_Last): Global variables, to replace those that were in the private part of package Prj. Add new parameter In__Tree to designate the project node tree to most subprograms. Adapt to change in Prj.Tree with project node tree In_Tree. (Post_Parse_Context_Clause): When specifying the project node of a with clause, indicate that it is a limited with only if there is "limited" in the with clause, not necessarily when In_Limited is True. (Parse): Add new parameter In_Tree to designate the project node tree * prj-pp.ads, prj-pp.adb (Pretty_Print): Add new parameter In_Tree to designate the project node tree. Adapt to change in Prj.Tree with project node tree In_Tree. * prj-proc.ads, prj-proc.adb (Recursive_Process): Specify the project tree In_Tree in the call to function Empty_Process to give its initial value to the project data Processed_Data. Add new parameters In_Tree to designate the project tree and From_Project_Node_Tree to designate the project node tree to several subprograms. Adapt to change in project manager with project tree In_Tree and project node tree From_Project_Node_Tree. * prj-strt.ads, prj-strt.adb (Buffer, Buffer_Last): Global variables, to replace those that were in the private part of package Prj. Add new parameter In_Tree to designate the project node tree to most subprograms. Adapt to change in Prj.Tree with project node tree In_Tree. * prj-tree.ads, prj-tree.adb: Add new parameter of type Project_Node_Tree_Ref to most subprograms. Use this new parameter to store project nodes in the designated project node tree. (Project_Node_Tree_Ref): New type to designate a project node tree (Tree_Private_Part): Change table to dynamic table and hash tables to dynamic hash tables. * prj-util.ads, prj-util.adb: Add new parameter In_Tree to designate the project tree to most subprograms. Adapt to changes in project manager using project tree In_Tree. * makegpr.adb (Project_Tree): New constant needed to use project manager. From-SVN: r96481
This commit is contained in:
parent
0ca89db7aa
commit
7e98a4c668
|
@ -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;
|
||||
|
|
|
@ -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),
|
||||
|
|
489
gcc/ada/make.adb
489
gcc/ada/make.adb
File diff suppressed because it is too large
Load Diff
|
@ -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)));
|
||||
|
|
|
@ -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;
|
||||
|
||||
---------------
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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));
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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.
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
|
@ -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;
|
||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -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;
|
||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -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;
|
||||
|
|
|
@ -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);
|
||||
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,
|
||||
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,
|
||||
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);
|
||||
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,
|
||||
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,
|
||||
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,
|
||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
1263
gcc/ada/prj-proc.adb
1263
gcc/ada/prj-proc.adb
File diff suppressed because it is too large
Load Diff
|
@ -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.
|
||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -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.
|
||||
|
|
1175
gcc/ada/prj-tree.adb
1175
gcc/ada/prj-tree.adb
File diff suppressed because it is too large
Load Diff
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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.
|
||||
|
|
296
gcc/ada/prj.adb
296
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 Buffer is too small, double its size
|
||||
|
||||
if Buffer_Last + S'Length > Buffer'Last then
|
||||
declare
|
||||
New_Buffer : constant String_Access :=
|
||||
new String (1 .. 2 * Buffer'Last);
|
||||
|
||||
begin
|
||||
New_Buffer (1 .. Buffer_Last) := Buffer (1 .. Buffer_Last);
|
||||
Free (Buffer);
|
||||
Buffer := New_Buffer;
|
||||
end;
|
||||
if To = null then
|
||||
To := new String (1 .. Initial_Buffer_Size);
|
||||
Last := 0;
|
||||
end if;
|
||||
|
||||
Buffer (Buffer_Last + 1 .. Buffer_Last + S'Length) := S;
|
||||
Buffer_Last := Buffer_Last + S'Length;
|
||||
-- If Buffer is too small, double its size
|
||||
|
||||
while Last + S'Length > To'Last loop
|
||||
declare
|
||||
New_Buffer : constant String_Access :=
|
||||
new String (1 .. 2 * Last);
|
||||
|
||||
begin
|
||||
New_Buffer (1 .. Last) := To (1 .. Last);
|
||||
Free (To);
|
||||
To := New_Buffer;
|
||||
end;
|
||||
end loop;
|
||||
|
||||
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;
|
||||
|
|
401
gcc/ada/prj.ads
401
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,38 +35,46 @@ 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.
|
||||
|
||||
No_Project_Tree : constant Project_Tree_Ref;
|
||||
|
||||
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.
|
||||
|
||||
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.
|
||||
|
||||
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.
|
||||
|
||||
Default_Ada_Spec_Suffix : Name_Id;
|
||||
-- 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;
|
||||
-- The Name_Id for the standard GNAT suffix for Ada body source file
|
||||
-- name ".adb". Initialized by Prj.Initialize.
|
||||
|
||||
Slash : Name_Id;
|
||||
-- "/", used as the path of locally removed files
|
||||
-----------------------------------------------------
|
||||
-- Multi-language stuff that will be modified soon --
|
||||
-----------------------------------------------------
|
||||
|
||||
type Language_Index is new Nat;
|
||||
|
||||
|
@ -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;
|
||||
|
|
Loading…
Reference in New Issue