Skip to content

R
riscv-gcc-1
Commit 7e98a4c6 by Vincent Celier Committed by Arnaud Charlet
Options

mlib-tgt-tru64.adb, [...] (Library_Exist_For, [...]): Add new parameter In_Tree… 

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
parent 0ca89db7
Showing with 543 additions and 424 deletions
gcc/ada/clean.adb
......@@ -37,7 +37,6 @@ with Opt; use Opt;
with Osint; use Osint;
with Osint.M; use Osint.M;
with Prj; use Prj;
with Prj.Com;
with Prj.Env;
with Prj.Ext;
with Prj.Pars;
......@@ -92,6 +91,8 @@ package body Clean is
Project_File_Name : String_Access := null;
Project_Tree : constant Prj.Project_Tree_Ref := new Prj.Project_Tree_Data;
Main_Project : Prj.Project_Id := Prj.No_Project;
All_Projects : Boolean := False;
......@@ -328,7 +329,8 @@ package body Clean is
procedure Clean_Archive (Project : Project_Id) is
Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
Data : constant Project_Data := Projects.Table (Project);
Data : constant Project_Data :=
Project_Tree.Projects.Table (Project);
Archive_Name : constant String :=
"lib" & Get_Name_String (Data.Name) & '.' & Archive_Ext;
......@@ -560,8 +562,9 @@ package body Clean is
-- Name of the executable file
Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
Data : constant Project_Data := Projects.Table (Project);
U_Data : Prj.Com.Unit_Data;
Data : constant Project_Data :=
Project_Tree.Projects.Table (Project);
U_Data : Unit_Data;
File_Name1 : Name_Id;
Index1 : Int;
File_Name2 : Name_Id;
......@@ -573,8 +576,6 @@ package body Clean is
Global_Archive : Boolean := False;
use Prj.Com;
begin
-- Check that we don't specify executable on the command line for
-- a main library project.
......@@ -612,8 +613,10 @@ package body Clean is
-- sources or inherited sources of the project.
if Data.Languages (Ada_Language_Index) then
for Unit in 1 .. Prj.Com.Units.Last loop
U_Data := Prj.Com.Units.Table (Unit);
for Unit in Unit_Table.First ..
Unit_Table.Last (Project_Tree.Units)
loop
U_Data := Project_Tree.Units.Table (Unit);
File_Name1 := No_Name;
File_Name2 := No_Name;
......@@ -749,8 +752,12 @@ package body Clean is
if Project = Main_Project and then not Data.Library then
Global_Archive := False;
for Proj in 1 .. Projects.Last loop
if Projects.Table (Proj).Other_Sources_Present then
for Proj in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
if Project_Tree.Projects.Table
(Proj).Other_Sources_Present
then
Global_Archive := True;
exit;
end if;
......@@ -769,7 +776,8 @@ package body Clean is
Source_Id := Data.First_Other_Source;
while Source_Id /= No_Other_Source loop
Source := Other_Sources.Table (Source_Id);
Source :=
Project_Tree.Other_Sources.Table (Source_Id);
if Is_Regular_File
(Get_Name_String (Source.Object_Name))
......@@ -839,7 +847,7 @@ package body Clean is
-- has not been processed already.
while Imported /= Empty_Project_List loop
Element := Project_Lists.Table (Imported);
Element := Project_Tree.Project_Lists.Table (Imported);
Imported := Element.Next;
Process := True;
......@@ -887,6 +895,7 @@ package body Clean is
Executable :=
Executable_Of
(Main_Project,
Project_Tree,
Main_Source_File,
Current_File_Index);
......@@ -1099,13 +1108,14 @@ package body Clean is
-- Set the project parsing verbosity to whatever was specified
-- by a possible -vP switch.
Prj.Pars.Set_Verbosity (To => Prj.Com.Current_Verbosity);
Prj.Pars.Set_Verbosity (To => Current_Verbosity);
-- Parse the project file. If there is an error, Main_Project
-- will still be No_Project.
Prj.Pars.Parse
(Project => Main_Project,
In_Tree => Project_Tree,
Project_File_Name => Project_File_Name.all,
Packages_To_Check => Packages_To_Check_By_Gnatmake);
......@@ -1121,12 +1131,10 @@ package body Clean is
New_Line;
end if;
-- We add the source directories and the object directories
-- to the search paths.
Add_Source_Directories (Main_Project);
Add_Object_Directories (Main_Project);
-- Add source directories and object directories to the search paths
Add_Source_Directories (Main_Project, Project_Tree);
Add_Object_Directories (Main_Project, Project_Tree);
end if;
Osint.Add_Default_Search_Dirs;
......@@ -1137,11 +1145,12 @@ package body Clean is
if Main_Project /= No_Project and then Osint.Number_Of_Files = 0 then
declare
Value : String_List_Id := Projects.Table (Main_Project).Mains;
Value : String_List_Id :=
Project_Tree.Projects.Table (Main_Project).Mains;
Main : String_Element;
begin
while Value /= Prj.Nil_String loop
Main := String_Elements.Table (Value);
Main := Project_Tree.String_Elements.Table (Value);
Osint.Add_File
(File_Name => Get_Name_String (Main.Value),
Index => Main.Index);
......@@ -1211,24 +1220,24 @@ package body Clean is
return True;
end if;
Data := Projects.Table (Of_Project);
Data := Project_Tree.Projects.Table (Of_Project);
while Data.Extends /= No_Project loop
if Data.Extends = Prj then
return True;
end if;
Data := Projects.Table (Data.Extends);
Data := Project_Tree.Projects.Table (Data.Extends);
end loop;
Data := Projects.Table (Prj);
Data := Project_Tree.Projects.Table (Prj);
while Data.Extends /= No_Project loop
if Data.Extends = Of_Project then
return True;
end if;
Data := Projects.Table (Data.Extends);
Data := Project_Tree.Projects.Table (Data.Extends);
end loop;
return False;
......@@ -1258,7 +1267,7 @@ package body Clean is
Csets.Initialize;
Namet.Initialize;
Snames.Initialize;
Prj.Initialize;
Prj.Initialize (Project_Tree);
end if;
-- Reset global variables
......@@ -1480,13 +1489,13 @@ package body Clean is
Verbose_Mode := True;
elsif Arg = "-vP0" then
Prj.Com.Current_Verbosity := Prj.Default;
Current_Verbosity := Prj.Default;
elsif Arg = "-vP1" then
Prj.Com.Current_Verbosity := Prj.Medium;
Current_Verbosity := Prj.Medium;
elsif Arg = "-vP2" then
Prj.Com.Current_Verbosity := Prj.High;
Current_Verbosity := Prj.High;
else
Bad_Argument;
......
gcc/ada/makeutl.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004 Free Software Foundation, Inc. --
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -185,7 +185,8 @@ package body Makeutl is
-----------------------------
function Linker_Options_Switches
(Project : Project_Id) return String_List
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return String_List
is
procedure Recursive_Add_Linker_Options (Proj : Project_Id);
-- The recursive routine used to add linker options
......@@ -202,29 +203,33 @@ package body Makeutl is
begin
if Proj /= No_Project then
Data := Projects.Table (Proj);
Data := In_Tree.Projects.Table (Proj);
if not Data.Seen then
Projects.Table (Proj).Seen := True;
In_Tree.Projects.Table (Proj).Seen := True;
Imported := Data.Imported_Projects;
while Imported /= Empty_Project_List loop
Recursive_Add_Linker_Options
(Project_Lists.Table (Imported).Project);
Imported := Project_Lists.Table (Imported).Next;
(In_Tree.Project_Lists.Table
(Imported).Project);
Imported := In_Tree.Project_Lists.Table
(Imported).Next;
end loop;
if Proj /= Project then
Linker_Package :=
Prj.Util.Value_Of
(Name => Name_Linker,
In_Packages => Data.Decl.Packages);
(Name => Name_Linker,
In_Packages => Data.Decl.Packages,
In_Tree => In_Tree);
Options :=
Prj.Util.Value_Of
(Name => Name_Ada,
Index => 0,
(Name => Name_Ada,
Index => 0,
Attribute_Or_Array_Name => Name_Linker_Options,
In_Package => Linker_Package);
In_Package => Linker_Package,
In_Tree => In_Tree);
-- If attribute is present, add the project with
-- the attribute to table Linker_Opts.
......@@ -244,8 +249,10 @@ package body Makeutl is
begin
Linker_Opts.Init;
for Index in 1 .. Projects.Last loop
Projects.Table (Index).Seen := False;
for Index in Project_Table.First ..
Project_Table.Last (In_Tree.Projects)
loop
In_Tree.Projects.Table (Index).Seen := False;
end loop;
Recursive_Add_Linker_Options (Project);
......@@ -262,15 +269,19 @@ package body Makeutl is
begin
-- If Dir_Path has not been computed for this project, do it now
if Projects.Table (Proj).Dir_Path = null then
Projects.Table (Proj).Dir_Path :=
if In_Tree.Projects.Table (Proj).Dir_Path = null then
In_Tree.Projects.Table (Proj).Dir_Path :=
new String'
(Get_Name_String (Projects.Table (Proj). Directory));
(Get_Name_String
(In_Tree.Projects.Table
(Proj). Directory));
end if;
while Options /= Nil_String loop
Option := String_Elements.Table (Options).Value;
Options := String_Elements.Table (Options).Next;
Option :=
In_Tree.String_Elements.Table (Options).Value;
Options :=
In_Tree.String_Elements.Table (Options).Next;
Add_Linker_Option (Get_Name_String (Option));
-- Object files and -L switches specified with
......@@ -280,7 +291,8 @@ package body Makeutl is
Test_If_Relative_Path
(Switch =>
Linker_Options_Buffer (Last_Linker_Option),
Parent => Projects.Table (Proj).Dir_Path,
Parent =>
In_Tree.Projects.Table (Proj).Dir_Path,
Including_L_Switch => True);
end loop;
end;
......@@ -326,7 +338,7 @@ package body Makeutl is
procedure Delete is
begin
Names.Set_Last (0);
Reset;
Mains.Reset;
end Delete;
---------------
......
gcc/ada/makeutl.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004 Free Software Foundation, Inc. --
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -56,8 +56,13 @@ package Makeutl is
-- been entered by a call to Prj.Ext.Add, so that in a project
-- file, External ("name") will return "value".
function Linker_Options_Switches (Project : Project_Id) return String_List;
-- Comment required ???
function Linker_Options_Switches
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return String_List;
-- Collect the options specified in the Linker'Linker_Options attributes
-- of project Project, in project tree In_Tree, and in the projects that
-- it imports directly or indirectly, and returns the result.
-- Package Mains is used to store the mains specified on the command line
-- and to retrieve them when a project file is used, to verify that the
......
gcc/ada/mlib-prj.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2003, Ada Core Technologies, Inc. --
-- Copyright (C) 2001-2005, Ada Core Technologies, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -32,6 +32,7 @@ package MLib.Prj is
procedure Build_Library
(For_Project : Project_Id;
In_Tree : Project_Tree_Ref;
Gnatbind : String;
Gnatbind_Path : String_Access;
Gcc : String;
......@@ -45,7 +46,8 @@ package MLib.Prj is
-- files. If Bind is False the binding of a stand-alone library is skipped.
-- If Link is False, the library is not linked/built.
procedure Check_Library (For_Project : Project_Id);
procedure Check_Library
(For_Project : Project_Id; In_Tree : Project_Tree_Ref);
-- Check if the library of a library project needs to be rebuilt,
-- because its time-stamp is earlier than the time stamp of one of its
-- object files.
......
gcc/ada/mlib-tgt-aix.adb
......@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2004, Ada Core Technologies, Inc. --
-- Copyright (C) 2003-2005, Ada Core Technologies, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -286,9 +286,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
......@@ -296,14 +298,17 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String
(Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String
(Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
......@@ -321,9 +326,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
......@@ -331,13 +339,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else
......@@ -382,7 +393,7 @@ package body MLib.Tgt is
function Support_For_Libraries return Library_Support is
begin
return Full;
return Static_Only;
end Support_For_Libraries;
end MLib.Tgt;
gcc/ada/mlib-tgt-hpux.adb
......@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2004, Ada Core Technologies, Inc. --
-- Copyright (C) 2003-2005, Ada Core Technologies, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -269,9 +269,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
......@@ -279,12 +281,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
......@@ -302,9 +308,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
......@@ -312,13 +321,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else
......
gcc/ada/mlib-tgt-irix.adb
......@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2004, Ada Core Technologies, Inc. --
-- Copyright (C) 2003-2005, Ada Core Technologies, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -309,9 +309,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
......@@ -319,12 +321,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
......@@ -342,9 +348,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
......@@ -352,13 +361,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else
......
gcc/ada/mlib-tgt-linux.adb
......@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2004, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -266,9 +266,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
......@@ -276,12 +278,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
......@@ -299,9 +305,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
......@@ -309,13 +318,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else
......
gcc/ada/mlib-tgt-lynxos.adb
......@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2003-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -174,9 +174,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
......@@ -184,12 +186,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
......@@ -207,9 +213,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
......@@ -217,13 +226,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else
......
gcc/ada/mlib-tgt-mingw.adb
......@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2004, Free Software Foundation, Inc. --
-- Copyright (C) 2002-2005, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -194,9 +194,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
......@@ -204,14 +206,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String
(Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String
(Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
MLib.Fil.Ext_To (Lib_Name, Archive_Ext));
......@@ -229,9 +233,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
......@@ -239,10 +246,13 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
......
gcc/ada/mlib-tgt-solaris.adb
......@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2002-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -263,9 +263,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
......@@ -273,12 +275,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
......@@ -296,9 +302,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
......@@ -306,13 +315,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else
......
gcc/ada/mlib-tgt-tru64.adb
......@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2002-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -280,9 +280,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
......@@ -290,12 +292,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
......@@ -313,9 +319,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
......@@ -323,13 +332,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else
......
gcc/ada/mlib-tgt-vms-alpha.adb
......@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2004, Free Software Foundation, Inc. --
-- Copyright (C) 2003-2005, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -29,17 +29,19 @@
with Ada.Characters.Handling; use Ada.Characters.Handling;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with MLib.Fil;
with MLib.Utl;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
with Prj.Com;
with System; use System;
with System.Case_Util; use System.Case_Util;
with System; use System;
with System.Case_Util; use System.Case_Util;
with System.CRTL; use System.CRTL;
package body MLib.Tgt is
......@@ -50,7 +52,7 @@ package body MLib.Tgt is
-- Used to add the generated auto-init object files for auto-initializing
-- stand-alone libraries.
Macro_Name : constant String := "mcr gnu:[bin]gcc -c -x assembler";
Macro_Name : constant String := "mcr gnu:[bin]gcc -c -x assembler";
-- The name of the command to invoke the macro-assembler
VMS_Options : Argument_List := (1 .. 1 => null);
......@@ -72,16 +74,6 @@ package body MLib.Tgt is
Link_With_Shared_Libgcc : Argument_List_Access :=
No_Shared_Libgcc_Switch'Access;
------------------------------
-- Target dependent section --
------------------------------
function Popen (Command, Mode : System.Address) return System.Address;
pragma Import (C, Popen);
function Pclose (File : System.Address) return Integer;
pragma Import (C, Pclose);
---------------------
-- Archive_Builder --
---------------------
......@@ -302,12 +294,12 @@ package body MLib.Tgt is
Len : Natural;
OK : Boolean := True;
Command : constant String :=
command : constant String :=
Macro_Name & " " & Macro_File_Name & ASCII.NUL;
-- The command to invoke the assembler on the generated auto-init
-- assembly file.
Mode : constant String := "r" & ASCII.NUL;
mode : constant String := "r" & ASCII.NUL;
-- The mode for the invocation of Popen
begin
......@@ -365,8 +357,8 @@ package body MLib.Tgt is
Write_Line ("""");
end if;
Popen_Result := Popen (Command (Command'First)'Address,
Mode (Mode'First)'Address);
Popen_Result := popen (command (command'First)'Address,
mode (mode'First)'Address);
if Popen_Result = Null_Address then
Fail ("assembly of auto-init assembly file """,
......@@ -375,7 +367,7 @@ package body MLib.Tgt is
-- Wait for the end of execution of the macro-assembler
Pclose_Result := Pclose (Popen_Result);
Pclose_Result := pclose (Popen_Result);
if Pclose_Result < 0 then
Fail ("assembly of auto init assembly file """,
......@@ -604,9 +596,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
......@@ -614,12 +608,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
......@@ -637,9 +635,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
......@@ -647,13 +648,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else
......
gcc/ada/mlib-tgt-vms-ia64.adb
......@@ -29,17 +29,19 @@
with Ada.Characters.Handling; use Ada.Characters.Handling;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with MLib.Fil;
with MLib.Utl;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
with Prj.Com;
with System; use System;
with System.Case_Util; use System.Case_Util;
with System; use System;
with System.Case_Util; use System.Case_Util;
with System.CRTL; use System.CRTL;
package body MLib.Tgt is
......@@ -72,16 +74,6 @@ package body MLib.Tgt is
Link_With_Shared_Libgcc : Argument_List_Access :=
No_Shared_Libgcc_Switch'Access;
------------------------------
-- Target dependent section --
------------------------------
function Popen (Command, Mode : System.Address) return System.Address;
pragma Import (C, Popen, "decc$popen");
function Pclose (File : System.Address) return Integer;
pragma Import (C, Pclose, "decc$pclose");
---------------------
-- Archive_Builder --
---------------------
......@@ -300,12 +292,12 @@ package body MLib.Tgt is
Len : Natural;
OK : Boolean := True;
Command : constant String :=
command : constant String :=
Macro_Name & " " & Macro_File_Name & ASCII.NUL;
-- The command to invoke the assembler on the generated auto-init
-- assembly file.
Mode : constant String := "r" & ASCII.NUL;
mode : constant String := "r" & ASCII.NUL;
-- The mode for the invocation of Popen
begin
......@@ -398,8 +390,8 @@ package body MLib.Tgt is
Write_Line ("""");
end if;
Popen_Result := Popen (Command (Command'First)'Address,
Mode (Mode'First)'Address);
Popen_Result := popen (command (command'First)'Address,
mode (mode'First)'Address);
if Popen_Result = Null_Address then
Fail ("assembly of auto-init assembly file """,
......@@ -408,7 +400,7 @@ package body MLib.Tgt is
-- Wait for the end of execution of the macro-assembler
Pclose_Result := Pclose (Popen_Result);
Pclose_Result := pclose (Popen_Result);
if Pclose_Result < 0 then
Fail ("assembly of auto init assembly file """,
......@@ -637,9 +629,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
......@@ -647,12 +641,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
......@@ -670,9 +668,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
......@@ -680,13 +681,15 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else
......
gcc/ada/mlib-tgt-vxworks.adb
......@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2003-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -215,9 +215,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
......@@ -225,12 +227,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
......@@ -248,9 +254,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
......@@ -258,13 +267,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else
......
gcc/ada/mlib-tgt.adb
......@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2004, Ada Core Technologies, Inc. --
-- Copyright (C) 2001-2005, Ada Core Technologies, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -172,8 +172,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
pragma Unreferenced (Project);
pragma Unreferenced (In_Tree);
begin
return False;
end Library_Exists_For;
......@@ -182,8 +185,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
pragma Unreferenced (Project);
pragma Unreferenced (In_Tree);
begin
return No_Name;
end Library_File_Name_For;
......
gcc/ada/mlib-tgt.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2004, Ada Core Technologies, Inc. --
-- Copyright (C) 2001-2005, Ada Core Technologies, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -147,11 +147,14 @@ package MLib.Tgt is
-- into account. For example, on Linux, Foreign, Afiles Lib_Address and
-- Relocatable are ignored.
function Library_Exists_For (Project : Project_Id) return Boolean;
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean;
-- Return True if the library file for a library project already exists.
-- This function can only be called for library projects.
function Library_File_Name_For (Project : Project_Id) return Name_Id;
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id;
-- Returns the file name of the library file of a library project.
-- This function can only be called for library projects.
......
gcc/ada/prj-attr.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -28,6 +28,7 @@
-- There are predefined packages and attributes.
-- It is also possible to define new packages with their attributes.
with Table;
with Types; use Types;
package Prj.Attr is
......
gcc/ada/prj-com.adb deleted 100644 → 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;
gcc/ada/prj-com.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2000-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -27,88 +27,18 @@
-- The following package declares data types for GNAT project.
-- These data types are used in the bodies of the Prj hierarchy.
with GNAT.HTable;
with Osint;
with Table;
with Types; use Types;
package Prj.Com is
-- At one point, this package was private.
-- It cannot be private, because it is used outside of
-- the Prj hierarchy.
type Fail_Proc is access procedure
(S1 : String; S2 : String := ""; S3 : String := "");
(S1 : String;
S2 : String := "";
S3 : String := "");
Fail : Fail_Proc := Osint.Fail'Access;
-- This procedure is used in the project facility, instead of
-- directly calling Osint.Fail.
-- It may be specified by tools to do clean up before calling
-- Osint.Fail, or to simply report an error and return.
Tool_Name : Name_Id := No_Name;
Current_Verbosity : Verbosity := Default;
type Spec_Or_Body is
(Specification, Body_Part);
type File_Name_Data is record
Name : Name_Id := No_Name;
Index : Int := 0;
Display_Name : Name_Id := No_Name;
Path : Name_Id := No_Name;
Display_Path : Name_Id := No_Name;
Project : Project_Id := No_Project;
Needs_Pragma : Boolean := False;
end record;
-- File and Path name of a spec or body.
type File_Names_Data is array (Spec_Or_Body) of File_Name_Data;
type Unit_Id is new Nat;
No_Unit : constant Unit_Id := 0;
type Unit_Data is record
Name : Name_Id := No_Name;
File_Names : File_Names_Data;
end record;
-- File and Path names of a unit, with a reference to its
-- GNAT Project File.
package Units is new Table.Table
(Table_Component_Type => Unit_Data,
Table_Index_Type => Unit_Id,
Table_Low_Bound => 1,
Table_Initial => 100,
Table_Increment => 100,
Table_Name => "Prj.Com.Units");
function Hash (Name : String_Id) return Header_Num;
package Units_Htable is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Unit_Id,
No_Element => No_Unit,
Key => Name_Id,
Hash => Hash,
Equal => "=");
-- Mapping of unit names to indexes in the Units table
type Unit_Project is record
Unit : Unit_Id := No_Unit;
Project : Project_Id := No_Project;
end record;
No_Unit_Project : constant Unit_Project := (No_Unit, No_Project);
package Files_Htable is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Unit_Project,
No_Element => No_Unit_Project,
Key => Name_Id,
Hash => Hash,
Equal => "=");
-- Mapping of file names to indexes in the Units table
-- This procedure is used in the project facility, instead of directly
-- calling Osint.Fail. It may be specified by tools to do clean up before
-- calling Osint.Fail, or to simply report an error and return.
end Prj.Com;
gcc/ada/prj-dect.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -31,9 +31,27 @@ with Prj.Tree;
private package Prj.Dect is
procedure Parse
(Declarations : out Prj.Tree.Project_Node_Id;
Current_Project : Prj.Tree.Project_Node_Id;
Extends : Prj.Tree.Project_Node_Id);
-- Parse project declarative items. What are parameters ???
(In_Tree : Prj.Tree.Project_Node_Tree_Ref;
Declarations : out Prj.Tree.Project_Node_Id;
Current_Project : Prj.Tree.Project_Node_Id;
Extends : Prj.Tree.Project_Node_Id;
Packages_To_Check : String_List_Access);
-- Parse project declarative items
--
-- In_Tree is the project node tree
--
-- Declarations is the resulting project node
--
-- Current_Project is the project node of the project for which the
-- declarative items are parsed.
--
-- Extends is the project node of the project that project Current_Project
-- extends. If project Current-Project does not extend any project,
-- Extends has the value Empty_Node.
--
-- Packages_To_Check is the list of packages that needs to be checked.
-- For legal packages declared in project Current_Project that are not in
-- Packages_To_Check, only the syntax of the declarations are checked, not
-- the attribute names and kinds.
end Prj.Dect;
gcc/ada/prj-env.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -32,14 +32,15 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
package Prj.Env is
procedure Initialize;
-- Called by Prj.Initialize to perform required initialization
-- steps for this package.
-- Called by Prj.Initialize to perform required initialization steps for
-- this package.
procedure Print_Sources;
procedure Print_Sources (In_Tree : Project_Tree_Ref);
-- Output the list of sources, after Project files have been scanned
procedure Create_Mapping_File
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Name : out Name_Id);
-- Create a temporary mapping file for project Project. For each unit
-- in the closure of immediate sources of Project, put the mapping of
......@@ -52,6 +53,7 @@ package Prj.Env is
procedure Create_Config_Pragmas_File
(For_Project : Project_Id;
Main_Project : Project_Id;
In_Tree : Project_Tree_Ref;
Include_Config_Files : Boolean := True);
-- If there needs to have SFN pragmas, either for non standard naming
-- schemes or for individual units, or (when Include_Config_Files is True)
......@@ -61,12 +63,15 @@ package Prj.Env is
-- a temporary file that contains all configuration pragmas, and specify
-- the configuration pragmas file in the project data.
function Ada_Include_Path (Project : Project_Id) return String_Access;
function Ada_Include_Path
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return String_Access;
-- Get the ADA_INCLUDE_PATH of a Project file. For the first call, compute
-- it and cache it.
function Ada_Include_Path
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Recursive : Boolean) return String;
-- Get the ADA_INCLUDE_PATH of a Project file. If Recursive it True,
-- get all the source directories of the imported and modified project
......@@ -76,6 +81,7 @@ package Prj.Env is
function Ada_Objects_Path
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean := True) return String_Access;
-- Get the ADA_OBJECTS_PATH of a Project file. For the first call, compute
-- it and cache it. When Including_Libraries is False, do not include the
......@@ -83,22 +89,25 @@ package Prj.Env is
procedure Set_Ada_Paths
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean);
-- Set the env vars for additional project path files, after
-- creating the path files if necessary.
procedure Delete_All_Path_Files;
procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref);
-- Delete all temporary path files that have been created by
-- calls to Set_Ada_Paths.
function Path_Name_Of_Library_Unit_Body
(Name : String;
Project : Project_Id) return String;
Project : Project_Id;
In_Tree : Project_Tree_Ref) return String;
-- Returns the Path of a library unit
function File_Name_Of_Library_Unit_Body
(Name : String;
Project : Project_Id;
In_Tree : Project_Tree_Ref;
Main_Project_Only : Boolean := True;
Full_Path : Boolean := False) return String;
-- Returns the file name of a library unit, in canonical case. Name may or
......@@ -117,7 +126,8 @@ package Prj.Env is
function Project_Of
(Name : String;
Main_Project : Project_Id) return Project_Id;
Main_Project : Project_Id;
In_Tree : Project_Tree_Ref) return Project_Id;
-- Get the project of a source. The source file name may be truncated
-- (".adb" or ".ads" may be missing). If the source is in a project being
-- extended, return the ultimate extending project. If it is not a source
......@@ -125,20 +135,25 @@ package Prj.Env is
procedure Get_Reference
(Source_File_Name : String;
In_Tree : Project_Tree_Ref;
Project : out Project_Id;
Path : out Name_Id);
-- Returns the project of a source and its path in displayable form
generic
with procedure Action (Path : String);
procedure For_All_Source_Dirs (Project : Project_Id);
-- Iterate through all the source directories of a project,
-- including those of imported or modified projects.
procedure For_All_Source_Dirs
(Project : Project_Id;
In_Tree : Project_Tree_Ref);
-- Iterate through all the source directories of a project, including
-- those of imported or modified projects.
generic
with procedure Action (Path : String);
procedure For_All_Object_Dirs (Project : Project_Id);
-- Iterate through all the object directories of a project,
-- including those of imported or modified projects.
procedure For_All_Object_Dirs
(Project : Project_Id;
In_Tree : Project_Tree_Ref);
-- Iterate through all the object directories of a project, including
-- those of imported or modified projects.
end Prj.Env;
gcc/ada/prj-nmsc.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2000-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -34,6 +34,7 @@ private package Prj.Nmsc is
procedure Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Report_Error : Put_Line_Access;
Follow_Links : Boolean);
-- Check the object directory and the source directories
......
gcc/ada/prj-pars.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -28,7 +28,6 @@ with Ada.Exceptions; use Ada.Exceptions;
with Opt;
with Output; use Output;
with Prj.Com; use Prj.Com;
with Prj.Err; use Prj.Err;
with Prj.Part;
with Prj.Proc;
......@@ -41,32 +40,40 @@ package body Prj.Pars is
-----------
procedure Parse
(Project : out Project_Id;
(In_Tree : Project_Tree_Ref;
Project : out Project_Id;
Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages)
is
Project_Tree : Project_Node_Id := Empty_Node;
Project_Node_Tree : constant Project_Node_Tree_Ref :=
new Project_Node_Tree_Data;
Project_Node : Project_Node_Id := Empty_Node;
The_Project : Project_Id := No_Project;
Success : Boolean := True;
begin
Prj.Tree.Initialize (Project_Node_Tree);
-- Parse the main project file into a tree
Prj.Part.Parse
(Project => Project_Tree,
(In_Tree => Project_Node_Tree,
Project => Project_Node,
Project_File_Name => Project_File_Name,
Always_Errout_Finalize => False,
Packages_To_Check => Packages_To_Check);
-- If there were no error, process the tree
if Project_Tree /= Empty_Node then
if Project_Node /= Empty_Node then
Prj.Proc.Process
(Project => The_Project,
Success => Success,
From_Project_Node => Project_Tree,
Report_Error => null,
Follow_Links => Opt.Follow_Links);
(In_Tree => In_Tree,
Project => The_Project,
Success => Success,
From_Project_Node => Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
Report_Error => null,
Follow_Links => Opt.Follow_Links);
Prj.Err.Finalize;
if not Success then
......
gcc/ada/prj-pars.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2000-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -34,10 +34,12 @@ package Prj.Pars is
-- Set the verbosity when parsing the project files
procedure Parse
(Project : out Project_Id;
(In_Tree : Project_Tree_Ref;
Project : out Project_Id;
Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages);
-- Parse a project files and all its imported project files.
-- Parse a project files and all its imported project files, in the
-- project tree In_Tree.
--
-- If parsing is successful, Project_Id is the project ID
-- of the main project file; otherwise, Project_Id is set
......
gcc/ada/prj-part.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2003 Free Software Foundation, Inc. --
-- Copyright (C) 2000-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -31,7 +31,8 @@ with Prj.Tree; use Prj.Tree;
package Prj.Part is
procedure Parse
(Project : out Project_Node_Id;
(In_Tree : Project_Node_Tree_Ref;
Project : out Project_Node_Id;
Project_File_Name : String;
Always_Errout_Finalize : Boolean;
Packages_To_Check : String_List_Access := All_Packages;
......
gcc/ada/prj-pp.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -27,7 +27,7 @@
-- This package is the Project File Pretty Printer.
-- It is used to output a project file from a project file tree.
-- It is used by gnatname to update or create project files.
-- It is also used GLIDE2 to display project file trees.
-- It is also used GPS to display project file trees.
-- It can also be used for debugging purposes for tools that create project
-- file trees.
......@@ -46,6 +46,7 @@ package Prj.PP is
procedure Pretty_Print
(Project : Prj.Tree.Project_Node_Id;
In_Tree : Prj.Tree.Project_Node_Tree_Ref;
Increment : Positive := 3;
Eliminate_Empty_Case_Constructions : Boolean := False;
Minimize_Empty_Lines : Boolean := False;
......
gcc/ada/prj-proc.adb
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/prj-proc.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -33,11 +33,13 @@ with Prj.Tree; use Prj.Tree;
package Prj.Proc is
procedure Process
(Project : out Project_Id;
Success : out Boolean;
From_Project_Node : Project_Node_Id;
Report_Error : Put_Line_Access;
Follow_Links : Boolean := True);
(In_Tree : Project_Tree_Ref;
Project : out Project_Id;
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access;
Follow_Links : Boolean := True);
-- Process a project file tree into project file data structures.
-- If Report_Error is null, use the error reporting mechanism.
-- Otherwise, report errors using Report_Error.
......
gcc/ada/prj-strt.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -30,7 +30,9 @@ with Prj.Tree; use Prj.Tree;
private package Prj.Strt is
procedure Parse_String_Type_List (First_String : out Project_Node_Id);
procedure Parse_String_Type_List
(In_Tree : Project_Node_Tree_Ref;
First_String : out Project_Node_Id);
-- Get the list of literal strings that are allowed for a typed string.
-- On entry, the current token is the first literal string following
-- a left parenthesis in a string type declaration such as:
......@@ -45,7 +47,9 @@ private package Prj.Strt is
-- or after a comma
-- - two literal strings in the list are equal
procedure Start_New_Case_Construction (String_Type : Project_Node_Id);
procedure Start_New_Case_Construction
(In_Tree : Project_Node_Tree_Ref;
String_Type : Project_Node_Id);
-- This procedure is called at the beginning of a case construction
-- The parameter String_Type is the node for the string type
-- of the case label variable.
......@@ -65,7 +69,8 @@ private package Prj.Strt is
-- not been specified.
procedure Parse_Choice_List
(First_Choice : out Project_Node_Id);
(In_Tree : Project_Node_Tree_Ref;
First_Choice : out Project_Node_Id);
-- Get the label for a choice list.
-- Report an error if
-- - a case label is not a literal string
......@@ -73,7 +78,8 @@ private package Prj.Strt is
-- - the same case label is repeated in the same case construction
procedure Parse_Expression
(Expression : out Project_Node_Id;
(In_Tree : Project_Node_Tree_Ref;
Expression : out Project_Node_Id;
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id;
Optional_Index : Boolean);
......@@ -85,7 +91,8 @@ private package Prj.Strt is
-- been parsed.
procedure Parse_Variable_Reference
(Variable : out Project_Node_Id;
(In_Tree : Project_Node_Tree_Ref;
Variable : out Project_Node_Id;
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id);
-- Parse a variable or attribute reference.
......
gcc/ada/prj-util.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -75,6 +75,7 @@ package body Prj.Util is
function Executable_Of
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Main : Name_Id;
Index : Int;
Ada_Main : Boolean := True) return Name_Id
......@@ -82,19 +83,21 @@ package body Prj.Util is
pragma Assert (Project /= No_Project);
The_Packages : constant Package_Id :=
Projects.Table (Project).Decl.Packages;
In_Tree.Projects.Table (Project).Decl.Packages;
Builder_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of
(Name => Name_Builder,
In_Packages => The_Packages);
In_Packages => The_Packages,
In_Tree => In_Tree);
Executable : Variable_Value :=
Prj.Util.Value_Of
(Name => Main,
Index => Index,
Attribute_Or_Array_Name => Name_Executable,
In_Package => Builder_Package);
In_Package => Builder_Package,
In_Tree => In_Tree);
Executable_Suffix : constant Variable_Value :=
Prj.Util.Value_Of
......@@ -102,15 +105,16 @@ package body Prj.Util is
Index => 0,
Attribute_Or_Array_Name =>
Name_Executable_Suffix,
In_Package => Builder_Package);
In_Package => Builder_Package,
In_Tree => In_Tree);
Body_Append : constant String := Get_Name_String
(Projects.Table
(In_Tree.Projects.Table
(Project).
Naming.Ada_Body_Suffix);
Spec_Append : constant String := Get_Name_String
(Projects.Table
(In_Tree.Projects.Table
(Project).
Naming.Ada_Spec_Suffix);
......@@ -128,7 +132,7 @@ package body Prj.Util is
Last : Positive := Name_Len;
Naming : constant Naming_Data :=
Projects.Table (Project).Naming;
In_Tree.Projects.Table (Project).Naming;
Spec_Suffix : constant String :=
Get_Name_String (Naming.Ada_Spec_Suffix);
......@@ -163,7 +167,8 @@ package body Prj.Util is
(Name => Name_Find,
Index => 0,
Attribute_Or_Array_Name => Name_Executable,
In_Package => Builder_Package);
In_Package => Builder_Package,
In_Tree => In_Tree);
end if;
end;
end if;
......@@ -400,7 +405,8 @@ package body Prj.Util is
function Value_Of
(Index : Name_Id;
In_Array : Array_Element_Id) return Name_Id
In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
Current : Array_Element_Id := In_Array;
Element : Array_Element;
......@@ -411,7 +417,7 @@ package body Prj.Util is
return No_Name;
end if;
Element := Array_Elements.Table (Current);
Element := In_Tree.Array_Elements.Table (Current);
if not Element.Index_Case_Sensitive then
Get_Name_String (Index);
......@@ -420,7 +426,7 @@ package body Prj.Util is
end if;
while Current /= No_Array_Element loop
Element := Array_Elements.Table (Current);
Element := In_Tree.Array_Elements.Table (Current);
if Real_Index = Element.Index then
exit when Element.Value.Kind /= Single;
......@@ -437,7 +443,8 @@ package body Prj.Util is
function Value_Of
(Index : Name_Id;
Src_Index : Int := 0;
In_Array : Array_Element_Id) return Variable_Value
In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref) return Variable_Value
is
Current : Array_Element_Id := In_Array;
Element : Array_Element;
......@@ -448,7 +455,7 @@ package body Prj.Util is
return Nil_Variable_Value;
end if;
Element := Array_Elements.Table (Current);
Element := In_Tree.Array_Elements.Table (Current);
if not Element.Index_Case_Sensitive then
Get_Name_String (Index);
......@@ -457,7 +464,7 @@ package body Prj.Util is
end if;
while Current /= No_Array_Element loop
Element := Array_Elements.Table (Current);
Element := In_Tree.Array_Elements.Table (Current);
if Real_Index = Element.Index and then
Src_Index = Element.Src_Index
......@@ -475,7 +482,8 @@ package body Prj.Util is
(Name : Name_Id;
Index : Int := 0;
Attribute_Or_Array_Name : Name_Id;
In_Package : Package_Id) return Variable_Value
In_Package : Package_Id;
In_Tree : Project_Tree_Ref) return Variable_Value
is
The_Array : Array_Element_Id;
The_Attribute : Variable_Value := Nil_Variable_Value;
......@@ -488,12 +496,14 @@ package body Prj.Util is
The_Array :=
Value_Of
(Name => Attribute_Or_Array_Name,
In_Arrays => Packages.Table (In_Package).Decl.Arrays);
In_Arrays => In_Tree.Packages.Table (In_Package).Decl.Arrays,
In_Tree => In_Tree);
The_Attribute :=
Value_Of
(Index => Name,
Src_Index => Index,
In_Array => The_Array);
In_Array => The_Array,
In_Tree => In_Tree);
-- If there is no array element, look for a variable
......@@ -501,7 +511,9 @@ package body Prj.Util is
The_Attribute :=
Value_Of
(Variable_Name => Attribute_Or_Array_Name,
In_Variables => Packages.Table (In_Package).Decl.Attributes);
In_Variables => In_Tree.Packages.Table
(In_Package).Decl.Attributes,
In_Tree => In_Tree);
end if;
end if;
......@@ -511,16 +523,18 @@ package body Prj.Util is
function Value_Of
(Index : Name_Id;
In_Array : Name_Id;
In_Arrays : Array_Id) return Name_Id
In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
Current : Array_Id := In_Arrays;
The_Array : Array_Data;
begin
while Current /= No_Array loop
The_Array := Arrays.Table (Current);
The_Array := In_Tree.Arrays.Table (Current);
if The_Array.Name = In_Array then
return Value_Of (Index, In_Array => The_Array.Value);
return Value_Of
(Index, In_Array => The_Array.Value, In_Tree => In_Tree);
else
Current := The_Array.Next;
end if;
......@@ -531,14 +545,15 @@ package body Prj.Util is
function Value_Of
(Name : Name_Id;
In_Arrays : Array_Id) return Array_Element_Id
In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Array_Element_Id
is
Current : Array_Id := In_Arrays;
The_Array : Array_Data;
begin
while Current /= No_Array loop
The_Array := Arrays.Table (Current);
The_Array := In_Tree.Arrays.Table (Current);
if The_Array.Name = Name then
return The_Array.Value;
......@@ -552,14 +567,15 @@ package body Prj.Util is
function Value_Of
(Name : Name_Id;
In_Packages : Package_Id) return Package_Id
In_Packages : Package_Id;
In_Tree : Project_Tree_Ref) return Package_Id
is
Current : Package_Id := In_Packages;
The_Package : Package_Element;
begin
while Current /= No_Package loop
The_Package := Packages.Table (Current);
The_Package := In_Tree.Packages.Table (Current);
exit when The_Package.Name /= No_Name
and then The_Package.Name = Name;
Current := The_Package.Next;
......@@ -570,14 +586,16 @@ package body Prj.Util is
function Value_Of
(Variable_Name : Name_Id;
In_Variables : Variable_Id) return Variable_Value
In_Variables : Variable_Id;
In_Tree : Project_Tree_Ref) return Variable_Value
is
Current : Variable_Id := In_Variables;
The_Variable : Variable;
begin
while Current /= No_Variable loop
The_Variable := Variable_Elements.Table (Current);
The_Variable :=
In_Tree.Variable_Elements.Table (Current);
if Variable_Name = The_Variable.Name then
return The_Variable.Value;
......
gcc/ada/prj-util.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -34,6 +34,7 @@ package Prj.Util is
function Executable_Of
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Main : Name_Id;
Index : Int;
Ada_Main : Boolean := True) return Name_Id;
......@@ -51,7 +52,8 @@ package Prj.Util is
function Value_Of
(Index : Name_Id;
In_Array : Array_Element_Id) return Name_Id;
In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref) return Name_Id;
-- Get a single string array component. Returns No_Name if there is no
-- component Index, if In_Array is null, or if the component is a String
-- list. Depending on the attribute (only attributes may be associative
......@@ -62,7 +64,8 @@ package Prj.Util is
function Value_Of
(Index : Name_Id;
Src_Index : Int := 0;
In_Array : Array_Element_Id) return Variable_Value;
In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref) return Variable_Value;
-- Get a string array component (single String or String list).
-- Returns Nil_Variable_Value if there is no component Index
-- or if In_Array is null.
......@@ -76,7 +79,8 @@ package Prj.Util is
(Name : Name_Id;
Index : Int := 0;
Attribute_Or_Array_Name : Name_Id;
In_Package : Package_Id) return Variable_Value;
In_Package : Package_Id;
In_Tree : Project_Tree_Ref) return Variable_Value;
-- In a specific package,
-- - if there exists an array Attribute_Or_Array_Name with an index
-- Name, returns the corresponding component (depending on the
......@@ -90,28 +94,32 @@ package Prj.Util is
function Value_Of
(Index : Name_Id;
In_Array : Name_Id;
In_Arrays : Array_Id) return Name_Id;
In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Name_Id;
-- Get a string array component in an array of an array list.
-- Returns No_Name if there is no component Index, if In_Arrays is null, if
-- In_Array is not found in In_Arrays or if the component is a String list.
function Value_Of
(Name : Name_Id;
In_Arrays : Array_Id) return Array_Element_Id;
In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Array_Element_Id;
-- Returns a specified array in an array list. Returns No_Array_Element
-- if In_Arrays is null or if Name is not the name of an array in
-- In_Arrays. The caller must ensure that Name is in lower case.
function Value_Of
(Name : Name_Id;
In_Packages : Package_Id) return Package_Id;
In_Packages : Package_Id;
In_Tree : Project_Tree_Ref) return Package_Id;
-- Returns a specified package in a package list. Returns No_Package
-- if In_Packages is null or if Name is not the name of a package in
-- Package_List. The caller must ensure that Name is in lower case.
function Value_Of
(Variable_Name : Name_Id;
In_Variables : Variable_Id) return Variable_Value;
In_Variables : Variable_Id;
In_Tree : Project_Tree_Ref) return Variable_Value;
-- Returns a specified variable in a variable list. Returns null if
-- In_Variables is null or if Variable_Name is not the name of a
-- variable in In_Variables. Caller must ensure that Name is lower case.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment